       IDENTIFICATION DIVISION.                                         
       PROGRAM-ID.   CSR04669.                                          
COB303 DATE-WRITTEN.     JUL 22, 2014.                                  
       DATE-COMPILED.                                                   
      *                                                                 00050000
      ******************************************************************00060000
      *                SOUTH CAROLINA ELECTRIC & GAS                   *00070000
      ******************************************************************00150000
      *                 P R O G R A M  S U M M A R Y                   *00160000
      *                                                                *00170000
      *  THIS PROGRAM UPDATES THE ACCOUNT CREDIT HISTORY DETAILS       *00200000
      *                                                                *00210000
      *                                                                *00220000
      *                                                                *00230000
      *  INPUT PARAMETERS                OUTPUT PARAMETERS             *00240000
      *  -------------------------       -----------------------       *00250000
      *  ACCOUNT-NO             X(13)    RETURN-CODE        S9(9)      *00260000
      *  ARREARS-HISTORY        X(24)    PREMISE-NO         X(10)      *00270000
      *  NORMAL-HISTORY         X(24)    SUPR-ID            X(7)       *00280000
      *  EXCEPTIONAL-HISTORY    X(24)    LOCAL-OFFICE       X(3)       *00290000
      *  NON-UTIL_HISTORY       X(24)    EFFT-DT            X(10)      *00300000
      *  CREDIT-GROUP           X(1)     AT-TIMESTAMP       X(26)      *00310000
      *  EFFECTIVE-DATE         X(10)    CZ-TIMESTAMP       X(26)      *00320000
      *  USERID                 X(7)                                   *00330000
      *  AT-TIMESTAMP           X(26)                                  *00340000
      *  CZ-TIMESTAMP           X(26)                                  *00350000
      *  TRAN-COMMENT           X(210)                                 *00360000
      *  NEXT-BILL-DATE         X(10)                                   00370000
P00726*  PROCESS-FL             X(01)                                           
P00726*  RISK-RATING-CODE       X(04)                                           
P00726*  RISK-RATING-EFFECT-DT  X(10)                                           
P00726*  APPL-RETURN-CODE       X(10)                                           
      *                                                                *00380000
      *  THE FOLLOWING TABLES ARE USED :                               *00390000
      *      TABLE NAME          DCLGEN NAME    2 CHAR ID              *00400000
      *      ------------------  -----------    ---------              *00410000
      *      CSS_ACCOUNT         TBACCT         AT                     *00420000
      *      CSS_CREDIT_PROFILE  TBCRPROF       CZ                     *00430000
      *      CSS_USER_PROFILE    TBUSRPRF       PF                     *00440000
      *      CSS_RESP_AREA       TBRSAREA       C1                     *00450000
      *                                                                *00460000
      ******************************************************************00470000
      *                                                                *00480000
      *                     PROGRAM MODIFICATION LOG                   *00490000
      *                                                                *00500000
      *    DATE    INITIALS   COMMENTS                                 *00510000
      *  --------  --------   ---------------------------------------  *00520000
      *  04/17/95    LN       CREATED.                                 *00530000
      *  07/26/95    WMG      MODIFIED TO FIX TPR #5658:               *00540000
      *                       NULL INDICATOR ADDED TO THE              *00540100
      *                       CR_GRP_EFFECT_DT COLUMN OF CSS_CREDIT_   *00540200
      *                       PROFILE TO ACCOUNT FOR NULL DATES. ALSO  *00540300
      *                       ADDED MAINTENANCE TRANSACTION JOURNALING *00540400
      *                       TABLE ID CODE FOR TRANSLATING VALUES.    *00540400
      *  01/18/96    AA       ADDED 8330- PARA TO DELETE CL ROW(S) TO  *        
      *                       FIX THE TPR # 2051 & 2470.               *        
      *  08/15/96    JEP      TPR 4799. REMOVED CWS00068.              *        
PCR263*  10/07/96    JTH      PCR 263.  REMOVED PARA OF 8330-DELETE-   *        
PCR263*                       CRED-COLL AND REPLACED WITH CPD306.      *        
      *                                                                *        
      *  03/18/97    MJG      TPR9659 THE EFFECTIVE DATE WAS NOT BEING *        
      *                       FORMATED IN MM/DD/YYYY FORMAT.           *        
T12142*  05/21/97    MJG      MOVED CALL THAT DELETES CREDIT_HIST SO   *        
      *                       IT WILL ONLY BE CALLED IF CREDIT_GROUP   *        
      *                       CHANGES.                                 *        
T16094*  05/04/98   ZB17046   MAKE CORRECTION TO MC05 LOGIC WHERE IN   *        
T16094*                       SEVERAL CASES THE FIELDS OR FIELD NAMES  *        
T16094*                       WERE NOT BEING MOVED TO THE ABEND WORK   *        
T16094*                       AREA.                                    *        
CBSI  *  08/03/98   CBSI      ABEND LOG MODIFIED TO INCLUDE ALL THE    *        
CBSI  *             MADRAS    ABEND PARAMETERS                         *        
T18478*  11/13/98   SHF       REMOVED LAST_UPDATE_TS FROM WHERE CLAUSE *        
      *                       IN PARA 7250.                            *        
T21187*  11/30/99   MDJ       IN PARA 8210, IF CZ-CR-GRP-EFFECT-DT NOT *        
      *                       = SPACES, MOVE 0 TO EFFECTIVE-DATE-IND   *        
T21957*  04/06/00   SFH       ADDED NON UTIL NORMAL AND NON UTIL       *        
      *                       EXCEPTIONAL CREDIT HISTORY TO PANEL 291. *        
C23235*  04/17/01   LEF       ADDED PANEL NO TO RPC.  THIS RPC IS NOW  *        
C23235*                       BEING CALLED BY PANEL291 AND PANEL131/132*        
C23235*                       IF PANEL131/132 IS BEING EXECUTED, THE   *        
C23235*                       APPROPRIATE CREDIT HISTORY IS UPDATED TO *        
C23235*                       'P' AND THE DATE CREDIT ACTION FOR C/F IS*        
C23235*                       UPDATED TO LOW-VALUES                    *        
      *                                                                *        
C28788*  07/11/03   MR90712   SINCE THIS RPC WILL NO LONGER BE CALLED  *        
C28788*                       FROM PANEL131/132, ALL THE LINES THAT    *        
C28788*                       REFER THESE PANELS WERE COMMENTED OUT.   *        
REARCH*  07/11/03   MR90712   RPC CONVERTED TO COBOL SP                *        
T31375*  09/07/03   COVANSYS  UNCOMMENTED TO MOVE PANEL NO TO APPL     *        
T31375*             CHENNAI   APPL PROGRAM ID                          *        
T35434*  10/10/07   MR97640   REPLACED MODEL_SQL WITH SET STATEMENT    *00570000
      *                       AND ADDED WITH UR TO AVOID -911 ABENDS.  *00570000
P00399*  12/09/10   MJ13662   IF CREDIT GROUP IS CHANGING FROM NEW TO  *00570000
P00399*                       ARREARS OR ARREARS TO NEW, DO NOT DELETE *        
P00399*                       CREDIT ACTION.                           *        
P00726*  07/22/14   AA97148   CREDIT ARRANGEMENTS RELEASE 3 CHANGES.   *        
P0726A*  01/20/15   GOKUL     PROCESS CREDIT HISTORY COMPARES ONLY WHEN*        
P0726A*                       CZ-LAST-UPDATE-TS FROM UI > SPACES.      *        
ACT233*  07/26/16   TP7R341   REPLACE CSR00028 WITH CSR04675           *00290000
ACT233*   A05460                                                       *00290000
      ******************************************************************00550000
      ******************************************************************00560000
      *                                                                *00570000
      *                ---- BASIC SEQUENCE STRUCTURE ----              *00580000
      *                                                                *00590000
      *  0000 - 0999  MAIN CONTROL PATH AND INITIALIZATION             *00600000
      *  1000 - 1999  INPUT PROCESSING CONTROL PATH                    *00610000
      *  2000 - 2999  OUTPUT PROCESSING CONTROL PATH                   *00620000
      *  3000 - 4999  NOT USED                                         *00630000
      *  5000 - 5999  COMMON PROGRAM MODULES                           *00640000
      *  6000 - 6999  COMMON SYSTEM MODULES                            *00650000
      *  7000 - 7999  INPUT MODULES                                    *00660000
      *  8000 - 8999  OUTPUT MODULES                                   *00670000
      *  9000 - 9999  TERMINATION,ABEND, MESSAGING MODULES             *00680000
      *                                                                *00690000
      ******************************************************************00700000
      *                                                                 00710000
       ENVIRONMENT DIVISION.                                            
       DATA DIVISION.                                                   
       WORKING-STORAGE SECTION.                                         

MSQ001     EXEC SQL
MSQ001      INCLUDE SQLDA
MSQ001     END-EXEC
MSQ001 01 MSQ001-SQLCABACK PIC X(136).
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 'CSR04669'.
MSQ017     COPY MFASQLM.
      *                                                                 00750000
       01  WS-START                                   PIC X(40) VALUE   
REARCH     'WORKING STORAGE FOR CSR04669 STARTS HERE'.                  
      *                                                                 00780000
      ******************************************************************00790000
      *    COBOL WORKING STORAGE COPY BOOKS                            *00800000
      ******************************************************************00810000
      *                                                                 00820000
      *--------< ERROR HANDLING >                                       00900000
REARCH     EXEC SQL                                                             
REARCH         INCLUDE CWSX0010                                                 
REARCH     END-EXEC.                                                            
      *--------< ERROR WORK AREA - SUPPORTS ONLINE/CSR JOURNALS >       00920000
           COPY CWS00027.                                               00930000
      *--------< SUPPORTS DB2 AND SQL ERROR CHECKING >                  00940000
           COPY CWS00303.                                               00950000
      *                                                                 00960000
      ******************************************************************00970000
      *    DB2 INCLUDES                                                *00980000
      ******************************************************************00990000
      *                                                                 01000000
           EXEC SQL                                                     01010000
              INCLUDE SQLCA                                             01020000
           END-EXEC.                                                    01030000
      *                                                                 01080000
P00399*-------------< CSS_ACCOUNT AT >                                  01090000
           EXEC SQL                                                     01100000
              INCLUDE TBACCT                                            01110000
           END-EXEC.                                                    01120000
      *                                                                         
P00399*-------------< CSS_CREDIT_PROFILE CZ >                           01140000
           EXEC SQL                                                     01150000
              INCLUDE TBCRPROF                                          01160000
           END-EXEC.                                                    01170000
      *                                                                 01180000
P00726*-------------< CSS_LOSS_RESERVE   ZL >                           01140000
P00726*                                                                 01180000
P00726     EXEC SQL                                                     01150000
P00726        INCLUDE TBLOSRES                                          01160000
P00726     END-EXEC.                                                    01170000
P00726*                                                                 01180000
P00726*-------------< CSS_CUST_MISC_INFO LQ >                           01140000
P00726*                                                                 01180000
P00726     EXEC SQL                                                     01150000
P00726        INCLUDE TBCSTMSC                                          01160000
P00726     END-EXEC.                                                    01170000
P00726*                                                                 01180000
      *-------------< CSS_MNT_TRANS_HIST MH >                           01190000
           EXEC SQL                                                     01200000
              INCLUDE TBMNHIST                                          01210000
           END-EXEC.                                                    01220000
      *                                                                 01230000
      *-------------< CSS_MN_TRN_HST_DET MI >                           01240000
           EXEC SQL                                                     01250000
              INCLUDE TBMNHDT                                           01260000
           END-EXEC.                                                    01270000
      *                                                                 01280000
      *-------------< CSS_USER_PROFILE PF >                             01290000
           EXEC SQL                                                     01300000
              INCLUDE TBUSRPRF                                          01310000
           END-EXEC.                                                    01320000
      *                                                                 01330000
      *-------------< CSS_RESP_AREA C1 >                                01340000
           EXEC SQL                                                     01350000
              INCLUDE TBRSAREA                                          01360000
           END-EXEC.                                                    01370000
      *                                                                 01380000
      *-------------< CSS_CRED_COLL CL >                                01240000
           EXEC SQL                                                     01250000
              INCLUDE TBCRCOLL                                          01260000
           END-EXEC.                                                    01270000
      *                                                                 01280000
      *--------< WORKING STORAGE WS-CODES-DATA-PRESENT >                01440000
           EXEC SQL                                                     01450000
              INCLUDE CWS00056                                          01460000
           END-EXEC.                                                    01470000
      *                                                                 01480000
ACT233*01 LOC4675 USAGE SQL TYPE IS RESULT-SET-LOCATOR VARYING.         
      *                                                                 01480000
      ******************************************************************01490000
      *    WORK AREAS                                                  *01500000
      ******************************************************************01510000
      *                                                                 01520000
       01  WS-MISC-FIELDS.                                              
REARCH     05  PROGRAM-NAME                 PIC X(8)   VALUE 'CSR04669'.
P00726     05  WS-PROGRAM-NAME              PIC X(8)   VALUE 'CSR04669'.
REARCH     05  WS-SQLSTATE                  PIC X(5)   VALUE SPACES.    
T31375*    05  WS-PANEL-NO                  PIC X(08)  VALUE SPACES.            
P00726     05  WS-OLD-RISK-RATING-TEXT      PIC X(15)  VALUE SPACES.    
P00726     05  WS-NEW-RISK-RATING-TEXT      PIC X(15)  VALUE SPACES.    
P00726     05  WS-RISK-RATING-TEXT          PIC X(15)  VALUE SPACES.    
P00726     05  WS-OLD-LOSS-RESERVE-CD       PIC S9(4)  COMP VALUE 0.    
P00726     05  WS-NEW-LOSS-RESERVE-CD       PIC S9(4)  COMP VALUE 0.    
P00726     05  WS-LOSS-RESERVE-CD           PIC S9(4)  COMP VALUE 0.    
P00726     05  WS-OLD-LOSS-RESRVE-EFF-DT    PIC X(10)  VALUE SPACES.    
P00726     05  WS-NEW-LOSS-RESRVE-EFF-DT    PIC X(10)  VALUE SPACES.    
P00726     05  WS-CUST-EXISTS-FLAG          PIC X(03)  VALUE 'NO '.     
P00726         88  CUST-EXISTS                         VALUE 'YES'.     
           05  WS-WQ-COMMENT                PIC X(50) VALUE             
               'CREDIT HISTORY/GROUP WAS CHANGED FOR THIS CUSTOMER'.    
      *                                                                 01640000
       01  FILLER                      PIC X(11) VALUE 'PARM FIELDS'.   
      *                                                                 01660000
       01  PARM-FIELDS.                                                 
REARCH     05  PARM-ACCOUNT-NO-TEMP        PIC X(13).                   
REARCH     05  PARM-ACCOUNT-RED REDEFINES PARM-ACCOUNT-NO-TEMP          
REARCH                                     PIC 9(13).                   
      *                                                                 01870000
       01 WS-NEW-FIELDS.                                                
           05  WNEW-L                  PIC S9(9) COMP.                  
           05  WNEW-ID1                PIC S9(9) COMP VALUE 1.          
           05  WNEW-ACCOUNT-NO             PIC X(13).                   
           05  WNEW-ARREARS-HISTORY        PIC X(24).                   
           05  WNEW-NORMAL-HISTORY         PIC X(24).                   
           05  WNEW-EXCEPTIONAL-HISTORY    PIC X(24).                   
           05  WNEW-NON-UTIL-HISTORY       PIC X(24).                   
           05  WNEW-CREDIT-GROUP           PIC X(1).                    
           05  WNEW-EFFECTIVE-DATE.                                     
               10  WNEW-EFFECTIVE-YEAR     PIC X(4).                    
               10  WNEW-FILL1              PIC X(1).                    
               10  WNEW-EFFECTIVE-MONTH    PIC X(2).                    
               10  WNEW-FILL2              PIC X(1).                    
               10  WNEW-EFFECTIVE-DAY      PIC X(2).                    
           05  WNEW-LAST-AT-UPDATE-TS      PIC X(26).                   
           05  WNEW-LAST-CZ-UPDATE-TS      PIC X(26).                   
T21957     05  WNEW-NON-UTIL-NORMAL        PIC X(24).                   
T21957     05  WNEW-NON-UTIL-EXCEPT        PIC X(24).                   
      *                                                                 02050000
       01 WS-OLD-FIELDS.                                                
           05  WOLD-L                  PIC S9(9) COMP.                  
           05  WOLD-ID1                PIC S9(9) COMP VALUE 1.          
           05  WOLD-ACCOUNT-NO             PIC X(13).                   
           05  WOLD-ARREARS-HISTORY        PIC X(24).                   
           05  WOLD-NORMAL-HISTORY         PIC X(24).                   
           05  WOLD-EXCEPTIONAL-HISTORY    PIC X(24).                   
           05  WOLD-NON-UTIL-HISTORY       PIC X(24).                   
           05  WOLD-CREDIT-GROUP           PIC X(1).                    
           05  WOLD-EFFECTIVE-DATE         PIC X(10).                   
           05  WOLD-LAST-AT-UPDATE-TS      PIC X(26).                   
           05  WOLD-LAST-CZ-UPDATE-TS      PIC X(26).                   
T21957     05  WOLD-NON-UTIL-NORMAL        PIC X(24).                   
T21957     05  WOLD-NON-UTIL-EXCEPT        PIC X(24).                   
      *                                                                 02180000
       01  WS-FLAGS.                                                    
           05  WS-ARREARS-FLAG           PIC X(1) VALUE 'N'.            
           05  WS-DISCONNECT-FLAG        PIC X(1) VALUE 'N'.            
           05  WS-EXCEPTIONAL-FLAG       PIC X(1) VALUE 'N'.            
           05  WS-CR-NON-UTIL-FLAG       PIC X(1) VALUE 'N'.            
           05  WS-CREDIT-GROUP-FLAG      PIC X(1) VALUE 'N'.            
           05  WS-GRP-EFF-DATE-FLAG      PIC X(1) VALUE 'N'.            
T21957     05  WS-CR-NON-UTIL-NORM-FLAG  PIC X(1) VALUE 'N'.            
T21957     05  WS-CR-NON-UTIL-EXCP-FLAG  PIC X(1) VALUE 'N'.            
P00726     05  WS-RISK-EFFECT-DT-FLAG    PIC X(1) VALUE 'N'.            
P00726     05  WS-RISK-RATING-CD-FLAG    PIC X(1) VALUE 'N'.            
      *                                                                 02300000
