       IDENTIFICATION DIVISION.                                         
       PROGRAM-ID.    CSR02146.                                         
COB303 DATE-WRITTEN.      AUGUST 15, 1995.                              
       DATE-COMPILED.                                                   
                                                                        
CVT000******************************************************************00000100
CVT000*     - - - - - >   R P C   C O N V E R S I O N   < - - - - -    *00000200
CVT000*         S146 CONVERTED TO DB2 SP CSR02146 ON 06/14/2006        *00000300
CVT000*             -NOTE: AUTOMATED CONVERSION PROGRAM USED           *00000400
CVT000*                                                                *00000500
CVT000*                    CVT000 - CONVERTED CODE                     *00000501
CVT000*                    CVT004 - NEEDED REVIEW                      *00000502
CVT000*                    CVT999 - COMMENTED OUT CODE THAT CAN        *00000503
CVT000*                             POTENTIALLY BE DELETED             *00000510
CVT000*                                                                *00000520
CVT000******************************************************************00000600
      ******************************************************************00060000
      *                                                                *00070000
      *                SOUTH CAROLINA ELECTRIC & GAS                   *00080000
      *                                                                *00090000
      *  THIS PROGRAM IS EXECUTED VIA A REMOTE PROCEDURE CALL (RPC).   *00100000
      *                                                                *00110000
      *  TRANID:     S146                                              *00120000
      *  PROGRAM:    S146                                              *00130000
      *  CALLING SP: PA_S146                                           *00140000
      *                                                                *00150000
      ******************************************************************00160000
      *                 P R O G R A M  S U M M A R Y                   *00170000
      *                                                                *00180000
      *  THIS PROCEDURE RETRIEVES CONTRACT INFORAMTION FOR SERVICE     *00190000
      *  ORDER TRANSFERS                                               *00200000
      *  THIS INFORMATION EXISTS TO SUPPORT THE MANAGEMENT OF THE      *00210000
      *  REGISTER INFORMATION.                                         *00220000
      ******************************************************************00230000
      *                                                                *00240000
      *                     PROGRAM MODIFICATION LOG                   *00250000
      *                                                                *00260000
      *    DATE    INITIALS   COMMENTS                                 *00270000
      *  --------  --------   ---------------------------------------  *00280000
      *  08/15/95    MAR      PROCEDURE ORIGINALLY CODED.              *00290000
      *  12/02/95    MAR      ADD RETURN CODE FOR NOT-FOUND            *00300000
      *  06/13/96    PP       RETRIEVES LIEN_CD FROM CSS_CONTRACT      *00310000
      *                       - REF. PCR0238                           *00320000
TP5944*  11/96       ADA      TPR 5944 - CONTRACT LIEN CD MUST BE 'N'  *00321000
TP5944*                       OR 'Y'.                                  *00322000
      *  03/24/97    WMG      ADD CORRECT SEND RESULT CODE TO RPC.     *00323000
CBSI  *  08/31/98    CBSI     ABEND LOG MODIFIED TO INCLUDE ALL THE    *00323100
CBSI  *              MADRAS   ABEND PARAMETERS                         *00323200
P00795*  01/21/15    DB18339  ADDED TRANSFER_FL COLUMN TO RETURN SET.  *00323100
A07021*  03/26/15    DB18339  ADDED CONTRACT DESC TO RETURN SET.       *00323100
      *                                                                *00324000
      ******************************************************************00330000
      ******************************************************************00340000
      *                                                                *00350000
      *                ---- BASIC SEQUENCE STRUCTURE ----              *00360000
      *                                                                *00370000
      *  0000 - 0999  MAIN CONTROL PATH AND INITIALIZATION             *00380000
      *  1000 - 1999  INPUT PROCESSING CONTROL PATH                    *00390000
      *  2000 - 2999  OUTPUT PROCESSING CONTROL PATH                   *00400000
      *  3000 - 4999  NOT USED                                         *00410000
      *  5000 - 5999  COMMON PROGRAM MODULES                           *00420000
      *  6000 - 6999  COMMON SYSTEM MODULES                            *00430000
      *  7000 - 7999  INPUT MODULES                                    *00440000
      *  8000 - 8999  OUTPUT MODULES                                   *00450000
      *  9000 - 9999  TERMINATION,ABEND, MESSAGING MODULES             *00460000
      *                                                                *00470000
      ******************************************************************00480000
                                                                        
       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 'CSR02146'.
MSQ017     COPY MFASQLM.
                                                                        
       01  WS-START                                   PIC X(40) VALUE   
           'WORKING STORAGE FOR RPC S146 STARTS HERE'.                  
                                                                        
      ******************************************************************00570000
      *    DB2 INCLUDES                                                *00580000
      ******************************************************************00590000
           EXEC SQL                                                     00610000
              INCLUDE SQLCA                                             00620000
           END-EXEC.                                                    00630000
                                                                        
           EXEC SQL                                                     00650000
              INCLUDE TBMODEL                                           00660000
           END-EXEC.                                                    00670000
                                                                        
           EXEC SQL                                                     00690000
              INCLUDE TBCNTRCT                                          00700000
           END-EXEC.                                                    00710000
                                                                        
           EXEC SQL                                                     00730000
              INCLUDE TBCNTINF                                          00740000
           END-EXEC.                                                    00750000
                                                                        
           EXEC SQL                                                     00770000
              INCLUDE TBARCNTL                                          00780000
           END-EXEC.                                                    00790000
                                                                        
      ******************************************************************00820000
      *    COBOL WORKING STORAGE COPY BOOKS                            *00830000
      ******************************************************************00840000
                                                                        
