       IDENTIFICATION DIVISION.                                         
       PROGRAM-ID.       CSR03792.                                      
COB303 DATE-WRITTEN.     JULY 01, 2014.                                 
       DATE-COMPILED.                                                   
                                                                        
      *----------------------------------------------------------------         
      *--                  SOUTH CAROLINA ELECTRIC & GAS             --         
      *----------------------------------------------------------------         
      *--                   STORED PROCEDURE:  CSR03792              --         
      *----------------------------------------------------------------         
      *--                         S U M M A R Y                      --         
      *--                                                            --         
      *--  CSR03792 :                                                --         
      *--                                                            --         
      *--  UPDATES AGENCY INFORMATION IN CSS_LIEAP_AGENCY TABLE AND  --         
      *--  FOR EACH UPDATE INSERT THE WQ MESSAGES IN CSS_WQ_ITEMS.   --         
      *--  THIS SPCB IS CONVERTED FROM SPDB CSR03792.                --         
      *----------------------------------------------------------------         
      *--                                                            --         
      *--  PARAMETERS                                                --         
      *--                                                            --         
      *--      INPUT                                                 --         
      *--             I_COMPANY_NO          CHAR(02)                 --         
      *--             I_CODE_AGENCY_ID      CHAR(05)                 --         
      *--             I_LAST_UPD_USERID     CHAR(07)                 --         
      *--             I_AGY_CONTCT_EMAIL    CHAR(100)                --         
      *--             I_AGY_CONTCT_NM       CHAR(50)                 --         
      *--             I_AGY_CONTCT_PHONE    CHAR(10)                 --         
      *--             I_AGY_EMAIL_FRQ_CD    CHAR(10)                 --         
      *--                                                            --         
      *--      OUT                                                   --         
      *--            NONE                                            --         
      *--                                                            --         
      *--      INOUT                                                 --         
      *--                                                            --         
      *--            NONE                                            --         
      *--                                                            --         
      *--  RESULT SET                                                --         
      *--                                                            --         
      *--  CSR03792_R1                                               --         
      *--                                                            --         
      *--           RETURN_CODE             INTEGER                  --         
      *--                                                            --         
      *----------------------------------------------------------------         
      *--                        MODIFICATION LOG                    --         
      *--                                                            --         
      *--  DATE          INITIALS    COMMENTS                        --         
      *--  -----------   --------    ----------------------------------         
      *--  07/01/2014    MR7E794     INITIAL CODE                    --         
      *----------------------------------------------------------------         
                                                                        
       ENVIRONMENT DIVISION.                                            
       DATA DIVISION.                                                   
       WORKING-STORAGE SECTION.                                         

MSQ002  01 MFA-CSRERLOG.
MSQ002    05 ARG-5 PIC X(255).
MSQ002    05 ARG-6 PIC X(255).
MSQ002    05 ARG-7 PIC X(447).

