       IDENTIFICATION DIVISION.                                         
       PROGRAM-ID.    PCSWQ200.                                         
COB303 DATE-WRITTEN.  AUG 18, 2003                                      
       DATE-COMPILED.                                                   
                                                                        
      *****************************************************************         
      *                                                               *         
      *                SOUTH CAROLINA ELECTRIC & GAS                  *         
      *                                                               *         
      *  PROGRAM:  PCSWQ200                                           *         
      *                                                               *         
      *****************************************************************         
      *                 PROGRAM SUMMARY                               *         
      *                                                               *         
      ***         THIS IS A NON CRITICAL PROGRAM                    ***         
      *                                                               *         
      * THIS COBOL BATCH PROGRAM WILL REPLACE THE EXISTING            *         
      * CSR_CWQ100.SQR PROGRAM.  THIS COBOL PROGRAM WILL BE USED TO   *         
      * DELETE THE COMPLETED WQ ITEMS FROM CSS_WQ_ITEMS.              *         
      *                                                                         
      *****************************************************************         
      *                     PROGRAM MODIFICATION LOG                  *         
      *                                                               *         
      *    DATE    INITIALS   COMMENTS                                *         
      *  --------  --------   -------------------------------------   *         
      **  08/18/03 VM91214    INITIAL PROGRAM VERSION                **         
      **                                                             **         
A05460**  8 SEP 2016 RF10596  FIX WORK-Q CURSOR                      **         
A05460** 17 OCT 2016 SM93554  FETCH WAS FAILING DUE TO NULL IN       **         
      **             ACT307   COMPLETE DATE WHICH HAS FXIED NOW.                
      *****************************************************************         
      *                                                               *         
      *                ---- BASIC SEQUENCE STRUCTURE ----             *         
      *                                                               *         
      *  0000 - 0999  MAIN CONTROL PATH AND INITIALIZATION            *         
      *  1000 - 1999  INPUT PROCESSING CONTROL PATH                   *         
      *  2000 - 2999  OUTPUT PROCESSING CONTROL PATH                  *         
      *  3000 - 4999  NOT USED                                        *         
      *  5000 - 5999  COMMON PROGRAM MODULES                          *         
      *  6000 - 6999  COMMON SYSTEM MODULES                           *         
      *  7000 - 7999  INPUT MODULES                                   *         
      *  8000 - 8999  OUTPUT MODULES                                  *         
      *  9000 - 9999  TERMINATION,ABEND, MESSAGING MODULES            *         
      *                                                               *         
      *****************************************************************         
       ENVIRONMENT DIVISION.                                            
      *                                                                         
       DATA DIVISION.                                                   
      *                                                                         
       WORKING-STORAGE SECTION.                                         

MSQ017 01 MFA-PROGRAM-ID PIC X(8) VALUE 'PCSWQ200'.
MSQ017     COPY MFASQLM.
                                                                        
       01  WS-START                      PIC X(40)                      
           VALUE 'WORKING STORAGE FOR PCSWQ200 STARTS HERE'.            
                                                                        
      * WORK AREAS                                                    *         
      *****************************************************************         
                                                                        
       01  PROGRAM-NAME                  PIC X(08) VALUE 'PCSWQ200'.    
       01  WS-FETCH-VARIABLES.                                          
COB305     05 WS-ITEM-ID        PIC S9(10)V COMP-3 VALUE 0.            
           05 WS-CATEGORY-ID             PIC S9(04) COMP VALUE +0.      
           05 WS-COMPLETE-DATE           PIC X(26) VALUE SPACES.        
           05 WS-LAST-UPDATE-TS          PIC X(26) VALUE SPACES.        
       01  WS-RETENTION-DAYS             PIC S9(09) COMP VALUE +0.      
       01  WS-RETENTION-DATE             PIC X(26) VALUE SPACES.        
       01  WS-CURR-TIMESTAMP             PIC X(26) VALUE SPACES.        