CVT999*    COPY SYGWCOB.                                                00860000
CVT999*    COPY SYDBCOB.                                                00870000
           COPY CCA00001.                                               00880000
CVT999*    COPY CWS00010.                                               00890000
           COPY CWS00027.                                               00900000
           COPY CWS00303.                                               00910000
                                                                        
      ******************************************************************00930000
      *    WORK AREAS                                                  *00940000
      ******************************************************************00950000
                                                                        
       01  GW-LIB-MISC-FIELDS.                                          
CVT999*    05  GWL-PROC                   POINTER.                      00980000
CVT999*    05  GWL-INIT-HANDLE            POINTER.                      00990000
CVT999*    05  GWL-RC                     PIC S9(9) COMP.               01000000
CVT999*    05  GWL-STATUS-NR              PIC S9(9) COMP.               01010000
CVT999*    05  GWL-STATUS-DONE            PIC S9(9) COMP.               01020000
CVT999*    05  GWL-STATUS-COUNT           PIC S9(9) COMP.               01030000
CVT999*    05  GWL-STATUS-COMM            PIC S9(9) COMP.               01040000
CVT999*    05  GWL-STATUS-RETURN-CODE     PIC S9(9) COMP.               01050000
           05  GWL-STATUS-SUBCODE         PIC S9(9) COMP.               
                                                                        
       01  FILLER                         PIC X(11) VALUE 'PARM FIELDS'.
                                                                        
       01  PARM-FIELDS.                                                 
           05  PARM-L                     PIC S9(9) COMP.               
CVT999*    05  PARM-ID1                   PIC S9(9) COMP VALUE 0.       01120000
           05  PARM-ACCOUNT-NO            PIC X(13)      VALUE SPACES.  
                                                                        
       01  SNA-FIELDS.                                                  
           05  SNA-SUBC                   PIC S9(9) COMP.               
CVT999*    05  SNA-CONNECTION-NAME        PIC X(8)  VALUE SPACES.       01170000
                                                                        
       01  COUNTER-FIELDS.                                              
CVT999*    05  CTR-COLUMN                 PIC S9(9) COMP VALUE 0.       01200000
           05  CTR-ROWS                   PIC S9(9) COMP VALUE 0.       
                                                                        
       01  WORK-FIELDS.                                                 
CVT999*    05  MAX-LENGTH-PARM            PIC S9(9) COMP.               01240000
CVT999*    05  WRKLEN1                    PIC S9(9) COMP.               01250000
CVT999*    05  WRKLEN2                    PIC S9(9) COMP.               01260000
           05  WRK-DONE-STATUS            PIC S9(9) COMP.               
                                                                        
       01  FILLER  PIC X(32) VALUE 'THIS IS THE ROW RETURN AREA.'.      
                                                                        
       01  GTT-RETURN-FIELDS.                                           
           05 RS-CONTRACT-ID          PIC S9(9)     COMP VALUE +0.      
           05 RS-CONTRACT-NAME-ABBR   PIC X(10)     VALUE SPACES.       
           05 RS-AR-TRAN-BAL          PIC S9(09)V99 COMP-3 VALUE +0.    
TP5944     05 RS-LIEN-CD              PIC X(1)      VALUE 'N'.          
P00795     05 RS-TRANSFER-FL          PIC X(1)      VALUE 'N'.          
A07021     05 RS-CNT-NAME-DESC        PIC X(30)     VALUE SPACES.       
           05 RS-RETURN-CODE          PIC S9(09) COMP VALUE 0.          
                                                                        
       01  WS-PROGRAM-NAME.                                             
           05  PROGRAM-NAME               PIC X(08) VALUE 'S146'.       
                                                                        
       01  SWITCHES.                                                    
           05  ALL-DONE-SW                PIC X(01) VALUE 'N'.          
               88 NOT-ALL-DONE                      VALUE 'N'.          
               88 ALL-DONE                          VALUE 'Y'.          
           05  SEND-DONE-SW               PIC X(01) VALUE 'Y'.          
               88 SEND-DONE-ERROR                   VALUE 'N'.          
               88 SEND-DONE-OK                      VALUE 'Y'.          
                                                                        
       01  STORAGE-FIELDS.                                              
           05  WS-PARM-FIELDS.                                          
               10 WS-ACCOUNT-NO.                                        
                  11 WS-ACCOUNT-NO-N      PIC S9(13)V.                  