ACT233 01  CSR04675-CALL-DATA.                                          
ACT233     05 IN-ITEM-ID-4675          PIC S9(10)V COMP-3 VALUE +0.     
ACT233     05 USER-ID-ASGN-4675        PIC X(07)   VALUE SPACES.        
COB305     05 SERV-ORDER-NO-4675        PIC S9(13)V USAGE COMP-3 
COB305       VALUE 0.        
ACT233     05 DATE-REQUIRED-4675       PIC X(26)   VALUE SPACES.        
ACT233     05 CATEGORY-ID-4675         PIC S9(4)   USAGE COMP.          
COB305     05 ACCOUNT-NO-4675        PIC S9(13)V USAGE COMP-3 VALUE 0.        
COB305     05 PREMISE-NO-4675        PIC S9(10)V USAGE COMP-3 VALUE 0.        
COB305     05 CUSTOMER-NO-4675        PIC S9(10)V USAGE COMP-3 VALUE 0.        
ACT233     05 USER-ID-ORIG-4675        PIC X(7)    VALUE SPACES.        
ACT233     05 RESP-AREA-ID-4675        PIC X(3)    VALUE SPACES.        
ACT233     05 LOCAL-OFFICE-4675        PIC X(3)    VALUE SPACES.        
ACT233     05 ROUTING-CATEGORY-4675    PIC X(1)    VALUE SPACES.        
ACT233     05 WQ-PRIORITY-4675         PIC X(1)    VALUE SPACES.        
ACT233     05 DATE-CREATED-4675        PIC X(26)   VALUE SPACES.        
ACT233     05 COMMENTS-4675.                                            
ACT233        49 COMMENTS-4675-LEN     PIC S9(4)   USAGE COMP VALUE 0.  
ACT233        49 COMMENTS-4675-TEXT    PIC X(250)  VALUE SPACES.        
ACT233     05 FREE-FORM-DATA-4675.                                      
ACT233        49 FREE-FORM-DATA-4675-LEN   PIC S9(4)                    
P00726                                             USAGE COMP VALUE 0.  
ACT233        49 FREE-FORM-DATA-4675-TEXT  PIC X(255)                   
P00726                                             VALUE SPACES.        
ACT233     05 CREATED-BY-4675          PIC X(16)   VALUE SPACES.        
                                                                        
ACT233 01  CSR04675-RETURN-DATA.                                        
ACT233     10 RETURN-CODE-4675         PIC S9(9)   COMP VALUE 0.        
ACT233     10 OUT-ITEM-ID-4675         PIC S9(10)V COMP-3 VALUE 0.      
      *                                                                 02300000
       01  COUNTER-FIELDS.                                              
           05  CTR-COLUMN              PIC S9(9) COMP VALUE 1.          
           05  CTR-ROWS                PIC S9(9) COMP VALUE 0.          
           05  WS-ROW-COUNT            PIC S9(9) COMP VALUE 0.          
      *                                                                 02350000
       01  WORK-FIELDS.                                                 
           05  MAX-LENGTH-PARM         PIC S9(9) COMP.                  
           05  WRKLEN1                 PIC S9(9) COMP.                  
           05  WRKLEN2                 PIC S9(9) COMP.                  
           05  WRK-DONE-STATUS         PIC S9(9) COMP.                  
      *                                                                 02410000
       01  NULL-INDICATORS.                                             
           05  EFFECTIVE-DATE-IND      PIC S9(04) COMP.                 
           05  NULL-VALUE              PIC S9(04) COMP VALUE -1.        
P00726     05  WS-RISK-EFFECT-DT-NULL  PIC S9(04) COMP VALUE 0.         
P00726     05  WS-CONSLT-PRJ-END-DT-NULL                                
P00726                                 PIC S9(04) COMP VALUE 0.         
      *                                                                 02410300
       01  FILLER  PIC X(32) VALUE 'THIS IS THE ROW RETURN AREA.'.      
      *                                                                 02430000
REARCH 01  CSRERLOG-P.                                                  
REARCH     10  S-SP-NAME                 PIC X(18)      VALUE SPACES.   
REARCH     10  S-SQLCODE                 PIC S9(9) COMP VALUE 0.        
REARCH     10  S-SQLSTATE                PIC X(5)       VALUE ' '.      
REARCH     10  S-TABLE-NAME              PIC X(18)      VALUE SPACES.   
REARCH     10  S-HOST-VARIABLES.                                        
REARCH         49  S-HOST-VARIABLES-L    PIC S9(4) USAGE COMP.          
REARCH         49  S-HOST-VARIABLES-V    PIC X(255).                    
REARCH     10  S-SQL-STATEMENT.                                         
REARCH         49  S-SQL-STATEMENT-L     PIC S9(4) USAGE COMP.          
REARCH         49  S-SQL-STATEMENT-V     PIC X(255).                    
REARCH     10  S-SQL-DESCRIPTION.                                       
REARCH         49  S-SQL-DESCRIPTION-L   PIC S9(4) USAGE COMP.          
REARCH         49  S-SQL-DESCRIPTION-V   PIC X(255).                    
REARCH*                                                                         
REARCH 01  GTT-MISC-FIELDS.                                             
REARCH     05  GTT-NAME                  PIC X(26)                      
REARCH                                      VALUE 'SESSION.CSR04669_R1'.
REARCH     05  GTT-ROW.                                                 
REARCH         49 GTT-ROW-LEN            PIC S9(04) COMP.               
REARCH         49 GTT-ROW-CHAR           PIC X(1024).                   
REARCH     05  GTT-SQLCODE               PIC S9(9) COMP.                
REARCH*                                                                         
       01  TDS-RETURN-FIELDS.                                           
           05  RS-RETURN-CODE         PIC S9(9) COMP VALUE 0.           
           05  RS-RESP-AREA-ID        PIC X(3)  VALUE SPACES.           
           05  RS-PREMISE-NO          PIC X(10) VALUE SPACES.           
           05  RS-LOCAL-OFFICE        PIC X(3)  VALUE SPACES.           
           05  RS-SUPR-ID             PIC X(7)  VALUE SPACES.           
           05  RS-EFFT-DT             PIC X(10) VALUE SPACES.           
           05  RS-CZ-TIME             PIC X(26) VALUE SPACES.           
           05  RS-DNP-D-FLAG          PIC X(01) VALUE SPACES.           
P00726     05  RS-APPL-RETURN-CODE    PIC X(10) VALUE SPACES.           
      *                                                                 02520000
REARCH*                                                                         
REARCH 01  GTT-RETURN-FIELDS.                                           
REARCH     05  S-RETURN-CODE             PIC S9(9) COMP VALUE 0.        
REARCH     05  S-RESP-AREA-ID            PIC X(3)  VALUE SPACES.        
REARCH     05  S-PREMISE-NO              PIC X(10) VALUE SPACES.        
REARCH     05  S-LOCAL-OFFICE            PIC X(3)  VALUE SPACES.        
REARCH     05  S-SUPR-ID                 PIC X(7)  VALUE SPACES.        
REARCH     05  S-EFFT-DT                 PIC X(10) VALUE SPACES.        
REARCH     05  S-CZ-TIME                 PIC X(26) VALUE SPACES.        
REARCH     05  S-DNP-D-FLAG              PIC X(01) VALUE SPACES.        
P00726     05  S-APPL-RETURN-CODE        PIC X(10) VALUE SPACES.        
REARCH*                                                                         
      *                                                                 02620000
       01  GENERAL-WORKING-STORAGE.                                     
           05  WS-ACCOUNT-NUM          PIC X(13).                       
           05  WS-ACCOUNT-RED                                           
                  REDEFINES WS-ACCOUNT-NUM PIC 9(13).                   
COB305     05 WS-ACCOUNT-NO        PIC S9(13)V COMP-3 VALUE 0.              
COB305     05 WS-ACCOUNT-NO-D        PIC S9(13)V COMP-3 VALUE 0.              
COB305     05 WS-CUSTOMER-NO        PIC S9(10)V USAGE COMP-3 VALUE 0.        
           05  WS-PREMISE-NO           PIC X(10).                       
           05  WS-JOURNAL-COMMENT-1    PIC X(25) VALUE                  
                              'INSERT CSS_CREDIT_PROFILE'.              
           05  WS-JOURNAL-COMMENT-2    PIC X(25) VALUE                  
                              'INSERT CSS_ACCOUNT       '.              
           05  WS-RCVPRM               PIC X(20) VALUE SPACES.          
           05  WS-ROW-COUNT            PIC 9(5)  VALUE 0.               
           05  WS-MAX-LEN              PIC S9(4) COMP.                  
           05  WS-VARCHAR              PIC X(255).                      
           05  FILLER REDEFINES WS-VARCHAR.                             
               10  WS-VARCHAR-POS PIC X(01) OCCURS 255.                 
           05  WS-VARCHAR-LEN          PIC S9(4)  COMP.                 
           05  WS-RESP-AREA-ID         PIC X(03)  VALUE SPACES.         
           05  WS-TRANS-APPL-NO        PIC S9(04) COMP VALUE ZERO.      
           05  WS-CZ-LAST-UPDATE-TS    PIC X(26).                       
           05  WS-AT-LAST-UPDATE-TS    PIC X(26).                       
           05  WS-NEW-TIMESTAMP        PIC X(26).                       
           05  WS-SUPR-ID              PIC X(7)   VALUE SPACES.         
           05  WSN-EFFECTIVE-DATE.                                      
               10  WSN-EFFECTIVE-MONTH    PIC X(2).                     
               10  WSN-FILL1              PIC X(1) VALUE '/'.           
               10  WSN-EFFECTIVE-DAY      PIC X(2).                     
               10  WSN-FILL2              PIC X(1) VALUE '/'.           
               10  WSN-EFFECTIVE-YEAR     PIC X(4).                     
      *                                                                 02930000
       01  WS-LITERAL.                                                  
           05  WS-A                    PIC X(01) VALUE 'A'.             
           05  WS-B                    PIC X(01) VALUE 'B'.             
           05  WS-C                    PIC X(01) VALUE 'C'.             
           05  WS-G                    PIC X(01) VALUE 'G'.             
           05  WS-I                    PIC X(01) VALUE 'I'.             
           05  WS-M                    PIC X(01) VALUE 'M'.             
           05  WS-R                    PIC X(01) VALUE 'R'.             
      *                                                                 03020000
       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'.
MSQ001        EXEC SQL
MSQ001          DECLARE RESULT_SET_CSR_4675 CURSOR
MSQ001          FOR CALL CSR04675                                             
ACT233            ( :IN-ITEM-ID-4675
                  , :ROUTING-CATEGORY-4675
                  , :LOCAL-OFFICE-4675
                  , :USER-ID-ORIG-4675
                  , :USER-ID-ASGN-4675
                  , :RESP-AREA-ID-4675
                  , :CATEGORY-ID-4675
                  , :ACCOUNT-NO-4675
                  , :PREMISE-NO-4675
                  , :CUSTOMER-NO-4675
                  , :SERV-ORDER-NO-4675
                  , :COMMENTS-4675
                  , :DATE-REQUIRED-4675
                  , :DATE-CREATED-4675
                  , :WQ-PRIORITY-4675
                  , :FREE-FORM-DATA-4675
                  , :CREATED-BY-4675
                  )
MSQ001        END-EXEC.
             
      *                                                                         
REARCH LINKAGE SECTION.                                                 
REARCH*                                                                         
REARCH 01  PARM-ACCOUNT-NO               PIC X(13).                     
REARCH 01  PARM-ARREARS-HISTORY          PIC X(24).                     
REARCH 01  PARM-NORMAL-HISTORY           PIC X(24).                     
REARCH 01  PARM-EXCEPTIONAL-HISTORY      PIC X(24).                     
REARCH 01  PARM-NON-UTIL-HISTORY         PIC X(24).                     
REARCH 01  PARM-CREDIT-GROUP             PIC X(1).                      
REARCH 01  PARM-EFFECTIVE-DATE           PIC X(10).                     
REARCH 01  PARM-USERID                   PIC X(7).                      
REARCH 01  PARM-LAST-AT-UPD-TS           PIC X(26).                     
REARCH 01  PARM-LAST-CZ-UPD-TS           PIC X(26).                     
P00726 01  PARM-TRAN-COMMENT-LEN         PIC X(04).                     
REARCH 01  PARM-TRAN-COMMENT-TEXT        PIC X(210).                    
REARCH 01  PARM-NEXT-BILL-DATE           PIC X(10).                     
REARCH 01  PARM-NON-UTIL-NORMAL          PIC X(24).                     
REARCH 01  PARM-NON-UTIL-EXCEPT          PIC X(24).                     
P00726 01  PARM-PROCESS-FL               PIC X(01).                     
P00726 01  PARM-RISK-RATING-CODE         PIC X(02).                     
P00726 01  PARM-RISK_RATING_EFFECT_DT    PIC X(10).                     
      *                                                                 03100000
      ******************************************************************03110000
      *    CURSOR DECLARATIONS                                         *03120000
      ******************************************************************03130000
      *                                                                 03140000
      *--- < NO CURSORS IN THIS PROCEDURE >                             03150000
      *                                                                 03160000
      *                                                                 03170000
HPCCDM*EJECT                                                            03180000
REARCH PROCEDURE DIVISION USING PARM-ACCOUNT-NO                         
REARCH                         ,PARM-ARREARS-HISTORY                    
REARCH                         ,PARM-NORMAL-HISTORY                     
REARCH                         ,PARM-EXCEPTIONAL-HISTORY                
REARCH                         ,PARM-NON-UTIL-HISTORY                   
REARCH                         ,PARM-CREDIT-GROUP                       
REARCH                         ,PARM-EFFECTIVE-DATE                     
REARCH                         ,PARM-USERID                             
REARCH                         ,PARM-LAST-AT-UPD-TS                     
REARCH                         ,PARM-LAST-CZ-UPD-TS                     
REARCH                         ,PARM-TRAN-COMMENT-LEN                   
REARCH                         ,PARM-TRAN-COMMENT-TEXT                  
REARCH                         ,PARM-NEXT-BILL-DATE                     
REARCH                         ,PARM-NON-UTIL-NORMAL                    
REARCH                         ,PARM-NON-UTIL-EXCEPT                    
P00726                         ,PARM-PROCESS-FL                         
P00726                         ,PARM-RISK-RATING-CODE                   
P00726                         ,PARM-RISK_RATING_EFFECT_DT.             
REARCH*                                                                 03200000
      ******************************************************************03210000
      * 0000-MAINLINE                                                  *0320000 
      *     CALLS 0100-INITIALIZE                                      *03230000
      *           1000-PROCESS-INPUT                                   *03240000
      *           2000-PROCESS-OUTPUT                                  *03250000
      *           2400-BUILD-RESULT                                    *03260000
      *           8100-SEND-RESULT                                     *03270000
      *           9999-END-PROGRAM                                     *03280000
      *                                                                *03290000
      *     CONTROLS THE MAIN PATH OF THE PROGRAM                      *03300000
      ******************************************************************03310000
      *                                                                 03320000
       0000-MAINLINE.                                                   
      *                                                                 03340000
           PERFORM 0100-INITIALIZE               THRU 0100-EXIT.        
           PERFORM 2000-PROCESS-OUTPUT           THRU 2000-EXIT.        
           PERFORM 2400-BUILD-RESULT             THRU 2400-EXIT.        
REARCH     PERFORM 2000A-MOVE-RESULT             THRU 2000A-EXIT.       
           PERFORM 9999-END-PROGRAM              THRU 9999-EXIT.        
      *                                                                 03410000
       0000-EXIT.                                                       
           EXIT.                                                        
      *                                                                 03440000
      ******************************************************************03450000
      * 0100-INITIALIZE                                                *03460000
      *     CALLS 9000-SEND-ERROR-RESULT                               *03470000
      *           9900-SQL-ERROR-ROUTINE                               *03480000
      *                                                                *03490000
      *     CALLED FROM 0000-MAINLINE                                  *03500000
      *                                                                *03510000
      *     1. RESET DB2 ERROR HANDLERS                                *03520000
      *     2. ESTABLISH GATEWAY ENVIRONMENT (TDINIT)                  *03530000
      *     3. ACCEPT CLIENT REQUEST/ESTABLISH SNA HANDLE (TDACCEPT)   *03540000
      *     4. DETERMINE IF CLIENT HAS SENT AN RPC PARAMETER (TDRESULT)*03550000
      *                                                                *03560000
      ******************************************************************03570000
      *                                                                 03580000
       0100-INITIALIZE.                                                 
      *                                                                 03600000
           MOVE '0100'               TO ACTIVE-PARAGRAPH.               
      *                                                                 03600000
P00726     INITIALIZE DCLCSS-LOSS-RESERVE                               
P00726                DCLCSS-CUST-MISC-INFO.                            
      *                                                                 03620000
           EXEC SQL WHENEVER SQLWARNING CONTINUE END-EXEC.              
           EXEC SQL WHENEVER SQLERROR   CONTINUE END-EXEC.              
           EXEC SQL WHENEVER NOT FOUND  CONTINUE END-EXEC.              
      *                                                                 03660000
REARCH     EXEC SQL                                                     
REARCH         DECLARE C1 CURSOR  FOR                        
REARCH         SELECT                                                   
REARCH            :S-RETURN-CODE      AS RETURN_CODE                    
REARCH           ,:S-RESP-AREA-ID     AS RESP_AREA_ID                   
REARCH           ,:S-PREMISE-NO       AS PREMISE_NO                     
REARCH           ,:S-LOCAL-OFFICE     AS LOCAL_OFFICE                   
REARCH           ,:S-SUPR-ID          AS SUPR_ID                        
REARCH           ,:S-EFFT-DT          AS EFFT_DT                        
REARCH           ,:S-CZ-TIME          AS CZ_TIME                        
REARCH           ,:S-DNP-D-FLAG       AS DNP_D_FLAG                     
P00726           ,:S-APPL-RETURN-CODE AS APPL_RETURN_CODE               
REARCH         FROM                                                     
REARCH             CIS.SYSDUMMY1                                     
REARCH     END-EXEC                                                     

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ027
MFA-TR*    EXEC SQL                                                             
MFA-TR*        DECLARE C1 CURSOR WITH RETURN FOR                                
MFA-TR*        SELECT                                                           
MFA-TR*           :S-RETURN-CODE      AS RETURN_CODE                            
MFA-TR*          ,:S-RESP-AREA-ID     AS RESP_AREA_ID                           
MFA-TR*          ,:S-PREMISE-NO       AS PREMISE_NO                             
MFA-TR*          ,:S-LOCAL-OFFICE     AS LOCAL_OFFICE                           
MFA-TR*          ,:S-SUPR-ID          AS SUPR_ID                                
MFA-TR*          ,:S-EFFT-DT          AS EFFT_DT                                
MFA-TR*          ,:S-CZ-TIME          AS CZ_TIME                                
MFA-TR*          ,:S-DNP-D-FLAG       AS DNP_D_FLAG                             
MFA-TR*          ,:S-APPL-RETURN-CODE AS APPL_RETURN_CODE                       
MFA-TR*        FROM                                                             
MFA-TR*            SYSIBM.SYSDUMMY1                                             
MFA-TR*    END-EXEC                                                             
      *                                                                 03820000
       0100-EXIT.                                                       
           EXIT.                                                        
      *                                                                 03850000
      ******************************************************************05620000
      * 2000-PROCESS-OUTPUT.                                           *05630000
      *     CALLS 2100-DESCRIBE-RESULT                                 *05640000
      *           2200-PROCESS-UPDATE                                  *05650000
      *                                                                *05660000
      *      CALLED FROM 0000-MAINLINE                                 *05670000
      *                                                                *05680000
      *      SETS UP PARAMETERS TO BE RETURNED, POPULATES THE PARMS    *05690000
      *                                                                 05700000
      ******************************************************************05710000
      *                                                                 05720000
       2000-PROCESS-OUTPUT.                                             
      *                                                                 05740000
           PERFORM 2200-PROCESS-UPDATE        THRU 2200-EXIT.           
      *                                                                 05770000
       2000-EXIT.                                                       
           EXIT.                                                        
