       IDENTIFICATION DIVISION.                                         
       PROGRAM-ID.    CSR04673.                                         
COB303 DATE-WRITTEN.     AUG  30, 2013.                                 
       DATE-COMPILED.                                                   
                                                                        
      ******************************************************************00060000
      *                SOUTH CAROLINA ELECTRIC & GAS                   *00070000
      *                                                                *00080000
      *  THIS PROGRAM UPDATES CREDIT ARRANGEMENT                       *00090000
      *  TABLES AND WRITE TRANSACTION HISTORY FOR CDD.                 *00090000
      *  THIS PROGRAM UPDATES COMPLIANCE AND STATUS.                   *00140000
      ******************************************************************        
      *                                                                *        
      *                     PROGRAM MODIFICATION LOG                   *        
      *                                                                *        
      *    DATE    INITIALS   COMMENTS                                 *        
      *  --------  --------   ---------------------------------------  *        
P00726*  08/30/13  SS42021    PROCEDURE ORIGINALLY CODED.              *        
P0726A*  11/13/13  AA97148    CREDIT ARRANGEMENTS - RELEASE 2 CHANGES. *        
P0726A*                       MODIFIED DECLARATION TO CHAR FROM INT    *        
P0726B*  07/08/14  AA97148    CREDIT ARRANGEMENTS - RELEASE 3 CHANGES. *        
P0726B*                       ADDED FLEX RELATED LOGIC TO THIS SP.     *        
      ******************************************************************        
      ******************************************************************00310000
      *                                                                *00320000
      *                ---- BASIC SEQUENCE STRUCTURE ----              *00330000
      *                                                                *00340000
      *  0000 - 0999  MAIN CONTROL PATH AND INITIALIZATION             *00350000
      *  1000 - 1999  INPUT PROCESSING CONTROL PATH                    *00360000
      *  2000 - 2999  OUTPUT PROCESSING CONTROL PATH                   *00370000
      *  3000 - 4999  NOT USED                                         *00380000
      *  5000 - 5999  COMMON PROGRAM MODULES                           *00390000
      *  6000 - 6999  COMMON SYSTEM MODULES                            *00400000
      *  7000 - 7999  INPUT MODULES                                    *00410000
      *  8000 - 8999  OUTPUT MODULES                                   *00420000
      *  9000 - 9999  TERMINATION, ABEND, MESSAGING MODULES            *00430000
      *                                                                *00440000
      ******************************************************************00450000
      *                                                                 00460000
       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 'CSR04673'.
MSQ017     COPY MFASQLM.
      *                                                                 00500000
       01  WS-START                                   PIC X(45) VALUE   
           'WORKING STORAGE FOR RPC CSR04673 STARTS HERE'.              
      *                                                                 00530000
      ******************************************************************00770000
      *    COBOL WORKING STORAGE COPY BOOKS                            *00780000
      ******************************************************************00790000
      ******************************************************************        
      *    ERROR HANDLING                                                       
      ******************************************************************        
      *                                                                         
           EXEC SQL                                                             
              INCLUDE CWSX0010                                                  
           END-EXEC.                                                            
      *                                                                         
      ******************************************************************        
      *    SUPPORTS DB2 AND SQL ERROR CHECKING                         *        
      ******************************************************************        
      *                                                                         
           COPY CWS00303.                                                       
      *                                                                         
      ******************************************************************00950000
      *    WORK AREAS                                                  *00960000
      ******************************************************************00970000
      *                                                                 00980000
       01  WS-MISC.                                                     
          05 PROGRAM-NAME                PIC X(08) VALUE 'CSR04673'.    
          05 WS-SQLSTATE                 PIC X(05) VALUE '     '.       
          05 MCSKR135                    PIC X(08) VALUE 'MCSKR135'.    
          05 WS-ARNG-SEQ-NO-C            PIC X(04) JUSTIFIED RIGHT.     
          05 WS-ARNG-SEQ-NO-N            PIC 9(04) VALUE 0.             
          05 WS-ARNG-SEQ-NUMBER          PIC S9(04) USAGE COMP VALUE 0. 
          05 WS-ARNG-COMMENTS-LEN-C      PIC X(04) JUSTIFIED RIGHT.     
          05 WS-ARNG-COMMENTS-LEN-N      PIC 9(04) VALUE 0.             
          05 WS-ARNG-COMMENTS-LEN        PIC S9(04) USAGE COMP VALUE 0. 
          05 SEND-DONE-SW                PIC X(01) VALUE 'Y'.           
              88 SEND-DONE-ERROR                   VALUE 'N'.           
              88 SEND-DONE-OK                      VALUE 'Y'.           
      *                                                                 05850002
          05 WS-ARNG-TOTAL-AMT-C         PIC X(13).                     
          05 WS-ARNG-TOTAL-AMT-N REDEFINES WS-ARNG-TOTAL-AMT-C          
                                         PIC  9999999999.99.            