ACT307 01  WS-COMPLETE-DATE-NULL         PIC S9(04) COMP VALUE +0.      
       01  RS-RETURN-CODE                PIC S9(09) COMP VALUE +0.      
       01  RS-RETURN-CODE-DISP           PIC S9(09) COMP VALUE +0.      
       01  WS-COUNTERS.                                                 
           05 WS-READ-CNTR               PIC  9(09) VALUE 0.            
           05 WS-DEL-CNTR                PIC  9(09) VALUE 0.            
           05 WS-COMMIT-CNTR             PIC  9(03) VALUE 0.            
                                                                        
       01  WS-MF-CSR-FLAG                PIC X(01).                     
           88  END-OF-WQ-CURSOR                     VALUE 'Y'.          
           88  NOT-END-OF-WQ-CURSOR                 VALUE 'N'.          
                                                                        
       01  WS-JOB-PARM-DATA-SPLIT.                                      
           05  WS-PARM-DATA-TEXT         PIC X(28) VALUE SPACES.        
           05  WS-PARM-DATA-NUM          PIC 9(03) VALUE ZEROES.        
           05  FILLER                    PIC X(49) VALUE SPACES.        
       01  WS-LITERALS-SWITCHES.                                        
           05  WS-PGRMNAME               PIC X(08) VALUE 'PCSWQ200'.    
      *                                                                         
       COPY FIOJC01.                                                            
      *                                                                         
      *****************************************************************         
      **         WS AREA FOR DB2 AND CICS ERROR PROCESSING           **         
      *****************************************************************         
      *                                                                         
       COPY CWS00303.                                                           
      *                                                                         
      *****************************************************************         
      **           WS AREA FOR THE ABEND SWITCH                      **         
      *****************************************************************         
      *                                                                         
       COPY CWS09900.                                                   00010001
       COPY CWS00010.                                                           
       COPY CWS00023.                                                           
      *****************************************************************         
      **   WS FOR PROCESSING JOB_PARM                                **         
      *****************************************************************         
                                                                        
       COPY CWS00038.                                                           
                                                                        
      *                                                                         
       01  WS-END                        PIC X(40)                      
           VALUE 'WORKING STORAGE FOR PCSWQ200 ENDS HERE  '.            
                                                                        
      *****************************************************************         
      * DB2 INCLUDES                                                  *         
      *****************************************************************         
                                                                        
           EXEC SQL                                                             
              INCLUDE SQLCA                                                     
           END-EXEC.                                                            
                                                                        
           EXEC SQL                                                             
              INCLUDE TBMODEL                                                   
           END-EXEC.                                                            
                                                                        
           EXEC SQL                                                             
              INCLUDE TBJBPARM                                                  
           END-EXEC.                                                            
                                                                        
                                                                        
      ******************************************************************        
      **   DB2 CURSOR DECLARATIONS                                    **        
      ******************************************************************        
                                                                        
           EXEC SQL                                                     
              DECLARE WORK-Q CURSOR WITH HOLD FOR                       
              SELECT ITEM_ID                                            
                    ,CATEGORY_ID                                        
                    ,REPLACE(REPLACE(CONVERT(CHAR(26), COMPLETE_DATE
           , 121), ' ', '-'), ':', '.') COMPLETE_DATE                          
ACT307              ,REPLACE(REPLACE(CONVERT(CHAR(26), LAST_UPDATE_TS
           , 121), ' ', '-'), ':', '.') LAST_UPDATE_TS                         