REARCH*                                                                         
REARCH*****************************************************************         
REARCH*                                                               *         
REARCH* 2000A-MOVE-RESULT.                                            *         
REARCH*                                                               *         
REARCH*****************************************************************         
REARCH*                                                                         
REARCH*                                                                         
REARCH 2000A-MOVE-RESULT.                                               
REARCH*                                                                         
REARCH     MOVE  RS-RETURN-CODE          TO S-RETURN-CODE               
P00726                                      RS-APPL-RETURN-CODE.        
REARCH     MOVE  RS-RESP-AREA-ID         TO S-RESP-AREA-ID.             
REARCH     MOVE  RS-PREMISE-NO           TO S-PREMISE-NO.               
REARCH     MOVE  RS-LOCAL-OFFICE         TO S-LOCAL-OFFICE.             
REARCH     MOVE  RS-SUPR-ID              TO S-SUPR-ID.                  
REARCH     MOVE  RS-EFFT-DT              TO S-EFFT-DT.                  
REARCH     MOVE  RS-CZ-TIME              TO S-CZ-TIME.                  
REARCH     MOVE  RS-DNP-D-FLAG           TO S-DNP-D-FLAG.               
P00726     MOVE  RS-APPL-RETURN-CODE     TO S-APPL-RETURN-CODE          
REARCH     ADD   +1  TO CTR-ROWS.                                       
REARCH*                                                                         
REARCH*                                                                         
REARCH 2000A-EXIT.                                                      
REARCH     EXIT.                                                        
      *                                                                 05800000
      ******************************************************************08750000
      * 2200-PROCESS-UPDATE                                            *08760000
      *     CALLS 2210-MOVE-FIELDS                                     *08770000
      *           2220-COMPARE-OLD-TO-NEW                              *08780000
      *           5010-JOURNALING                                      *08790000
      *                                                                *08800000
      *     CALLED FROM 2000-PROCESS-OUTPUT                            *08810000
      *                                                                *08820000
      *     PROCESSES THE UPDATE TO CREDIT HISTORY                     *08830000
      ******************************************************************08840000
      *                                                                 08850000
       2200-PROCESS-UPDATE.                                             
      *                                                                 08870000
           PERFORM 2210-MOVE-FIELDS              THRU 2210-EXIT.        
      *                                                                 08890000
           PERFORM 2220-COMPARE-OLD-TO-NEW       THRU 2220-EXIT.        
      *                                                                         
           PERFORM 5010-JOURNALING               THRU 5010-EXIT.        
      *                                                                         
       2200-EXIT.                                                       
           EXIT.                                                        
      *                                                                 08960000
      ******************************************************************08970000
      * 2210-MOVE-FIELDS                                               *08980000
      *                                                                *08990000
      *     CALLED FROM 2200-PROCESS-UPDATE                            *09000000
      *                                                                *09010000
      *     MOVES THE PARM FIELDS TO WORK FIELDS                       *09020000
      ******************************************************************09030000
      *                                                                 09040000
       2210-MOVE-FIELDS.                                                
      *                                                                 09060000
REARCH     MOVE PARM-ACCOUNT-NO            TO PARM-ACCOUNT-NO-TEMP.     
REARCH*                                                                         
           MOVE PARM-ARREARS-HISTORY       TO WNEW-ARREARS-HISTORY.     
           MOVE PARM-NORMAL-HISTORY        TO WNEW-NORMAL-HISTORY.      
           MOVE PARM-EXCEPTIONAL-HISTORY   TO WNEW-EXCEPTIONAL-HISTORY. 
           MOVE PARM-NON-UTIL-HISTORY      TO WNEW-NON-UTIL-HISTORY.    
           MOVE PARM-EFFECTIVE-DATE        TO WOLD-EFFECTIVE-DATE.      
           MOVE PARM-CREDIT-GROUP          TO WNEW-CREDIT-GROUP.        
      *                                                                 09190000
           MOVE PARM-ACCOUNT-RED           TO AT-ACCOUNT-NO.            
           MOVE PARM-USERID                TO PF-USER-ID.               
      *                                                                 09220000
           MOVE PARM-LAST-AT-UPD-TS        TO WS-AT-LAST-UPDATE-TS.     
           MOVE PARM-LAST-CZ-UPD-TS        TO WS-CZ-LAST-UPDATE-TS.     
      *                                                                 09250000
T21957     MOVE PARM-NON-UTIL-NORMAL       TO WNEW-NON-UTIL-NORMAL.     
T21957     MOVE PARM-NON-UTIL-EXCEPT       TO WNEW-NON-UTIL-EXCEPT.     
      *                                                                 09250000
T31375*    MOVE PARM-PANEL-NO              TO WS-PANEL-NO.                      
C23235*                                                                         
P00726     MOVE PARM-RISK-RATING-CODE     TO WS-NEW-LOSS-RESERVE-CD.    
P00726                                                                  
P00726     IF PARM-RISK_RATING_EFFECT_DT > SPACES THEN                  
P00726        MOVE PARM-RISK_RATING_EFFECT_DT                           
P00726                                    TO WS-NEW-LOSS-RESRVE-EFF-DT  
P00726        MOVE 0                      TO WS-RISK-EFFECT-DT-NULL     
P00726     ELSE                                                         
P00726        MOVE SPACES                 TO WS-NEW-LOSS-RESRVE-EFF-DT  
P00726        MOVE -1                     TO WS-RISK-EFFECT-DT-NULL     
P00726     END-IF.                                                      
P00726                                                                  
        2210-EXIT.                                                      
           EXIT.                                                        
      *                                                                 09280000
      ******************************************************************09290000
      * 2220-COMPARE-OLD-TO-NEW                                        *09300000
      *     CALLS 7200-SELECT-CREDIT-PROFILE                           *09310000
      *           7250-SELECT-ACCOUNT                                  *09320000
      *           2310-COMPARE-ARREARS-HIST                            *09330000
      *           2320-COMPARE-DISCONNECT-HIST                         *09340000
      *           2330-COMPARE-EXCEPTIONAL-HIS                         *09350000
      *           2340-COMPARE-CR-NON-UTIL-HIST                        *09360000
      *           2350-COMPARE-CREDIT-GROUP                            *09370000
      *                                                                *09380000
      *     CALLED FROM 2200-PROCESS-UPDATE                            *09390000
      *                                                                *09400000
      *     COMPARE THE OLD AND NEW CREDIT INFORMATION                 *09410000
      ******************************************************************09420000
                                                                        
       2220-COMPARE-OLD-TO-NEW.                                         
                                                                        
           PERFORM 7250-SELECT-ACCOUNT           THRU 7250-EXIT.        
                                                                        
P00726     IF PARM-PROCESS-FL = 'R'                                     
P00726        PERFORM 7340-SELECT-CUST              THRU 7340-EXIT      
P00726        MOVE LQ-LOSS-RESERVE-CD      TO WS-OLD-LOSS-RESERVE-CD    
P00726        MOVE LQ-LOSS-RESRVE-EFF-DT   TO WS-OLD-LOSS-RESRVE-EFF-DT 
P00726        MOVE WS-NEW-LOSS-RESERVE-CD  TO WS-LOSS-RESERVE-CD        
P00726        PERFORM 7350-SELECT-RISK-RATING-TEXT  THRU 7350-EXIT      
P00726        MOVE WS-RISK-RATING-TEXT     TO WS-NEW-RISK-RATING-TEXT   
P00726        MOVE WS-OLD-LOSS-RESERVE-CD  TO WS-LOSS-RESERVE-CD        
P00726        PERFORM 7350-SELECT-RISK-RATING-TEXT  THRU 7350-EXIT      
P00726        MOVE WS-RISK-RATING-TEXT     TO WS-OLD-RISK-RATING-TEXT   
P00726        PERFORM 2380-COMPARE-RISK-RATING-CODE THRU 2380-EXIT      
P00726        PERFORM 2390-COMPARE-RISK-EFFECT-DT   THRU 2390-EXIT      
P00726     ELSE                                                         
P0726A        IF WS-CZ-LAST-UPDATE-TS > SPACES                          
P0726A           PERFORM 7200-SELECT-CREDIT-PROFILE    THRU 7200-EXIT   
P0726A           PERFORM 2310-COMPARE-ARREARS-HIST     THRU 2310-EXIT   
P0726A           PERFORM 2320-COMPARE-DISCONNECT-HIST  THRU 2320-EXIT   
P0726A           PERFORM 2330-COMPARE-EXCEPTIONAL-HIST THRU 2330-EXIT   
P0726A           PERFORM 2340-COMPARE-CR-NON-UTIL-HIST THRU 2340-EXIT   
P0726A           PERFORM 2360-COMPARE-CR-NON-UTIL-NORM THRU 2360-EXIT   
P0726A           PERFORM 2370-COMPARE-CR-NON-UTIL-EXCP THRU 2370-EXIT   
P0726A        END-IF                                                    
P0726A        PERFORM 2350-COMPARE-CREDIT-GROUP     THRU 2350-EXIT      
P00726     END-IF.                                                      
                                                                        
       2220-EXIT.                                                       
           EXIT.                                                        
                                                                        
      ******************************************************************09580000
      * 2230-PROCESS-DELETE.                                           *09590000
      *                                                                *09600000
      *     CALLS 8320-SELECT-CREDIT-COLL                              *09610000
PCR263*           8330-DELETE-CREDIT-COLL                              *        
      *                                                                *09630000
      *     CALLED FROM 2200-PROCESS-UPDATE                            *09640000
      *                                                                *09650000
      *     SELECT TABLE CSS_CRED_COLL FOR DNP FLAG D                  *09660000
      *     DELETE ROW(S) FROM CL BASED ON CERTAIN CONDITION           *        
      ******************************************************************09670000
      *                                                                 09680000
       2230-PROCESS-DELETE.                                             
      *                                                                         
           PERFORM 8320-SELECT-CRED-COLL         THRU 8320-EXIT.        
           IF RS-DNP-D-FLAG <= SPACES                                   
              MOVE SPACES                  TO RS-DNP-D-FLAG             
           END-IF.                                                      
PCR263     MOVE AT-ACCOUNT-NO              TO WS-ACCOUNT-NO-D.          
PCR263     PERFORM 8330-DELETE-CRED-COLL         THRU 8330-EXIT.        
      *                                                                         
       2230-EXIT.                                                       
           EXIT.                                                        
      *                                                                 10570000
      ******************************************************************10580000
      * 2310-COMPARE-ARREARS-HIST                                      *10590000
      *                                                                *10600000
      *     CALLED FROM 2220-COMPARE-OLD-TO-NEW                        *10610000
      *                                                                *10620000
      *     COMPARES THE OLD AND NEW VALUES OF ARREARS-HIST            *10630000
      ******************************************************************10640000
      *                                                                 10650000
       2310-COMPARE-ARREARS-HIST.                                       
      *                                                                 10670000
           MOVE CZ-ARREARS-HIST            TO WOLD-ARREARS-HISTORY.     
      *                                                                 10690000
           IF WNEW-ARREARS-HISTORY EQUAL CZ-ARREARS-HIST                
              MOVE 'N'                     TO WS-ARREARS-FLAG           
           ELSE                                                         
              IF WNEW-ARREARS-HISTORY NOT EQUAL TO SPACES               
                 MOVE WNEW-ARREARS-HISTORY TO CZ-ARREARS-HIST           
                 MOVE 'Y'                  TO WS-ARREARS-FLAG           
              ELSE                                                      
                 MOVE 'N'                  TO WS-ARREARS-FLAG           
              END-IF                                                    
           END-IF.                                                      
      *                                                                 10800000
       2310-EXIT.                                                       
           EXIT.                                                        
      *                                                                 10830000
      ******************************************************************10840000
      * 2320-COMPARE-DISCONNECT-HIST                                   *10850000
      *                                                                *10860000
      *     CALLED FROM 2220-COMPARE-OLD-TO-NEW                        *10870000
      *                                                                *10880000
      *     COMPARES THE OLD AND NEW VALUES OF DISCONNECT-HIST         *10890000
      ******************************************************************10900000
      *                                                                 10910000
       2320-COMPARE-DISCONNECT-HIST.                                    
      *                                                                 10930000
           MOVE CZ-DISCONNECT-HIST         TO WOLD-NORMAL-HISTORY.      
      *                                                                 10950000
           IF WNEW-NORMAL-HISTORY EQUAL CZ-DISCONNECT-HIST              
              MOVE 'N'                     TO WS-DISCONNECT-FLAG        
           ELSE                                                         
              IF WNEW-NORMAL-HISTORY NOT EQUAL TO SPACES                
                 MOVE WNEW-NORMAL-HISTORY  TO CZ-DISCONNECT-HIST        
                 MOVE 'Y'                  TO WS-DISCONNECT-FLAG        
              ELSE                                                      
                 MOVE 'N'                  TO WS-DISCONNECT-FLAG        
              END-IF                                                    
           END-IF.                                                      
      *                                                                 11060000
       2320-EXIT.                                                       
           EXIT.                                                        
      *                                                                 11090000
      ******************************************************************11100000
      * 2330-COMPARE-EXCEPTIONAL-HIST                                  *11110000
      *                                                                *11120000
      *     CALLED FROM 2220-COMPARE-OLD-TO-NEW                        *11130000
      *                                                                *11140000
      *     COMPARES THE OLD AND NEW VALUES OF EXCEPTIONAL-HIST        *11150000
      ******************************************************************11160000
      *                                                                 11170000
       2330-COMPARE-EXCEPTIONAL-HIST.                                   
      *                                                                 11190000
           MOVE CZ-DISC-EXCEPTN-HIST       TO WOLD-EXCEPTIONAL-HISTORY. 
      *                                                                 11210000
           IF WNEW-EXCEPTIONAL-HISTORY EQUAL TO CZ-DISC-EXCEPTN-HIST    
              MOVE 'N'                     TO WS-EXCEPTIONAL-FLAG       
           ELSE                                                         
              IF WNEW-EXCEPTIONAL-HISTORY NOT EQUAL TO SPACES           
                 MOVE WNEW-EXCEPTIONAL-HISTORY TO CZ-DISC-EXCEPTN-HIST  
                 MOVE 'Y'                  TO WS-EXCEPTIONAL-FLAG       
              ELSE                                                      
                 MOVE 'N'                  TO WS-EXCEPTIONAL-FLAG       
              END-IF                                                    
           END-IF.                                                      
      *                                                                 11320000
       2330-EXIT.                                                       
           EXIT.                                                        
      *                                                                 11350000
      ******************************************************************11360000
      * 2340-COMPARE-CR-NON-UTIL-HIST                                  *11370000
      *                                                                *11380000
      *     CALLED FROM 2220-COMPARE-OLD-TO-NEW                        *11390000
      *                                                                *11400000
      *     COMPARES THE OLD AND NEW VALUES OF CR-NON-UTIL-HIST        *11410000
      ******************************************************************11420000
      *                                                                 11430000
       2340-COMPARE-CR-NON-UTIL-HIST.                                   
      *                                                                 11450000
           MOVE CZ-NON-UTL-ARRER-HIST      TO WOLD-NON-UTIL-HISTORY.    
      *                                                                 11470000
           IF WNEW-NON-UTIL-HISTORY EQUAL CZ-NON-UTL-ARRER-HIST         
              MOVE 'N'                     TO WS-CR-NON-UTIL-FLAG       
           ELSE                                                         
              IF WNEW-NON-UTIL-HISTORY NOT EQUAL TO SPACES              
                 MOVE WNEW-NON-UTIL-HISTORY TO CZ-NON-UTL-ARRER-HIST    
                 MOVE 'Y'                  TO WS-CR-NON-UTIL-FLAG       
              ELSE                                                      
                 MOVE 'N'                  TO WS-CR-NON-UTIL-FLAG       
              END-IF                                                    
           END-IF.                                                      
      *                                                                 11580000
       2340-EXIT.                                                       
           EXIT.                                                        
      *                                                                 11610000
      ******************************************************************11620000
      * 2350-COMPARE-CREDIT-GROUP                                      *11630000
      *                                                                *11640000
      *     CALLED FROM 2220-COMPARE-OLD-TO-NEW                        *11650000
      *                                                                *11660000
      *     COMPARES THE OLD AND NEW VALUES OF AT-CREDIT-GROUP         *11670000
      *                                                                *11680000
      ******************************************************************11690000
      *                                                                 11700000
       2350-COMPARE-CREDIT-GROUP.                                       
      *                                                                 11720000
           MOVE AT-CREDIT-GROUP            TO WOLD-CREDIT-GROUP.        
      *                                                                 11740000
           IF WNEW-CREDIT-GROUP EQUAL AT-CREDIT-GROUP                   
              MOVE 'N'                        TO WS-CREDIT-GROUP-FLAG   
           ELSE                                                         
              IF WNEW-CREDIT-GROUP NOT EQUAL TO SPACES                  
                 MOVE WNEW-CREDIT-GROUP    TO AT-CREDIT-GROUP           
                 MOVE PARM-NEXT-BILL-DATE  TO WNEW-EFFECTIVE-DATE       
                 MOVE WNEW-EFFECTIVE-YEAR  TO WSN-EFFECTIVE-YEAR        
                 MOVE WNEW-EFFECTIVE-MONTH TO WSN-EFFECTIVE-MONTH       
                 MOVE WNEW-EFFECTIVE-DAY   TO WSN-EFFECTIVE-DAY         
                 MOVE WNEW-EFFECTIVE-DATE  TO CZ-CR-GRP-EFFECT-DT       
                 MOVE WNEW-CREDIT-GROUP    TO AT-CREDIT-GROUP           
                 MOVE 'Y'                  TO WS-CREDIT-GROUP-FLAG      
              ELSE                                                      
                 MOVE 'N'                  TO WS-CREDIT-GROUP-FLAG      
              END-IF                                                    
           END-IF.                                                      
      *                                                                 11910000
       2350-EXIT.                                                       
           EXIT.                                                        
      *                                                                 11940000
      ******************************************************************11950000
