Handling SQL error codes

Signed-off-by: Janos Varga <[email protected]>

Author: vargajb

COBOL Programming Course #3 - Advanced Topics/Labs/cbl/CBLDB23.cbl

@@ -50,6 +50,17 @@
       * SQL INCLUDE FOR SQLCA                             *             
       *****************************************************             
                 EXEC SQL INCLUDE SQLCA  END-EXEC.                       
+      *****************************************************
+      * DECLARATIONS FOR SQL ERROR HANDLING               *
+      *****************************************************
+       01 ERROR-MESSAGE.
+           02 ERROR-LEN      PIC S9(4)  COMP VALUE +1320.
+           02 ERROR-TEXT     PIC X(132) OCCURS 10 TIMES
+                                        INDEXED BY ERROR-INDEX.
+       77 ERROR-TEXT-LEN     PIC S9(9)  COMP VALUE +132.
+       77 ERROR-TEXT-HBOUND  PIC S9(9)  COMP VALUE +10.
+      * USER DEFINED ERROR MESSAGE
+       01 UD-ERROR-MESSAGE   PIC X(80)  VALUE SPACES.
       *****************************************************             
       * SQL DECLARATION FOR VIEW ACCOUNTS                 *             
       *****************************************************             
@@ -113,19 +124,45 @@
                    AT END SET NOMORE-INPUT TO TRUE.
        GET-ALL.                                                         
                 EXEC SQL OPEN CUR1  END-EXEC.                           
+                IF SQLCODE NOT = 0 THEN
+                   MOVE 'OPEN CUR1' TO UD-ERROR-MESSAGE
+                   PERFORM SQL-ERROR-HANDLING
+                END-IF
                 EXEC SQL FETCH CUR1  INTO :CUSTOMER-RECORD END-EXEC.    
-                   PERFORM PRINT-ALL                                    
+                PERFORM PRINT-ALL                                    
                      UNTIL SQLCODE IS NOT EQUAL TO ZERO.                
+                IF SQLCODE NOT = 100 THEN
+                   MOVE 'FETCH CUR1' TO UD-ERROR-MESSAGE
+                   PERFORM SQL-ERROR-HANDLING
+                END-IF
                 EXEC SQL CLOSE CUR1  END-EXEC.                          
+                IF SQLCODE NOT = 0 THEN
+                   MOVE 'CLOSE CUR1' TO UD-ERROR-MESSAGE
+                   PERFORM SQL-ERROR-HANDLING
+                END-IF
+                .
        PRINT-ALL.                                                       
                 PERFORM PRINT-A-LINE.                                   
                 EXEC SQL FETCH CUR1  INTO :CUSTOMER-RECORD END-EXEC.    
        GET-SPECIFIC.                                                    
                 EXEC SQL OPEN  CUR2  END-EXEC.                          
+                IF SQLCODE NOT = 0 THEN
+                   MOVE 'OPEN CUR2' TO UD-ERROR-MESSAGE
+                   PERFORM SQL-ERROR-HANDLING
+                END-IF
                 EXEC SQL FETCH CUR2  INTO :CUSTOMER-RECORD END-EXEC.    
-                   PERFORM PRINT-SPECIFIC                               
+                PERFORM PRINT-SPECIFIC                               
                      UNTIL SQLCODE IS NOT EQUAL TO ZERO.                
+                IF SQLCODE NOT = 100 THEN
+                   MOVE 'FETCH CUR2' TO UD-ERROR-MESSAGE
+                   PERFORM SQL-ERROR-HANDLING
+                END-IF
                 EXEC SQL CLOSE CUR2  END-EXEC.                          
+                IF SQLCODE NOT = 0 THEN
+                   MOVE 'CLOSE CUR2' TO UD-ERROR-MESSAGE
+                   PERFORM SQL-ERROR-HANDLING
+                END-IF
+                .
        PRINT-SPECIFIC.                                                  
                 PERFORM PRINT-A-LINE.                                   
                 EXEC SQL FETCH CUR2  INTO :CUSTOMER-RECORD END-EXEC.    
@@ -135,3 +172,17 @@
                 MOVE  ACCT-FIRSTN  TO  ACCT-FIRSTN-O.                   
                 MOVE  ACCT-ADDR3   TO  ACCT-ADDR3-O.                    
                 WRITE REPREC AFTER ADVANCING 2 LINES.                   
+
+       SQL-ERROR-HANDLING.
+           DISPLAY 'ERROR AT ' FUNCTION TRIM(UD-ERROR-MESSAGE, TRAILING)
+           CALL 'DSNTIAR' USING SQLCA ERROR-MESSAGE ERROR-TEXT-LEN.
+           PERFORM VARYING ERROR-INDEX FROM 1 BY 1
+                     UNTIL ERROR-INDEX > ERROR-TEXT-HBOUND
+                        OR ERROR-TEXT(ERROR-INDEX) = SPACES
+              DISPLAY FUNCTION TRIM(ERROR-TEXT(ERROR-INDEX), TRAILING)
+           END-PERFORM
+           IF SQLCODE NOT = 0 AND SQLCODE NOT = 100
+              MOVE 1000 TO RETURN-CODE
+              STOP RUN
+           END-IF
+           .