COB305         10 WS-ACCOUNT-NO-COMP        PIC S9(13)V COMP-3 VALUE 0.         
           05  WS-RESULTS-RETURNED        PIC X(01) VALUE 'N'.          
                                                                        
      ******************************************************************01690000
      *                  CONTRACT CURSORS                              *01700000
      * LIEN CODE IS BEING RETRIEVED AS PER PCR0238                    *01710000
      ******************************************************************01720000
                                                                        
           EXEC SQL                                                     
               DECLARE CONTRACT CURSOR FOR                              
                  SELECT CT.CNT_ITEM_ID,                                
                         CT.PYMT_PRIORITY_LVL,                          
                         K6.CNT_NAME_ABBR,                              
P00795                   CT.LIEN_CD,                                    
P00795                   K6.TRANSFER_FL,                                
A07021                   K6.CNT_NAME_DESC                               
                    FROM CSS_CONTRACT CT,                               
                         CSS_CONTRACT_INFO K6                           
                   WHERE CT.ACCOUNT_NO  = :CT-ACCOUNT-NO                
                     AND CT.CNT_NAME_CD = K6.CNT_NAME_CD                
           END-EXEC.                                                    
                                                                        
HPCCDM*EJECT                                                            01870000
                                                                        
                                                                        
CVT000     EXEC SQL                                                     00000010
CVT000         INCLUDE CWSX0010                                         00000020
CVT000     END-EXEC.                                                    00000030
CVT000                                                                  
CVT000 01  CSRERLOG-P.                                                  
CVT000     10  S-SP-NAME                 PIC X(18) VALUE SPACES.        
CVT000     10  S-SQLCODE                 PIC S9(9) COMP VALUE 0.        
CVT000     10  S-SQLSTATE                PIC X(5)  VALUE ' '.           
CVT000     10  S-TABLE-NAME              PIC X(18) VALUE SPACES.        
CVT000     10  S-HOST-VARIABLES.                                        
CVT000         49  S-HOST-VARIABLES-L    PIC S9(4) USAGE COMP.          
CVT000         49  S-HOST-VARIABLES-V    PIC X(255).                    
CVT000     10  S-SQL-STATEMENT.                                         
CVT000         49  S-SQL-STATEMENT-L     PIC S9(4) USAGE COMP.          
CVT000         49  S-SQL-STATEMENT-V     PIC X(255).                    
CVT000     10  S-SQL-DESCRIPTION.                                       
CVT000         49  S-SQL-DESCRIPTION-L   PIC S9(4) USAGE COMP.          
CVT000         49  S-SQL-DESCRIPTION-V   PIC X(255).                    
CVT000     10  WS-ABEND-SQLERRMC.                                       
CVT000         49  WS-ABEND-SQLERRMC-L   PIC S9(4) USAGE COMP.          
CVT000         49  WS-ABEND-SQLERRMC-V   PIC X(255).                    
CVT000     10  S-RETURN-CODE             PIC S9(9) COMP VALUE 0.        
CVT000     10  WS-SQLSTATE               PIC X(05) VALUE SPACES.        
CVT000                                                                  
CVT000                                                                  
CVT000                                                                  
CVT000                                                                  
CVT000     EXEC SQL                                                     
CVT000         DECLARE C1 CURSOR  FOR                        
CVT000         SELECT *                                                 
CVT000         FROM #CSR02146_R1                                 
CVT000     END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ049
MFA-TR*    EXEC SQL                                                     00000100
MFA-TR*        DECLARE C1 CURSOR WITH RETURN FOR                        00000300
MFA-TR*        SELECT *                                                 00000400
MFA-TR*        FROM SESSION.CSR02146_R1                                 00000500
MFA-TR*    END-EXEC.                                                    00000700
CVT000                                                                  
                                                                        
CVT000 LINKAGE SECTION.                                                 
CVT000 01  LINK-ACCOUNT-NO          PIC X(13)                .          
                                                                        
CVT000 PROCEDURE DIVISION USING                                         
CVT000          LINK-ACCOUNT-NO                                         
CVT000         .                                                        
CVT000     EXEC SQL                                                     
CVT000         WHENEVER SQLWARNING                                      
CVT000             CONTINUE                                             
CVT000     END-EXEC.                                                    
CVT000                                                                  
CVT000     EXEC SQL                                                     
CVT000         WHENEVER SQLERROR                                        
CVT000             CONTINUE                                             
CVT000     END-EXEC.                                                    
CVT000                                                                  
CVT000     EXEC SQL                                                     
CVT000         WHENEVER NOT FOUND                                       
CVT000             CONTINUE                                             
CVT000     END-EXEC.                                                    
CVT999*PROCEDURE DIVISION.                                              01900000
                                                                        
                                                                        
      ******************************************************************01930000
      * 0000-MAINLINE                                                  *01940000
      *     CONTROLS THE MAIN PATH OF THE PROGRAM                      *01950000
      *                                                                *01951000
      *                                                                *01952000
      ******************************************************************01960000
       0000-MAINLINE.                                                   
                                                                        
           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.             
                                                                        
       0000-EXIT.                                                       
           EXIT.                                                        
                                                                        
                                                                        
      ******************************************************************02080000
      * 0100-INITIALIZE                                                *02090000
      *                                                                *02100000
      *     1. RESET DB2 ERROR HANDLERS                                *02110000
      *     2. ESTABLISH GATEWAY ENVIRONMENT (TDINIT)                  *02120000
      *     3. ACCEPT CLIENT REQUEST/ESTABLISH SNA HANDLE (TDACCEPT)   *02130000
      *     4. DETERMINE IF CLIENT HAS SENT AN RPC PARAMETER (TDRESULT)*02140000
      *                                                                *02150000
      ******************************************************************02160000
       0100-INITIALIZE.                                                 
                                                                        