COB305    05 WS-ARNG-TOTAL-AMT        PIC S9(11)V99 COMP-3 VALUE 0.          
      *                                                                         
          05 WS-TOT-AR-BAL-C             PIC X(13).                     
          05 WS-TOT-AR-BAL-N     REDEFINES WS-TOT-AR-BAL-C              
                                         PIC  9999999999.99.            
COB305    05 WS-TOT-AR-BAL        PIC S9(11)V99 COMP-3 VALUE 0.          
      *                                                                         
          05 WS-TOT-UTL-BAL-C            PIC X(13).                     
          05 WS-TOT-UTL-BAL-N    REDEFINES WS-TOT-UTL-BAL-C             
                                         PIC  9999999999.99.            
COB305    05 WS-TOT-UTL-BAL        PIC S9(11)V99 COMP-3 VALUE 0.          
      *                                                                         
          05 WS-TOT-NUTL-BAL-C           PIC X(13).                     
          05 WS-TOT-NUTL-BAL-N   REDEFINES WS-TOT-NUTL-BAL-C            
                                         PIC  9999999999.99.            
COB305    05 WS-TOT-NUTL-BAL        PIC S9(11)V99 COMP-3 VALUE 0.          
      *                                                                         
          05 WS-UTL-ARRS-AMT-C           PIC X(13).                     
          05 WS-UTL-ARRS-AMT-N   REDEFINES WS-UTL-ARRS-AMT-C            
                                         PIC  9999999999.99.            
COB305    05 WS-UTL-ARRS-AMT        PIC S9(11)V99 COMP-3 VALUE 0.          
      *                                                                         
          05 WS-NUTL-ARRS-AMT-C          PIC X(13).                     
          05 WS-NUTL-ARRS-AMT-N  REDEFINES WS-NUTL-ARRS-AMT-C           
                                         PIC  9999999999.99.            
COB305    05 WS-NUTL-ARRS-AMT        PIC S9(11)V99 COMP-3 VALUE 0.          
      *                                                                         
       01 COUNTER-FIELDS.                                               
          05 CTR-ROWS                    PIC S9(9) COMP VALUE 0.        
      *                                                                         
       01 GTT-RETURN-FIELDS.                                            
          05 S-RETURN-CODE               PIC S9(04) COMP VALUE 0.       
          05 S-APPL-RETURN-CODE          PIC X(10) VALUE SPACES.        
      *                                                                         
      ******************************************************************00540000
      *    SQL COMMUNICATION AREA                                      *00550000
      ******************************************************************00560000
           EXEC SQL                                                     00580000
              INCLUDE SQLCA                                             00590000
           END-EXEC.                                                    00600000
      *                                                                         
      ******************************************************************        
      * VARIABLES NEEDED FOR CREDIT ARRANGEMENT PROCESS                *        
      ******************************************************************        
           EXEC SQL                                                             
              INCLUDE CWSKR135                                                  
           END-EXEC.                                                            
      *                                                                         