MSQ017 01 MFA-PROGRAM-ID PIC X(8) VALUE 'CSR03792'.
MSQ017     COPY MFASQLM.
      *                                                                         
       01 WS-START                         PIC X(40) VALUE              
            'WORKING STORAGE FOR CSR03792 STARTS HERE'.                 
      *                                                                         
      ******************************************************************        
      *    WORK AREAS                                                  *        
      ******************************************************************        
                                                                        
       01  WS-MISC-FIELDS.                                              
           05  PROGRAM-NAME                PIC X(8) VALUE 'CSR03792'.   
           05  MCSCB077                    PIC X(8) VALUE 'MCSCB077'.   
           05  WS-MCSCB077-RET-CODE        PIC S9(04) COMP VALUE 0.     
           05  WS-CURRENT-TIMESTAMP        PIC X(26) VALUE SPACES.      
           05  WS-CURRENT-DATE             PIC X(10).                   
           05  WS-DATABASE                 PIC 9(01) VALUE ZERO.        
               88  CSR-DATABASE                  VALUE 1.               
               88  SEB-DATABASE                  VALUE 2.               
                                                                        
       01  WS-WQ-COMMENTS.                                              
           05 WS-WQ-CODE-LEFTB             PIC X(1) VALUE '('.          
           05 WS-WQ-CODE-AGENCY-ID         PIC X(5) VALUE SPACES.       
           05 WS-WQ-CODE-RIGHTB            PIC X(1) VALUE ')'.          
           05 WS-WQ-CODE-SPACES            PIC X(1) VALUE SPACES.       
           05 WS-WQ-COMM-TXT               PIC X(26) VALUE              
               'AGENCY INFORMATION UPDATED'.                            
                                                                        
      ******************************************************************        
      *    RESULT SET FIELDS                                           *        
      ******************************************************************        
                                                                        
       01  GTT-RETURN-FIELDS.                                           
           05  S-RETURN-CODE-1             PIC S9(9) COMP VALUE 0.      
                                                                        
      ******************************************************************        
      *    FOR MCSCB077                                                *        
      ******************************************************************        
                                                                        
           EXEC SQL                                                             
              INCLUDE CWS00077                                                  
           END-EXEC.                                                            
                                                                        
      ******************************************************************        
      *    DB2 INCLUDES                                                *        
      ******************************************************************        
           EXEC SQL                                                             
              INCLUDE SQLCA                                                     
           END-EXEC.                                                            
                                                                        
      ******************************************************************        
      *    C8 - CSS_DELINQUENCY                                        *        
      ******************************************************************        
           EXEC SQL                                                             
              INCLUDE TBDELQ                                                    
           END-EXEC.                                                            
                                                                        
      ******************************************************************        
      *    I5 - CSS_LIEAP_AGENCY                                       *        
      ******************************************************************        
           EXEC SQL                                                             
              INCLUDE TBLIAGCY                                                  
           END-EXEC.                                                            
                                                                        
      ******************************************************************        
      *    ERROR HANDLING                                                       
      ******************************************************************        
           EXEC SQL                                                             
               INCLUDE CWSX0010                                                 
           END-EXEC.                                                            
                                                                        
      ******************************************************************        
      *    SUPPORTS DB2 AND SQL ERROR CHECKING                         *        
      ******************************************************************        
           COPY CWS00303.                                                       
                                                                        
      ******************************************************************        
       LINKAGE SECTION.                                                 
       01 PARM-COMPANY-NO                  PIC X(2) VALUE SPACES.       
       01 PARM-CODE-AGENCY-ID              PIC X(5) VALUE SPACES.       
       01 PARM-LAST-UPD-USERID             PIC X(7) VALUE SPACES.       
       01 PARM-AGY-CONTCT-EMAIL            PIC X(100) VALUE SPACES.     
       01 PARM-AGY-CONTCT-NM               PIC X(50) VALUE SPACES.      
       01 PARM-AGY-CONTCT-PHONE            PIC X(10) VALUE SPACES.      
       01 PARM-AGY-EMAIL-FRQ_CD            PIC X(10) VALUE SPACES.      
                                                                        
       PROCEDURE DIVISION USING PARM-COMPANY-NO,                        
                                PARM-CODE-AGENCY-ID,                    
                                PARM-LAST-UPD-USERID,                   
                                PARM-AGY-CONTCT-EMAIL,                  
                                PARM-AGY-CONTCT-NM,                     
                                PARM-AGY-CONTCT-PHONE,                  
                                PARM-AGY-EMAIL-FRQ_CD.                  
      *                                                                         
      ******************************************************************        
      * 0000-MAINLINE                                                  *        
      *     CONTROLS THE MAIN PATH OF THE PROGRAM                      *        
      ******************************************************************        
      *                                                                         
       0000-MAINLINE.                                                   
                                                                        
           MOVE '0000'                     TO ACTIVE-PARAGRAPH.         
           PERFORM 0100-INITIALIZE         THRU 0100-EXIT.              
           PERFORM 1000-PROCESS-INOUT      THRU 1000-EXIT.              
           PERFORM 9999-END-PROGRAM        THRU 9999-EXIT.              
                                                                        
       0000-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ******************************************************************02920000
      * 0100-INITIALIZE                                                *02930000
      *                                                                *02940000
      *     1. RESET DB2 ERROR HANDLERS                                *02950000
      *     2. DECLARE CURSORS FOR RETURN VALUES.                      *02960000
      *                                                                *02990000
      ******************************************************************03000000
      *                                                                         
       0100-INITIALIZE.                                                 
                                                                        
           MOVE '0100'                     TO ACTIVE-PARAGRAPH.         
                                                                        
           EXEC SQL WHENEVER SQLWARNING CONTINUE END-EXEC.              
           EXEC SQL WHENEVER SQLERROR   CONTINUE END-EXEC.              
           EXEC SQL WHENEVER NOT FOUND  CONTINUE END-EXEC.              
                                                                        
           EXEC SQL                                                     
              DECLARE C1 CURSOR  FOR                         
              SELECT :S-RETURN-CODE-1         AS RETURN_CODE            
                FROM CIS.SYSDUMMY1                                   
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ027
MFA-TR*    EXEC SQL                                                             
MFA-TR*       DECLARE C1 CURSOR WITH RETURN FOR                                 
MFA-TR*       SELECT :S-RETURN-CODE-1         AS RETURN_CODE                    
MFA-TR*         FROM SYSIBM.SYSDUMMY1                                           
MFA-TR*    END-EXEC.                                                            
                                                                        
           MOVE 'DATABASE' TO C8-DELINQ-CD.                             
           PERFORM 0110-GET-DELINQ-DATA   THRU 0110-EXIT.               
           MOVE C8-DELINQ-VALUE TO WS-DATABASE.                         
                                                                        
       0100-EXIT.                                                       
            EXIT.                                                       
      *                                                                         
      ******************************************************************        
      *                                                                *        
      * 0110-GET-DELINQ-DATA                                           *        
      ******************************************************************        
       0110-GET-DELINQ-DATA.                                            
      *                                                                         
           EXEC SQL                                                     
              SELECT TOP(1) DELINQ_VALUE                                       
                INTO :C8-DELINQ-VALUE                                   
                FROM CSS_DELINQUENCY WITH(READUNCOMMITTED)                      
               WHERE DELINQ_CD = :C8-DELINQ-CD                          
                                           
                                                            
           END-EXEC                                                     

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ003
MFA-TR* MSQ020
MFA-TR* MSQ022
MFA-TR*    EXEC SQL                                                             
MFA-TR*       SELECT DELINQ_VALUE                                               
MFA-TR*         INTO :C8-DELINQ-VALUE                                           
MFA-TR*         FROM CSS_DELINQUENCY                                            
MFA-TR*        WHERE DELINQ_CD = :C8-DELINQ-CD                                  
MFA-TR*        FETCH FIRST 1 ROW ONLY WITH UR                                   
MFA-TR*        QUERYNO 0110                                                     
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-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL                   
              NEXT SENTENCE                                             
           ELSE                                                         
              MOVE PROGRAM-NAME              TO ABEND-PROGRAM           
              MOVE '0110'                    TO ACTIVE-PARAGRAPH        
              MOVE 'SELECT'                  TO ABEND-FUNCTION          
              MOVE 'CSS_DELINQUENCY'         TO TABLE-1                 
              MOVE 'DELINQ_CD'               TO TABLE-ELEMENT-1         
              MOVE 'DATABASE'                TO HOSTVAR-ELEMENT-1       
              MOVE 'COMPANY_NO'              TO TABLE-ELEMENT-1         
              MOVE '01'                      TO HOSTVAR-ELEMENT-1       
              PERFORM 9700-PROCESS-ABEND     THRU 9700-EXIT             
           END-IF.                                                      
           .                                                            
       0110-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ******************************************************************        
      *                                                                *        
      * 1000-PROCESS-INOUT                                             *        
      ******************************************************************        
      *                                                                         
       1000-PROCESS-INOUT.                                              
                                                                        
           MOVE '1000'                     TO ACTIVE-PARAGRAPH.         
           PERFORM 1100-PROCESS-INPUT      THRU 1100-EXIT.              
           PERFORM 2000-PROCESS-OUTPUT     THRU 2000-EXIT.              
                                                                        
       1000-EXIT.                                                       
            EXIT.                                                       
      *                                                                         
      ******************************************************************        
      *                                                                *        
      * 1100-PROCESS-INPUT                                             *        
      ******************************************************************        
      *                                                                         
       1100-PROCESS-INPUT.                                              
                                                                        
           MOVE '1100'                     TO ACTIVE-PARAGRAPH.         
           INITIALIZE DCLCSS-LIEAP-AGENCY.                              
           MOVE PARM-COMPANY-NO            TO I5-COMPANY-NO.            
           MOVE PARM-CODE-AGENCY-ID        TO I5-CODE-AGENCY-ID.        
           MOVE PARM-LAST-UPD-USERID       TO I5-LAST-UPDATE-USERID.    
           MOVE LENGTH OF I5-AGY-CONTACT-EMAIL-TEXT                     
                                           TO I5-AGY-CONTACT-EMAIL-LEN. 
           MOVE PARM-AGY-CONTCT-EMAIL      TO I5-AGY-CONTACT-EMAIL-TEXT.
           MOVE PARM-AGY-CONTCT-NM         TO I5-AGY-CONTACT-NM.        
           MOVE PARM-AGY-CONTCT-PHONE      TO I5-AGY-CONTACT-PHONE.     
           MOVE PARM-AGY-EMAIL-FRQ_CD      TO I5-AGY-EMAIL-FREQ-CD.     
                                                                        
       1100-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ******************************************************************        
      *                                                                *        
      * 2000-PROCESS-OUTPUT.                                           *        
      ******************************************************************        
      *                                                                         
       2000-PROCESS-OUTPUT.                                             
                                                                        
           PERFORM 7050-SELECT-TIMESTAMP       THRU 7050-EXIT.          
           PERFORM 7100-UPDATE-AGENCY-INFO     THRU 7100-EXIT.          
                                                                        
           IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL                   
              PERFORM 2200-PROCESS-WQ-CREATION THRU 2200-EXIT
           END-IF.          
                                                                        
       2000-EXIT.                                                       
           EXIT.                                                        