CVT999*    EXEC SQL WHENEVER SQLWARNING CONTINUE END-EXEC.              02200000
CVT999*    EXEC SQL WHENEVER SQLERROR   CONTINUE END-EXEC.              02210000
CVT999*    EXEC SQL WHENEVER NOT FOUND  CONTINUE END-EXEC.              02220000
                                                                        
CVT999*    CALL 'TDINIT'   USING DFHEIBLK, GWL-RC, GWL-INIT-HANDLE.     02240000
                                                                        
CVT999*    CALL 'TDACCEPT' USING GWL-PROC, GWL-RC, GWL-INIT-HANDLE,     02260000
CVT999*                          SNA-CONNECTION-NAME, SNA-SUBC.         02270000
                                                                        
CVT999*    CALL 'TDRESULT' USING GWL-PROC, GWL-RC.                      02290000
                                                                        
CVT999*    IF GWL-RC NOT = TDS-PARM-PRESENT                             02310000
CVT999*        MOVE PROGRAM-NAME         TO ABEND-PROGRAM               02320000
CVT999*        MOVE '0100'               TO ACTIVE-PARAGRAPH            02330000
CVT999*        MOVE 'TDRESULT - NO RPC PARM SENT' TO ABEND-FUNCTION     02340000
CVT999*        MOVE 'CICS TRANSACTION'   TO TABLE-1                     02350000
CVT999*        MOVE GWL-RC               TO WS-ACTIVE-RETURN-CODE       02360000
CVT999*        PERFORM 9000-SEND-ERROR-RESULT    THRU 9000-EXIT         02370000
CVT999*        PERFORM 9900-SQL-ERROR-ROUTINE    THRU 9900-EXIT         02380000
CVT999*    END-IF.                                                      02390000
                                                                        
CVT000     MOVE LINK-ACCOUNT-NO           TO PARM-ACCOUNT-NO          . 
CVT000     PERFORM 0100A-DECLARE-GTT                                    
CVT000       THRU 0100A-EXIT.                                           
       0100-EXIT.                                                       
           EXIT.                                                        
                                                                        
CVT000 0100A-DECLARE-GTT.                                               
CVT000     EXEC SQL
             CALL CIS.DROP_TEMP_TABLE('#CSR02146_R1')
           END-EXEC
           EXEC SQL
             CREATE TABLE #CSR02146_R1
              (                                                          
CVT000         CONTRACT_ID              INT                         
CVT000        ,CONTRACT_NAME_ABBR CHAR(10)  COLLATE 
                            LATIN1_GENERAL_100_BIN2                        
CVT000        ,AR_TRAN_BAL              DECIMAL(11,2)                   
CVT000        ,LIEN_CD CHAR(1)  COLLATE LATIN1_GENERAL_100_BIN2                 
P00795        ,TRANSFER_FL CHAR(1)  COLLATE LATIN1_GENERAL_100_BIN2             
A07021        ,CNT_NAME_DESC CHAR(30)  COLLATE LATIN1_GENERAL_100_BIN2          
CVT000        ,RETURN_CODE              INT                         
CVT000       )
           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               
                   NEXT SENTENCE                                        
               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 'CSR03501_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.                                                      
CVT000 0100A-EXIT.                                                      
CVT000         EXIT.                                                    
                                                                        
                                                                        
                                                                        
      ******************************************************************02450000
      * 1000-PROCESS-INPUT                                             *02460000
      *                                                                *02470000
      *     1. RECEIVE PARMS.                                          *02480000
      *     2. ASSIGNS PARMS TO WORKING STORAGE.                       *02490000
      *                                                                *02500000
      ******************************************************************02510000
       1000-PROCESS-INPUT.                                              
           MOVE '1000'                        TO ACTIVE-PARAGRAPH.      
                                                                        
           PERFORM 1100-RECEIVE-PARMS         THRU 1100-EXIT.           
           PERFORM 1150-ASSIGN-WS-VARS        THRU 1150-EXIT.           
                                                                        
       1000-EXIT.                                                       
           EXIT.                                                        
                                                                        
                                                                        
      ******************************************************************02630000
      * 1100-RECEIVE-PARMS                                             *02640000
      *                                                                *02650000
      *     RECEIVE EACH PARAMETER FROM THE REMOTE PROCEDURE           *02660000
      *                                                                *02670000
      ******************************************************************02680000
       1100-RECEIVE-PARMS.                                              
                                                                        