HPCCDM*EJECT                                                            02000000
      *                                                                         
      ******************************************************************        
      **   LINKAGE SECTION.                                           **        
      ******************************************************************        
       LINKAGE SECTION.                                                 
      *                                                                         
       01  PARM-ACCOUNT-NO             PIC  X(13).                      
       01  PARM-ARNG-ID                PIC  X(05).                      
       01  PARM-ARNG-SEQ-NO            PIC  X(04).                      
       01  PARM-ARNG-COMPL-CD          PIC  X(02).                      
       01  PARM-ARNG-STATUS-CD         PIC  X(01).                      
       01  PARM-ARNG-COMMENTS-LEN      PIC  X(04).                      
       01  PARM-ARNG-COMMENTS          PIC  X(255).                     
       01  PARM-USER-ID                PIC  X(07).                      
P0726B 01  PARM-FLEX-DNP-FLAG          PIC  X(01).                      
P0726B 01  PARM-ARNG-DNP-DT            PIC  X(10).                      
      *                                                                         
       PROCEDURE DIVISION USING  PARM-ACCOUNT-NO                        
                               , PARM-ARNG-ID                           
                               , PARM-ARNG-SEQ-NO                       
                               , PARM-ARNG-COMPL-CD                     
                               , PARM-ARNG-STATUS-CD                    
                               , PARM-ARNG-COMMENTS-LEN                 
                               , PARM-ARNG-COMMENTS                     
                               , PARM-USER-ID                           