HPCCDM*    EJECT                                                                
      *                                                                         
      ******************************************************************        
      * 2200-PROCESS-WQ-CREATION                                       *        
      *                                                                *        
      *     CREATE A WQ FOR ALL THE SCCESSFUL TABLE UPDATES            *        
      *                                                                *        
      ******************************************************************        
      *                                                                         
       2200-PROCESS-WQ-CREATION.                                        
                                                                        
           INITIALIZE CWS00077-FIELDS.                                  
           MOVE WS-CURRENT-TIMESTAMP       TO WS-77-DATE-CREATED        
                                              WS-77-DATE-REQUIRED.      
           MOVE 'SYSTEM'                   TO WS-77-USER-ID-ORIG.       
           MOVE 554                        TO WS-77-CATEGORY-ID.        
           MOVE '2'                        TO WS-77-ROUTE-CATEGORY.     
           IF CSR-DATABASE                                              
              MOVE '178'                   TO WS-77-RESP-AREA-ID        
           ELSE                                                         
              MOVE '003'                   TO WS-77-RESP-AREA-ID
           END-IF.       
           MOVE I5-CODE-AGENCY-ID          TO WS-WQ-CODE-AGENCY-ID.     
           MOVE WS-WQ-COMMENTS             TO WS-77-COMMENTS-TEXT.      
           COMPUTE WS-77-COMMENTS-LEN = LENGTH OF WS-77-COMMENTS-TEXT.  
           MOVE 'N'                        TO WS-77-PRIORITY.           
           MOVE PROGRAM-NAME               TO WS-77-CREATED-BY.         
      *                                                                         
           PERFORM 8895-INSERT-WORK-QUEUE  THRU 8895-EXIT.              
                                                                        
       2200-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ******************************************************************        
      * SELECT CURRENT TIMESTAMP                                       *        
      ******************************************************************        
       7050-SELECT-TIMESTAMP.                                           
      *                                                                         
           EXEC SQL                                                     
              SELECT
              REPLACE(REPLACE(CONVERT(CHAR(26), CIS.CURRENT$TIMESTAMP()
           , 121), ' ', '-'), ':', '.'),
              CAST(SYSDATETIMEOFFSET() AS DATE)
            INTO
              :WS-CURRENT-TIMESTAMP,
              :WS-CURRENT-DATE                  
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ006
MFA-TR* MSQ028
MFA-TR* MSQ061
MFA-TR*    EXEC SQL                                                             
MFA-TR*       SET :WS-CURRENT-TIMESTAMP = CURRENT TIMESTAMP                     
MFA-TR*          ,:WS-CURRENT-DATE      = CURRENT DATE                          
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.    
                                                                        
           IF  WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL                  
               CONTINUE                                                 
           ELSE                                                         
               MOVE PROGRAM-NAME           TO ABEND-PROGRAM             
               MOVE '7050'                 TO ACTIVE-PARAGRAPH          
               MOVE 'SET CURRENT TMP'      TO ABEND-FUNCTION            
               MOVE SPACES                 TO ABEND-SQL-PREDICATES      
                                              ABEND-TABLES              
               PERFORM 9700-PROCESS-ABEND  THRU 9700-EXIT               
           END-IF.                                                      
      *                                                                         
       7050-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ******************************************************************        
      * 7100-UPDATE-AGENCY-INFO.                                       *        
      *                                                                *        
      *     UPDATE THE AGENCY INFORMATION BASED ON THE AGENCY ID       *        
      *                                                                *        
      ******************************************************************        
      *                                                                         
       7100-UPDATE-AGENCY-INFO.                                         
                                                                        
           MOVE '7100'                     TO ACTIVE-PARAGRAPH.         
                                                                        
           EXEC SQL                                                     
              UPDATE CSS_LIEAP_AGENCY                                   
              SET LAST_UPDATE_TS      = CIS.CURRENT$TIMESTAMP()               
                 ,LAST_UPDATE_USERID  = :I5-LAST-UPDATE-USERID          
                 ,AGY_CONTACT_EMAIL   = :I5-AGY-CONTACT-EMAIL           
                 ,AGY_CONTACT_NM      = :I5-AGY-CONTACT-NM              
                 ,AGY_CONTACT_PHONE   = :I5-AGY-CONTACT-PHONE           
                 ,AGY_EMAIL_FREQ_CD   = :I5-AGY-EMAIL-FREQ-CD           
              WHERE                                                     
                  CODE_AGENCY_ID      = :I5-CODE-AGENCY-ID              
                                                            
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ003
MFA-TR* MSQ028
MFA-TR*    EXEC SQL                                                             
MFA-TR*       UPDATE CSS_LIEAP_AGENCY                                           
MFA-TR*       SET LAST_UPDATE_TS      = CURRENT TIMESTAMP                       
MFA-TR*          ,LAST_UPDATE_USERID  = :I5-LAST-UPDATE-USERID                  
MFA-TR*          ,AGY_CONTACT_EMAIL   = :I5-AGY-CONTACT-EMAIL                   
MFA-TR*          ,AGY_CONTACT_NM      = :I5-AGY-CONTACT-NM                      
MFA-TR*          ,AGY_CONTACT_PHONE   = :I5-AGY-CONTACT-PHONE                   
MFA-TR*          ,AGY_EMAIL_FREQ_CD   = :I5-AGY-EMAIL-FREQ-CD                   
MFA-TR*       WHERE                                                             
MFA-TR*           CODE_AGENCY_ID      = :I5-CODE-AGENCY-ID                      
MFA-TR*         QUERYNO 7100                                                    
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     
                                              S-RETURN-CODE-1.          
                                                                        
           IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL                   
               CONTINUE                                                 
           ELSE                                                         
               MOVE PROGRAM-NAME           TO ABEND-PROGRAM             
               MOVE '7100'                 TO ACTIVE-PARAGRAPH          
               MOVE 'UPDATE'               TO ABEND-FUNCTION            
               MOVE SPACES                 TO ABEND-SQL-PREDICATES      
                                              ABEND-TABLES              
               MOVE 'CSS_LIEAP_AGENCY'     TO TABLE-1                   
               MOVE 'CODE_AGENCY_ID'       TO TABLE-ELEMENT-1           
               MOVE I5-CODE-AGENCY-ID      TO HOSTVAR-ELEMENT-1         
               PERFORM 9700-PROCESS-ABEND  THRU 9700-EXIT               
           END-IF.                                                      
                                                                        
       7100-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ****************************************************************          
      ** 8895-INSERT-WORK-QUEUE                                     **          
      **  CALL SUB PROGRAM MCSCB077 FOR INSERTING WORK QUEUES INTO  **  28610000
      **  CSS_WQ_ITEMS.                                             **  28620000
      ****************************************************************          
      *                                                                         
       8895-INSERT-WORK-QUEUE.                                          
                                                                        
           CALL MCSCB077  USING   CWS00077-FIELDS,                      
                                  ABEND-FILE,                           
                                  WS-MCSCB077-RET-CODE.                 
      *                                                                         
           MOVE WS-MCSCB077-RET-CODE       TO WS-ACTIVE-RETURN-CODE.    
                                                                        
           IF ABEND-FUNCTION > SPACES OR WS-MCSCB077-RET-CODE NOT = 0   
               MOVE PROGRAM-NAME           TO ABEND-PROGRAM             
               MOVE '8895'                 TO ACTIVE-PARAGRAPH          
               MOVE 'CALL'                 TO ABEND-FUNCTION            
               MOVE 'MCSCB077'             TO TABLE-1                   
               DISPLAY 'COMMENTS        ' WS-77-COMMENTS                
               DISPLAY 'SQL RETURN CODE ' WS-ACTIVE-RETURN-CODE         
               PERFORM 9700-PROCESS-ABEND THRU 9700-EXIT                
           END-IF.                                                      
                                                                        
       8895-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ******************************************************************        
      *                                                                *        
      * 8900-SEND-DONE.                                                *        
      ******************************************************************        
      *                                                                         
       8900-SEND-DONE.                                                  
                                                                        
           MOVE PROGRAM-NAME               TO ABEND-PROGRAM             
           MOVE '8900'                     TO ACTIVE-PARAGRAPH          
           MOVE 'OPEN'                     TO ABEND-FUNCTION            
                                                                        
           EXEC SQL                                                     
               OPEN C1                                                  
           END-EXEC.                                                    

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