CVT999*    ADD  1                             TO PARM-ID1.              02710000
CVT999*    MOVE LENGTH OF PARM-ACCOUNT-NO     TO MAX-LENGTH-PARM,       02720000
CVT999*                                                                 02730000
CVT999*    CALL 'TDRCVPRM' USING GWL-PROC,                              02740000
CVT999*                          GWL-RC,                                02750000
CVT999*                          PARM-ID1,                              02760000
CVT999*                          PARM-ACCOUNT-NO,                       02770000
CVT999*                          TDSCHAR,                               02780000
CVT999*                          MAX-LENGTH-PARM,                       02790000
CVT999*                          PARM-L.                                02800000
                                                                        
       1100-EXIT.                                                       
           EXIT.                                                        
                                                                        
                                                                        
      ******************************************************************02870000
      * 1150 ASSIGN-WS-VARS                                            *02880000
      *     -- THIS MODULE MOVES THE PASSED IN PARAMETER VALUES AND    *02890000
      *        MOVES THEM INTO WORKING STORAGE VARIABLES.  THEN,       *02900000
      *        THESE WORKING STORAGE VARIABLES ARE MOVED INTO THEIR    *02910000
      *        RESPECTIVE REDEFINED FIELDS FOR COMPLETING THE SQL      *02920000
      *        SELECT STATEMENTS.                                      *02930000
      ******************************************************************02940000
       1150-ASSIGN-WS-VARS.                                             
           MOVE '1150'                        TO ACTIVE-PARAGRAPH.      
                                                                        
           MOVE PARM-ACCOUNT-NO               TO WS-ACCOUNT-NO.         
           MOVE WS-ACCOUNT-NO-N               TO WS-ACCOUNT-NO-COMP.    
           MOVE WS-ACCOUNT-NO-COMP            TO CT-ACCOUNT-NO.         
                                                                        
       1150-EXIT.                                                       
           EXIT.                                                        
                                                                        
                                                                        
      ******************************************************************03060000
      * 2000-PROCESS-OUTPUT.                                           *03070000
      *                                                                *03080000
      *     1. DESCRIBE RESULT SET                                     *03090000
      *     2. RETRIVE DB2 DATA                                        *03100000
      *     3. BUILD RESULT SET                                        *03110000
      *     4. SEND RESULT SET                                         *03120000
      *                                                                *03130000
      ******************************************************************03140000
       2000-PROCESS-OUTPUT.                                             
                                                                        
           MOVE '2000'                      TO ACTIVE-PARAGRAPH.        
                                                                        
           PERFORM 7000-OPEN-CONT-CURSOR    THRU 7000-EXIT.             
           PERFORM 7100-FETCH-CONTRACT      THRU 7100-EXIT.             
                                                                        
           IF WS-ACTIVE-RETURN-CODE = NOT-FOUND                         
              PERFORM 8100-SEND-RESULT      THRU 8100-EXIT              
              MOVE 'Y'                      TO WS-RESULTS-RETURNED      
           END-IF.                                                      
                                                                        
           PERFORM 5000-PROCESS-CONTRACTS   THRU 5000-EXIT              
              UNTIL WS-ACTIVE-RETURN-CODE = NOT-FOUND.                  
                                                                        
           PERFORM 7200-CLOSE-CONT-CURSOR   THRU 7200-EXIT.             
                                                                        
           IF WS-RESULTS-RETURNED = 'N'                                 
              MOVE +100                     TO RS-RETURN-CODE           
              MOVE SPACES                   TO RS-LIEN-CD               
P00795        MOVE SPACES                   TO RS-TRANSFER-FL           
A07021        MOVE SPACES                   TO RS-CNT-NAME-DESC         
              PERFORM 8100-SEND-RESULT      THRU 8100-EXIT              
           END-IF.                                                      
                                                                        
       2000-EXIT.                                                       
           EXIT.                                                        
                                                                        
      ******************************************************************04720000
      * 5000-PROCESS-CONTRACTS.                                        *04730000
      *                                                                *04740000
      *     1. FETCH CONTRACT                                          *04750000
      *     2. SEND RESULTS                                            *04760000
      *                                                                *04770000
      ******************************************************************04780000
       5000-PROCESS-CONTRACTS.                                          
                                                                        
           MOVE '5000'                      TO ACTIVE-PARAGRAPH.        
                                                                        
           PERFORM 7300-GET-AR-BALANCE      THRU 7300-EXIT              
                                                                        
           IF AC-AMT-TRAN-BALANCE > 0                                   
              PERFORM 5100-BUILD-RESULT     THRU 5100-EXIT              
              PERFORM 8100-SEND-RESULT      THRU 8100-EXIT              
              MOVE 'Y'                      TO WS-RESULTS-RETURNED      
           END-IF.                                                      
                                                                        
           PERFORM 7100-FETCH-CONTRACT      THRU 7100-EXIT.             
                                                                        
       5000-EXIT.                                                       
           EXIT.                                                        
                                                                        
                                                                        
      ******************************************************************04930000
      * 5100 BUILD RESULT.                                             *04940000
      *                                                                *04941000
      *   MOVE THE RETRIVED FIELDS TO THEIR RESPECTIVE RESULT FIELD.   *04950000
      *                                                                *04960000
      ******************************************************************04970000
       5100-BUILD-RESULT.                                               
                                                                        
           MOVE '5100'                    TO ACTIVE-PARAGRAPH.          
                                                                        
           MOVE CT-CNT-ITEM-ID            TO RS-CONTRACT-ID.            
           MOVE K6-CNT-NAME-ABBR          TO RS-CONTRACT-NAME-ABBR.     
           MOVE AC-AMT-TRAN-BALANCE       TO RS-AR-TRAN-BAL.            
           MOVE CT-LIEN-CD                TO RS-LIEN-CD.                