P0726B                         , PARM-FLEX-DNP-FLAG                     
P0726B                         , PARM-ARNG-DNP-DT.                      
      *                                                                         
      ******************************************************************02030000
      * 0000-MAINLINE                                                  *02040000
      *     CALLS 0100-INITIALIZE                                      *02050000
      *           1000-PROCESS-INPUT                                   *02060000
      *           2000-PROCESS-OUTPUT                                  *02070000
      *           9999-END-PROGRAM                                     *02080000
      *                                                                *02090000
      *     CONTROLS THE MAIN PATH OF THE PROGRAM                      *02100000
      ******************************************************************02110000
      *================================================================*02120000
       0000-MAINLINE.                                                   
      *================================================================*02120000
      *                                                                 02140000
           PERFORM 0100-INITIALIZE     THRU 0100-EXIT.                  
           PERFORM 1000-PROCESS-INPUT  THRU 1000-EXIT.                  
           PERFORM 2000-PROCESS-OUTPUT THRU 2000-EXIT.                  
           PERFORM 9999-END-PROGRAM    THRU 9999-EXIT.                  
      *                                                                 02190000
       0000-EXIT.                                                       
           EXIT.                                                        
      *                                                                 02220000
      *================================================================*02120000
       0100-INITIALIZE.                                                 
      *================================================================*02120000
      *                                                                 02380000
           MOVE '0100'          TO ACTIVE-PARAGRAPH.                    
      *                                                                 02400000
           EXEC SQL WHENEVER SQLWARNING CONTINUE END-EXEC.              
           EXEC SQL WHENEVER SQLERROR   CONTINUE END-EXEC.              
           EXEC SQL WHENEVER NOT FOUND  CONTINUE END-EXEC.              
      *                                                                 02440000
           PERFORM 0100A-DECLARE-GTT    THRU 0100A-EXIT.                
      *                                                                 02440000
           EXEC SQL                                                     
               DECLARE C1 CURSOR                             
                                 WITH ROWSET POSITIONING FOR            
               SELECT                                                   
                   RETURN_CODE                                          
                  ,APPL_RETURN_CODE                                     
               FROM #CSR04673_R1                                 
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ049
MFA-TR*    EXEC SQL                                                             
MFA-TR*        DECLARE C1 CURSOR WITH RETURN                            00000300
MFA-TR*                          WITH ROWSET POSITIONING FOR                    
MFA-TR*        SELECT                                                   00000400
MFA-TR*            RETURN_CODE                                                  
MFA-TR*           ,APPL_RETURN_CODE                                             
MFA-TR*        FROM SESSION.CSR04673_R1                                 00000500
MFA-TR*    END-EXEC.                                                    00000700
      *                                                                         
       0100-EXIT.                                                       
           EXIT.                                                        
      *                                                                 02630000
      *================================================================*07800000
       0100A-DECLARE-GTT.                                               
      *================================================================*07800000
      * DECLARE TABLE TO HOLD RESULT SET                               *        
      *                                                                         
           EXEC SQL
             CALL CIS.DROP_TEMP_TABLE('#CSR04673_R1')
           END-EXEC
           EXEC SQL
             CREATE TABLE #CSR04673_R1
              (                                                       
                     RETURN_CODE            INT                     
                    ,APPL_RETURN_CODE CHAR(10)  COLLATE 
                                  LATIN1_GENERAL_100_BIN2                    
                )
           END-EXEC.                                                    

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

      *                                                                         
           MOVE SQLSTATE              TO WS-SQLSTATE.                   
           MOVE SQLCODE               TO WS-ACTIVE-RETURN-CODE.         
      *                                                                         
           IF WS-SQLSTATE = '42710'                                     
              PERFORM 8000A-DELETE-GTT-ROWS THRU 8000A-EXIT             
           ELSE                                                         
              IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL                
                 CONTINUE                                               
              ELSE                                                      
                 MOVE PROGRAM-NAME       TO ABEND-PROGRAM               
                 MOVE SQLCODE            TO ABEND-SQLCODE               
                 MOVE SQLSTATE           TO ABEND-SQLSTATE              
                 MOVE '0100A'            TO ACTIVE-PARAGRAPH            
                 MOVE 'DECLARE GTT'      TO ABEND-FUNCTION              
                 MOVE SPACES             TO ABEND-SQL-PREDICATES        
                                            ABEND-TABLES                
                 MOVE 'CSR04673_R1'      TO TABLE-1                     
                 MOVE SPACES             TO TABLE-ELEMENT-1             
                 MOVE SPACES             TO HOSTVAR-ELEMENT-1           
                 PERFORM 9900-SQL-ERROR-ROUTINE THRU 9900-EXIT          
              END-IF                                                    
           END-IF.                                                      
      *                                                                         
       0100A-EXIT.                                                      
            EXIT.                                                       
      *                                                                         
      *================================================================*02710000
       1000-PROCESS-INPUT.                                              
      *================================================================*02710000
      *     RECEIVE PARMS.                                             *02700000
           MOVE PARM-ACCOUNT-NO        TO WS-CAR-ACCOUNT-NO             
           MOVE PARM-ARNG-ID           TO WS-CAR-ARNG-ID                
           MOVE PARM-ARNG-COMPL-CD     TO WS-CAR-ARNG-COMPL-CD          
           MOVE PARM-ARNG-STATUS-CD    TO WS-CAR-ARNG-STATUS-CD         
           MOVE PARM-ARNG-COMMENTS     TO WS-CRED-COMMENTS-TEXT         
           MOVE PARM-USER-ID           TO WS-CAR-USER-ID                
           MOVE 'Y'                    TO WS-CAR-TRNS-HST-FL.           
           UNSTRING PARM-ARNG-SEQ-NO       DELIMITED BY ' '             
                                       INTO WS-ARNG-SEQ-NO-C.           
           MOVE WS-ARNG-SEQ-NO-C       TO WS-ARNG-SEQ-NO-N.             
           MOVE WS-ARNG-SEQ-NO-N       TO WS-ARNG-SEQ-NUMBER.           
                                                                        
           UNSTRING PARM-ARNG-COMMENTS-LEN  DELIMITED BY ' '            
                                       INTO WS-ARNG-COMMENTS-LEN-C.     
           MOVE WS-ARNG-COMMENTS-LEN-C TO WS-ARNG-COMMENTS-LEN-N.       
           MOVE WS-ARNG-COMMENTS-LEN-N TO WS-ARNG-COMMENTS-LEN.         
           MOVE WS-ARNG-SEQ-NUMBER     TO WS-ARNG-SEQ-NO.               
           MOVE WS-ARNG-COMMENTS-LEN   TO WS-CRED-COMMENTS-LEN.         