T21957* 2360-COMPARE-CR-NON-UTIL-NORM                                  *11370000
T21957*                                                                *11380000
T21957*     CALLED FROM 2220-COMPARE-OLD-TO-NEW                        *11390000
T21957*                                                                *11400000
T21957*     COMPARES THE OLD AND NEW VALUES OF CR-NON-UTIL-NORM        *11410000
T21957******************************************************************11420000
T21957*                                                                 11430000
T21957 2360-COMPARE-CR-NON-UTIL-NORM.                                   
T21957*                                                                 11450000
T21957     MOVE CZ-NON-UTL-CR-HST          TO WOLD-NON-UTIL-NORMAL.     
T21957*                                                                 11470000
T21957     IF WNEW-NON-UTIL-NORMAL EQUAL CZ-NON-UTL-CR-HST              
T21957        MOVE 'N'                     TO WS-CR-NON-UTIL-NORM-FLAG  
T21957     ELSE                                                         
T21957        IF WNEW-NON-UTIL-NORMAL NOT EQUAL TO SPACES               
T21957           MOVE WNEW-NON-UTIL-NORMAL TO CZ-NON-UTL-CR-HST         
T21957           MOVE 'Y'                  TO WS-CR-NON-UTIL-NORM-FLAG  
T21957        ELSE                                                      
T21957           MOVE 'N'                  TO WS-CR-NON-UTIL-NORM-FLAG  
T21957        END-IF                                                    
T21957     END-IF.                                                      
T21957*                                                                 11580000
T21957 2360-EXIT.                                                       
T21957     EXIT.                                                        
T21957*                                                                 11940000
T21957******************************************************************11360000
T21957* 2370-COMPARE-CR-NON-UTIL-EXCP                                  *11370000
T21957*                                                                *11380000
T21957*     CALLED FROM 2220-COMPARE-OLD-TO-NEW                        *11390000
T21957*                                                                *11400000
T21957*     COMPARES THE OLD AND NEW VALUES OF CR-NON-UTIL-EXCP        *11410000
T21957******************************************************************11420000
T21957*                                                                 11430000
T21957 2370-COMPARE-CR-NON-UTIL-EXCP.                                   
T21957*                                                                 11450000
T21957     MOVE CZ-NON-UTL-CR-HST-EX       TO WOLD-NON-UTIL-EXCEPT.     
T21957*                                                                 11470000
T21957     IF WNEW-NON-UTIL-EXCEPT EQUAL CZ-NON-UTL-CR-HST-EX           
T21957        MOVE 'N'                     TO WS-CR-NON-UTIL-EXCP-FLAG  
T21957     ELSE                                                         
T21957        IF WNEW-NON-UTIL-EXCEPT NOT EQUAL TO SPACES               
T21957           MOVE WNEW-NON-UTIL-EXCEPT TO CZ-NON-UTL-CR-HST-EX      
T21957           MOVE 'Y'                  TO WS-CR-NON-UTIL-EXCP-FLAG  
T21957        ELSE                                                      
T21957           MOVE 'N'                  TO WS-CR-NON-UTIL-EXCP-FLAG  
T21957        END-IF                                                    
T21957     END-IF.                                                      
T21957*                                                                 11580000
T21957 2370-EXIT.                                                       
T21957     EXIT.                                                        
T21957*                                                                 11610000
P00726******************************************************************11360000
P00726* 2380-COMPARE-RISK-RATING-CODE                                  *11370000
P00726******************************************************************11420000
P00726                                                                  
P00726 2380-COMPARE-RISK-RATING-CODE.                                   
P00726                                                                  
P00726     IF WS-NEW-LOSS-RESERVE-CD = WS-OLD-LOSS-RESERVE-CD           
P00726        MOVE 'N'                     TO WS-RISK-RATING-CD-FLAG    
P00726     ELSE                                                         
P00726        IF WS-NEW-LOSS-RESERVE-CD NOT = WS-OLD-LOSS-RESERVE-CD    
P00726           MOVE WS-NEW-LOSS-RESERVE-CD  TO LQ-LOSS-RESERVE-CD     
P00726           MOVE 'Y'                  TO WS-RISK-RATING-CD-FLAG    
P00726        ELSE                                                      
P00726           MOVE 'N'                  TO WS-RISK-RATING-CD-FLAG    
P00726        END-IF                                                    
P00726     END-IF.                                                      
P00726                                                                  
P00726 2380-EXIT.                                                       
P00726     EXIT.                                                        
P00726                                                                  
P00726******************************************************************11360000
P00726* 2390-COMPARE-RISK-EFFECT-DT                                    *11370000
P00726******************************************************************11420000
P00726                                                                  
P00726 2390-COMPARE-RISK-EFFECT-DT.                                     
P00726                                                                  
P00726     IF WS-NEW-LOSS-RESRVE-EFF-DT = WS-OLD-LOSS-RESRVE-EFF-DT     
P00726        MOVE 'N'                     TO WS-RISK-EFFECT-DT-FLAG    
P00726     ELSE                                                         
P00726        IF WS-NEW-LOSS-RESRVE-EFF-DT NOT =                        
P00726                                        WS-OLD-LOSS-RESRVE-EFF-DT 
P00726           MOVE WS-NEW-LOSS-RESRVE-EFF-DT                         
P00726                                     TO LQ-LOSS-RESRVE-EFF-DT     
P00726           MOVE 'Y'                  TO WS-RISK-EFFECT-DT-FLAG    
P00726        ELSE                                                      
P00726           MOVE 'N'                  TO WS-RISK-EFFECT-DT-FLAG    
P00726        END-IF                                                    
P00726     END-IF.                                                      
P00726                                                                  
P00726 2390-EXIT.                                                       
P00726     EXIT.                                                        
P00726                                                                  
      ******************************************************************11950000
      * 2400-BUILD-RESULT                                              *11960000
      *                                                                *11970000
      *     CALLED FROM 0000-MAINLINE                                  *11980000
      *                                                                *11990000
      *     MOVES THE TABLE FIELDS TO THE RETURN FIELDS                *12000000
      *                                                                *12010000
      ******************************************************************12020000
      *                                                                 12030000
       2400-BUILD-RESULT.                                               
      *                                                                 12050000
           MOVE WS-RESP-AREA-ID            TO RS-RESP-AREA-ID.          
           MOVE AT-PREMISE-NO              TO RS-PREMISE-NO.            
           MOVE AT-LOCAL-OFFICE            TO RS-LOCAL-OFFICE.          
           MOVE WS-SUPR-ID                 TO RS-SUPR-ID.               
      *                                                                 12100000
           IF WS-CREDIT-GROUP-FLAG = 'Y'                                
               MOVE WSN-EFFECTIVE-DATE     TO RS-EFFT-DT                
           ELSE                                                         
               MOVE WOLD-EFFECTIVE-DATE    TO RS-EFFT-DT                
           END-IF.                                                      
      *                                                                 12160000
       2400-EXIT.                                                       
           EXIT.                                                        
      *                                                                 12190000
      ******************************************************************12200000
      * 5010-JOURNALING                                                *12210000
      *                                                                *12220000
      *     CALLS 7300-GET-TIMESTAMP                                   *12230000
      *           7320-GET-RESP-AREA                                   *12240000
      *           7330-GET-SUPR-ID                                     *12250000
      *           5400-JOURNAL-HEADER                                  *12260000
      *           5500-JOURNAL-TRANS                                   *12270000
      *           8210-UPDATE-CREDIT-PROFILE                           *12280000
      *           8220-UPDATE-ACCOUNT                                  *12290000
      *                                                                *12300000
      *     CALLED FROM 2200-PROCESS-UPDATE                            *12310000
      *                                                                *12320000
      ******************************************************************12330000
      *                                                                 12340000
       5010-JOURNALING.                                                 
      *                                                                 12360000
           PERFORM 7300-GET-TIMESTAMP            THRU 7300-EXIT.        
           MOVE WS-NEW-TIMESTAMP           TO MH-TRANS-HIST-SEQ-NO.     
           PERFORM 7320-GET-RESP-AREA            THRU 7320-EXIT.        
           PERFORM 7330-GET-SUPR-ID              THRU 7330-EXIT.        
           PERFORM 5400-JOURNAL-HEADER           THRU 5400-EXIT.        
           PERFORM 5500-JOURNAL-TRANS            THRU 5500-EXIT.        
      *                                                                 12430000
P00726     IF PARM-PROCESS-FL = 'W'                                     
ACT233        PERFORM 5020-CALL-CSR04675         THRU 5020-EXIT         
P00726     END-IF                                                       
P00726                                                                  
P00399     IF    WS-ARREARS-FLAG = 'Y'           OR                     
P00399           WS-DISCONNECT-FLAG = 'Y'        OR                     
P00399           WS-EXCEPTIONAL-FLAG = 'Y'       OR                     
P00399           WS-CR-NON-UTIL-FLAG = 'Y'       OR                     
P00726           WS-CREDIT-GROUP-FLAG = 'Y'      OR                     
P00399           WS-CR-NON-UTIL-NORM-FLAG = 'Y'  OR                     
P00399           WS-CR-NON-UTIL-EXCP-FLAG = 'Y'                         
P00399           PERFORM 8210-UPDATE-CREDIT-PROFILE   THRU 8210-EXIT    
P00399     END-IF.                                                      
P00726                                                                  
P00726     IF WS-RISK-RATING-CD-FLAG   = 'Y'     OR                     
P00726        WS-RISK-EFFECT-DT-FLAG   = 'Y'                            
P00726        IF CUST-EXISTS                                            
P00726           PERFORM 8230-UPDATE-CUST-STATS       THRU 8230-EXIT    
P00726        ELSE                                                      
P00726           PERFORM 8500-INSERT-CUST-STATS       THRU 8500-EXIT    
P00726        END-IF                                                    
P00726     END-IF.                                                      
      *                                                                 12450000
P00399     IF WS-CREDIT-GROUP-FLAG = 'Y'                                
              PERFORM 8220-UPDATE-ACCOUNT             THRU 8220-EXIT    
P00399     END-IF.                                                      
      *                                                                 12470000
       5010-EXIT.                                                       
           EXIT.                                                        
      *                                                                 12500000
P00726******************************************************************        
ACT233* 5020-CALL-CSR04675.                                            *        
P00726******************************************************************        
P00726                                                                  
ACT233 5020-CALL-CSR04675.                                              
P00726                                                                  
ACT233     MOVE 0                      TO IN-ITEM-ID-4675.              
ACT233     MOVE '3'                    TO ROUTING-CATEGORY-4675.        
ACT233     MOVE AT-LOCAL-OFFICE        TO LOCAL-OFFICE-4675.            
ACT233     MOVE PARM-USERID            TO USER-ID-ORIG-4675.            
ACT233     MOVE WS-SUPR-ID             TO USER-ID-ASGN-4675             
ACT233     MOVE WS-RESP-AREA-ID        TO RESP-AREA-ID-4675             
ACT233     MOVE 27                     TO CATEGORY-ID-4675.             
ACT233     MOVE AT-ACCOUNT-NO          TO ACCOUNT-NO-4675.              
ACT233     MOVE AT-PREMISE-NO          TO PREMISE-NO-4675.              
ACT233     MOVE AT-CUSTOMER-NO         TO CUSTOMER-NO-4675.             
ACT233     MOVE 0                      TO SERV-ORDER-NO-4675.           
ACT233     MOVE WS-WQ-COMMENT          TO COMMENTS-4675-TEXT.           
ACT233     MOVE 50                     TO COMMENTS-4675-LEN.            
ACT233     MOVE SPACES                 TO DATE-CREATED-4675             
ACT233                                    DATE-REQUIRED-4675.           
ACT233     MOVE 'N'                    TO WQ-PRIORITY-4675              
ACT233     MOVE SPACES                 TO FREE-FORM-DATA-4675-TEXT      
ACT233     MOVE 0                      TO FREE-FORM-DATA-4675-LEN.      
ACT233     MOVE 'CSR04669'             TO CREATED-BY-4675.              
P00726                                                                  
P00726*    EXEC SQL                                                     
ACT233*       CALL CSR04675                                             
ACT233*           (:IN-ITEM-ID-4675,                                    
ACT233*            :ROUTING-CATEGORY-4675,                              
ACT233*            :LOCAL-OFFICE-4675,                                  
ACT233*            :USER-ID-ORIG-4675,                                  
ACT233*            :USER-ID-ASGN-4675,                                  
ACT233*            :RESP-AREA-ID-4675,                                  
ACT233*            :CATEGORY-ID-4675,                                   
ACT233*            :ACCOUNT-NO-4675,                                    
ACT233*            :PREMISE-NO-4675,                                    
ACT233*            :CUSTOMER-NO-4675,                                   
ACT233*            :SERV-ORDER-NO-4675,                                 
ACT233*            :COMMENTS-4675,                                      
ACT233*            :DATE-REQUIRED-4675,                                 
ACT233*            :DATE-CREATED-4675,                                  
ACT233*            :WQ-PRIORITY-4675,                                   
ACT233*            :FREE-FORM-DATA-4675,                                
ACT233*            :CREATED-BY-4675)                                    
P00726*    END-EXEC.                                                    

MSQ001        EXEC SQL
MSQ001          CLOSE RESULT_SET_CSR_4675
MSQ001        END-EXEC
MSQ001        EXEC SQL
MSQ001          OPEN RESULT_SET_CSR_4675
MSQ001        END-EXEC
MSQ017     CALL "MFASQLCA"
MSQ017       USING SQLCA, BY VALUE MFA-PROGRAM-ID, "0", "0", "0",
MSQ017       BY REFERENCE MFSQLMESSAGETEXT
MSQ017     END-CALL

MSQ001        MOVE SQLCA TO MSQ001-SQLCABACK
MSQ001        MOVE 0 TO SQLD
MSQ001        EXEC SQL
MSQ001          DESCRIBE CURSOR RESULT_SET_CSR_4675 INTO :SQLDA
MSQ001        END-EXEC
MSQ001        MOVE MSQ001-SQLCABACK TO SQLCA
MSQ001        IF SQLD > 0 AND SQLCODE = 0 THEN
MSQ001          MOVE 466 TO SQLCODE
MSQ001        END-IF
P00726                                                                  
P00726     MOVE SQLCODE TO WS-ACTIVE-RETURN-CODE.                       
P00726                                                                  
P00726     IF WS-ACTIVE-RETURN-CODE NOT EQUAL +466                      
P00726        MOVE PROGRAM-NAME          TO ABEND-PROGRAM               
P00726        MOVE SQLCODE               TO ABEND-SQLCODE               
P00726                                      RS-RETURN-CODE              
P00726        MOVE '5020'                TO ACTIVE-PARAGRAPH            
P00726        MOVE 'CALL'                TO ABEND-FUNCTION              
ACT233        MOVE 'CSR04675'            TO TABLE-1                     
P00726        MOVE 'PREMISE_NO'          TO TABLE-ELEMENT-1             
ACT233        MOVE PREMISE-NO-4675       TO HOSTVAR-ELEMENT-1           
P00726        MOVE 'ACCOUNT_NO'          TO TABLE-ELEMENT-2             
ACT233        MOVE ACCOUNT-NO-4675       TO HOSTVAR-ELEMENT-2           
P00726        PERFORM 9000-SEND-ERROR-RESULT     THRU 9000-EXIT         
P00726        PERFORM 9900-SQL-ERROR-ROUTINE     THRU 9900-EXIT         
P00726     END-IF.                                                      
P00726                                                                  
P00726*    EXEC SQL                                                     
P00726*       ASSOCIATE LOCATORS                                        
ACT233*       (:LOC4675)                                                
ACT233*       WITH PROCEDURE CSR04675                                   
P00726*    END-EXEC.                                                    
P00726                                                                  
P00726*    EXEC SQL                                                     
ACT233*       ALLOCATE RESULT_SET_CSR_4675 CURSOR FOR RESULT SET        
ACT233*       :LOC4675                                                  
P00726*    END-EXEC.                                                    
P00726                                                                  
P00726     EXEC SQL                                                     
ACT233        FETCH RESULT_SET_CSR_4675 INTO                            
ACT233           :RETURN-CODE-4675,                                     
ACT233           :OUT-ITEM-ID-4675                                      
P00726     END-EXEC.                                                    

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

P00726                                                                  
P00726     MOVE SQLCODE TO WS-ACTIVE-RETURN-CODE                        
P00726     EVALUATE WS-ACTIVE-RETURN-CODE                               
P00726         WHEN SUCCESSFUL-CALL                                     
ACT233             IF RETURN-CODE-4675 NOT = 0                          
ACT233                 MOVE RETURN-CODE-4675  TO RS-RETURN-CODE         
P00726                                           WS-ACTIVE-RETURN-CODE  
P00726                 MOVE PROGRAM-NAME      TO ABEND-PROGRAM          
P00726                 MOVE '5020'            TO ACTIVE-PARAGRAPH       
P00726                 MOVE 'FETCH'           TO ABEND-FUNCTION         
P00726                 MOVE SQLCODE           TO ABEND-SQLCODE          
ACT233                 MOVE 'CSR04675'        TO TABLE-1                
P00726                 MOVE 'PREMISE_NO'      TO TABLE-ELEMENT-1        
ACT233                 MOVE PREMISE-NO-4675   TO HOSTVAR-ELEMENT-1      
P00726                 MOVE 'ACCOUNT_NO'      TO TABLE-ELEMENT-2        
ACT233                 MOVE ACCOUNT-NO-4675   TO HOSTVAR-ELEMENT-2      
P00726                 PERFORM 9000-SEND-ERROR-RESULT THRU 9000-EXIT    
P00726                 PERFORM 9900-SQL-ERROR-ROUTINE THRU 9900-EXIT    
P00726             END-IF                                               
P00726         WHEN OTHER                                               
P00726             MOVE WS-ACTIVE-RETURN-CODE TO RS-RETURN-CODE         
P00726             MOVE PROGRAM-NAME          TO ABEND-PROGRAM          
P00726             MOVE '5020'                TO ACTIVE-PARAGRAPH       
P00726             MOVE 'FETCH'               TO ABEND-FUNCTION         
ACT233             MOVE 'CSR04675'            TO TABLE-1                
P00726             MOVE 'PREMISE_NO'          TO TABLE-ELEMENT-1        
ACT233             MOVE PREMISE-NO-4675       TO HOSTVAR-ELEMENT-1      
P00726             MOVE 'ACCOUNT_NO'          TO TABLE-ELEMENT-2        
ACT233             MOVE ACCOUNT-NO-4675       TO HOSTVAR-ELEMENT-2      
P00726             PERFORM 9000-SEND-ERROR-RESULT THRU 9000-EXIT        
P00726             PERFORM 9900-SQL-ERROR-ROUTINE THRU 9900-EXIT        
P00726     END-EVALUATE.                                                
P00726                                                                  
P00726 5020-EXIT.                                                       
P00726      EXIT.                                                       
P00726                                                                  
      ***************************************************************** 13800000
      * 5400-JOURNAL-HEADER                                           * 13810000
      *                                                               * 13820000
      *     CALLED FROM 5010-JOURNALING                               * 13830000
      *                                                               * 13840000
      *     MOVES THE TRANSASTION HEADER WORK FIELDS TO THE MH FIELDS * 13850000
      *                                                               * 13860000
      ***************************************************************** 13870000
      *                                                               * 13880000
       5400-JOURNAL-HEADER.                                             
      *                                                                 13900000
           MOVE 'F'                        TO MH-CODE-TRAN-TYPE.        
           MOVE PARM-ACCOUNT-NO            TO MH-ACCOUNT-NO.            
           MOVE ZEROS                      TO MH-CUSTOMER-NO.           
           MOVE ZEROS                      TO MH-PREMISE-NO.            
           MOVE WS-RESP-AREA-ID            TO MH-RESP-AREA-ID.          
           MOVE PARM-USERID                TO MH-USER-ID.               