P00795     MOVE K6-TRANSFER-FL            TO RS-TRANSFER-FL.            
A07021     MOVE K6-CNT-NAME-DESC          TO RS-CNT-NAME-DESC.          
                                                                        
       5100-EXIT.                                                       
           EXIT.                                                        
                                                                        
                                                                        
      ******************************************************************05100000
      * 7000 OPEN CONT CURSOR                                          *05110000
      *                                                                *05111000
      *   THIS MODULE RETRIEVES ACCOUNT INFORAMTION.                   *05120000
      *                                                                *05121000
      ******************************************************************05130000
       7000-OPEN-CONT-CURSOR.                                           
                                                                        
           MOVE '7000'                       TO ACTIVE-PARAGRAPH.       
                                                                        
           EXEC SQL                                                     
               OPEN CONTRACT                                            
           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                                                         
              MOVE PROGRAM-NAME              TO ABEND-PROGRAM           
              MOVE 'OPEN'                    TO ABEND-FUNCTION          
              MOVE SPACES                    TO ABEND-SQL-PREDICATES    
                                                ABEND-TABLES            
              MOVE 'CSS_CONTRACT'            TO TABLE-1                 
CBSI          MOVE 'CSS_CONTRACT_INFO'       TO TABLE-2                 
CBSI          MOVE 'ACCOUNT_NO'              TO TABLE-ELEMENT-1         
CBSI          MOVE CT-ACCOUNT-NO             TO HOSTVAR-ELEMENT-1       
              PERFORM 9000-SEND-ERROR-RESULT THRU 9000-EXIT             
              PERFORM 9900-SQL-ERROR-ROUTINE THRU 9900-EXIT             
           END-IF.                                                      
                                                                        
       7000-EXIT.                                                       
           EXIT.                                                        
                                                                        
                                                                        
      ******************************************************************05390000
      * 7100 FETCH CONTRACT.                                           *05400000
      *                                                                *05401000
      *   THIS MODULE FETCHES THE RESULT ROWS                          *05410000
      *                                                                *05411000
      ******************************************************************05420000
       7100-FETCH-CONTRACT.                                             
                                                                        
           MOVE '7100'                      TO ACTIVE-PARAGRAPH.        
                                                                        
           EXEC SQL                                                     
               FETCH CONTRACT                                           
                INTO :CT-CNT-ITEM-ID,                                   
                     :CT-PYMT-PRIORITY-LVL,                             
                     :K6-CNT-NAME-ABBR,                                 
                     :CT-LIEN-CD,                                       
P00795               :K6-TRANSFER-FL,                                   
A07021               :K6-CNT-NAME-DESC                                  
           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 RS-RETURN-CODE          
                                                WS-ACTIVE-RETURN-CODE.  
                                                                        
           IF SQLCODE = SUCCESSFUL-CALL OR NOT-FOUND                    
              NEXT SENTENCE                                             
           ELSE                                                         
              MOVE PROGRAM-NAME              TO ABEND-PROGRAM           
              MOVE 'FETCH'                   TO ABEND-FUNCTION          
              MOVE SPACES                    TO ABEND-SQL-PREDICATES    
                                                ABEND-TABLES            
              MOVE 'CSS_CONTRACT'            TO TABLE-1                 
CBSI          MOVE 'CSS_CONTRACT_INFO'       TO TABLE-2                 
              MOVE 'ACCOUNT_NO'              TO TABLE-ELEMENT-1         
              MOVE WS-ACCOUNT-NO             TO HOSTVAR-ELEMENT-1       
              PERFORM 9000-SEND-ERROR-RESULT THRU 9000-EXIT             
              PERFORM 9900-SQL-ERROR-ROUTINE THRU 9900-EXIT             
           END-IF.                                                      
                                                                        
       7100-EXIT.                                                       
           EXIT.                                                        
                                                                        
                                                                        
      ******************************************************************05760000
      * 7200 CLOSE CONT CURSOR.                                        *05770000
      *                                                                *05771000
      *    THIS MODULE CLOSES THE CONTRACT CURSOR                      *05780000
      *                                                                *05781000
      ******************************************************************05790000
       7200-CLOSE-CONT-CURSOR.                                          
                                                                        
           MOVE '7200'                       TO ACTIVE-PARAGRAPH.       
                                                                        
           EXEC SQL                                                     
               CLOSE CONTRACT                                           
           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 RS-RETURN-CODE          
                                             WS-ACTIVE-RETURN-CODE.     
                                                                        
           IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL                   
               NEXT SENTENCE                                            
           ELSE                                                         
              MOVE PROGRAM-NAME              TO ABEND-PROGRAM           