ACT307          FROM CSS_WQ_ITEMS                                       
ACT307         WHERE STATUS IN ('C','D')                                
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ061
MFA-TR*    EXEC SQL                                                             
MFA-TR*       DECLARE WORK-Q CURSOR WITH HOLD FOR                               
MFA-TR*       SELECT ITEM_ID                                                    
MFA-TR*             ,CATEGORY_ID                                                
MFA-TR*             ,COMPLETE_DATE                                              
MFA-TR*             ,LAST_UPDATE_TS                                             
MFA-TR*         FROM CSS_WQ_ITEMS                                               
MFA-TR*        WHERE STATUS IN ('C','D')                                        
MFA-TR*    END-EXEC.                                                            
                                                                        
       PROCEDURE DIVISION.                                              
      ******************************************************************        
      **                                                              **        
      **    0000-MAINLINE                                             **        
      **                                                              **        
      **    CONTROLS THE MAIN PATH OF THE PROGRAM                     **        
      **                                                              **        
      ******************************************************************        
       0000-MAINLINE.                                                   
                                                                        
           PERFORM 1000-INITIALIZATION   THRU 1000-EXIT.                
           PERFORM 2000-PROCESS-PARA     THRU 2000-EXIT.                
           PERFORM 9100-END-PROCESS      THRU 9100-EXIT.                
           STOP RUN.                                                    
       0000-EXIT.                                                       
           EXIT.                                                        
                                                                        
      ******************************************************************        
      **    1000-INITIALIZATION                                       **        
      **    CALLED FROM 0000-MAINLINE                                 **        
      **    PROGRAM EXECUTION BEGINS HERE. GETS THE COMMIT COUNT      **        
      **    FROM JOB PARM TABLE                                       **        
      ******************************************************************        
                                                                        
       1000-INITIALIZATION.                                             
      *                                                                         
           DISPLAY 'PROGRAM EXECUTION STARTED'.                         
           MOVE SPACES                   TO    WS-SYSIPT.               
           MOVE WS-PGRMNAME              TO    WS-PROGRAM.              
           MOVE WS-PARM                  TO    WS-COMMAND.              
           MOVE +1                       TO    WS-SEQUENCE.             
                                                                        
           PERFORM 7600-START-FCSJC01    THRU  7600-EXIT.               
                                                                        
           PERFORM 7610-READ-FCSJC01     THRU  7610-EXIT                
              UNTIL (WS-INPUT-DATA-BREAKDOWN(1:28) =                    
                   'NO OF RECORDS FOR COMMIT IS ' AND INPUT-ACTIVE)     
                  OR  END-OF-SYSIPT.                                    
                                                                        
           MOVE G6-PARM-DATA             TO WS-JOB-PARM-DATA-SPLIT.     
                                                                        
           IF END-OF-SYSIPT OR WS-PARM-DATA-NUM  NOT NUMERIC            
              DISPLAY '** PCSWQ200 PROCESSING ERROR        **'          
              DISPLAY '** COMMIT COUNT IS NOT AVAILABLE    **'          
              DISPLAY '** PROCESSING TERMINATED            **'          
              PERFORM 7611-CLOSE         THRU  7611-EXIT                
              PERFORM 9900-ABEND         THRU  9900-EXIT                
           END-IF.                                                      
                                                                        
           DISPLAY 'NO. OF RECORDS FOR COMMIT FROM JOB PARM TABLE = '   
                                           WS-PARM-DATA-NUM.            
                                                                        
           PERFORM 7000-SELECT-CURR-TIMESTAMP                           
                                         THRU 7000-EXIT.                
           DISPLAY 'START DATE & TIME      : ' WS-CURR-TIMESTAMP.       
      *                                                                         
       1000-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ******************************************************************        
      **    2000-PROCESS-PARA                                         **        
      **    CALLED FROM 0000-MAINLINE                                 **        
      ******************************************************************        
       2000-PROCESS-PARA.                                               
      *                                                                         
           PERFORM 7100-OPEN-WORK-Q      THRU 7100-EXIT.                
           SET NOT-END-OF-WQ-CURSOR      TO TRUE.                       
           PERFORM 7200-FETCH-WORK-Q     THRU 7200-EXIT.                
           PERFORM UNTIL END-OF-WQ-CURSOR                               
              PERFORM 7400-SELECT-RETENTION-DAYS                        
                                         THRU 7400-EXIT                 
              IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL                
                 PERFORM 2100-SUB-PROCESS-PARA                          
                                         THRU 2100-EXIT                 
              END-IF                                                    
              PERFORM 7200-FETCH-WORK-Q  THRU 7200-EXIT                 
           END-PERFORM                                                  
              PERFORM 7300-CLOSE-WORK-Q  THRU 7300-EXIT.                
      *                                                                         
       2000-EXIT.                                                       
           EXIT.                                                        
                                                                        
      ******************************************************************        
      * 2100-SUB-PROCESS-PARA.  CALLED FROM 2000-PROCESS PARA.                  
      * CALCULATES THE RETENTION DATE AND COMPARES WITH CURRENT                 
      * TIMESTAMP.                                                              
      * COMMITS THE TRANSACTION AFTER SUCCESSFUL DELETETION OF                  
      * 'X' RECORDS. 'X' IS PASSED FROM JOB PARM TABLE                          
      ******************************************************************        
       2100-SUB-PROCESS-PARA.                                           
      *                                                                         
                                                                        
           EXEC SQL                                                     
               SELECT
              REPLACE(REPLACE(CONVERT(CHAR(26), DATEADD( DAY, 
                                                   :WS-RETENTION-DAYS, 
           CIS.CHAR2TIMESTAMP (:WS-COMPLETE-DATE) ), 121), ' ', '-'), 
           ':', '.')
            INTO
              :WS-RETENTION-DATE       
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ006
MFA-TR* MSQ029
MFA-TR* MSQ044
MFA-TR* MSQ061
MFA-TR*    EXEC SQL                                                             
MFA-TR*        SET :WS-RETENTION-DATE =                                         
MFA-TR*                       TIMESTAMP (:WS-COMPLETE-DATE) +                   
MFA-TR*                                 (:WS-RETENTION-DAYS DAYS)               
MFA-TR*    END-EXEC.                                                            