P00726     MOVE WS-PROGRAM-NAME            TO MH-APPL-PROGRAM-ID.       
           MOVE PARM-TRAN-COMMENT-LEN      TO MH-TRAN-COMMENT-LEN.      
           MOVE PARM-TRAN-COMMENT-TEXT     TO MH-TRAN-COMMENT-TEXT.     
      *                                                                 14000000
       5400-EXIT.                                                       
           EXIT.                                                        
      *                                                                 14030000
      ***************************************************************** 14040000
      * 5500-JOURNAL-TRANS                                            * 14050000
      *                                                               * 14060000
      *     CALLS 5510-JRNL-ARREARS                                   * 14070000
      *           5520-JRNL-DISCONNECT                                * 14080000
      *           5530-JRNL-EXCEPTIONAL                               * 14090000
      *           5540-JRNL-NON-UTIL                                  * 14100000
      *           5550-JRNL-EFFECT-DT                                 * 14110000
      *           5560-JRNL-CREDIT-GROUP                              * 14120000
      *                                                               * 14130000
      *     CALLED FROM 5010-JOURNALING                               * 14140000
      *                                                               * 14150000
      *     CHECKS THE FLAG AND DETERMINES IF A CHANGE WAS MADE       * 14160000
      *                                                               * 14170000
      ***************************************************************** 14180000
      *                                                                 14190000
       5500-JOURNAL-TRANS.                                              
      *                                                                 14210000
           IF WS-ARREARS-FLAG = 'Y'                                     
               PERFORM 5510-JRNL-ARREARS         THRU 5510-EXIT         
           END-IF.                                                      
           IF WS-DISCONNECT-FLAG = 'Y'                                  
               PERFORM 5520-JRNL-DISCONNECT      THRU 5520-EXIT         
           END-IF.                                                      
           IF WS-EXCEPTIONAL-FLAG = 'Y'                                 
               PERFORM 5530-JRNL-EXCEPTIONAL     THRU 5530-EXIT         
           END-IF.                                                      
           IF WS-CR-NON-UTIL-FLAG = 'Y'                                 
               PERFORM 5540-JRNL-NON-UTIL        THRU 5540-EXIT         
           END-IF.                                                      
           IF WS-CREDIT-GROUP-FLAG = 'Y'                                
               PERFORM 5550-JRNL-CREDIT-GROUP    THRU 5550-EXIT         
               PERFORM 5560-JRNL-EFFECT-DT       THRU 5560-EXIT         
P00399         IF (WNEW-CREDIT-GROUP = 'A' AND                          
P00399             WOLD-CREDIT-GROUP = 'N') OR                          
P00399            (WNEW-CREDIT-GROUP = 'N' AND                          
P00399             WOLD-CREDIT-GROUP = 'A')                             
P00399            CONTINUE                                              
P00399         ELSE                                                     
P00399            PERFORM 2230-PROCESS-DELETE    THRU 2230-EXIT         
P00399         END-IF                                                   
           END-IF.                                                      
T21957     IF WS-CR-NON-UTIL-NORM-FLAG = 'Y'                            
T21957         PERFORM 5541-JRNL-NON-UTIL-NORM   THRU 5541-EXIT         
T21957     END-IF.                                                      
T21957     IF WS-CR-NON-UTIL-EXCP-FLAG = 'Y'                            
T21957         PERFORM 5542-JRNL-NON-UTIL-EXCP   THRU 5542-EXIT         
T21957     END-IF.                                                      
P00726     IF WS-RISK-RATING-CD-FLAG   = 'Y'                            
P00726        PERFORM 5570-JRNL-RISK-RATING-CODE THRU 5570-EXIT         
P00726     END-IF.                                                      
P00726     IF WS-RISK-EFFECT-DT-FLAG   = 'Y'                            
P00726         PERFORM 5580-JRNL-RISK-EFFECT-DT  THRU 5580-EXIT         
P00726     END-IF.                                                      
      *                                                                 14340000
       5500-EXIT.                                                       
           EXIT.                                                        
      *                                                                 14370000
      ***************************************************************** 14380000
      * 5510-JRNL-ARREARS                                             * 14390000
      *                                                               * 14400000
      *     CALLS 6530-LOAD-MNT-TRANS-HIST                            * 14410000
      *                                                               * 14420000
      *     CALLED FROM 5500-JOURNAL-TRANS                            * 14430000
      *                                                               * 14440000
      *     MOVES THE TRANSASTION ARREARS FIELD INFO TO THE MI FIELDS * 14450000
      *                                                               * 14460000
      ***************************************************************** 14470000
      *                                                                 14480000
       5510-JRNL-ARREARS.                                               
      *                                                                 14500000
           ADD  1                          TO WS-TRANS-APPL-NO.         
           MOVE WS-TRANS-APPL-NO           TO MI-TRAN-APPL-NO.          
           MOVE SPACES                     TO MI-TABLE-ID.              
           MOVE 'ARREARS HIST  '           TO MI-COLUMN-DESC.           
           MOVE MH-TRANS-HIST-SEQ-NO       TO MI-TRANS-HIST-SEQ-NO.     
      *                                                                 14550000
           IF WNEW-ARREARS-HISTORY > SPACES                             
              MOVE +24                     TO MI-CHG-COLUMN-VALUE-LEN   
              MOVE WNEW-ARREARS-HISTORY    TO MI-CHG-COLUMN-VALUE-TEXT  
           ELSE                                                         
              MOVE +9                      TO MI-CHG-COLUMN-VALUE-LEN   
              MOVE '*DELETED*'             TO MI-CHG-COLUMN-VALUE-TEXT  
           END-IF.                                                      
      *                                                                 14670000
           IF WOLD-ARREARS-HISTORY > SPACES                             
              MOVE +24                     TO MI-PRV-COLUMN-VALUE-LEN   
              MOVE WOLD-ARREARS-HISTORY    TO MI-PRV-COLUMN-VALUE-TEXT  
           ELSE                                                         
              MOVE +5                      TO MI-PRV-COLUMN-VALUE-LEN   
              MOVE '*NEW*'                 TO MI-PRV-COLUMN-VALUE-TEXT  
           END-IF.                                                      
      *                                                                 14790000
           PERFORM 6530-LOAD-MNT-TRANS-HIST      THRU 6530-EXIT.        
      *                                                                 14810000
       5510-EXIT.                                                       
           EXIT.                                                        
      *                                                                 14840000
      ***************************************************************** 14850000
      * 5520-JRNL-DISCONNECT                                          * 14860000
      *                                                               * 14870000
      *     CALLS 6530-LOAD-MNT-TRANS-HIST                            * 14880000
      *                                                               * 14890000
      *     CALLED FROM 5500-JOURNAL-TRANS                            * 14900000
      *                                                               * 14910000
      *     MOVES THE TRANSASTION DISCONN FIELD INFO TO THE MI FIELDS * 14920000
      *                                                               * 14930000
      ***************************************************************** 14940000
      *                                                                 14950000
       5520-JRNL-DISCONNECT.                                            
      *                                                                 14970000
           ADD  1                          TO WS-TRANS-APPL-NO.         
           MOVE WS-TRANS-APPL-NO           TO MI-TRAN-APPL-NO.          
           MOVE SPACES                     TO MI-TABLE-ID.              
           MOVE 'DISCONNECT HIST'          TO MI-COLUMN-DESC.           
           MOVE MH-TRANS-HIST-SEQ-NO       TO MI-TRANS-HIST-SEQ-NO.     
      *                                                                 15020000
           IF WNEW-NORMAL-HISTORY > SPACES                              
              MOVE +24                     TO MI-CHG-COLUMN-VALUE-LEN   
              MOVE WNEW-NORMAL-HISTORY     TO MI-CHG-COLUMN-VALUE-TEXT  
           ELSE                                                         
              MOVE +9                      TO MI-CHG-COLUMN-VALUE-LEN   
              MOVE '*DELETED*'             TO MI-CHG-COLUMN-VALUE-TEXT  
           END-IF.                                                      
      *                                                                 15140000
           IF WOLD-NORMAL-HISTORY > SPACES                              
              MOVE +24                     TO MI-PRV-COLUMN-VALUE-LEN   
              MOVE WOLD-NORMAL-HISTORY     TO MI-PRV-COLUMN-VALUE-TEXT  
           ELSE                                                         
              MOVE +5                      TO MI-PRV-COLUMN-VALUE-LEN   
              MOVE '*NEW*'                 TO MI-PRV-COLUMN-VALUE-TEXT  
           END-IF.                                                      
      *                                                                 15260000
           PERFORM 6530-LOAD-MNT-TRANS-HIST      THRU 6530-EXIT.        
                                                                        
       5520-EXIT.                                                       
           EXIT.                                                        
      *                                                                 15310000
      ***************************************************************** 15320000
      * 5530-JRNL-EXCEPTIONAL                                         * 15330000
      *                                                               * 15340000
      *     CALLS 6530-LOAD-MNT-TRANS-HIST                            * 15350000
      *                                                               * 15360000
      *     CALLED FROM 5500-JOURNAL-TRANS                            * 15370000
      *                                                               * 15380000
      *     MOVES THE TRANSASTION EXCEPTN FIELD INFO TO THE MI FIELDS * 15390000
      *                                                               * 15400000
      ***************************************************************** 15410000
      *                                                                 15420000
       5530-JRNL-EXCEPTIONAL.                                           
      *                                                                 15440000
           ADD  1                          TO WS-TRANS-APPL-NO.         
           MOVE WS-TRANS-APPL-NO           TO MI-TRAN-APPL-NO.          
           MOVE SPACES                     TO MI-TABLE-ID.              
           MOVE 'EXCEPTION HIST '          TO MI-COLUMN-DESC.           
           MOVE MH-TRANS-HIST-SEQ-NO       TO MI-TRANS-HIST-SEQ-NO.     
      *                                                                 15490000
           IF WNEW-EXCEPTIONAL-HISTORY > SPACES                         
              MOVE +24                     TO MI-CHG-COLUMN-VALUE-LEN   
              MOVE WNEW-EXCEPTIONAL-HISTORY                             
                                           TO MI-CHG-COLUMN-VALUE-TEXT  
           ELSE                                                         
              MOVE +9                      TO MI-CHG-COLUMN-VALUE-LEN   
              MOVE '*DELETED*'             TO MI-CHG-COLUMN-VALUE-TEXT  
           END-IF.                                                      
      *                                                                 15610000
           IF WOLD-EXCEPTIONAL-HISTORY > SPACES                         
              MOVE +24                     TO MI-PRV-COLUMN-VALUE-LEN   
              MOVE WOLD-EXCEPTIONAL-HISTORY                             
                                           TO MI-PRV-COLUMN-VALUE-TEXT  
           ELSE                                                         
              MOVE +5                      TO MI-PRV-COLUMN-VALUE-LEN   
              MOVE '*NEW*'                 TO MI-PRV-COLUMN-VALUE-TEXT  
           END-IF.                                                      
      *                                                                 15730000
           PERFORM 6530-LOAD-MNT-TRANS-HIST      THRU 6530-EXIT.        
       5530-EXIT.                                                       
           EXIT.                                                        
      *                                                                 15780000
      ***************************************************************** 15790000
      * 5540-JRNL-NON-UTIL                                            * 15800000
      *                                                               * 15810000
      *     CALLS 6530-LOAD-MNT-TRANS-HIST                            * 15820000
      *                                                               * 15830000
      *     CALLED FROM 5500-JOURNAL-TRANS                            * 15840000
      *                                                               * 15850000
      *     MOVES THE TRANSASTION EXCEPTN FIELD INFO TO THE MI FIELDS * 15860000
      *                                                               * 15870000
      ******************************************************************15880000
      *                                                                 15890000
       5540-JRNL-NON-UTIL.                                              
      *                                                                 15910000
           ADD  1                          TO WS-TRANS-APPL-NO.         
           MOVE WS-TRANS-APPL-NO           TO MI-TRAN-APPL-NO.          
           MOVE SPACES                     TO MI-TABLE-ID.              
           MOVE 'NON UTIL ARREAR'          TO MI-COLUMN-DESC.           
           MOVE MH-TRANS-HIST-SEQ-NO       TO MI-TRANS-HIST-SEQ-NO.     
      *                                                                 15960000
           IF WNEW-NON-UTIL-HISTORY > SPACES                            
              MOVE +24                     TO MI-CHG-COLUMN-VALUE-LEN   
              MOVE WNEW-NON-UTIL-HISTORY   TO MI-CHG-COLUMN-VALUE-TEXT  
           ELSE                                                         
              MOVE +9                      TO MI-CHG-COLUMN-VALUE-LEN   
              MOVE '*DELETED*'             TO MI-CHG-COLUMN-VALUE-TEXT  
           END-IF.                                                      
      *                                                                 16080000
           IF WOLD-NON-UTIL-HISTORY > SPACES                            
              MOVE +24                     TO MI-PRV-COLUMN-VALUE-LEN   
              MOVE WOLD-NON-UTIL-HISTORY   TO MI-PRV-COLUMN-VALUE-TEXT  
           ELSE                                                         
              MOVE +5                      TO MI-PRV-COLUMN-VALUE-LEN   
              MOVE '*NEW*'                 TO MI-PRV-COLUMN-VALUE-TEXT  
           END-IF.                                                      
      *                                                                 16200000
           PERFORM 6530-LOAD-MNT-TRANS-HIST      THRU 6530-EXIT.        
      *                                                                 16220000
       5540-EXIT.                                                       
           EXIT.                                                        
      *                                                                 16250000
      ***************************************************************** 16260000
T21957* 5541-JRNL-NON-UTIL-NORM                                       * 15800000
T21957*                                                               * 15810000
T21957*     CALLS 6530-LOAD-MNT-TRANS-HIST                            * 15820000
T21957*                                                               * 15830000
T21957*     CALLED FROM 5500-JOURNAL-TRANS                            * 15840000
T21957*                                                               * 15850000
T21957*     MOVES THE TRANSASTION EXCEPTN FIELD INFO TO THE MI FIELDS * 15860000
T21957*                                                               * 15870000
T21957******************************************************************15880000
T21957*                                                                 15890000
T21957 5541-JRNL-NON-UTIL-NORM.                                         
T21957*                                                                 15910000
T21957     ADD  1                          TO WS-TRANS-APPL-NO.         
T21957     MOVE WS-TRANS-APPL-NO           TO MI-TRAN-APPL-NO.          
T21957     MOVE SPACES                     TO MI-TABLE-ID.              
T21957     MOVE 'NON UTIL NORMAL'          TO MI-COLUMN-DESC.           
T21957     MOVE MH-TRANS-HIST-SEQ-NO       TO MI-TRANS-HIST-SEQ-NO.     
T21957*                                                                 15960000
T21957     IF WNEW-NON-UTIL-NORMAL > SPACES                             
T21957        MOVE +24                     TO MI-CHG-COLUMN-VALUE-LEN   
T21957        MOVE WNEW-NON-UTIL-NORMAL    TO MI-CHG-COLUMN-VALUE-TEXT  
T21957     ELSE                                                         
T21957        MOVE +9                      TO MI-CHG-COLUMN-VALUE-LEN   
T21957        MOVE '*DELETED*'             TO MI-CHG-COLUMN-VALUE-TEXT  
T21957     END-IF.                                                      
T21957*                                                                 16080000
T21957     IF WOLD-NON-UTIL-NORMAL > SPACES                             
T21957        MOVE +24                     TO MI-PRV-COLUMN-VALUE-LEN   
T21957        MOVE WOLD-NON-UTIL-NORMAL    TO MI-PRV-COLUMN-VALUE-TEXT  
T21957     ELSE                                                         
T21957        MOVE +5                      TO MI-PRV-COLUMN-VALUE-LEN   
T21957        MOVE '*NEW*'                 TO MI-PRV-COLUMN-VALUE-TEXT  
T21957     END-IF.                                                      
T21957*                                                                 16200000
T21957     PERFORM 6530-LOAD-MNT-TRANS-HIST      THRU 6530-EXIT.        
T21957 5541-EXIT.                                                       
T21957     EXIT.                                                        
T21957*                                                                 16250000
T21957***************************************************************** 15790000
T21957* 5542-JRNL-NON-UTIL-EXCP                                       * 15800000
T21957*                                                               * 15810000
T21957*     CALLS 6530-LOAD-MNT-TRANS-HIST                            * 15820000
T21957*                                                               * 15830000
T21957*     CALLED FROM 5500-JOURNAL-TRANS                            * 15840000
T21957*                                                               * 15850000
T21957*     MOVES THE TRANSASTION EXCEPTN FIELD INFO TO THE MI FIELDS * 15860000
T21957*                                                               * 15870000
T21957******************************************************************15880000
T21957*                                                                 15890000
T21957 5542-JRNL-NON-UTIL-EXCP.                                         
T21957*                                                                 15910000
T21957     ADD  1                          TO WS-TRANS-APPL-NO.         
T21957     MOVE WS-TRANS-APPL-NO           TO MI-TRAN-APPL-NO.          
T21957     MOVE SPACES                     TO MI-TABLE-ID.              
T21957     MOVE 'NON UTIL EXCEPT'          TO MI-COLUMN-DESC.           
T21957     MOVE MH-TRANS-HIST-SEQ-NO       TO MI-TRANS-HIST-SEQ-NO.     
T21957*                                                                 15960000
T21957     IF WNEW-NON-UTIL-EXCEPT > SPACES                             
T21957        MOVE +24                     TO MI-CHG-COLUMN-VALUE-LEN   
T21957        MOVE WNEW-NON-UTIL-EXCEPT    TO MI-CHG-COLUMN-VALUE-TEXT  
T21957     ELSE                                                         
T21957        MOVE +9                      TO MI-CHG-COLUMN-VALUE-LEN   
T21957        MOVE '*DELETED*'             TO MI-CHG-COLUMN-VALUE-TEXT  
T21957     END-IF.                                                      
T21957*                                                                 16080000
T21957     IF WOLD-NON-UTIL-EXCEPT > SPACES                             
T21957        MOVE +24                     TO MI-PRV-COLUMN-VALUE-LEN   
T21957        MOVE WOLD-NON-UTIL-EXCEPT    TO MI-PRV-COLUMN-VALUE-TEXT  
T21957     ELSE                                                         
T21957        MOVE +5                      TO MI-PRV-COLUMN-VALUE-LEN   
T21957        MOVE '*NEW*'                 TO MI-PRV-COLUMN-VALUE-TEXT  
T21957     END-IF.                                                      
T21957*                                                                 16200000
T21957     PERFORM 6530-LOAD-MNT-TRANS-HIST      THRU 6530-EXIT.        
T21957 5542-EXIT.                                                       
T21957     EXIT.                                                        
T21957*                                                                 16250000
      ***************************************************************** 16260000
      * 5550-JRNL-CREDIT-GROUP                                        * 16270000
      *                                                               * 16280000
      *     CALLS 6530-LOAD-MNT-TRANS-HIST                            * 16290000
      *                                                               * 16300000
      *     CALLED FROM 5500-JOURNAL-TRANS                            * 16310000
      *                                                               * 16320000
      *     MOVES THE TRANSASTION CRDGRP  FIELD INFO TO THE MI FIELDS * 16330000
      *                                                               * 16340000
      ******************************************************************16350000
      *                                                                 16360000
       5550-JRNL-CREDIT-GROUP.                                          
      *                                                                 16380000
           ADD  1                          TO WS-TRANS-APPL-NO.         
           MOVE WS-TRANS-APPL-NO           TO MI-TRAN-APPL-NO.          
           MOVE '33'                       TO MI-TABLE-ID.              
           MOVE 'CREDIT GROUP '            TO MI-COLUMN-DESC.           
           MOVE MH-TRANS-HIST-SEQ-NO       TO MI-TRANS-HIST-SEQ-NO.     
      *                                                                 16430000
           IF WNEW-CREDIT-GROUP > SPACES                                
              MOVE +24                     TO MI-CHG-COLUMN-VALUE-LEN   
              MOVE WNEW-CREDIT-GROUP       TO MI-CHG-COLUMN-VALUE-TEXT  
           ELSE                                                         
              MOVE +9                      TO MI-CHG-COLUMN-VALUE-LEN   
              MOVE '*DELETED*'             TO MI-CHG-COLUMN-VALUE-TEXT  
           END-IF.                                                      
      *                                                                 16550000
           IF WOLD-CREDIT-GROUP > SPACES                                
              MOVE +24                     TO MI-PRV-COLUMN-VALUE-LEN   
              MOVE WOLD-CREDIT-GROUP       TO MI-PRV-COLUMN-VALUE-TEXT  
           ELSE                                                         
              MOVE +5                      TO MI-PRV-COLUMN-VALUE-LEN   
              MOVE '*NEW*'                 TO MI-PRV-COLUMN-VALUE-TEXT  
           END-IF.                                                      
      *                                                                 16670000
           PERFORM 6530-LOAD-MNT-TRANS-HIST      THRU 6530-EXIT.        
      *                                                                 16690000
       5550-EXIT.                                                       
           EXIT.                                                        
      *                                                                 16720000
      ***************************************************************** 16730000
      * 5560-JRNL-EFFECT-DT                                           * 16740000
      *                                                               * 16750000
      *     CALLS 6530-LOAD-MNT-TRANS-HIST                            * 16760000
      *                                                               * 16770000
      *     CALLED FROM 5500-JOURNAL-TRANS                            * 16780000
      *                                                               * 16790000
      *     MOVES THE TRANSASTION EFFDATE FIELD INFO TO THE MI FIELDS * 16800000
      *                                                               * 16810000
      ******************************************************************16820000
      *                                                                 16830000
       5560-JRNL-EFFECT-DT.                                             
      *                                                                 16850000
           ADD  1                          TO WS-TRANS-APPL-NO.         
           MOVE WS-TRANS-APPL-NO           TO MI-TRAN-APPL-NO.          
           MOVE SPACES                     TO MI-TABLE-ID.              
           MOVE 'EFFECTIVE DT '            TO MI-COLUMN-DESC.           
           MOVE MH-TRANS-HIST-SEQ-NO       TO MI-TRANS-HIST-SEQ-NO.     
      *                                                                 16900000
           IF WSN-EFFECTIVE-DATE > SPACES                               
              MOVE +24                     TO MI-CHG-COLUMN-VALUE-LEN   
              MOVE WSN-EFFECTIVE-DATE      TO MI-CHG-COLUMN-VALUE-TEXT  
           ELSE                                                         
              MOVE +9                      TO MI-CHG-COLUMN-VALUE-LEN   
              MOVE '*DELETED*'             TO MI-CHG-COLUMN-VALUE-TEXT  
           END-IF.                                                      
      *                                                                 17020000
           IF WOLD-EFFECTIVE-DATE > SPACES                              
              MOVE +24                     TO MI-PRV-COLUMN-VALUE-LEN   
              MOVE WOLD-EFFECTIVE-DATE     TO MI-PRV-COLUMN-VALUE-TEXT  
           ELSE                                                         
              MOVE +5                      TO MI-PRV-COLUMN-VALUE-LEN   
              MOVE '*NEW*'                 TO MI-PRV-COLUMN-VALUE-TEXT  
           END-IF.                                                      
      *                                                                 17140000
           PERFORM 6530-LOAD-MNT-TRANS-HIST      THRU 6530-EXIT.        
      *                                                                 17160000
       5560-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
