Handling SQL error codes

Signed-off-by: Janos Varga <113785741+vargajb@users.noreply.github.com>

Author: vargajb

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

@@ -53,6 +53,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                 *             
       *****************************************************             
@@ -120,21 +131,47 @@
       *                                                                 
        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.                                   
@@ -148,3 +185,17 @@
                 MOVE  ACCT-FIRSTN  TO  ACCT-FIRSTN-O.                   
                 MOVE  ACCT-COMMENT TO  ACCT-COMMENT-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
+           .