MSQ017     CALL "MFASQLCA"
MSQ017       USING SQLCA, BY VALUE MFA-PROGRAM-ID, "0", "0", "0",
MSQ017       BY REFERENCE MFSQLMESSAGETEXT
MSQ017     END-CALL

                                                                        
           IF WS-RETENTION-DATE <= WS-CURR-TIMESTAMP                    
              PERFORM 8000-DELETE-WORK-Q                                
                                         THRU 8000-EXIT                 
              IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL                
                 ADD 1                   TO WS-DEL-CNTR                 
                                            WS-COMMIT-CNTR              
                 IF WS-COMMIT-CNTR = WS-PARM-DATA-NUM                   
                    EXEC SQL                                            
                        COMMIT                                          
                    END-EXEC                                            

MSQ017     CALL "MFASQLCA"
MSQ017       USING SQLCA, BY VALUE MFA-PROGRAM-ID, "0", "0", "0",
MSQ017       BY REFERENCE MFSQLMESSAGETEXT
MSQ017     END-CALL

                    MOVE ZEROES          TO WS-COMMIT-CNTR              
                 END-IF                                                 
              END-IF                                                    
           END-IF.                                                      
      *                                                                         
       2100-EXIT.                                                       
           EXIT.                                                        
                                                                        
      *****************************************************************         
      **   7000-SELECT-CURR-TIMESTAMP                                **         
      **   RETRIEVES CURRENT TIMESTAMP FROM CSS_MODEL_SQL            **         
      *****************************************************************         
                                                                        
       7000-SELECT-CURR-TIMESTAMP.                                      
      *                                                                         
           EXEC SQL                                                     
               SELECT                                                   
                   REPLACE(REPLACE(CONVERT(CHAR(26), 
           CIS.CURRENT$TIMESTAMP(), 121), ' ', '-'), ':', '.')                 
               INTO                                                     
                   :WS-CURR-TIMESTAMP                                   
               FROM                                                     
                   CSS_MODEL_SQL                                        
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ028
MFA-TR* MSQ061
MFA-TR*    EXEC SQL                                                             
MFA-TR*        SELECT                                                           
MFA-TR*            CURRENT TIMESTAMP                                            
MFA-TR*        INTO                                                             
MFA-TR*            :WS-CURR-TIMESTAMP                                           
MFA-TR*        FROM                                                             
MFA-TR*            CSS_MODEL_SQL                                                
MFA-TR*    END-EXEC.                                                            