P00726******************************************************************16260000
P00726* 5570-JRNL-RISK-RATING-CODE                                     *16270000
P00726******************************************************************16350000
P00726                                                                  
P00726 5570-JRNL-RISK-RATING-CODE.                                      
P00726                                                                  
P00726     ADD  1                          TO WS-TRANS-APPL-NO.         
P00726     MOVE WS-TRANS-APPL-NO           TO MI-TRAN-APPL-NO.          
P00726     MOVE 'RISK RATING'              TO MI-COLUMN-DESC.           
P00726     MOVE '  '                       TO MI-TABLE-ID.              
P00726     MOVE MH-TRANS-HIST-SEQ-NO       TO MI-TRANS-HIST-SEQ-NO.     
P00726     MOVE +15                        TO MI-PRV-COLUMN-VALUE-LEN   
P00726                                        MI-CHG-COLUMN-VALUE-LEN.  
P00726     IF WS-NEW-LOSS-RESERVE-CD > 0                                
P00726        MOVE WS-NEW-RISK-RATING-TEXT TO MI-CHG-COLUMN-VALUE-TEXT  
P00726     ELSE                                                         
P00726        MOVE '*DELETED*'             TO MI-CHG-COLUMN-VALUE-TEXT  
P00726     END-IF.                                                      
P00726                                                                  
P00726     IF WS-OLD-LOSS-RESERVE-CD > 0                                
P00726        MOVE WS-OLD-RISK-RATING-TEXT TO MI-PRV-COLUMN-VALUE-TEXT  
P00726     ELSE                                                         
P00726        MOVE '*NEW*'                 TO MI-PRV-COLUMN-VALUE-TEXT  
P00726     END-IF.                                                      
P00726                                                                  
P00726     PERFORM 6530-LOAD-MNT-TRANS-HIST      THRU 6530-EXIT.        
P00726                                                                  
P00726 5570-EXIT.                                                       
P00726     EXIT.                                                        
P00726                                                                  
P00726******************************************************************16260000
P00726* 5580-JRNL-RISK-EFFECT-DT                                       *16270000
P00726******************************************************************16350000
P00726                                                                  
P00726 5580-JRNL-RISK-EFFECT-DT.                                        
P00726                                                                  
P00726     ADD  1                          TO WS-TRANS-APPL-NO.         
P00726     MOVE WS-TRANS-APPL-NO           TO MI-TRAN-APPL-NO.          
P00726     MOVE 'DATE CHANGED'             TO MI-COLUMN-DESC            
P00726     MOVE '  '                       TO MI-TABLE-ID.              
P00726     MOVE MH-TRANS-HIST-SEQ-NO       TO MI-TRANS-HIST-SEQ-NO.     
P00726     MOVE +10                        TO MI-PRV-COLUMN-VALUE-LEN   
P00726                                        MI-CHG-COLUMN-VALUE-LEN.  
P00726     IF WS-NEW-LOSS-RESRVE-EFF-DT > SPACES                        
P00726        MOVE WS-NEW-LOSS-RESRVE-EFF-DT                            
P00726                                     TO MI-CHG-COLUMN-VALUE-TEXT  
P00726     ELSE                                                         
P00726        MOVE '*DELETED*'             TO MI-CHG-COLUMN-VALUE-TEXT  
P00726     END-IF.                                                      
P00726                                                                  
P00726     IF WS-OLD-LOSS-RESRVE-EFF-DT > SPACES                        
P00726        MOVE WS-OLD-LOSS-RESRVE-EFF-DT                            
P00726                                     TO MI-PRV-COLUMN-VALUE-TEXT  
P00726     ELSE                                                         
P00726        MOVE '*NEW*'                 TO MI-PRV-COLUMN-VALUE-TEXT  
P00726     END-IF.                                                      
P00726                                                                  
P00726     PERFORM 6530-LOAD-MNT-TRANS-HIST      THRU 6530-EXIT.        
P00726                                                                  
P00726 5580-EXIT.                                                       
P00726     EXIT.                                                        
P00726                                                                  
      ******************************************************************09580000
      * 5900-CALC-VARCHAR-LENGTH                                       *09590000
      ******************************************************************09580000
       COPY CPD00060.                                                   12510000
      *                                                                 17160000
      ******************************************************************09580000
      * 6530-LOAD-MNT-TRANS-HIST                                      * 09590000
      * 6540-INSERT-MNT-TRANS-HIST                                     *09590000
      * 6550-INSERT-MT-TRN-HST-DET                                     *09590000
      ******************************************************************09580000
           EXEC SQL                                                     12530000
               INCLUDE CPD00067                                         12540000
           END-EXEC.                                                    12550000
      *                                                                         
      ******************************************************************09580000
      * 7200-SELECT-CREDIT-PROFILE                                     *09590000
      *                                                                *09600000
      *     CALLS 9000-SEND-ERROR-RESULT                               *09610000
      *           9900-SQL-ERROR-ROUTINE                               *09620000
      *                                                                *09630000
      *     CALLED FROM 2220-COMPARE-OLD-TO-NEW                        *09640000
      *                                                                *09650000
      *     SELECTS A ROW FROM THE TABLE CSS_CREDIT_PROFILE            *09660000
      ******************************************************************09670000
      *                                                                 09680000
       7200-SELECT-CREDIT-PROFILE.                                      
      *                                                                 09700000
           MOVE '7200'          TO ACTIVE-PARAGRAPH.                    
      *                                                                 09720000
           EXEC SQL                                                     
              SELECT  ARREARS_HIST,                                     
                      DISCONNECT_HIST,                                  
                      DISC_EXCEPTN_HIST,                                
                      NON_UTL_ARRER_HIST,                               
                      CR_GRP_EFFECT_DT,                                 
                      REPLACE(REPLACE(CONVERT(CHAR(26), LAST_UPDATE_TS
           , 121), ' ', '-'), ':', '.') LAST_UPDATE_TS,                        
T21957                NON_UTL_CR_HST,                                   
T21957                NON_UTL_CR_HST_EX                                 
              INTO   :CZ-ARREARS-HIST,                                  
                     :CZ-DISCONNECT-HIST,                               
                     :CZ-DISC-EXCEPTN-HIST,                             
                     :CZ-NON-UTL-ARRER-HIST,                            
                     :CZ-CR-GRP-EFFECT-DT :EFFECTIVE-DATE-IND,           
                     :CZ-LAST-UPDATE-TS,                                
T21957               :CZ-NON-UTL-CR-HST,                                
T21957               :CZ-NON-UTL-CR-HST-EX                              
              FROM    CSS_CREDIT_PROFILE WITH(READUNCOMMITTED)                  
              WHERE   ACCOUNT_NO     = :AT-ACCOUNT-NO                   
              AND     LAST_UPDATE_TS = CIS.CHAR2TIMESTAMP(
                                                  :WS-CZ-LAST-UPDATE-TS
              )            
T35434                                                        
P00399                                                      
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ003
MFA-TR* MSQ022
MFA-TR* MSQ054
MFA-TR* MSQ061
MFA-TR*    EXEC SQL                                                     09730000
MFA-TR*       SELECT  ARREARS_HIST,                                     09740000
MFA-TR*               DISCONNECT_HIST,                                  09750000
MFA-TR*               DISC_EXCEPTN_HIST,                                09760000
MFA-TR*               NON_UTL_ARRER_HIST,                               09770000
MFA-TR*               CR_GRP_EFFECT_DT,                                 09780000
MFA-TR*               LAST_UPDATE_TS,                                   09790000
MFA-TR*               NON_UTL_CR_HST,                                           
MFA-TR*               NON_UTL_CR_HST_EX                                         
MFA-TR*       INTO   :CZ-ARREARS-HIST,                                  09800000
MFA-TR*              :CZ-DISCONNECT-HIST,                               09810000
MFA-TR*              :CZ-DISC-EXCEPTN-HIST,                             09820000
MFA-TR*              :CZ-NON-UTL-ARRER-HIST,                            09830000
MFA-TR*              :CZ-CR-GRP-EFFECT-DT:EFFECTIVE-DATE-IND,           09840000
MFA-TR*              :CZ-LAST-UPDATE-TS,                                09850000
MFA-TR*              :CZ-NON-UTL-CR-HST,                                        
MFA-TR*              :CZ-NON-UTL-CR-HST-EX                                      
MFA-TR*       FROM    CSS_CREDIT_PROFILE                                09860000
MFA-TR*       WHERE   ACCOUNT_NO     = :AT-ACCOUNT-NO                   09870000
MFA-TR*       AND     LAST_UPDATE_TS = :WS-CZ-LAST-UPDATE-TS            09880000
MFA-TR*       WITH    UR                                                        
MFA-TR*       QUERYNO 7200                                                      
MFA-TR*    END-EXEC.                                                    09890000

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

      *                                                                 09900000
           MOVE SQLCODE TO WS-ACTIVE-RETURN-CODE.                       
      *                                                                 09920000
           IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL                   
              IF EFFECTIVE-DATE-IND = NULL-VALUE                        
                 MOVE SPACES               TO CZ-CR-GRP-EFFECT-DT       
              END-IF                                                    
           ELSE                                                         
              MOVE WS-ACTIVE-RETURN-CODE   TO RS-RETURN-CODE            
              MOVE PROGRAM-NAME            TO ABEND-PROGRAM             
              MOVE 'SELECT'                TO ABEND-FUNCTION            
CBSI          MOVE SPACES                  TO ABEND-SQL-PREDICATES      
CBSI                                          ABEND-TABLES              
              MOVE 'CSS_CREDIT_PROFILE'    TO TABLE-1                   
CBSI          MOVE 'ACCOUNT_NO'            TO TABLE-ELEMENT-1           
CBSI          MOVE 'LAST_UPDATE_TS'        TO TABLE-ELEMENT-2           
              MOVE AT-ACCOUNT-NO           TO HOSTVAR-ELEMENT-1         
T16094        MOVE WS-CZ-LAST-UPDATE-TS    TO HOSTVAR-ELEMENT-2         
      *                                                                 10020000
              PERFORM 9000-SEND-ERROR-RESULT     THRU 9000-EXIT         
              PERFORM 9900-SQL-ERROR-ROUTINE     THRU 9900-EXIT         
           END-IF.                                                      
      *                                                                 10060000
       7200-EXIT.                                                       
           EXIT.                                                        
      *                                                                 10090000
      ******************************************************************10100000
      * 7250-SELECT-ACCOUNT                                            *10110000
      *                                                                *10120000
      *     CALLS 9000-SEND-ERROR-RESULT                               *10130000
      *           9900-SQL-ERROR-ROUTINE                               *10140000
      *                                                                *10150000
      *     CALLED FROM 2220-COMPARE-OLD-TO-NEW                        *10160000
      *                                                                *10170000
      *     SELECTS A ROW FROM THE TABLE CSS_ACCOUNT                   *10180000
      ******************************************************************10190000
      *                                                                 10200000
       7250-SELECT-ACCOUNT.                                             
      *                                                                 10220000
           MOVE '7250'          TO ACTIVE-PARAGRAPH.                    
      *                                                                 10240000
           EXEC SQL                                                     
              SELECT CREDIT_GROUP,                                      
                     REPLACE(REPLACE(CONVERT(CHAR(26), LAST_UPDATE_TS
           , 121), ' ', '-'), ':', '.') LAST_UPDATE_TS,                        
                     PREMISE_NO,                                        
                     LOCAL_OFFICE,                                      
P00726               COMPANY_NO,                                        
P00726               CUSTOMER_NO                                        
              INTO  :AT-CREDIT-GROUP,                                   
                    :AT-LAST-UPDATE-TS,                                 
                    :AT-PREMISE-NO,                                     
                    :AT-LOCAL-OFFICE,                                   
P00726              :AT-COMPANY-NO,                                     
P00726              :AT-CUSTOMER-NO                                     
              FROM   CSS_ACCOUNT WITH(READUNCOMMITTED)                          
              WHERE  ACCOUNT_NO      = :AT-ACCOUNT-NO                   
T35434                                                         
P00399                                                      
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ003
MFA-TR* MSQ022
MFA-TR* MSQ061
MFA-TR*    EXEC SQL                                                     10250000
MFA-TR*       SELECT CREDIT_GROUP,                                      10260000
MFA-TR*              LAST_UPDATE_TS,                                    10270000
MFA-TR*              PREMISE_NO,                                        10280000
MFA-TR*              LOCAL_OFFICE,                                      10290000
MFA-TR*              COMPANY_NO,                                                
MFA-TR*              CUSTOMER_NO                                                
MFA-TR*       INTO  :AT-CREDIT-GROUP,                                   10300000
MFA-TR*             :AT-LAST-UPDATE-TS,                                 10310000
MFA-TR*             :AT-PREMISE-NO,                                     10320000
MFA-TR*             :AT-LOCAL-OFFICE,                                   10330000
MFA-TR*             :AT-COMPANY-NO,                                             
MFA-TR*             :AT-CUSTOMER-NO                                             
MFA-TR*       FROM   CSS_ACCOUNT                                        10340000
MFA-TR*       WHERE  ACCOUNT_NO      = :AT-ACCOUNT-NO                   10350000
MFA-TR*       WITH   UR                                                         
MFA-TR*       QUERYNO 7250                                                      
MFA-TR*    END-EXEC.                                                    10370000

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

      *                                                                 10380000
           MOVE SQLCODE TO WS-ACTIVE-RETURN-CODE.                       
      *                                                                 10400000
           IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL                   
              NEXT SENTENCE                                             
           ELSE                                                         
              MOVE WS-ACTIVE-RETURN-CODE   TO RS-RETURN-CODE            
              MOVE PROGRAM-NAME            TO ABEND-PROGRAM             
              MOVE 'SELECT'                TO ABEND-FUNCTION            
CBSI          MOVE SPACES                  TO ABEND-SQL-PREDICATES      
CBSI                                          ABEND-TABLES              
              MOVE 'CSS_ACCOUNT'           TO TABLE-1                   
CBSI          MOVE 'ACCOUNT_NO'            TO TABLE-ELEMENT-1           
CBSI          MOVE 'LAST_UPDATE_TS'        TO TABLE-ELEMENT-2           
              MOVE AT-ACCOUNT-NO           TO HOSTVAR-ELEMENT-1         
T16094        MOVE WS-AT-LAST-UPDATE-TS    TO HOSTVAR-ELEMENT-2         
      *                                                                 10500000
              PERFORM 9000-SEND-ERROR-RESULT     THRU 9000-EXIT         
              PERFORM 9900-SQL-ERROR-ROUTINE     THRU 9900-EXIT         
           END-IF.                                                      
      *                                                                 10540000
       7250-EXIT.                                                       
           EXIT.                                                        
      *                                                                 12560000
      ******************************************************************12570000
      * 7300-GET-ACCOUNT-TIMESTAMP                                     *12580000
      *                                                                *12590000
      *     CALLS 9000-SEND-ERROR-RESULT                               *12600000
      *           9900-SQL-ERROR-ROUTINE                               *12610000
      *                                                                *12620000
      *     CALLED FROM 5010-JOURNALING                                *12630000
      *                                                                *12640000
      *     PUTS CURRENT TIMESTAMP IN THE  TRANSACTION HISTORY TABLE   *12650000
      *                                                                *12660000
      ******************************************************************12670000
      *                                                                 12680000
       7300-GET-TIMESTAMP.                                              
      *                                                                 12700000
           MOVE '7300'          TO ACTIVE-PARAGRAPH.                    
      *                                                                 12720000
           EXEC SQL                                                     