MSQ034     IF SQLCODE = 0 
MSQ034       EXEC SQL 
MSQ034           CLOSE C1 WITH RETURN TO CALLER
MSQ034       END-EXEC
MSQ017     CALL "MFASQLCA"
MSQ017       USING SQLCA, BY VALUE MFA-PROGRAM-ID, "0", "0", "0",
MSQ017       BY REFERENCE MFSQLMESSAGETEXT
MSQ017     END-CALL

MSQ034     END-IF
                                                                        
           MOVE SQLCODE                    TO WS-ACTIVE-RETURN-CODE     
                                              S-RETURN-CODE-1.          
                                                                        
           IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL                   
              CONTINUE                                                  
           ELSE                                                         
              MOVE SQLCODE                 TO ABEND-SQLCODE             
              MOVE SQLSTATE                TO ABEND-SQLSTATE            
              MOVE 'CSR03792_R1'           TO TABLE-1                   
              PERFORM 9700-PROCESS-ABEND   THRU 9700-EXIT               
           END-IF.                                                      
                                                                        
       8900-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ******************************************************************        
      *                                                                *        
      * 9000-SEND-ERROR-RESULT                                         *        
      ******************************************************************        
      *                                                                         
       9000-SEND-ERROR-RESULT.                                          
                                                                        
           INITIALIZE GTT-RETURN-FIELDS.                                
           MOVE WS-ACTIVE-RETURN-CODE      TO ABEND-SQLCODE             
                                              S-RETURN-CODE-1.          
                                                                        
           MOVE SQLERRMC                   TO ABEND-SQLERRMC.           
                                                                        
           EXEC SQL                                                     
               ROLLBACK                                                 
           END-EXEC.                                                    

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

                                                                        
           IF SQLCODE = 0                                               
              CONTINUE                                                  
           ELSE                                                         
              MOVE 'ROLLBACK'              TO ABEND-FUNCTION            
           END-IF.                                                      
                                                                        
       9000-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ******************************************************************        
      * 9700-ABEND-PROCESSING.                                         *        
      ******************************************************************        
       9700-PROCESS-ABEND.                                              
                                                                        
           PERFORM 9000-SEND-ERROR-RESULT  THRU 9000-EXIT.              
           PERFORM 9900-SQL-ERROR-ROUTINE  THRU 9900-EXIT.              
                                                                        
       9700-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ******************************************************************        
      * 9900-SQL-ERROR-ROUTINE.                                        *        
      ******************************************************************        
      *                                                                         
           EXEC SQL                                                             
              INCLUDE CPDSP300                                                  
           END-EXEC.                                                            
      *                                                                         
      ******************************************************************        
      * 9999-END-PROGRAM.                                              *        
      ******************************************************************        
      *                                                                         
       9999-END-PROGRAM.                                                
                                                                        
            PERFORM 8900-SEND-DONE         THRU 8900-EXIT.              
                                                                        
           
MSQ016        GOBACK.                                                    
                                                                        
       9999-EXIT.                                                       
           EXIT.                                                        