MSQ017     CALL "MFASQLCA"
MSQ017       USING SQLCA, BY VALUE MFA-PROGRAM-ID, "0", "0", "0",
MSQ017       BY REFERENCE MFSQLMESSAGETEXT
MSQ017     END-CALL

                                                                        
           MOVE SQLCODE                  TO WS-ACTIVE-RETURN-CODE       
                                            RS-RETURN-CODE.             
           IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL                   
              NEXT SENTENCE                                             
           ELSE                                                         
              DISPLAY '************************************************'
              DISPLAY '****             ERROR OCCURED IN           ****'
              DISPLAY '7000-SELECT-CURR-TIMESTAMP   RETURN CODE = '     
                                              RS-RETURN-CODE            
              DISPLAY '************************************************'
              PERFORM 9900-ABEND         THRU 9900-EXIT                 
           END-IF.                                                      
      *                                                                         
       7000-EXIT.                                                       
           EXIT.                                                        
                                                                        
      ******************************************************************05050000
      * 7100-OPEN-WORK-Q. OPENS THE CURSOR WORK-Q                      *05060003
      ******************************************************************05071000
       7100-OPEN-WORK-Q.                                                
      *                                                                         
           EXEC SQL                                                     
                OPEN WORK-Q                                             
           END-EXEC.                                                    

MSQ017     CALL "MFASQLCA"
MSQ017       USING SQLCA, BY VALUE MFA-PROGRAM-ID, "0", "0", "0",
MSQ017       BY REFERENCE MFSQLMESSAGETEXT
MSQ017     END-CALL

                                                                        
           MOVE SQLCODE                  TO WS-ACTIVE-RETURN-CODE       
                                            RS-RETURN-CODE.             
           IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL                   
              NEXT SENTENCE                                             
           ELSE                                                         
              DISPLAY '************************************************'
              DISPLAY '****             ERROR OCCURED IN           ****'
              DISPLAY '7100-OPEN-WORK-Q RETURN CODE = '                 
                                              RS-RETURN-CODE            
              DISPLAY '************************************************'
              PERFORM 9900-ABEND         THRU 9900-EXIT                 
           END-IF.                                                      
      *                                                                         
       7100-EXIT.                                                       
           EXIT.                                                        
                                                                        
      ******************************************************************        
      * 7200-FETCH-WORK-Q  - FETCHES THE ITEMS FROM CURSOR WORK-Q      *        
      ******************************************************************        
       7200-FETCH-WORK-Q.                                               
      *                                                                         
           INITIALIZE WS-ITEM-ID                                        
                      WS-CATEGORY-ID                                    
                      WS-COMPLETE-DATE                                  
ACT307                WS-LAST-UPDATE-TS.                                
           EXEC SQL                                                     
              FETCH WORK-Q                                              
              INTO                                                      
                  :WS-ITEM-ID                                           
                 ,:WS-CATEGORY-ID                                       
ACT307           ,:WS-COMPLETE-DATE :WS-COMPLETE-DATE-NULL              
                 ,:WS-LAST-UPDATE-TS                                    
           END-EXEC.                                                    

MSQ017     CALL "MFASQLCA"
MSQ017       USING SQLCA, BY VALUE MFA-PROGRAM-ID, "0", "0", "0",
MSQ017       BY REFERENCE MFSQLMESSAGETEXT
MSQ017     END-CALL

                                                                        
           MOVE SQLCODE                  TO WS-ACTIVE-RETURN-CODE       
                                            RS-RETURN-CODE.             
           IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL                   
              ADD 1                      TO WS-READ-CNTR                