T35434       SELECT
              REPLACE(REPLACE(CONVERT(CHAR(26), CIS.CURRENT$TIMESTAMP()
           , 121), ' ', '-'), ':', '.'),
              CAST(SYSDATETIMEOFFSET() AS DATE)
            INTO
              :WS-NEW-TIMESTAMP,
              :MH-DATE-TRANS                          
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ006
MFA-TR* MSQ028
MFA-TR* MSQ061
MFA-TR*    EXEC SQL                                                     12730000
MFA-TR*      SET :WS-NEW-TIMESTAMP = CURRENT TIMESTAMP,                         
MFA-TR*          :MH-DATE-TRANS = CURRENT DATE                                  
MFA-TR*    END-EXEC.                                                    12790000

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

      *                                                                 12800000
           MOVE SQLCODE TO WS-ACTIVE-RETURN-CODE.                       
      *                                                                 12820000
           IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL                   
              NEXT SENTENCE                                             
           ELSE                                                         
              MOVE WS-ACTIVE-RETURN-CODE   TO RS-RETURN-CODE            
              MOVE PROGRAM-NAME            TO ABEND-PROGRAM             
              MOVE '7300'                  TO ACTIVE-PARAGRAPH          
CBSI          MOVE SPACES                  TO ABEND-SQL-PREDICATES      
CBSI                                          ABEND-TABLES              
T35434        MOVE 'SET'                   TO ABEND-FUNCTION            
CBSI          MOVE 'ACCOUNT_NO'            TO TABLE-ELEMENT-1           
CBSI          MOVE PARM-ACCOUNT-NO         TO HOSTVAR-ELEMENT-1         
              PERFORM 9000-SEND-ERROR-RESULT     THRU 9000-EXIT         
              PERFORM 9900-SQL-ERROR-ROUTINE     THRU 9900-EXIT         
           END-IF.                                                      
      *                                                                 12940000
       7300-EXIT.                                                       
           EXIT.                                                        
      *                                                                 12970000
      ***************************************************************** 12980000
      * 7320-GET-RESP-AREA                                            * 12990000
      *                                                               * 13000000
      *     CALLS 9000-SEND-ERROR-RESULT                              * 13010000
      *           9900-SQL-ERROR-ROUTINE                              * 13020000
      *                                                               * 13030000
      *     CALLED FROM 5010-JOURNALING                               * 13040000
      *                                                               * 13050000
      *     SELECTS CSS_PREMISE                                       * 13060000
      *                                                               * 13070000
      ***************************************************************** 13080000
      *                                                                 13090000
       7320-GET-RESP-AREA.                                              
      *                                                                 13110000
           MOVE '7320'               TO ACTIVE-PARAGRAPH.               
      *                                                                 13130000
           EXEC SQL                                                     
              SELECT RESP_AREA_ID                                       
                INTO :WS-RESP-AREA-ID                                   
                FROM CSS_USER_PROFILE WITH(READUNCOMMITTED)                     
               WHERE USER_ID = :PF-USER-ID                              
T35434                                                          
P00399                                                      
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ003
MFA-TR* MSQ022
MFA-TR*    EXEC SQL                                                     13140000
MFA-TR*       SELECT RESP_AREA_ID                                       13150000
MFA-TR*         INTO :WS-RESP-AREA-ID                                   13160000
MFA-TR*         FROM CSS_USER_PROFILE                                   13170000
MFA-TR*        WHERE USER_ID = :PF-USER-ID                              13180000
MFA-TR*        WITH  UR                                                         
MFA-TR*        QUERYNO 7320                                                     
MFA-TR*    END-EXEC.                                                    13190000

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

      *                                                                 13200000
           MOVE SQLCODE TO WS-ACTIVE-RETURN-CODE.                       
      *                                                                 13220000
           IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL                   
              NEXT SENTENCE                                             
           ELSE                                                         
              MOVE WS-ACTIVE-RETURN-CODE   TO RS-RETURN-CODE            
              MOVE PROGRAM-NAME            TO ABEND-PROGRAM             
              MOVE 'SELECT'                TO ABEND-FUNCTION            
CBSI          MOVE SPACES                  TO ABEND-SQL-PREDICATES      
CBSI                                          ABEND-TABLES              
              MOVE 'CSS_USER_PROFILE'      TO TABLE-1                   
CBSI          MOVE 'USER_ID'               TO TABLE-ELEMENT-1           
CBSI          MOVE 'ACCOUNT_NO'            TO TABLE-ELEMENT-2           
              MOVE PF-USER-ID              TO HOSTVAR-ELEMENT-1         
T16094        MOVE AT-ACCOUNT-NO           TO HOSTVAR-ELEMENT-2         
              PERFORM 9000-SEND-ERROR-RESULT     THRU 9000-EXIT         
              PERFORM 9900-SQL-ERROR-ROUTINE     THRU 9900-EXIT         
           END-IF.                                                      
      *                                                                 13350000
       7320-EXIT.                                                       
           EXIT.                                                        
      *                                                                 13380000
      ***************************************************************** 13390000
      * 7330-GET-SUPR-ID                                              * 13400000
      *                                                               * 13410000
      *     CALLS 9000-SEND-ERROR-RESULT                              * 13420000
      *           9900-SQL-ERROR-ROUTINE                              * 13430000
      *                                                               * 13440000
      *     CALLED FROM 5010-JOURNALING                               * 13450000
      *                                                               * 13460000
      *     SELECTS CSS_PREMISE                                       * 13470000
      *                                                               * 13480000
      ***************************************************************** 13490000
      *                                                                 13500000
       7330-GET-SUPR-ID.                                                
      *                                                                 13520000
           MOVE '7330'               TO ACTIVE-PARAGRAPH.               
      *                                                                 13540000
           EXEC SQL                                                     
              SELECT USER_ID                                            
                INTO :WS-SUPR-ID                                        
                FROM CSS_RESP_AREA WITH(READUNCOMMITTED)                        
               WHERE RESP_AREA_ID = :WS-RESP-AREA-ID                    
T35434                                                          
P00399                                                      
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ003
MFA-TR* MSQ022
MFA-TR*    EXEC SQL                                                     13550000
MFA-TR*       SELECT USER_ID                                            13560000
MFA-TR*         INTO :WS-SUPR-ID                                        13570000
MFA-TR*         FROM CSS_RESP_AREA                                      13580000
MFA-TR*        WHERE RESP_AREA_ID = :WS-RESP-AREA-ID                    13590000
MFA-TR*        WITH  UR                                                         
MFA-TR*        QUERYNO 7330                                                     
MFA-TR*    END-EXEC.                                                    13600000

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

      *                                                                 13610000
           MOVE SQLCODE TO WS-ACTIVE-RETURN-CODE.                       
      *                                                                 13630000
           IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL                   
              NEXT SENTENCE                                             
           ELSE                                                         
              MOVE WS-ACTIVE-RETURN-CODE   TO RS-RETURN-CODE            
              MOVE PROGRAM-NAME            TO ABEND-PROGRAM             
              MOVE 'SELECT'                TO ABEND-FUNCTION            
CBSI          MOVE SPACES                  TO ABEND-SQL-PREDICATES      
CBSI                                          ABEND-TABLES              
              MOVE 'CSS_RESP_AREA'         TO TABLE-1                   
              MOVE 'RESP_AREA_ID'          TO TABLE-ELEMENT-1           
CBSI          MOVE 'ACCOUNT_NO'            TO TABLE-ELEMENT-2           
              MOVE WS-RESP-AREA-ID         TO HOSTVAR-ELEMENT-1         
T16094        MOVE AT-ACCOUNT-NO           TO HOSTVAR-ELEMENT-2         
              PERFORM 9000-SEND-ERROR-RESULT     THRU 9000-EXIT         
              PERFORM 9900-SQL-ERROR-ROUTINE     THRU 9900-EXIT         
           END-IF.                                                      
      *                                                                 13760000
       7330-EXIT.                                                       
           EXIT.                                                        
      *                                                                 17190000
P00726******************************************************************04290099
P00726* 7340-SELECT-CUST                                               *04300099
P00726******************************************************************04310099
P00726 7340-SELECT-CUST.                                                
P00726                                                                  
P00726     EXEC SQL                                                     
P00726        SELECT LOSS_RESERVE_CD                                    
P00726              ,LOSS_RESRVE_EFF_DT                                 
P00726         INTO  :LQ-LOSS-RESERVE-CD                                
P00726              ,:LQ-LOSS-RESRVE-EFF-DT :WS-RISK-EFFECT-DT-NULL     
P00726         FROM CSS_CUST_MISC_INFO WITH(READUNCOMMITTED)                    
P00726         WHERE CUSTOMER_NO = :AT-CUSTOMER-NO                      
P00726                                                           
P00726                                                      
P00726     END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ003
MFA-TR* MSQ022
MFA-TR*    EXEC SQL                                                     04340099
MFA-TR*       SELECT LOSS_RESERVE_CD                                            
MFA-TR*             ,LOSS_RESRVE_EFF_DT                                         
MFA-TR*        INTO  :LQ-LOSS-RESERVE-CD                                        
MFA-TR*             ,:LQ-LOSS-RESRVE-EFF-DT :WS-RISK-EFFECT-DT-NULL             
MFA-TR*        FROM CSS_CUST_MISC_INFO                                  04430010
MFA-TR*        WHERE CUSTOMER_NO = :AT-CUSTOMER-NO                      04440099
MFA-TR*        WITH UR                                                          
MFA-TR*        QUERYNO 7340                                                     
MFA-TR*    END-EXEC.                                                    04450099

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

P00726                                                                  
P00726     MOVE SQLCODE                       TO WS-ACTIVE-RETURN-CODE. 
P00726                                                                  
P00726     EVALUATE WS-ACTIVE-RETURN-CODE                               
P00726         WHEN SUCCESSFUL-CALL                                     
P00726              MOVE 'YES'                TO WS-CUST-EXISTS-FLAG    
P00726              IF WS-RISK-EFFECT-DT-NULL < 0                       
P00726                 MOVE SPACES            TO LQ-LOSS-RESRVE-EFF-DT  
P00726              END-IF                                              
P00726         WHEN NOT-FOUND                                           
P00726              MOVE 'NO'                 TO WS-CUST-EXISTS-FLAG    
P00726              MOVE SPACES               TO LQ-LOSS-RESRVE-EFF-DT  
P00726         WHEN OTHER                                               
P00726              MOVE PROGRAM-NAME         TO ABEND-PROGRAM          
P00726              MOVE '7340'               TO ACTIVE-PARAGRAPH       
P00726              MOVE 'SELECT'             TO ABEND-FUNCTION         
P00726              MOVE 'CSS_CUST_MISC_INFO' TO TABLE-1                
P00726              MOVE 'CUSTOMER_NO'        TO TABLE-ELEMENT-1        
P00726              MOVE AT-CUSTOMER-NO       TO HOSTVAR-ELEMENT-1      
P00726              PERFORM 9000-SEND-ERROR-RESULT THRU 9000-EXIT       
P00726              PERFORM 9900-SQL-ERROR-ROUTINE THRU 9900-EXIT       
P00726     END-EVALUATE.                                                
P00726                                                                  
P00726 7340-EXIT.                                                       
P00726     EXIT.                                                        
P00726                                                                  
P00726******************************************************************04290099
P00726* 7350-SELECT-RISK-RATING-TEXT                                   *04300099
P00726******************************************************************04310099
P00726                                                                  
P00726 7350-SELECT-RISK-RATING-TEXT.                                    
P00726                                                                  
P00726     EXEC SQL                                                     
P00726        SELECT LOSS_RESERVE_TX                                    
P00726          INTO :WS-RISK-RATING-TEXT                               
P00726          FROM CSS_LOSS_RESERVE WITH(READUNCOMMITTED)                     
P00726         WHERE LOSS_RESERVE_CD = :WS-LOSS-RESERVE-CD              
P00726           AND COMPANY_NO      = :AT-COMPANY-NO                   
P00726                                                           
P00726                                                      
P00726     END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ003
MFA-TR* MSQ022
MFA-TR*    EXEC SQL                                                             
MFA-TR*       SELECT LOSS_RESERVE_TX                                            
MFA-TR*         INTO :WS-RISK-RATING-TEXT                                       
MFA-TR*         FROM CSS_LOSS_RESERVE                                           
MFA-TR*        WHERE LOSS_RESERVE_CD = :WS-LOSS-RESERVE-CD                      
MFA-TR*          AND COMPANY_NO      = :AT-COMPANY-NO                           
MFA-TR*        WITH UR                                                          
MFA-TR*        QUERYNO 7350                                                     
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

P00726                                                                  
P00726     MOVE SQLCODE                       TO WS-ACTIVE-RETURN-CODE. 
P00726                                                                  
P00726     EVALUATE WS-ACTIVE-RETURN-CODE                               
P00726         WHEN SUCCESSFUL-CALL                                     
P00726         WHEN NOT-FOUND                                           
P00726              CONTINUE                                            
P00726         WHEN OTHER                                               
P00726              MOVE PROGRAM-NAME         TO ABEND-PROGRAM          
P00726              MOVE '7340'               TO ACTIVE-PARAGRAPH       
P00726              MOVE 'SELECT'             TO ABEND-FUNCTION         
P00726              MOVE 'CSS_LOSS_RESERVE'   TO TABLE-1                
P00726              MOVE 'LOSS_RESERVE_CD'    TO TABLE-ELEMENT-1        
P00726              MOVE WS-LOSS-RESERVE-CD   TO HOSTVAR-ELEMENT-1      
P00726              MOVE 'COMPANY_NO'         TO TABLE-ELEMENT-2        
P00726              MOVE AT-COMPANY-NO        TO HOSTVAR-ELEMENT-2      
P00726              PERFORM 9000-SEND-ERROR-RESULT THRU 9000-EXIT       
P00726              PERFORM 9900-SQL-ERROR-ROUTINE THRU 9900-EXIT       
P00726     END-EVALUATE.                                                
P00726                                                                  
P00726 7350-EXIT.                                                       
P00726     EXIT.                                                        
P00726                                                                  
      *                                                                         
      ******************************************************************17200000
      * 8210-UPDATE-CREDIT-PROFILE                                     *17210000
      *                                                                *17220000
      *     CALLS 9900-SQL-ERROR-ROUTINE                               *17230000
      *                                                                *17240000
      *     CALLED FROM 5010-JOURNALING                                *17250000
      *                                                                *17260000
      *     UPDATES THE CSS_CREDIT_PROFILE TABLE WITH THE NEW VALUES   *17270000
      *                                                                *17280000
      ******************************************************************17290000
      *                                                                 17300000
       8210-UPDATE-CREDIT-PROFILE.                                      
      *                                                                 17320000
           MOVE '8210'              TO ACTIVE-PARAGRAPH.                
      *                                                                 17340000
           IF CZ-CR-GRP-EFFECT-DT = SPACES                              
              MOVE NULL-VALUE       TO EFFECTIVE-DATE-IND               
T21187     ELSE                                                         
T21187        MOVE ZERO             TO EFFECTIVE-DATE-IND               
           END-IF.                                                      
      *                                                                 17340400
           EXEC SQL                                                     
              UPDATE CSS_CREDIT_PROFILE                                 
              SET    ARREARS_HIST       = :CZ-ARREARS-HIST,             
                     CR_GRP_EFFECT_DT   = IIF(TRY_CONVERT(DATE, 
                                                  :CZ-CR-GRP-EFFECT-DT 
                                                    :EFFECTIVE-DATE-IND
              ) IS NULL OR (PATINDEX('%.%', :CZ-CR-GRP-EFFECT-DT 
                                                    :EFFECTIVE-DATE-IND
              ) <> 0) OR (LEN(:CZ-CR-GRP-EFFECT-DT :EFFECTIVE-DATE-IND
              ) <> 10), CIS.CHAR2DATE(:CZ-CR-GRP-EFFECT-DT 
                                                    :EFFECTIVE-DATE-IND
              ), CONVERT(DATE, :CZ-CR-GRP-EFFECT-DT :EFFECTIVE-DATE-IND
              ) ),          
                     DISC_EXCEPTN_HIST  = :CZ-DISC-EXCEPTN-HIST,        
                     DISCONNECT_HIST    = :CZ-DISCONNECT-HIST,          
                     LAST_UPDATE_TS     = CIS.CHAR2TIMESTAMP(
                                                      :WS-NEW-TIMESTAMP
              ),            
                     NON_UTL_ARRER_HIST = :CZ-NON-UTL-ARRER-HIST,       
T21957               NON_UTL_CR_HST     = :CZ-NON-UTL-CR-HST,           
T21957               NON_UTL_CR_HST_EX  = :CZ-NON-UTL-CR-HST-EX         
              WHERE  ACCOUNT_NO         = :AT-ACCOUNT-NO                
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ054
MFA-TR*    EXEC SQL                                                     17350000
MFA-TR*       UPDATE CSS_CREDIT_PROFILE                                 17360000
MFA-TR*       SET    ARREARS_HIST       = :CZ-ARREARS-HIST,             17370000
MFA-TR*              CR_GRP_EFFECT_DT   = :CZ-CR-GRP-EFFECT-DT:         17380000
MFA-TR*                                    EFFECTIVE-DATE-IND,          17380100
MFA-TR*              DISC_EXCEPTN_HIST  = :CZ-DISC-EXCEPTN-HIST,        17390000
MFA-TR*              DISCONNECT_HIST    = :CZ-DISCONNECT-HIST,          17400000
MFA-TR*              LAST_UPDATE_TS     = :WS-NEW-TIMESTAMP,            17410000
MFA-TR*              NON_UTL_ARRER_HIST = :CZ-NON-UTL-ARRER-HIST,       17420000
MFA-TR*              NON_UTL_CR_HST     = :CZ-NON-UTL-CR-HST,           17420000
MFA-TR*              NON_UTL_CR_HST_EX  = :CZ-NON-UTL-CR-HST-EX         17420000
MFA-TR*       WHERE  ACCOUNT_NO         = :AT-ACCOUNT-NO                17430000
MFA-TR*    END-EXEC.                                                    17440000

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

      *                                                                 17450000
           MOVE SQLCODE TO WS-ACTIVE-RETURN-CODE.                       
      *                                                                 17470000
           IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL                   
              MOVE WS-NEW-TIMESTAMP    TO RS-CZ-TIME                    
           ELSE                                                         
              MOVE WS-ACTIVE-RETURN-CODE TO RS-RETURN-CODE              
              MOVE PROGRAM-NAME        TO ABEND-PROGRAM                 
              MOVE 'UPDATE'            TO ABEND-FUNCTION                
              MOVE SPACES              TO ABEND-SQL-PREDICATES          
                                          ABEND-TABLES                  
              MOVE 'CSS_CREDIT_PROFILE' TO TABLE-1                      
              MOVE AT-ACCOUNT-NO        TO HOSTVAR-ELEMENT-1            