CBSI          MOVE 'CLOSE'                   TO ABEND-FUNCTION          
              MOVE SPACES                    TO ABEND-SQL-PREDICATES    
                                                ABEND-TABLES            
CBSI          MOVE 'CSS_CONTRACT'            TO TABLE-1                 
CBSI          MOVE 'CSS_CONTRACT_INFO'       TO TABLE-2                 
CBSI          MOVE 'ACCOUNT_NO'              TO TABLE-ELEMENT-1         
CBSI          MOVE CT-ACCOUNT-NO             TO HOSTVAR-ELEMENT-1       
              PERFORM 9000-SEND-ERROR-RESULT THRU 9000-EXIT             
              PERFORM 9900-SQL-ERROR-ROUTINE THRU 9900-EXIT             
           END-IF.                                                      
                                                                        
       7200-EXIT.                                                       
           EXIT.                                                        
                                                                        
                                                                        
      ******************************************************************06080000
      * 7300-GET-AR-BALANCE.                                           *06090000
      *                                                                *06091000
      *    THIS RETRIEVES AR-BALANCES IF THERE IS ONE.                 *06100000
      *                                                                *06101000
      ******************************************************************06110000
       7300-GET-AR-BALANCE.                                             
                                                                        
           MOVE '7300'                       TO ACTIVE-PARAGRAPH.       
                                                                        
           EXEC SQL                                                     
                SELECT AMT_TRAN_BALANCE                                 
                  INTO :AC-AMT-TRAN-BALANCE                             
                  FROM CSS_AR_CNTL                                      
                 WHERE ACCOUNT_NO        = :CT-ACCOUNT-NO               
                   AND ITEM_ID           = :CT-CNT-ITEM-ID              
                   AND PYMT_PRIORITY_LVL = :CT-PYMT-PRIORITY-LVL        
           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 RS-RETURN-CODE           
                                               WS-ACTIVE-RETURN-CODE.   
                                                                        
           IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL                   
               NEXT SENTENCE                                            
           ELSE                                                         
           IF WS-ACTIVE-RETURN-CODE = NOT-FOUND                         
              MOVE 0                        TO AC-AMT-TRAN-BALANCE      
           ELSE                                                         
              MOVE PROGRAM-NAME             TO ABEND-PROGRAM            
              MOVE 'SELECT'                 TO ABEND-FUNCTION           
              MOVE SPACES                   TO ABEND-SQL-PREDICATES     
                                               ABEND-TABLES             
              MOVE 'CSS_AR_CNTL'            TO TABLE-1                  
              MOVE 'ACCOUNT_NO'             TO TABLE-ELEMENT-1          
              MOVE WS-ACCOUNT-NO            TO HOSTVAR-ELEMENT-1        
              MOVE 'ITEM_ID'                TO TABLE-ELEMENT-2          
              MOVE CT-CNT-ITEM-ID           TO HOSTVAR-ELEMENT-2        
CBSI          MOVE 'PYMT_PRIORITY_LVL'      TO TABLE-ELEMENT-3          
CBSI          MOVE CT-PYMT-PRIORITY-LVL     TO HOSTVAR-ELEMENT-3        
              PERFORM 9000-SEND-ERROR-RESULT THRU 9000-EXIT             
              PERFORM 9900-SQL-ERROR-ROUTINE THRU 9900-EXIT             
           END-IF
           END-IF.                                                      
                                                                        
       7300-EXIT.                                                       
           EXIT.                                                        
                                                                        
                                                                        
      ******************************************************************06500000
      * 9900- JOURNALING / ERROR HANDLING INCLUDE                      *06510000
      ******************************************************************06520000
           EXEC SQL                                                     06530000
              INCLUDE CPDSP300                                          06540000
           END-EXEC.                                                    06550000
                                                                        
      ******************************************************************06570000
      * 9999- END PROGRAM COPYLIB                                      *06580000
      ******************************************************************06590000