ACT307        IF WS-COMPLETE-DATE-NULL LESS THAN ZERO                   
ACT307           MOVE WS-LAST-UPDATE-TS  TO  WS-COMPLETE-DATE           
ACT307        END-IF                                                    
           ELSE IF WS-ACTIVE-RETURN-CODE = NOT-FOUND                    
ACT307             SET END-OF-WQ-CURSOR  TO TRUE                        
           ELSE                                                         
              DISPLAY '************************************************'
              DISPLAY '****         ERROR OCCURED IN              *****'
              DISPLAY '7200-FETCH-WORK-Q RETURN CODE = '                
                                              RS-RETURN-CODE            
              DISPLAY 'ITEM ID     = ' WS-ITEM-ID                       
              DISPLAY 'CATEGORY ID = ' WS-CATEGORY-ID                   
              DISPLAY 'COMPLETE DT = ' WS-COMPLETE-DATE                 
              DISPLAY '************************************************'
              PERFORM 9900-ABEND         THRU 9900-EXIT                 
           END-IF
           END-IF.                                                      
      *                                                                         
       7200-EXIT.                                                       
           EXIT.                                                        
                                                                        
      ******************************************************************        
      * 7300-CLOSE-WORK-Q  CLOSES THE CURSOR WORK-Q                    *        
      ******************************************************************        
       7300-CLOSE-WORK-Q.                                               
      *                                                                         
           EXEC SQL                                                     
              CLOSE WORK-Q                                              
           END-EXEC.                                                    

MSQ017     CALL "MFASQLCA"
MSQ017       USING SQLCA, BY VALUE MFA-PROGRAM-ID, "0", "0", "0",
MSQ017       BY REFERENCE MFSQLMESSAGETEXT
MSQ017     END-CALL

                                                                        
           MOVE SQLCODE                  TO WS-ACTIVE-RETURN-CODE       
                                            RS-RETURN-CODE.             
           IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL                   
              NEXT SENTENCE                                             
           ELSE                                                         
              DISPLAY '************************************************'
              DISPLAY '****        ERROR OCCURED IN                ****'
              DISPLAY '7300-CLOSE-WORK-Q RETURN CODE = '                
                                              RS-RETURN-CODE            
              DISPLAY '************************************************'
              PERFORM 9900-ABEND         THRU 9900-EXIT                 
           END-IF.                                                      
      *                                                                         
       7300-EXIT.                                                       
           EXIT.                                                        
                                                                        
      ******************************************************************        
      * 7400-SELECT-RETENTION-DAYS. SELECTS RETENTION DAYS                      
      ******************************************************************        
       7400-SELECT-RETENTION-DAYS.                                      
      *                                                                         
           INITIALIZE WS-RETENTION-DAYS.                                
                                                                        
           EXEC SQL                                                     
              SELECT                                                    
                  WQ_RETENTION_DAYS                                     
              INTO                                                      
                  :WS-RETENTION-DAYS                                    
              FROM                                                      
                   CSS_WQ_CATEGORY                                      
              WHERE                                                     
                   CATEGORY_ID = :WS-CATEGORY-ID                        
           END-EXEC.                                                    

MSQ017     CALL "MFASQLCA"
MSQ017       USING SQLCA, BY VALUE MFA-PROGRAM-ID, "0", "0", "0",
MSQ017       BY REFERENCE MFSQLMESSAGETEXT
MSQ017     END-CALL

                                                                        
           MOVE SQLCODE                  TO WS-ACTIVE-RETURN-CODE       
                                            RS-RETURN-CODE.             
           IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL OR NOT-FOUND      
              NEXT SENTENCE                                             
           ELSE                                                         
              DISPLAY '************************************************'
              DISPLAY '****        ERROR OCCURED IN                ****'
              DISPLAY '7400-SELECT-RETENTION-DAYS  RETURN CODE = '      
                                              RS-RETURN-CODE            
              DISPLAY 'CATEGORY ID = ' WS-CATEGORY-ID                   
              DISPLAY '************************************************'
              PERFORM 9900-ABEND         THRU 9900-EXIT                 
           END-IF.                                                      
      *                                                                         
       7400-EXIT.                                                       
           EXIT.                                                        
                                                                        
      *****************************************************************         
      * 7600- READ THE CSS_JOB_PARM DATABASE TABLE.                  **         
      *****************************************************************         
                                                                        
           EXEC SQL                                                             
              INCLUDE CPD00038                                                  
           END-EXEC.                                                            
                                                                        
      ******************************************************************        
      * 8000-DELETE-WORK-Q                                                      
      *      DELETE THE LAST ITEM FETCHED FROM THE CURSOR.                      
      ******************************************************************        
       8000-DELETE-WORK-Q.                                              
      *                                                                         
           EXEC SQL                                                     
               DELETE                                                   
               FROM                                                     
                  CSS_WQ_ITEMS                                          
               WHERE                                                    
                  ITEM_ID = :WS-ITEM-ID                                 
           END-EXEC.                                                    