T16094        MOVE CZ-ARREARS-HIST      TO HOSTVAR-ELEMENT-2            
T16094        MOVE CZ-CR-GRP-EFFECT-DT  TO HOSTVAR-ELEMENT-3            
CBSI          MOVE 'ACCOUNT_NO'         TO TABLE-ELEMENT-1              
CBSI          MOVE 'ARREARS_HIST'       TO TABLE-ELEMENT-2              
CBSI          MOVE 'CR_GRP_EFFECT_DT'   TO TABLE-ELEMENT-3              
              PERFORM 9900-SQL-ERROR-ROUTINE  THRU  9900-EXIT           
           END-IF.                                                      
      *                                                                 17600000
       8210-EXIT.                                                       
           EXIT.                                                        
      *                                                                 17630000
      ******************************************************************17640000
      * 8220-UPDATE-ACCOUNT                                            *17650000
      *                                                                *17660000
      *     CALLS 9900-SQL-ERROR-ROUTINE                               *17670000
      *                                                                *17680000
      *     CALLED FROM 5010-JOURNALING                                *17690000
      *                                                                *17700000
      *     UPDATES THE CSS_ACCOUNT TABLE WITH THE NEW VALUES          *17710000
      ******************************************************************17720000
      *                                                                 17730000
       8220-UPDATE-ACCOUNT.                                             
      *                                                                 17750000
           MOVE '8220'              TO ACTIVE-PARAGRAPH.                
      *                                                                 17770000
           EXEC SQL                                                     
                UPDATE CSS_ACCOUNT                                      
                SET CREDIT_GROUP = :AT-CREDIT-GROUP                     
                   ,LAST_UPDATE_TS = CIS.CHAR2TIMESTAMP(
                                                      :WS-NEW-TIMESTAMP
              )                  
                WHERE ACCOUNT_NO = :AT-ACCOUNT-NO                       
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ054
MFA-TR*    EXEC SQL                                                     17780000
MFA-TR*         UPDATE CSS_ACCOUNT                                      17790000
MFA-TR*         SET CREDIT_GROUP = :AT-CREDIT-GROUP                     17800000
MFA-TR*            ,LAST_UPDATE_TS = :WS-NEW-TIMESTAMP                  17810000
MFA-TR*         WHERE ACCOUNT_NO = :AT-ACCOUNT-NO                       17820000
MFA-TR*    END-EXEC.                                                    17830000

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

      *                                                                 17840000
           MOVE SQLCODE TO WS-ACTIVE-RETURN-CODE.                       
      *                                                                 17860000
           IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL                   
              NEXT SENTENCE                                             
           ELSE                                                         
              MOVE WS-ACTIVE-RETURN-CODE TO RS-RETURN-CODE              
              MOVE PROGRAM-NAME          TO ABEND-PROGRAM               
              MOVE 'UPDATE'              TO ABEND-FUNCTION              
              MOVE SPACES                TO ABEND-SQL-PREDICATES        
                                            ABEND-TABLES                
T16094        MOVE 'CSS_ACCOUNT'         TO TABLE-1                     
              MOVE AT-ACCOUNT-NO         TO HOSTVAR-ELEMENT-1           
T16094        MOVE AT-CREDIT-GROUP       TO HOSTVAR-ELEMENT-2           
T16094        MOVE WS-NEW-TIMESTAMP      TO HOSTVAR-ELEMENT-3           
CBSI          MOVE 'ACCOUNT_NO'          TO TABLE-ELEMENT-1             
CBSI          MOVE 'CREDIT_GROUP'        TO TABLE-ELEMENT-2             
CBSI          MOVE 'LAST_UPDATE_TS'      TO TABLE-ELEMENT-3             
              PERFORM 9900-SQL-ERROR-ROUTINE  THRU  9900-EXIT           
           END-IF.                                                      
      *                                                                 17990000
       8220-EXIT.                                                       
           EXIT.                                                        
      *                                                                 18020000
P00726******************************************************************04660099
P00726* 8230-UPDATE-CUST-STATS                                         *04670099
P00726******************************************************************04680099
P00726 8230-UPDATE-CUST-STATS.                                          
P00726                                                                  
P00726     IF LQ-LOSS-RESRVE-EFF-DT = LOW-VALUES OR SPACES              
P00726        MOVE -1                    TO WS-RISK-EFFECT-DT-NULL      
P00726     ELSE                                                         
P00726        MOVE ZERO                  TO WS-RISK-EFFECT-DT-NULL      
P00726     END-IF                                                       
P00726                                                                  
P00726     EXEC SQL                                                     
P00726        UPDATE CSS_CUST_MISC_INFO                                 
P00726           SET LOSS_RESERVE_CD    = :LQ-LOSS-RESERVE-CD           
P00726              ,LOSS_RESRVE_EFF_DT =                               
P00726               IIF(TRY_CONVERT(DATE, :LQ-LOSS-RESRVE-EFF-DT 
                                           :WS-RISK-EFFECT-DT-NULL
              ) IS NULL OR (PATINDEX('%.%', :LQ-LOSS-RESRVE-EFF-DT 
                                                :WS-RISK-EFFECT-DT-NULL
              ) <> 0) OR (LEN(:LQ-LOSS-RESRVE-EFF-DT 
                                                :WS-RISK-EFFECT-DT-NULL
              ) <> 10), CIS.CHAR2DATE(:LQ-LOSS-RESRVE-EFF-DT 
                                                :WS-RISK-EFFECT-DT-NULL
              ), CONVERT(DATE, :LQ-LOSS-RESRVE-EFF-DT 
                                                :WS-RISK-EFFECT-DT-NULL
              ) )     
P00726         WHERE CUSTOMER_NO        = :AT-CUSTOMER-NO               
P00726                                                      
P00726     END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ003
MFA-TR* MSQ054
MFA-TR*    EXEC SQL                                                     04710099
MFA-TR*       UPDATE CSS_CUST_MISC_INFO                                 04720010
MFA-TR*          SET LOSS_RESERVE_CD    = :LQ-LOSS-RESERVE-CD                   
MFA-TR*             ,LOSS_RESRVE_EFF_DT =                                       
MFA-TR*              :LQ-LOSS-RESRVE-EFF-DT :WS-RISK-EFFECT-DT-NULL             
MFA-TR*        WHERE CUSTOMER_NO        = :AT-CUSTOMER-NO               04760099
MFA-TR*        QUERYNO 8230                                                     
MFA-TR*    END-EXEC.                                                    04770099

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

P00726                                                                  
P00726     MOVE SQLCODE TO WS-ACTIVE-RETURN-CODE.                       
P00726                                                                  
P00726     IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL                   
P00726        NEXT SENTENCE                                             
P00726     ELSE                                                         
P00726        MOVE PROGRAM-NAME         TO ABEND-PROGRAM                
P00726        MOVE '8230'               TO ACTIVE-PARAGRAPH             
P00726        MOVE 'UPDATE'             TO ABEND-FUNCTION               
P00726        MOVE 'CSS_CUST_MISC_INFO' TO TABLE-1                      
P00726        MOVE 'CUSTOMER_NO'        TO TABLE-ELEMENT-1              
P00726        MOVE AT-CUSTOMER-NO       TO HOSTVAR-ELEMENT-1            
P00726        MOVE 'LOSS_RESERVE_CD'    TO TABLE-ELEMENT-2              
P00726        MOVE LQ-LOSS-RESERVE-CD   TO HOSTVAR-ELEMENT-2            
P00726        PERFORM 9000-SEND-ERROR-RESULT  THRU 9000-EXIT            
P00726        PERFORM 9900-SQL-ERROR-ROUTINE  THRU 9900-EXIT            
P00726     END-IF.                                                      
P00726                                                                  
P00726 8230-EXIT.                                                       
P00726     EXIT.                                                        
P00726                                                                  
      ******************************************************************        
      * 8320-SELECT-CRED-COLL                                          *        
      *                                                                *        
      *     CALLS       9000-SEND-ERROR-RESULT                         *        
      *                 9900-SQL-ERROR-ROUTINE                         *        
      *                                                                *        
      *     CALLED FROM 2230-PROCESS-DELETE                            *        
      *                                                                *        
      *     SELECT TABLE CSS_CRED_COLL FOR DNP FLAG D                  *        
      ******************************************************************        
      *                                                                         
       8320-SELECT-CRED-COLL.                                           
      *                                                                         
           MOVE '8320' TO ACTIVE-PARAGRAPH.                             
      *                                                                         
           EXEC SQL                                                     
              SELECT DISTINCT 'Y'                                       
              INTO :RS-DNP-D-FLAG                                       
              FROM CSS_CRED_COLL WITH(READUNCOMMITTED)                          
              WHERE ACCOUNT_NO         = :AT-ACCOUNT-NO                 
              AND   CODE_NOTICE_TYPE   = 'D'                            
              AND   DATE_CREDIT_ACTION < CAST(SYSDATETIMEOFFSET() 
           AS DATE)                   
T35434                                                          
P00399                                                      
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ003
MFA-TR* MSQ022
MFA-TR* MSQ028
MFA-TR*    EXEC SQL                                                             
MFA-TR*       SELECT DISTINCT 'Y'                                               
MFA-TR*       INTO :RS-DNP-D-FLAG                                               
MFA-TR*       FROM CSS_CRED_COLL                                                
MFA-TR*       WHERE ACCOUNT_NO         = :AT-ACCOUNT-NO                         
MFA-TR*       AND   CODE_NOTICE_TYPE   = 'D'                                    
MFA-TR*       AND   DATE_CREDIT_ACTION < CURRENT DATE                           
MFA-TR*       WITH  UR                                                          
MFA-TR*       QUERYNO 8320                                                      
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      
              NEXT SENTENCE                                             
           ELSE                                                         
              MOVE PROGRAM-NAME               TO ABEND-PROGRAM          
T16094        MOVE 'SELECT'                   TO ABEND-FUNCTION         
CBSI          MOVE SPACES                     TO ABEND-SQL-PREDICATES   
CBSI                                             ABEND-TABLES           
              MOVE 'CSS_CRED_COLL'            TO TABLE-1                
              MOVE AT-ACCOUNT-NO              TO HOSTVAR-ELEMENT-1      
T16094        MOVE 'D'                        TO HOSTVAR-ELEMENT-2      
CBSI          MOVE 'ACCOUNT_NO'               TO TABLE-ELEMENT-1        
T16094        MOVE 'CODE_NOTICE_TYPE'         TO TABLE-ELEMENT-2        
              PERFORM 9000-SEND-ERROR-RESULT  THRU 9000-EXIT            
              PERFORM 9900-SQL-ERROR-ROUTINE  THRU 9900-EXIT            
           END-IF.                                                      
      *                                                                         
       8320-EXIT.                                                       
           EXIT.                                                        
                                                                        
P00726******************************************************************04980099
P00726* 8500-INSERT-CUST-STATS                                         *04990099
P00726******************************************************************05000099
P00726 8500-INSERT-CUST-STATS.                                          
P00726                                                                  
P00726     IF LQ-LOSS-RESRVE-EFF-DT = LOW-VALUES OR SPACES              
P00726        MOVE -1                    TO WS-RISK-EFFECT-DT-NULL      
P00726     ELSE                                                         
P00726        MOVE ZERO                  TO WS-RISK-EFFECT-DT-NULL      
P00726     END-IF                                                       
P00726                                                                  
P00726     IF LQ-CONSLT-PRJ-END-DT  = LOW-VALUES OR SPACES              
P00726        MOVE -1                    TO WS-CONSLT-PRJ-END-DT-NULL   
P00726     ELSE                                                         
P00726        MOVE ZERO                  TO WS-CONSLT-PRJ-END-DT-NULL   
P00726     END-IF                                                       
P00726                                                                  
P00726     EXEC SQL                                                     
P00726        INSERT INTO CSS_CUST_MISC_INFO                            
P00726               ( CUSTOMER_NO,                                     
P00726                 INFLUENTIAL_CUST,                                
P00726                 KEY_CUSTOMER,                                    
P00726                 SPECIAL_CUST,                                    
P00726                 CONSULTING_PROJECT,                              
P00726                 CONSLT_PRJ_END_DT,                               
P00726                 INTR_CO_IND,                                     
P00726                 LOSS_RESERVE_CD,                                 
P00726                 LOSS_RESRVE_EFF_DT,                              
P00726                 IVR_NDO_EXEMPT)                                  
P00726        VALUES (:AT-CUSTOMER-NO,                                  
P00726                :LQ-INFLUENTIAL-CUST,                             
P00726                :LQ-KEY-CUSTOMER,                                 
P00726                :LQ-SPECIAL-CUST,                                 
P00726                :LQ-CONSULTING-PROJECT,                           
P00726                IIF(TRY_CONVERT(DATE, :LQ-CONSLT-PRJ-END-DT 
                                            :WS-CONSLT-PRJ-END-DT-NULL
              ) IS NULL OR (PATINDEX('%.%', :LQ-CONSLT-PRJ-END-DT 
                                             :WS-CONSLT-PRJ-END-DT-NULL
              ) <> 0) OR (LEN(:LQ-CONSLT-PRJ-END-DT 
                                             :WS-CONSLT-PRJ-END-DT-NULL
              ) <> 10), CIS.CHAR2DATE(:LQ-CONSLT-PRJ-END-DT 
                                             :WS-CONSLT-PRJ-END-DT-NULL
              ), CONVERT(DATE, :LQ-CONSLT-PRJ-END-DT 
                                             :WS-CONSLT-PRJ-END-DT-NULL
              ) ),
P00726                :LQ-INTR-CO-IND,                                  
P00726                :LQ-LOSS-RESERVE-CD,                              
P00726                IIF(TRY_CONVERT(DATE, :LQ-LOSS-RESRVE-EFF-DT 
                                            :WS-RISK-EFFECT-DT-NULL
              ) IS NULL OR (PATINDEX('%.%', :LQ-LOSS-RESRVE-EFF-DT 
                                                :WS-RISK-EFFECT-DT-NULL
              ) <> 0) OR (LEN(:LQ-LOSS-RESRVE-EFF-DT 
                                                :WS-RISK-EFFECT-DT-NULL
              ) <> 10), CIS.CHAR2DATE(:LQ-LOSS-RESRVE-EFF-DT 
                                                :WS-RISK-EFFECT-DT-NULL
              ), CONVERT(DATE, :LQ-LOSS-RESRVE-EFF-DT 
                                                :WS-RISK-EFFECT-DT-NULL
              ) ),   
P00726                :LQ-IVR-NDO-EXEMPT)                               
P00726     END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ054
MFA-TR*    EXEC SQL                                                     05030099
MFA-TR*       INSERT INTO CSS_CUST_MISC_INFO                            05040010
MFA-TR*              ( CUSTOMER_NO,                                     05050099
MFA-TR*                INFLUENTIAL_CUST,                                05310099
MFA-TR*                KEY_CUSTOMER,                                    05320099
MFA-TR*                SPECIAL_CUST,                                    05330099
MFA-TR*                CONSULTING_PROJECT,                              05340099
MFA-TR*                CONSLT_PRJ_END_DT,                               05350099
MFA-TR*                INTR_CO_IND,                                     05440099
MFA-TR*                LOSS_RESERVE_CD,                                         
MFA-TR*                LOSS_RESRVE_EFF_DT,                                      
MFA-TR*                IVR_NDO_EXEMPT)                                          
MFA-TR*       VALUES (:AT-CUSTOMER-NO,                                  05450010
MFA-TR*               :LQ-INFLUENTIAL-CUST,                             05710010
MFA-TR*               :LQ-KEY-CUSTOMER,                                 05720010
MFA-TR*               :LQ-SPECIAL-CUST,                                 05730010
MFA-TR*               :LQ-CONSULTING-PROJECT,                           05740010
MFA-TR*               :LQ-CONSLT-PRJ-END-DT  :WS-CONSLT-PRJ-END-DT-NULL,05750010
MFA-TR*               :LQ-INTR-CO-IND,                                  05840010
MFA-TR*               :LQ-LOSS-RESERVE-CD,                                      
MFA-TR*               :LQ-LOSS-RESRVE-EFF-DT :WS-RISK-EFFECT-DT-NULL,           
MFA-TR*               :LQ-IVR-NDO-EXEMPT)                                       
MFA-TR*    END-EXEC.                                                    05850099

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

P00726                                                                  
P00726     MOVE SQLCODE TO WS-ACTIVE-RETURN-CODE.                       
P00726                                                                  
P00726     IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL                   
P00726        NEXT SENTENCE                                             
P00726     ELSE                                                         
P00726        MOVE PROGRAM-NAME    TO ABEND-PROGRAM                     
P00726        MOVE '5150'          TO ACTIVE-PARAGRAPH                  
P00726        MOVE 'INSERT'             TO ABEND-FUNCTION               
P00726        MOVE 'CSS_CUST_MISC_INFO' TO TABLE-1                      
P00726        MOVE 'CUSTOMER_NO'        TO TABLE-ELEMENT-1              
P00726        MOVE 'INFLUENTIAL_CUST'   TO TABLE-ELEMENT-2              
P00726        MOVE 'KEY_CUSTOMER'       TO TABLE-ELEMENT-3              
P00726        MOVE 'SPECIAL_CUST'       TO TABLE-ELEMENT-4              
P00726        MOVE AT-CUSTOMER-NO       TO HOSTVAR-ELEMENT-1            
P00726        MOVE LQ-INFLUENTIAL-CUST  TO HOSTVAR-ELEMENT-2            
P00726        MOVE LQ-KEY-CUSTOMER      TO HOSTVAR-ELEMENT-3            
P00726        MOVE LQ-SPECIAL-CUST      TO HOSTVAR-ELEMENT-4            
P00726        PERFORM 9000-SEND-ERROR-RESULT  THRU 9000-EXIT            
P00726        PERFORM 9900-SQL-ERROR-ROUTINE  THRU 9900-EXIT            
P00726     END-IF.                                                      
P00726                                                                  
P00726 8500-EXIT.                                                       
P00726     EXIT.                                                        
P00726                                                                  
PCR263******************************************************************18030000
PCR263* 8330-DELETE-CRED-COLL                                          *18040000
PCR263******************************************************************18050000
PCR263*                                                                 18060000
PCR263     EXEC SQL                                                     18070000
PCR263        INCLUDE CPD00306                                          18080000
PCR263     END-EXEC.                                                    18090000
PCR263*                                                                 18100000
      ******************************************************************18030000
      * 9900 - JOURNALING / ERROR HANDLING ROUTINE                     *18040000
      ******************************************************************18050000
      *                                                                 18060000
           EXEC SQL                                                     18070000
REARCH        INCLUDE CPDSP300                                                  
           END-EXEC.                                                    18090000
      *                                                                 18100000
      ******************************************************************18110000
      *       END PROGRAM COPYLIB                                      *18120000
      ******************************************************************18130000
      *                                                                 18100000
REARCH     EXEC SQL                                                             
REARCH        INCLUDE CPD00321                                                  
REARCH     END-EXEC.                                                            
      *                                                                 18150000