P0726B     MOVE PARM-ARNG-DNP-DT       TO WS-CAR-NEW-DNP-DATE.          
P0726B     MOVE PARM-FLEX-DNP-FLAG     TO WS-CAR-FLEX-DNP-FLAG.         
P0726B     MOVE PARM-ARNG-COMMENTS-LEN TO WS-CAR-COMMENTS-LEN.          
P0726B     MOVE PARM-ARNG-COMMENTS     TO WS-CAR-COMMENTS-TEXT.         
      *                                                                 08910002
      *    MOVE PARM-ARNG-DUE-DT      TO  WS-CAR-ARNG-DUE-DT            02753071
      *    MOVE PARM-ARNG-TOTAL-AMT       TO WS-ARNG-TOTAL-AMT-C                
      *    MOVE WS-ARNG-TOTAL-AMT-N       TO WS-ARNG-TOTAL-AMT                  
      *    MOVE WS-ARNG-TOTAL-AMT         TO WS-CAR-ARNG-TOTAL-AMT              
      *                                                                 08910002
      *    MOVE PARM-TOTAL-AR-BALANCE     TO WS-TOT-AR-BAL-C                    
      *    MOVE WS-TOT-AR-BAL-N           TO WS-TOT-AR-BAL                      
      *    MOVE WS-TOT-AR-BAL             TO WS-CAR-TOTAL-AR-BALANCE            
      *                                                                 08910002
      *    MOVE PARM-TOTAL-UTL-BALANCE    TO WS-TOT-UTL-BAL-C                   
      *    MOVE WS-TOT-UTL-BAL-N          TO WS-TOT-UTL-BAL                     
      *    MOVE WS-TOT-UTL-BAL            TO WS-CAR-TOTAL-UTL-BALANCE           
      *                                                                 08910002
      *    MOVE PARM-TOTAL-NONUTL-BALANCE TO WS-TOT-NUTL-BAL-C                  
      *    MOVE WS-TOT-NUTL-BAL-N         TO WS-TOT-NUTL-BAL                    
      *    MOVE WS-TOT-NUTL-BAL           TO WS-CAR-TOTAL-NONUTL-BALANCE        
      *                                                                 08910002
      *    MOVE PARM-UTL-ARREARS-AMT      TO WS-UTL-ARRS-AMT-C                  
      *    MOVE WS-UTL-ARRS-AMT-N         TO WS-UTL-ARRS-AMT                    
      *    MOVE WS-UTL-ARRS-AMT           TO WS-CAR-UTL-ARREARS-AMT             
      *                                                                 08910002
      *    MOVE PARM-NONUTL-ARREARS-AMT   TO WS-NUTL-ARRS-AMT-C                 
      *    MOVE WS-NUTL-ARRS-AMT-N        TO WS-NUTL-ARRS-AMT                   
      *    MOVE WS-NUTL-ARRS-AMT          TO WS-CAR-NONUTL-ARREARS-AMT          
      *                                                                 08910002
      *                                                                 11895600
       1000-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      *================================================================*03300000
       2000-PROCESS-OUTPUT.                                             
      *================================================================*03300000
      *                                                                 03330000
           MOVE '2000'                       TO   ACTIVE-PARAGRAPH      
      *                                                                         
           PERFORM 5000-CRED-ARNG-PROCESS    THRU 5000-EXIT             
      *                                                                         
           IF CTR-ROWS < 1 THEN                                         
              PERFORM 8100-SEND-RESULT   THRU 8100-EXIT                 
           END-IF.                                                      
      *                                                                         
       2000-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      *================================================================*03300000
       5000-CRED-ARNG-PROCESS.                                          
      *================================================================*03300000
      * CREDIT ARRANGEMENT UPDATE PROCESS.                                      
      *                                                                         
           MOVE 'U'      TO     WS-CAR-ACTION-FL                        
           CALL MCSKR135 USING  WS-KR135-IN-FIELDS                      
                                WS-KR135-OUT-FIELDS                     
                                WS-KR135-WORK-AREA                      
                                ABEND-FILE.                             
      *                                                                         
           IF ABEND-FUNCTION  > SPACES                                  
              MOVE ABEND-SQLCODE           TO S-RETURN-CODE             
                                              WS-ACTIVE-RETURN-CODE     
              PERFORM 9700-PROCESS-ABEND   THRU 9700-EXIT               
           ELSE                                                         
              MOVE RS-RETURN-CODE        TO S-RETURN-CODE               
              MOVE WS-APPL-RETURN-CODE   TO S-APPL-RETURN-CODE          
           END-IF.                                                      
      *                                                                         
       5000-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      *================================================================*07800000
       8000A-DELETE-GTT-ROWS.                                           
      *================================================================*07800000
      * DELETE TEMPORARY TABLE WHEN REQUIRED.                          *        
      *                                                                         
           EXEC SQL                                                     
               DELETE FROM #CSR04673_R1                          
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ049
MFA-TR*    EXEC SQL                                                             
MFA-TR*        DELETE FROM SESSION.CSR04673_R1                                  
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 OR NOT-FOUND      
              CONTINUE                                                  
           ELSE                                                         
              MOVE PROGRAM-NAME          TO ABEND-PROGRAM               
              MOVE '8000A'               TO ACTIVE-PARAGRAPH            
              MOVE 'DELETE'              TO ABEND-FUNCTION              
              MOVE SQLCODE               TO ABEND-SQLCODE               
              MOVE SPACES                TO ABEND-SQL-PREDICATES        
                                                    ABEND-TABLES        
              MOVE 'CSR04673_R1'         TO TABLE-1                     
              MOVE SPACES                TO TABLE-ELEMENT-1             
              MOVE SPACES                TO HOSTVAR-ELEMENT-1           
              PERFORM 9900-SQL-ERROR-ROUTINE THRU 9900-EXIT             
           END-IF.                                                      
      *                                                                         
       8000A-EXIT.                                                      
           EXIT.                                                        
      *                                                                         
      *================================================================*07800000
       8100-SEND-RESULT.                                                
      *================================================================*07800000
      * INSERT RESULT SET INTO TEMPORARY TABLE.                        *        
      *                                                                         
           EXEC SQL                                                     
                INSERT INTO #CSR04673_R1                         
                (                                                       
                     RETURN_CODE                                        
                    ,APPL_RETURN_CODE                                   
                )                                                       
                VALUES                                                  
                (                                                       
                     :S-RETURN-CODE                                     
                    ,:S-APPL-RETURN-CODE                                
                )                                                       
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ049
MFA-TR*    EXEC SQL                                                     42750000
MFA-TR*         INSERT INTO SESSION.CSR04673_R1                                 
MFA-TR*         (                                                               
MFA-TR*              RETURN_CODE                                                
MFA-TR*             ,APPL_RETURN_CODE                                           
MFA-TR*         )                                                               
MFA-TR*         VALUES                                                          
MFA-TR*         (                                                               
MFA-TR*              :S-RETURN-CODE                                             
MFA-TR*             ,:S-APPL-RETURN-CODE                                32980000
MFA-TR*         )                                                               
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                  
               ADD +1                    TO CTR-ROWS                    
            ELSE                                                        
               MOVE PROGRAM-NAME         TO ABEND-PROGRAM               
               MOVE SQLCODE              TO ABEND-SQLCODE               
               MOVE '8100'               TO ACTIVE-PARAGRAPH            
               MOVE 'INSERT'             TO ABEND-FUNCTION              
               MOVE SPACES               TO ABEND-SQL-PREDICATES        
                                            ABEND-TABLES                
               MOVE 'CSR04673_R1'        TO TABLE-1                     
               PERFORM 9900-SQL-ERROR-ROUTINE  THRU 9900-EXIT           
           END-IF.                                                      
      *                                                                         
       8100-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ******************************************************************42800000
      * 9700-PROCESS-ABEND.                                            *42810000
      ******************************************************************42820000
           EXEC SQL                                                             
              INCLUDE CPD0023C                                                  
           END-EXEC.                                                            
      *                                                                         
      ******************************************************************42800000
      * 9900 - JOURNALING / ERROR HANDLING ROUTINE                     *42810000
      ******************************************************************42820000
           EXEC SQL                                                             
              INCLUDE CPDSP300                                                  
           END-EXEC.                                                            
      *                                                                 42860000
      ******************************************************************42870000
      *       END PROGRAM COPYLIB                                      *42880000
      ******************************************************************42890000
           EXEC SQL                                                             
              INCLUDE CPD00320                                                  
           END-EXEC.                                                            
      *                                                                 42860000