MSQ017     CALL "MFASQLCA"
MSQ017       USING SQLCA, BY VALUE MFA-PROGRAM-ID, "0", "0", "0",
MSQ017       BY REFERENCE MFSQLMESSAGETEXT
MSQ017     END-CALL

                                                                        
           MOVE SQLCODE                  TO WS-ACTIVE-RETURN-CODE       
                                            RS-RETURN-CODE.             
           IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL OR NOT-FOUND      
              NEXT SENTENCE                                             
           ELSE                                                         
              DISPLAY '************************************************'
              DISPLAY '****        ERROR OCCURED IN                ****'
              DISPLAY '8000-DELETE-WORK-Q RETURN CODE = '               
                                              RS-RETURN-CODE            
              DISPLAY 'ITEM ID = ' WS-ITEM-ID                           
              DISPLAY '************************************************'
              PERFORM 9900-ABEND         THRU 9900-EXIT                 
           END-IF.                                                      
                                                                        
      *                                                                         
       8000-EXIT.                                                       
           EXIT.                                                        
                                                                        
      ****************************************************************          
      **   9000-TERMINATE                                                       
      ***** TERMINATES THE PROGRAM IN CASE OF ABENDS     *****                  
      ****************************************************************          
       9000-TERMINATE.                                                  
      *                                                                         
           DISPLAY 'NUMBER OF ROWS READ    : ' WS-READ-CNTR.            
           DISPLAY 'NUMBER OF ROWS DELETED : ' WS-DEL-CNTR.             
           DISPLAY 'PROGRAM ABENDED'.                                   
      *                                                                         
       9000-EXIT.                                                       
           EXIT.                                                        
      ****************************************************************          
      **   9100-END-PROCESS                                         **          
      *****   PERFORMS BEFORE SUCCESSFUL COMPLETION                ***          
      ****************************************************************          
       9100-END-PROCESS.                                                
      *                                                                         
           DISPLAY 'NUMBER OF ROWS READ    : ' WS-READ-CNTR.            
           DISPLAY 'NUMBER OF ROWS DELETED : ' WS-DEL-CNTR.             
           PERFORM 7000-SELECT-CURR-TIMESTAMP.                          
           DISPLAY 'END DATE & TIME        : ' WS-CURR-TIMESTAMP.       
           DISPLAY 'PROGRAM ENDED SUCCESSFULLY'.                        
      *                                                                         
       9100-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ****************************************************************  08140000
      **    THIS INCLUDES THE DB2 SQL SYSTEM ABEND MODULE           **  08150000
      ****************************************************************  08160000
      *                                                                         
           EXEC SQL                                                     08171000
               INCLUDE CPD09900                                         08180001
           END-EXEC.                                                    08190000
      ****************************************************************  08140000
      **    THIS INCLUDES THE DB2 SQL SYSTEM ABEND MODULE           **  08150000
      ****************************************************************  08160000
      *                                                                         
           EXEC SQL                                                     08171000
               INCLUDE CPD0023B                                         08180001
           END-EXEC.                                                    08190000
                                                                        