CVT999*    COPY CPD00302.                                               06600000
                                                                        
                                                                        
CVT000 8100-SEND-RESULT.                                                
CVT000     EXEC SQL                                                     
CVT000       INSERT INTO #CSR02146_R1                            
CVT000       (                                                          
CVT000        CONTRACT_ID                                               
CVT000       ,CONTRACT_NAME_ABBR                                        
CVT000       ,AR_TRAN_BAL                                               
CVT000       ,LIEN_CD                                                   
P00795       ,TRANSFER_FL                                               
A07021       ,CNT_NAME_DESC                                             
CVT000       ,RETURN_CODE                                               
CVT000       )                                                          
CVT000       VALUES                                                     
CVT000       (                                                          
CVT000        :RS-CONTRACT-ID                                           
CVT000       ,:RS-CONTRACT-NAME-ABBR                                    
CVT000       ,:RS-AR-TRAN-BAL                                           
CVT000       ,:RS-LIEN-CD                                               
P00795       ,:RS-TRANSFER-FL                                           
A07021       ,:RS-CNT-NAME-DESC                                         
CVT000       ,:RS-RETURN-CODE                                           
CVT000       )                                                          
CVT000     END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ049
MFA-TR*    EXEC SQL                                                             
MFA-TR*      INSERT INTO SESSION.CSR02146_R1                                    
MFA-TR*      (                                                                  
MFA-TR*       CONTRACT_ID                                                       
MFA-TR*      ,CONTRACT_NAME_ABBR                                                
MFA-TR*      ,AR_TRAN_BAL                                                       
MFA-TR*      ,LIEN_CD                                                           
MFA-TR*      ,TRANSFER_FL                                                       
MFA-TR*      ,CNT_NAME_DESC                                                     
MFA-TR*      ,RETURN_CODE                                                       
MFA-TR*      )                                                                  
MFA-TR*      VALUES                                                             
MFA-TR*      (                                                                  
MFA-TR*       :RS-CONTRACT-ID                                                   
MFA-TR*      ,:RS-CONTRACT-NAME-ABBR                                            
MFA-TR*      ,:RS-AR-TRAN-BAL                                                   
MFA-TR*      ,:RS-LIEN-CD                                                       
MFA-TR*      ,:RS-TRANSFER-FL                                                   
MFA-TR*      ,:RS-CNT-NAME-DESC                                                 
MFA-TR*      ,:RS-RETURN-CODE                                                   
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

CVT000     MOVE SQLCODE                 TO WS-ACTIVE-RETURN-CODE.       
CVT000                                                                  
CVT000     IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL                   
CVT000        NEXT SENTENCE                                             
CVT000     ELSE                                                         
CVT000        MOVE PROGRAM-NAME         TO ABEND-PROGRAM                
CVT000         MOVE SQLCODE              TO ABEND-SQLCODE               
CVT000         MOVE SQLSTATE             TO ABEND-SQLSTATE              
CVT000        MOVE '8900'               TO ACTIVE-PARAGRAPH             
CVT000        MOVE 'INSERT'             TO ABEND-FUNCTION               
CVT000        MOVE 'CSR0TEST_R1'        TO TABLE-1                      
CVT000        PERFORM 9900-SQL-ERROR-ROUTINE  THRU 9900-EXIT            
CVT000     END-IF.                                                      
CVT000                                                                  
CVT000     ADD 1 TO CTR-ROWS.                                           
CVT000*    INITIALIZE GTT-RETURN-FIELDS.                                00001900
CVT000*                                                                 00002000
CVT000 8100-EXIT.                                                       
CVT000      EXIT.                                                       
CVT000******************************************************************00000100
CVT000* 8000A-DELETE-GTT-ROWS.                                         *00000200
CVT000******************************************************************00000300
CVT000 8000A-DELETE-GTT-ROWS.                                           
CVT000*                                                                 00000500
CVT000     MOVE                                                         
CVT000     'DELETE ROWS'                                                
CVT000         TO S-SQL-STATEMENT-V.                                    
CVT000*                                                                 00000900
CVT000      EXEC SQL                                                    
CVT000          DELETE FROM #CSR02146_R1                         
CVT000      END-EXEC.                                                   

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ049
MFA-TR*     EXEC SQL                                                    00001000
MFA-TR*         DELETE FROM SESSION.CSR02146_R1                         00001100
MFA-TR*     END-EXEC.                                                   00001200

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

CVT000*                                                                 00001300
CVT000      MOVE SQLCODE TO WS-ACTIVE-RETURN-CODE.                      
CVT000*                                                                 00001500
CVT000      IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL OR NOT-FOUND     
CVT000          NEXT SENTENCE                                           
CVT000      ELSE                                                        
CVT000         MOVE PROGRAM-NAME         TO ABEND-PROGRAM               
CVT000         MOVE SQLCODE              TO ABEND-SQLCODE               
CVT000         MOVE SQLSTATE             TO ABEND-SQLSTATE              
CVT000         MOVE '8000A'              TO ACTIVE-PARAGRAPH            
CVT000         MOVE 'DELETE'             TO ABEND-FUNCTION              
CVT000         MOVE SPACES               TO ABEND-SQL-PREDICATES        
CVT000                                      ABEND-TABLES                
CVT000         MOVE 'CSR02146_R1'        TO TABLE-1                     
CVT000         MOVE SPACES               TO TABLE-ELEMENT-1             
CVT000         MOVE SPACES               TO HOSTVAR-ELEMENT-1           
CVT000         PERFORM 9900-SQL-ERROR-ROUTINE  THRU 9900-EXIT           
CVT000     END-IF.                                                      
CVT000*                                                                 00003100
CVT000 8000A-EXIT.                                                      
CVT000     EXIT.                                                        
CVT000*                                                                 00003400
CVT000     EXEC SQL                                                     00000100
CVT000         INCLUDE CPD00320                                         00000200
CVT000     END-EXEC.                                                    00000300
