       IDENTIFICATION DIVISION.                                         
       PROGRAM-ID.    CSR02396.                                         
COB303 DATE-WRITTEN.      DECEMBER 16, 1994.                            
       DATE-COMPILED.                                                   
                                                                        
CVT000******************************************************************00000100
CVT000*     - - - - - >   R P C   C O N V E R S I O N   < - - - - -    *00000200
CVT000*         S396 CONVERTED TO DB2 SP CSR02396 ON 03/09/2007        *00000300
CVT000*             -NOTE: AUTOMATED CONVERSION PROGRAM USED           *00000400
CVT000*                                                                *00000500
CVT000*                    CVT000 - CONVERTED CODE                     *00000501
CVT000*                    CVT004 - NEEDED REVIEW                      *00000502
CVT000*                    CVT999 - COMMENTED OUT CODE THAT CAN        *00000503
CVT000*                             POTENTIALLY BE DELETED             *00000510
CVT000*                                                                *00000520
CVT000******************************************************************00000600
      *****************************************************************         
      *                                                                         
      *                SOUTH CAROLINA ELECTRIC & GAS                            
      *                                                                         
      *  THIS PROGRAM IS EXECUTED VIA A REMOTE PROCEDURE CALL (RPC).            
      *                                                                         
      *  TRANID:        S396                                                    
      *  PROGRAM:       S396                                                    
      *  CALLING SP:    PA_S396                                                 
      *                                                                         
      *****************************************************************         
      *                 P R O G R A M  S U M M A R Y                            
      *                                                                         
      *  THIS PROGRAM UPDATES THE CSS_ACCOUNT, CSS_AR_CNTL,                     
      *  CSS_AR_TRANS_HIST, CSS_AR_TRN_HST_DET, AND THE                         
      *  CSS_CONNECT_CHRG TABLES WITH MISCELLANEOUS CHARGES                     
      *  BASED ON THE RECEIVABLE TYPE GIVEN.                                    
      *                                                                         
      *****************************************************************         
      *                                                                         
      *                     PROGRAM MODIFICATION LOG                            
      *                                                                         
      *    DATE    INITIALS   COMMENTS                                          
      *  --------  --------   ---------------------------------------           
      *  12/19/94    MLR      ORIGINAL CODE                                     
      *  04/17/95    ECC      PROCEDURE CODED PER MODIFIED DESIGN               
      *  07/26/95    MB       VALUE SET TO WS-PAR-'S396'                        
      *  01/22/96    DMD      TPR 2065 - SET WS-CODE-EPP-OFFER, EPP-            
      *                       OFFER-DATE AND EPP-OFFER-AMOUNT TO                
      *                       SPACES SO THAT AUTOMATIC ENROLLMENT IN            
      *                       EPP IS NOT TRIGGERED IN CPD00010                  
      *  03/28/96    LMB      TPR 2508 - ADDED TBLIEAP                          
      *  03/28/96    LMB      TPR 2585 - ADDED TBNSFHST, TBCRPROF               
      *  07/26/96    JEP      TPR 4893 - REMOVED REFERENCES TO CPD00068         
      *                       CWS00068, TBCRCOLL AND TBDELQ.                    
      *  09/23/96    PD       PCR 305 ADDED CJF00105 FOR CPD10 CHANGES          
      *  09/30/96    PD       COMMENTED CODE FOR CIAC FOR PCR072.      *        
      *  10/09/96    JRX      ADD CANCELDNP-FLAG TO THE RESULT SET     *        
      *  02/04/97    PD       MAKE DIRECTED PYMT FOR RCC AMT.          *        
      ** 03/19/97     PD      ADD DCLGEN TBWOARGM FOR CPD73 CHANGES.  *         
      ** 03/31/97    MJG      ADDED TWO DCLGENS FOR CPD00068 CHANGES. *         
      ** 04/07/97    PD       MADE THE PAYMENT ON UNBILLED RCC AS A   *         
      **                      PRE PAYMENT WHICH DOES NOT CHANGE THE   *         
      **                      AR BALANCE OF THE ACCOUNT, BUT ONLY     *         
      **                      CHANGES THE RCC AR-TRAN-BALANCE.        *         
      *  05/08/97    PP       PCR404 CHANGES.                         *         
      *  06/05/97    PP       PROPER POPULATION OF PROGRAM ID.        *         
T11360*  06/18/97    CHANDRA  IF THE BILLED BALANCE IS ZERO FOR       *         
T11360*                       PPTY 60/100/129, THEN PAY THE TRAN      *         
T11360*                       BALANCE                                 *         
T11797*  06/24/97    PP       PANEL310D CHANGED TO PANEL310E          *         
NONUTL**  7/11/97    CHANDRA  ADDED CPD00312, CWS10016, TBHLDAY       *         
T12460*  08/01/97    EMS      ADDED CSS_DNP DCLGEN FOR CPD68 CHANGES  *         
T13034*  11/03/97    PD       JOURNAL DETAIL WHILE CREDITING CNT.     *         
T13773*  11/14/97    PD       ALWAYS USE CPD10 TO CREDIT CNT.         *         
T14840*  02/26/98    PD/KTB   CHANGES TO PROCESS REBATE ONLY CONTRACTS*         
T16114*  04/28/98    PD       SPLIT THE JOURNAL FOR LPC AND RCC EVEN  *         
T16114*                       THOSE RECEIVABLES ARE NOT PRESENT.      *         
T16561*  05/26/98    PD       CHANGE AMT-ORIG-ENTERED WITH THE TOTAL  *         
T16561*                       TRANSACTION AMOUNT.                     *         
T16792*  06/12/98    VIJI     TPR 16792 - CHANGED WS-RECV-TYPE TO     *         
      *                       PARM-RECV-TYPE SO THAT "MISC CREDIT"    *         
      *                       SHOWS UP AS DESCRIPTION FOR A DIRECTED  *         
      *                       UTE CREDIT MISC CHARGES.                *         
T17032*  07/13/98    PD       DO NOT GO UNDIRECTED IF ACCOUNT HAS     *         
T17032*                       A PAID RECONNECT.                       *         
T17253*  07/31/98    SV       ADD ACCTING PERIOD TO PANEL310          *         
T17191*  08/04/98    SV       USE CREDIT-LPC FLAG FOR CORRECT SPLITTING         
      *                       OF THE RECEIVABLES                      *         
PCR307*    09/03/98  AMG      IF THE PAYMENT IS NOT ENOUGH TO CANCEL  *         
PCR307*                       THE DNP, THEN INSERT A ROW INTO         *         
PCR307*                       CSS_SO_DNP_CANCEL WITH A FLAG OF 'U'    *         
T17816*  09/16/98    PRA      MOVE AT-ACCOUNT-NO TO XK-ACCOUNT-NO     *         
      *                       INSTEAD OF WS-ACCOUNT-NO                *         
T18179*  10/19/98    SV       WHILE DOING MISC CREDIT, CHECK THAT THE *         
      *                       CREDIT AMOUNT IS NOT MORE THAN BILLED   *         
      *                       BALANCE OF CONTRACT.                    *         
T17071*  11/19/98    MDJ      ADDED INCLUDE TBCSTALT FOR CUST_ALERT IN*         
      *                       CPD00068.                               *         
T18526*   12/01/98    SV      HANDLE EXTRA CREDIT APPLIED TO THE      *         
      *                       RECEIVABLES.                            *         
CBSI  *  12/15/98    CBSI     ABEND LOG MODIFIED TO INCLUDE ALL THE    *        
CBSI  *              MADRAS   ABEND PARAMETERS                         *        
T19614*   4/7/99     BAB      UPDATE T18179 TO ALLOW CR AMOUNT UP     *         
      *                       TO TRAN BALANCE OF CONTRACT             *         
T19646*   4/22/99    BAB      MODIFIED SO THAT LPC CREDIT ON ACCOUNT  *         
      *                       WITH RECONNECT WOULD PROCESS (BAD PPL   *         
      *                       SENT TO CSS_AR_CNTL SELECT).  ALSO,     *         
      *                       UPDATED SO IF FAILED, WOULD RETURN CODE *         
      *                       TO DESKTOP INDICATING FAILURE RATHER    *         
      *                       THAN SUCCESS.                           *         
T19996*   5/24/99    FB       ALLOW MARKETING CONTRACTS ON SUB        *         
      *                       ACCOUNTS.                               *         
T20099*   5/28/99    BB       UPDATE TAX PROCESSING TO ACCOMODATE FOR *         
      *                       MULTIPLE 'OTHER' TAXES.                 *         
T22179*   5/05/00    LHO      ADD RFD LOGIC.                          *         
T19557*  05/08/00    CBSI     COPYBOOK CDP00068 CHANGED TO SUB PROGRAM*         
T19557*              MADRAS   SCSCO068.                               *         
T22359*  06/21/00    MDJ      MADE CHANGES TO KEEP IDENTITY OF PROGRAM *        
      *                       CALLING SCSCO068 OR SCSCB068.  THERE IS  *        
      *                       SPECIFIC LOGIC IN CPD00068 FOR CERTAIN   *        
      *                       PROGRAMS WHICH WAS NOT BEING EXECUTED    *        
      *                       PROPERLY BECAUSE THE PROGRAM NAME WAS    *        
      *                       ALWAYS SCSCO068 OR SCSCB068.             *        
      *  04/11/01    CHANELLE MCR310 PSNC. USE '01' FOR CSS_GL_ACCT_NO *        
      *                       AND 0700-.                               *        
C23235*  05/01       SR82046  RECONNECT TYPE CODE IS INCLUDED FOR      *        
C23235*                       RECONNECT_CHRG TABLE                     *        
C24555*  07/25/01    SR82046  CHANGES AS PER LISA.                     *        
T24436*  10/15/01    COVANSYS ADDED LOGIC TO IMPLEMENT CPYC CPD00061   *        
T24436*              CHENNAI  CONVERSION TO SUBPROGRAM SCSCO061        *        
C26130*  06/20/02    MDJ      REMOVED LOGIC THAT SET EPP-OFFER FIELDS  *        
      *                       TO ZERO.  CPD10 WILL NOT SET UP AUTO EPP *        
      *                       OFFER IF CALLING PROGRAM = S294, S396 OR *        
      **                      S998.                                    *        
C28788*  07/07/03    MDJ      GET IVR-EXEMPT-CD FOR CPD00068.          *        
C29457*  08/07/03    BB18179  ADD LOGIC TO SET APPL_PROGRAM_ID FOR     *        
      *                       EMC REFUND.                              *        
C31347*  11/29/04    RR       ADD CHANGES TO CREDIT MKT SWITCH FEE     *        
C33041*  12/01/05    SS       ADD CREDIT FOR NEW ACCOUNT CAMPAIGN      *        
C33442*  02/02/06    SS       ADD CREDIT FOR MOVER MARKET CAMPAIGN     *        
C33442*                       AND ENSURE ONLY IT OR NEW ACCT IS GIVEN  *        
T33431** 03/16/06   SK88120        COG PROJECT CHANGES -                        
T33431**                           A- ADD NEW COPYBOOKS                         
T33431**                           B- CHANGE IN CPD00073                        
C34039*  03/28/06    SS19371  ADD CREDIT FOR SMALL COMMERICAL CREDIT   *        
C34039*                       CAMPAIGN.                                *        
C34571*  08/14/06    MSR      ADD CREDIT FOR SEB FALL CAMPAIGN         *        
T34097*  02/20/07    COVANSYS  REPLACED MODEL_SQL WITH SET COMMAND     *        
T36211*  08/30/07    SS19371  ADD CREDIT FOR SEB FALL CAMPAIGN                  
T36211*  10/17/07    SS19371  ADD WEB PROMO CREDIT FOR SEB FALL CAMPAIGN        
A00956*  03/26/09    CVNS       REPLACE CPD00006 WITH CPD0006A.        *        
A00956*              CHENNAI                                           *        
A36248*  06/11/09    LG41184  CALL NEW SUBPROGRAM MCSCB371 TO UPDATE   *        
A36248*                       DNP BALANCE REAL TIME FOR CSR.           *        
A37061*  07/01/09    LG41184  USE ACCOUNT-TYPE INSTEAD OF REVENUE-CLASS*        
A37302*  07/28/09    LG41184  DCLGEN TBRVCACT REMOVED.                 *        
P00641** 05/01/12   DB41297  DELETE TBGLNAME                           *        
A04527** 09/18/13    MR7E794 REMOVED UNUSED DCLGEN                     *        
A04860*  04/04/16  MS7M727   REPLACE CSS_WQ_ITEMS_MF TABLE WITH        *01790100
A04860*            ACT105    CSS_WQ_ITEMS TABLE                        *01790200
      ******************************************************************        
      *****************************************************************         
      *                                                                         
      *                ---- BASIC SEQUENCE STRUCTURE ----                       
      *                                                                         
      *  0000 - 0999  MAIN CONTROL PATH AND INITIALIZATION                      
      *  1000 - 1999  INPUT PROCESSING CONTROL PATH                             
      *  2000 - 2999  OUTPUT PROCESSING CONTROL PATH                            
      *  3000 - 4999  NOT USED                                                  
      *  5000 - 5999  COMMON PROGRAM MODULES                                    
      *  6000 - 6999  COMMON SYSTEM MODULES                                     
      *  7000 - 7999  INPUT MODULES                                             
      *  8000 - 8999  OUTPUT MODULES                                            
      *  9000 - 9999  TERMINATION,ABEND, MESSAGING MODULES                      
      *                                                                         
      *****************************************************************         
                                                                        
       ENVIRONMENT DIVISION.                                            
       DATA DIVISION.                                                   
       WORKING-STORAGE SECTION.                                         

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 'CSR02396'.
MSQ017     COPY MFASQLM.
                                                                        
       01  WS-START                                   PIC X(40) VALUE   
           'WORKING STORAGE FOR RPC S396 STARTS HERE'.                  
                                                                        
      *****************************************************************         
      *    COBOL WORKING STORAGE COPY BOOKS                                     
      *****************************************************************         
                                                                        
           COPY CWS00004.                                                       
           COPY CWS00007.                                                       
           EXEC SQL                                                             
              INCLUDE CWS00008                                                  
           END-EXEC.                                                            
           COPY CWS00056.                                                       
           COPY CWS00303.                                                       
           COPY CJF00101.                                                       
           COPY CJF00102.                                                       
           COPY CJF00105.                                                       
T19557     COPY CWS0068L.                                                       
T33431     COPY CWSCA225.                                                       
ACT105     COPY CWS00077.                                                       
                                                                        
      *****************************************************************         
      *    WORK AREAS                                                           
      *****************************************************************         
                                                                        
       01  WS-MISC.                                                     
           05  PROGRAM-NAME             PIC X(08) VALUE 'S396    '.     
ACT105     05  WS-WQ-CALL-PGM           PIC X(08)  VALUE 'MCSCB077'.    
ACT105     05  MCSCB077                 PIC X(08)  VALUE 'MCSCB077'.    
ACT105     05  SCSCB077                 PIC X(08)  VALUE 'SCSCB077'.    
ACT105     05  WS-CPD0010S-CALL-TYPE    PIC X(01)  VALUE 'O'.           
ACT105         88 WS-CPD0010S-ONLINE-CALL          VALUE 'O'.           
ACT105         88 WS-CPD0010S-BATCH-CALL           VALUE 'B'.           
           05  PANEL-NAME               PIC X(08) VALUE 'PANEL310'.     
           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'.            
           05  WS-SAVE-ROW-COUNT PIC S9(04) COMP VALUE +0.              
           05  WS-DATE-ORIG-PYMT-IND    PIC S9(04) COMP VALUE +0.       
           05  WS-CHRG-OFF-ACCT         PIC  X(01) VALUE 'N'.           
           05  WS-JRNL-CNTL             PIC  X(01) VALUE 'Y'.           
           05  WS-SUB                   PIC S9(04) COMP VALUE +0.       
           05  WS-MAX-SUB               PIC S9(04) COMP VALUE +0.       
           05  WS-CASH-DRAWER.                                          
               10  WS-CD-COMPANY-NO     PIC  X(02).                     
               10  WS-CD-LOCAL-OFFICE   PIC  X(03).                     
               10  WS-CD-REPORT-NO      PIC  X(03).                     
               10  WS-CD-REPORT-DATE    PIC  X(10).                     
               10  WS-CASH-DRAWER-ID    PIC  S9(04) COMP.               
           05  WS-DIR-PAY-TABLE.                                        
               10  WS-DIR-PAY-TAB OCCURS 20 TIMES.                      
                   15  WS-DIR-PAY-REC-TYPE   PIC S9(04) COMP.           
                   15  WS-DIR-PAY-ITEM-ID    PIC S9(09) COMP.           
COB305             15 WS-DIR-PAY-AMT        PIC S9(09)V99 COMP-3 
COB305               VALUE 0.      
                   15  WS-DIR-PAY-AHEAD-TYPE PIC  X(01).                
                   15  WS-DIR-PAY-CHRG-OFF   PIC  X(01).                
                                                                        
           05  WS-RECV-TYPE             PIC X(03).                      
COB305     05 WS-CREDIT-REMAINING        PIC S9(09)V99 COMP-3 VALUE 0.          
COB305     05 WS-SPLIT-CREDIT-REMAINING        PIC S9(09)V99 COMP-3 
COB305       VALUE 0.          
COB305     05 WS-REMAINING-AMOUNT        PIC S9(09)V99 COMP-3 VALUE 0.          
COB305     05 WS-REMAINING-CONTRACT        PIC S9(09)V99 COMP-3 VALUE 0.        
COB305     05 WS-AC-AMT-AR-TOTAL        PIC S9(09)V99 COMP-3 VALUE 0.           
COB305     05 WS-AC-AMT-AR-TOTAL-CNT        PIC S9(09)V99 COMP-3 
COB305       VALUE 0.           
COB305     05 WS-DIST-AC-AMT-AR-TOTAL        PIC S9(09)V99 COMP-3 
COB305       VALUE 0.           
                                                                        
           05  WS-ACCOUNT-NO-CHK        PIC  9(13).                     
SEBSEB     05  WS-ACCOUNT-NO-SEB.                                       
SEBSEB         10  FILLER               PIC X(7) VALUE '0000000'.       
SEBSEB         10  WS-ACCOUNT-NO-SEB-NUM    PIC  X(13).                 
           05  WS-ACCOUNT-NO            PIC X(13).                      
           05  WS-ACCOUNT-NO-NUM REDEFINES WS-ACCOUNT-NO                
                                        PIC 9(13).                      
COB305     05 WS-ACCOUNT-NO-COMP3        PIC S9(13) COMP-3 VALUE 0.             
                                                                        
           05  WS-AMOUNT-CHECK          PIC  X(11).                     
           05  WS-AMOUNT-CHECK-NUM REDEFINES WS-AMOUNT-CHECK            
                                        PIC  9(09)V99.                  
           05  WS-AMOUNT-CHECK-COMP3    PIC S9(09)V99 COMP-3 VALUE +0.  
                                                                        
           05  WS-AMOUNT-MORDER         PIC  X(11).                     
           05  WS-AMOUNT-MORDER-NUM REDEFINES WS-AMOUNT-MORDER          
                                        PIC  9(09)V99.                  
           05  WS-AMOUNT-MORDER-COMP3   PIC S9(09)V99 COMP-3 VALUE +0.  
                                                                        
           05  WS-AMOUNT-LIHEAP         PIC  X(11).                     
           05  WS-AMOUNT-LIHEAP-NUM REDEFINES WS-AMOUNT-LIHEAP          
                                        PIC  9(09)V99.                  
           05  WS-AMOUNT-LIHEAP-COMP3   PIC S9(09)V99 COMP-3 VALUE +0.  
                                                                        
           05  WS-AMOUNT-CASH           PIC  X(11).                     
           05  WS-AMOUNT-CASH-NUM REDEFINES WS-AMOUNT-CASH              
                                        PIC  9(09)V99.                  
           05  WS-AMOUNT-CASH-COMP3     PIC S9(09)V99 COMP-3 VALUE +0.  
                                                                        
           05  WS-AMT-CHRG-CARD         PIC  X(11).                     
           05  WS-AMT-CHRG-CARD-NUM REDEFINES WS-AMT-CHRG-CARD          
                                        PIC  9(09)V99.                  
           05  WS-AMT-CHRG-CARD-COMP3   PIC S9(09)V99 COMP-3 VALUE +0.  
                                                                        
           05  WS-BILLED-AMT            PIC S9(11)V99 COMP-3 VALUE +0.  
                                                                        
           05  WS-DIR-PAYMENT-BREAKDOWN.                                
               10  WS-REV-TYPE          PIC  X(04).                     
               10  WS-REV-TYPE-NUM REDEFINES WS-REV-TYPE                
                                        PIC S9(04).                     
               10  WS-ITEM-ID           PIC  X(09).                     
               10  WS-ITEM-ID-NUM REDEFINES WS-ITEM-ID                  
                                        PIC S9(09).                     
               10  WS-AMT-DIR-PYMT      PIC  X(11).                     
               10  WS-AMT-DIR-PYMT-NUM REDEFINES WS-AMT-DIR-PYMT        
                                        PIC S9(09)V99.                  
               10  WS-PAY-AHEAD-TYPE    PIC  X(01).                     
               10  WS-PAY-CHRG-OFF      PIC  X(01).                     
                                                                        
           05  WS-CURRENT-DATE          PIC  X(10) VALUE SPACES.        
           05  WS-CURRENT-TIMESTAMP     PIC  X(26) VALUE SPACES.        
           05  WS-AR-CNTL-CHG-CHK-FLAG  PIC  X(01) VALUE 'Y'.           
               88  AR-CNTL-CHANGED-CHECK VALUE 'Y'.                     
           05  WS-ACCT-EXISTS-FLAG     PIC X(01) VALUE 'N'.             
               88 WS-ACCT-EXISTS                 VALUE 'Y'.             
           05  WS-AR-CNTL-EXISTS-FLAG  PIC X(01) VALUE 'N'.             
               88 WS-AR-CNTL-EXISTS              VALUE 'Y'.             
           05  WS-CPD10-USAGE-FLAG     PIC X(01) VALUE 'Y'.             
               88 CPD10-CAN-BE-USED              VALUE 'Y'.             
               88 CPD10-CAN-NOT-BE-USED          VALUE 'N'.             
           05  WS-CREDIT-TYPE-FLAG     PIC X(01) VALUE ' '.             
               88 CHECKING-FOR-CREDIT-TYPE       VALUE ' '.             
               88 CREDIT-EXISTING-RECV           VALUE 'E'.             
               88 ADD-MISC-CREDIT                VALUE 'A'.             
           05  WS-CREDIT-TYPE-LITERALS.                                 
               10  W-LT-CREDIT-EXISTING-RECV PIC X(01) VALUE 'E'.       
               10  W-LT-ADD-MISC-CREDIT      PIC X(01) VALUE 'A'.       
                                                                        
T16114     05  WS-SPLIT-GL-ACCT1       PIC S9(03)V9999 COMP-3 VALUE 0.  
T16114     05  WS-SPLIT-GL-ACCT2       PIC S9(03)V9999 COMP-3 VALUE 0.  
T16114     05  WS-SPLIT-PERCENT        PIC S9(02)V99   COMP-3 VALUE 0.  
T16114     05  WS-TOT-AMT-TO-SPLIT     PIC S9(09)V99   COMP-3 VALUE 0.  
T16114     05  WS-UTE-EXISTS            PIC X.                          
T16114         88  HAVE-UTE             VALUE 'Y'.                      
T16114         88  HAVE-NOT-UTE         VALUE 'N'.                      
T16114     05  WS-UTG-EXISTS            PIC X.                          
T16114         88  HAVE-UTG             VALUE 'Y'.                      
T16114         88  HAVE-NOT-UTG         VALUE 'N'.                      
                                                                        
T20099     05  WS-SUB2                 PIC S9(04) COMP VALUE +0.        
T20099     05  WS-NBR-TAX-OTHER        PIC S9(04) COMP VALUE +0.        
T20099     05  WS-NBR-TAX-OTHER-MAX    PIC S9(04) COMP VALUE +10.       
T20099     05  WS-TOT-TAX-OTHER-RATE   PIC S9V9999 COMP-3 VALUE +0.     
T20099     05  WS-TOT-TAX-OTHER        PIC S9(9)V9(2) COMP-3 VALUE +0.  
T20099     05  WS-RMNG-TAX-OTHER       PIC S9(9)V9(2) COMP-3 VALUE +0.  
T20099     05  WS-REVENUE-MONTH-CHAR   PIC X(07) VALUE SPACES.          
T20099     05  WS-REVENUE-DATE         PIC X(10) VALUE SPACES.          
T20099     05  WS-OTHER-TAX-GL-SW      PIC X(01) VALUE 'N'.             
T20099         88  OTHER-TAX-GL-LOADED           VALUE 'Y'.             
T20099     05  WS-TAX-OTHER-INFORMATION.                                
T20099         10  WS-TAX-OTHER-INFO OCCURS 10 TIMES.                   
COB305             15 WS-TAX-OTHER-GL-NBR        PIC S9(3)V9(4) 
COB305               USAGE COMP-3 VALUE 0.
COB305             15 WS-TAX-OTHER-RATE        PIC S9V9999 USAGE COMP-3 
COB305               VALUE 0.   
T33431     05  MCSCB225                 PIC X(8) VALUE  'MCSCB225'.     
T33431     05  WS-COG-TRAN-TYPE-CD-73   PIC X(1) VALUE  'P'.            
      *                                                                         
                                                                        
COB305     05 WS-GL-ACCT-CREDIT        PIC S9(03)V9999 COMP-3 VALUE 0.          
COB305     05 WS-GL-ACCT-DEBIT        PIC S9(03)V9999 COMP-3 VALUE 0.          
           05  CREDIT-LPC              PIC X(03) VALUE 'LPC'.           
           05  CREDIT-LPN              PIC X(03) VALUE 'LPN'.           
           05  CREDIT-CNT              PIC X(03) VALUE 'CNT'.           
           05  CREDIT-RCC              PIC X(03) VALUE 'RCC'.           
           05  CREDIT-CIA              PIC X(03) VALUE 'CIA'.           
           05  CREDIT-CCA              PIC X(03) VALUE 'CCA'.           
           05  CREDIT-PJS              PIC X(03) VALUE 'PJS'.           
           05  CREDIT-NSC              PIC X(03) VALUE 'NSC'.           
           05  CREDIT-MIS              PIC X(03) VALUE 'MIS'.           
T14840     05  CREDIT-REB              PIC X(03) VALUE 'REB'.           
T22179     05  CREDIT-RFD              PIC X(03) VALUE 'RFD'.           
                                                                        
T31347     05  WS-60-DAYS-AGO-DT       PIC X(10).                       
T31347     05  WS-60-DAYS-AGO          PIC X(26).                       
T33041     05  WS-90-DAYS-AGO-DT       PIC X(10).                       
T33041     05  WS-90-DAYS-AGO          PIC X(26).                       
                                                                        
T31347     05  WS-ADD-SWITCH-FACTOR    PIC X(01) VALUE 'N'.             
T31347         88 WS-FREE-SWITCH       VALUE 'Y'.                       
T31347         88 WS-PAY-SWITCH        VALUE 'N'.                       
T31347     05  WS-ADD-NEWACCT-FACTOR   PIC X(01) VALUE 'N'.             
T31347         88 WS-FREE-ESTABLISH    VALUE 'Y'.                       
T31347         88 WS-PAY-ESTABLISH     VALUE 'N'.                       
C34571     05  WS-NEW-CREDIT-FACTOR    PIC X(01) VALUE 'N'.             
C34571         88 WS-60-BILL-CREDIT    VALUE 'Y'.                       
                                                                        
C29457*** SWITCH TO CHECK FOR SPECIFIC GL TO ASSIGN APPL_PROGRAM_ID             
C29457     05  WS-GL-DEBIT-ID-SW       PIC 9(03)V9999 VALUE 0.          
C29457         88  WS-EMC-RFND-2003                   VALUE 810.0137.   
                                                                        
      *** USED TO CONVERT TO COMP-3                                             
COB305     05 WS-PARM-DB-GL-NUMBER        PIC S9(03)V9999 COMP-3 
COB305       VALUE 0.         
COB305     05 WS-PARM-CR-AMT-AR-DAY-00        PIC S9(09)V99 COMP-3 
COB305       VALUE 0.         
COB305     05 WS-PARM-CR-AMT-AR-DAY-30        PIC S9(09)V99 COMP-3 
COB305       VALUE 0.         
COB305     05 WS-PARM-CR-AMT-AR-DAY-60        PIC S9(09)V99 COMP-3 
COB305       VALUE 0.         
COB305     05 WS-PARM-CR-AMT-AR-DAY-90        PIC S9(09)V99 COMP-3 
COB305       VALUE 0.         
COB305     05 WS-PARM-CR-AMT-AR-TOTAL        PIC S9(09)V99 COMP-3 
COB305       VALUE 0.         
COB305     05 WS-PARM-0-3-6-9-TOTAL        PIC S9(09)V99 COMP-3 VALUE 0.        
      *** USED TO CONVERT TO COMP-3                                             
COB305     05 WS-PRINCIPAL-AMT        PIC S9(09)V99 COMP-3 VALUE 0.         
COB305     05 WS-STATE-TAX-AMT        PIC S9(09)V99 COMP-3 VALUE 0.         
COB305     05 WS-CITY-TAX-AMT        PIC S9(09)V99 COMP-3 VALUE 0.         
COB305     05 WS-OTHER-TAX-AMT        PIC S9(09)V99 COMP-3 VALUE 0.         
COB305     05 WS-DEF-INT-AMT        PIC S9(09)V99 COMP-3 VALUE 0.         
COB305     05 WS-EARNED-INT-AMT        PIC S9(09)V99 COMP-3 VALUE 0.         
CBSI       05  WS-AMT-ORIG-ENTERED-ED   PIC -(9)9.99.                   
T19557     05  WS-EIBRESP               PIC S9(8)                       
T19557                                  COMP SYNC VALUE ZERO.           
A36248     05  WS-DNP-UPDATE-FL         PIC X(01)  VALUE 'N'.           
A36248     05  WS-DATABASE              PIC 9(01)  VALUE 0.             
A36248     05  WS-CPD68-DNP-BAL         PIC S9(9)V99 COMP-3 VALUE 0.    
                                                                        
       01  WS-LITERAL.                                                  
           05  WS-A                     PIC X(01) VALUE 'A'.            
           05  WS-C                     PIC X(01) VALUE 'C'.            
           05  WS-D                     PIC X(01) VALUE 'D'.            
           05  WS-E                     PIC X(01) VALUE 'E'.            
           05  WS-I                     PIC X(01) VALUE 'I'.            
           05  WS-N                     PIC X(01) VALUE 'N'.            
           05  WS-P                     PIC X(01) VALUE 'P'.            
           05  WS-S                     PIC X(01) VALUE 'S'.            
           05  WS-Y                     PIC X(01) VALUE 'Y'.            
           05  WS-U                     PIC X(01) VALUE 'U'.            
           05  WS-RCV-TYPE              PIC S9(04) COMP.                
           05  WS-NO                    PIC  X(01) VALUE 'N'.           
           05  WS-YES                   PIC  X(01) VALUE 'Y'.           
           05  WS-NO-ERROR              PIC  X(05) VALUE 'NOERR'.       
           05  WS-UNDIRECTED            PIC  X(03) VALUE 'UND'.         
           05  WS-NULL                  PIC S9(04) COMP VALUE -1.       
REARCH     05  MCSCO061                 PIC  X(08) VALUE 'MCSCO061'.    
REARCH     05  MCSCB068                 PIC  X(08) VALUE 'MCSCB068'.    
A36248     05  MCSCB371                 PIC  X(08) VALUE 'MCSCB371'.    
                                                                        
       01  WS-NULL-IND-VARS.                                            
           05  WS-NULL-INDICATOR-1      PIC S9(04) COMP.                
           05  WS-NULL-INDICATOR-2      PIC S9(04) COMP.                
           05  WS-NULL-INDICATOR-3      PIC S9(04) COMP.                
           05  WS-NULL-INDICATOR-4      PIC S9(04) COMP.                
                                                                        
       01  PARM-FIELDS.                                                 
           05  PARM-L                   PIC S9(9) COMP.                 
CVT999*    05  PARM-ID1                 PIC S9(9) COMP VALUE 1.                 
           05  PARM-ACCOUNT-NO-X.                                       
               10 PARM-ACCOUNT-NO       PIC 9(13).                      
           05  PARM-ITEM-ID             PIC S9(09) COMP.                
           05  PARM-RECV-TYPE           PIC X(03).                      
           05  PARM-PYMT-PRIORITY-LVL   PIC S9(04) COMP VALUE ZERO.     
           05  PARM-DB-GL-NUMBER-X.                                     
               10  PARM-DB-GL-NUMBER    PIC 9(03)V9999.                 
           05  PARM-CR-AMT-AR-DAY-00-X.                                 
               10  PARM-CR-AMT-AR-DAY-00 PIC S9(09)V99.                 
           05  PARM-CR-AMT-AR-DAY-30-X.                                 
               10  PARM-CR-AMT-AR-DAY-30 PIC S9(09)V99.                 
           05  PARM-CR-AMT-AR-DAY-60-X.                                 
               10  PARM-CR-AMT-AR-DAY-60 PIC S9(09)V99.                 
           05  PARM-CR-AMT-AR-DAY-90-X.                                 
               10  PARM-CR-AMT-AR-DAY-90 PIC S9(09)V99.                 
           05  PARM-CR-AMT-AR-TOTAL-X.                                  
               10  PARM-CR-AMT-AR-TOTAL-SEB  PIC 9(11).                 
           05  PARM-DIST-RECV-TYPE      PIC X(03).                      
           05  PARM-DIST-PYMT-PRI-LVL   PIC S9(04) COMP.                
           05  PARM-DIST-ITEM-ID        PIC S9(09) COMP VALUE ZERO.     
           05  PARM-RESP-AREA           PIC X(03).                      
           05  PARM-USER-ID             PIC X(07).                      
           05  PARM-AT-LAST-UPDATE-TS   PIC X(26).                      
           05  PARM-AC-LAST-UPDATE-TS   PIC X(26).                      
           05  PARM-TRAN-COMMENT.                                       
               49  PARM-TRAN-COMMENT-LEN  PIC S9(4) COMP SYNC VALUE +0. 
               49  PARM-TRAN-COMMENT-TEXT PIC X(210) VALUE SPACES.      
T13034     05  PARM-PRINCIPAL-AMT-X.                                    
T13034         10  PARM-PRINCIPAL-AMT     PIC S9(09)V99.                
T13034     05  PARM-STATE-TAX-AMT-X.                                    
T13034         10  PARM-STATE-TAX-AMT     PIC S9(09)V99.                
T13034     05  PARM-CITY-TAX-AMT-X.                                     
T13034         10  PARM-CITY-TAX-AMT      PIC S9(09)V99.                
T13034     05  PARM-OTHER-TAX-AMT-X.                                    
T13034         10  PARM-OTHER-TAX-AMT     PIC S9(09)V99.                
T13034     05  PARM-DEF-INT-AMT-X.                                      
T13034         10  PARM-DEF-INT-AMT       PIC S9(09)V99.                
T13034     05  PARM-EARNED-INT-AMT-X.                                   
T13034         10  PARM-EARNED-INT-AMT    PIC S9(09)V99.                
T14840     05  PARM-CNT-NAME-CD           PIC S9(04) COMP VALUE 0.      
T17253     05  PARM-REVENUE-MONTH.                                      
T17253         10 PARM-ACCTING-PERIOD     PIC S9(6).                    
                                                                        
       01  WS-CR-AMT-AR-TOTAL-SEB      PIC 9(11).                       
       01  PARM-CR-AMT-AR-TOTAL        PIC S9(09)V99.                   
                                                                        
       01  COUNTER-FIELDS.                                              
CVT999     05  CTR-ROWS                PIC S9(9) COMP VALUE 0.          
                                                                        
       01  WORK-FIELDS.                                                 
           05  WRK-DONE-STATUS         PIC S9(9) COMP.                  
                                                                        
       01  FILLER  PIC X(32) VALUE 'THIS IS THE ROW RETURN AREA.'.      
       01  GTT-RETURN-FIELDS.                                           
           05  RS-RETURN-CODE          PIC S9(9) COMP VALUE 0.          
           05   S-RETURN-CODE          PIC S9(9) COMP VALUE 0.          
           05  RS-CANCELDNP-FLAG       PIC X(01) VALUE SPACES.          
           05  RS-AR-LOCKOUT-IND       PIC X(01) VALUE SPACES.          
           05  RS-XFER-ACCT-NO         PIC X(13) VALUE SPACES.          
                                                                        
CVT999*****************************************************************         
CVT999* DATABASE DEFINITION                                                     
CVT999*****************************************************************         
CVT999*                                                                         
           EXEC SQL                                                             
              INCLUDE SQLCA                                                     
           END-EXEC.                                                            
                                                                        
      ******************************************************************        
      * CSS_CONTRACT_INFO, K6                                          *        
      ******************************************************************        
           EXEC SQL                                                             
              INCLUDE TBCNTINF                                                  
           END-EXEC.                                                            
                                                                        
      ******************************************************************        
      * CSS_MT_TRN_HST_DET, MI                                         *        
      ******************************************************************        
C26130     EXEC SQL                                                             
C26130        INCLUDE TBMNHDT                                                   
C26103     END-EXEC.                                                            
                                                                        
      ******************************************************************        
      * CSS_MNT_TRANS_HIST, MH                                         *        
      ******************************************************************        
C26130     EXEC SQL                                                             
C26130        INCLUDE TBMNHIST                                                  
C26103     END-EXEC.                                                            
                                                                        
      ******************************************************************        
      * CSS_MKT_XREF_ACCT, XM                                          *        
      ******************************************************************        
           EXEC SQL                                                             
              INCLUDE TBMRKXR                                                   
           END-EXEC.                                                            
                                                                        
      ******************************************************************        
      * CSS_CNT_DETAIL, EA                                             *        
      ******************************************************************        
           EXEC SQL                                                             
              INCLUDE TBCNTDET                                                  
           END-EXEC.                                                            
                                                                        
      ******************************************************************        
      * CSS_CHRG_OFF, CO                                               *        
      ******************************************************************        
           EXEC SQL                                                             
              INCLUDE TBCHGOFF                                                  
           END-EXEC.                                                            
                                                                        
      ******************************************************************        
      * CSS_ACCOUNT, AT                                                *        
      ******************************************************************        
           EXEC SQL                                                             
              INCLUDE TBACCT                                                    
           END-EXEC.                                                            
                                                                        
      ******************************************************************        
      * CSS_CUSTOMER, CU                                               *        
      ******************************************************************        
           EXEC SQL                                                             
              INCLUDE TBCUST                                                    
           END-EXEC.                                                            
                                                                        
      ******************************************************************        
      * CSS_PREMISE, PR                                                *        
      ******************************************************************        
           EXEC SQL                                                             
              INCLUDE TBPREM                                                    
           END-EXEC.                                                            
                                                                        
      ******************************************************************        
      * CSS_AR_CNTL, AC                                                *        
      ******************************************************************        
           EXEC SQL                                                             
              INCLUDE TBARCNTL                                                  
           END-EXEC.                                                            
                                                                        
      ******************************************************************        
      * CSS_CONTRACT, CT                                               *        
      ******************************************************************        
           EXEC SQL                                                             
              INCLUDE TBCNTRCT                                                  
           END-EXEC.                                                            
                                                                        
      ******************************************************************        
      * CSS_AR_TRANS_HIST, AR                                          *        
      ******************************************************************        
           EXEC SQL                                                             
              INCLUDE TBARHIST                                                  
           END-EXEC.                                                            
                                                                        
      ******************************************************************        
      * CSS_AR_TRN_HST_DET, AU                                         *        
      ******************************************************************        
           EXEC SQL                                                             
              INCLUDE TBARHDT                                                   
           END-EXEC.                                                            
                                                                        
      ******************************************************************        
      * CSS_CSH_DRWR_CNTL, CS                                          *        
      ******************************************************************        
           EXEC SQL                                                             
              INCLUDE TBCDCNTL                                                  
           END-EXEC.                                                            
                                                                        
      ******************************************************************        
      * CSS_CSH_DRWR_JRNL, CJ                                          *        
      ******************************************************************        
           EXEC SQL                                                             
              INCLUDE TBCDJRNL                                                  
           END-EXEC.                                                            
                                                                        
      ******************************************************************        
      * CSS_BCH_DRWR_CNTL, BC                                          *        
      ******************************************************************        
           EXEC SQL                                                             
              INCLUDE TBBJCNTL                                                  
           END-EXEC.                                                            
                                                                        
      ******************************************************************        
      * CSS_BATCH_JRNL, BJ                                             *        
      ******************************************************************        
           EXEC SQL                                                             
              INCLUDE TBBTJRNL                                                  
           END-EXEC.                                                            
                                                                        
      ******************************************************************        
      * CSS_MISC_JRNL, MJ                                              *        
      ******************************************************************        
           EXEC SQL                                                             
              INCLUDE TBMSJRNL                                                  
           END-EXEC.                                                            
                                                                        
      ******************************************************************        
      * CSS_USER_PROFILE, PF                                           *        
      ******************************************************************        
           EXEC SQL                                                             
              INCLUDE TBUSRPRF                                                  
           END-EXEC.                                                            
                                                                        
      ******************************************************************        
      * CSS_PROJ_SHARE, PJ                                             *        
      ******************************************************************        
           EXEC SQL                                                             
              INCLUDE TBPRJSHR                                                  
           END-EXEC.                                                            
                                                                        
      ******************************************************************        
      * CSS_DFA_ACCT, DA                                               *        
      ******************************************************************        
           EXEC SQL                                                             
              INCLUDE TBDFAACT                                                  
           END-EXEC.                                                            
                                                                        
      ******************************************************************        
      * CSS_DFA_RECVBLE, DV                                            *        
      ******************************************************************        
           EXEC SQL                                                             
              INCLUDE TBDFARCV                                                  
           END-EXEC.                                                            
                                                                        
      ******************************************************************        
      * CSS_AR_PMT_PRTY, C9                                            *        
      ******************************************************************        
           EXEC SQL                                                             
              INCLUDE TBARPMT                                                   
           END-EXEC.                                                            
                                                                        
      ******************************************************************        
      * CSS_GL_ACCT_NO, GO                                             *        
      ******************************************************************        
           EXEC SQL                                                             
              INCLUDE TBGLATNO                                                  
           END-EXEC.                                                            
                                                                        
      ******************************************************************        
      * CSS_DEP_PAY_HST, DP                                            *        
      ******************************************************************        
           EXEC SQL                                                             
              INCLUDE TBDEPHST                                                  
           END-EXEC.                                                            
                                                                        
      ******************************************************************        
      * CSS_RECONNECT, DL                                              *        
      ******************************************************************        
           EXEC SQL                                                             
              INCLUDE TBRECNCT                                                  
           END-EXEC.                                                            
                                                                        
      ******************************************************************        
      * CSS_AR_LOCKOUT, AL                                             *        
      ******************************************************************        
           EXEC SQL                                                             
              INCLUDE TBARLOCK                                                  
           END-EXEC.                                                            
                                                                        
      ******************************************************************        
      * CSS_LIEAP, LI                                                  *        
      ******************************************************************        
           EXEC SQL                                                             
              INCLUDE TBLIEAP                                                   
           END-EXEC.                                                            
                                                                        
      ******************************************************************        
      * CSS_NSF_HIST, NH                                               *        
      ******************************************************************        
           EXEC SQL                                                             
              INCLUDE TBNSFHST                                                  
           END-EXEC.                                                            
                                                                        
      ******************************************************************        
      * CSS_CREDIT_PROFILE, CZ                                         *        
      ******************************************************************        
           EXEC SQL                                                             
              INCLUDE TBCRPROF                                                  
           END-EXEC.                                                            
                                                                        
      ******************************************************************        
      * CSS_SO_DNP_CANCEL, XK                                          *        
      ******************************************************************        
PCR307     EXEC SQL                                                             
PCR307        INCLUDE TBSODNPC                                                  
PCR307     END-EXEC.                                                            
                                                                        
      ******************************************************************        
      * CSS_DELINQUENCY, C8                                            *        
      ******************************************************************        
           EXEC SQL                                                             
              INCLUDE TBDELQ                                                    
           END-EXEC.                                                            
                                                                        
      ******************************************************************        
      * CSS_CUST_PLAN, CP                                              *        
      ******************************************************************        
T16114     EXEC SQL                                                             
T16114        INCLUDE TBCSTPLN                                                  
T16114     END-EXEC.                                                            
                                                                        
      ******************************************************************        
      * CSS_UTIL_ENVRNMT, UT                                           *        
      ******************************************************************        
T16114     EXEC SQL                                                             
T16114        INCLUDE TBUTLENV                                                  
T16114     END-EXEC.                                                            
                                                                        
      ******************************************************************        
      *  CSS_COMM_DATA, KO                                             *        
      ******************************************************************        
T31347     EXEC SQL                                                             
T31347        INCLUDE TBCOMDAT                                                  
T31347     END-EXEC.                                                            
                                                                        
      ******************************************************************        
      *  CSS_LOCAL_OFFICE, B1                                          *        
      ******************************************************************        
           EXEC SQL                                                             
              INCLUDE TBLOCOFC                                                  
           END-EXEC.                                                            
                                                                        
      ******************************************************************        
      *  CSS_RECONNECT_CHRG, U7                                        *        
      ******************************************************************        
           EXEC SQL                                                             
              INCLUDE TBRCNCHR                                                  
           END-EXEC.                                                            
                                                                        
      ******************************************************************        
      *  CSS_CONNECT_CHRG, CC                                          *        
      ******************************************************************        
           EXEC SQL                                                             
              INCLUDE TBCCCHRG                                                  
           END-EXEC.                                                            
                                                                        
      ******************************************************************        
      *  CSS_WO_ARRANGEMENT, WG                                        *        
      ******************************************************************        
           EXEC SQL                                                             
               INCLUDE TBWOARGM                                                 
           END-EXEC.                                                            
HPCCDM*EJECT                                                                    
                                                                        
      ***********CPD00068*******************************                        
           EXEC SQL                                                             
              INCLUDE CWS00068                                                  
           END-EXEC.                                                            
                                                                        
           EXEC SQL                                                             
A00956        INCLUDE CWS0013B                                                  
           END-EXEC.                                                            
                                                                        
           EXEC SQL                                                             
              INCLUDE CWS00017                                                  
           END-EXEC.                                                            
                                                                        
           EXEC SQL                                                             
              INCLUDE CWS00061                                                  
           END-EXEC.                                                            
                                                                        
T24436******************************************************************        
T24436* INCLUDED THE COPYBOOK FOR LINK RECORD CPD00061                          
T24436******************************************************************        
T24436     EXEC SQL                                                             
T24436        INCLUDE CWS0061L                                                  
T24436     END-EXEC.                                                            
                                                                        
           EXEC SQL                                                             
              INCLUDE CWS00073                                                  
           END-EXEC.                                                            
                                                                        
NONUTL******************************************************************        
NONUTL*    HOLIDAY CHECK                                               *        
NONUTL******************************************************************        
NONUTL     EXEC SQL                                                             
NONUTL         INCLUDE CWS10016                                                 
NONUTL     END-EXEC.                                                            
HPCCDM*EJECT                                                                    
                                                                        
      ******************************************************************        
      *  CSS_BUDGET_PLAN, BU                                           *        
      ******************************************************************        
           EXEC SQL                                                             
              INCLUDE TBBGTPLN                                                  
           END-EXEC.                                                            
                                                                        
      ******************************************************************        
      *  CSS_BUDGET_HIST, BH                                           *        
      ******************************************************************        
           EXEC SQL                                                             
              INCLUDE TBBGTHST                                                  
           END-EXEC.                                                            
                                                                        
      ******************************************************************        
      *  CSS_DEP_ON_HAND, DO                                           *        
      ******************************************************************        
           EXEC SQL                                                             
              INCLUDE TBDEPHND                                                  
           END-EXEC.                                                            
                                                                        
NONUTL******************************************************************        
NONUTL*  CSS_HOLIDAY, J8                                               *        
NONUTL******************************************************************        
NONUTL     EXEC SQL                                                             
NONUTL         INCLUDE TBHLDAY                                                  
NONUTL     END-EXEC.                                                            
HPCCDM*EJECT                                                                    
                                                                        
NONUTL******************************************************************        
NONUTL*  CSS_GUARANTOR, GU                                             *        
NONUTL******************************************************************        
NONUTL     EXEC SQL                                                             
NONUTL         INCLUDE TBGTNTR                                                  
NONUTL     END-EXEC.                                                            
HPCCDM*EJECT                                                                    
                                                                        
NONUTL******************************************************************        
NONUTL*  CSS_MSTSUB_ACCT, MU                                           *        
NONUTL******************************************************************        
NONUTL     EXEC SQL                                                             
NONUTL         INCLUDE TBMSTSUB                                                 
NONUTL     END-EXEC.                                                            
HPCCDM*EJECT                                                                    
                                                                        
T20099******************************************************************        
T20099*  CSS_TAX_RATE, TR                                              *        
T20099******************************************************************        
T20099     EXEC SQL                                                             
T20099        INCLUDE TBTXRATE                                                  
T20099     END-EXEC.                                                            
                                                                        
T20099******************************************************************        
T20099*  CSS_TAX_CNTL, TC                                              *        
T20099******************************************************************        
T20099     EXEC SQL                                                             
T20099        INCLUDE TBTXCNTL                                                  
T20099     END-EXEC.                                                            
                                                                        
T33431     EXEC SQL                                                             
T33431       INCLUDE TBJBPARM                                                   
T33431     END-EXEC.                                                            
                                                                        
T20099******************************************************************        
T20099*  CSS_SPCL_FCTR, SF                                             *        
T20099******************************************************************        
T20099     EXEC SQL                                                             
T20099        INCLUDE TBSPLFTR                                                  
T20099     END-EXEC.                                                            
                                                                        
T20099******************************************************************        
T20099*  CSS_BILL_WINDOW, BN                                           *        
T20099******************************************************************        
T20099     EXEC SQL                                                             
T20099        INCLUDE TBBILWDW                                                  
T20099     END-EXEC.                                                            
                                                                        
      ******************************************************************        
      *  CURSORS                                                       *        
      ******************************************************************        
T13034     EXEC SQL                                                     
T13034         DECLARE CNT-DETAIL       CURSOR   FOR                    
T13034          SELECT NOE_CODE,                                        
T13034                 FUNCTION_CODE,                                   
T13034                 COST_CENTER,                                     
T13034                 BNFT_COST_CENTER,                                
T13034                 WORK_ORDER_NO,                                   
T13034                 PROPERTY_UNIT_CD                                 
T13034            FROM CSS_CNT_DETAIL WITH(READUNCOMMITTED)                     
T13034           WHERE ACCOUNT_NO          = :EA-ACCOUNT-NO             
T13034             AND CNT_ITEM_ID         = :EA-CNT-ITEM-ID            
A36248             FOR READ ONLY                                
P00641                                                      
T13034     END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ003
MFA-TR* MSQ004
MFA-TR* MSQ022
MFA-TR*    EXEC SQL                                                             
MFA-TR*        DECLARE CNT-DETAIL       CURSOR   FOR                            
MFA-TR*         SELECT NOE_CODE,                                                
MFA-TR*                FUNCTION_CODE,                                           
MFA-TR*                COST_CENTER,                                             
MFA-TR*                BNFT_COST_CENTER,                                        
MFA-TR*                WORK_ORDER_NO,                                           
MFA-TR*                PROPERTY_UNIT_CD                                         
MFA-TR*           FROM CSS_CNT_DETAIL                                           
MFA-TR*          WHERE ACCOUNT_NO          = :EA-ACCOUNT-NO                     
MFA-TR*            AND CNT_ITEM_ID         = :EA-CNT-ITEM-ID                    
MFA-TR*            FOR FETCH ONLY WITH UR                                       
MFA-TR*        QUERYNO 7700                                                     
MFA-TR*    END-EXEC.                                                            
                                                                        
T16114     EXEC SQL                                                     
T16114         DECLARE UTIL-CURSOR CURSOR FOR                           
T16114          SELECT CODE_UTIL_TYPE,                                  
T16114                 IC_NO                                            
T16114            FROM CSS_UTIL_ENVRNMT WITH(READUNCOMMITTED)                   
T16114           WHERE ACCOUNT_NO = :UT-ACCOUNT-NO                      
A36248             FOR READ ONLY                                
P00641                                                      
T16114     END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ003
MFA-TR* MSQ004
MFA-TR* MSQ022
MFA-TR*    EXEC SQL                                                             
MFA-TR*        DECLARE UTIL-CURSOR CURSOR FOR                                   
MFA-TR*         SELECT CODE_UTIL_TYPE,                                          
MFA-TR*                IC_NO                                                    
MFA-TR*           FROM CSS_UTIL_ENVRNMT                                         
MFA-TR*          WHERE ACCOUNT_NO = :UT-ACCOUNT-NO                              
MFA-TR*            FOR FETCH ONLY WITH UR                                       
MFA-TR*        QUERYNO 7920                                                     
MFA-TR*    END-EXEC.                                                            
                                                                        
T16114     EXEC SQL                                                     
T16114         DECLARE UNMTRD-CURSOR CURSOR FOR                         
T16114          SELECT CODE_SERVICE_TYPE                                
T16114            FROM CSS_CUST_PLAN                                    
T16114           WHERE ACCOUNT_NO = :CP-ACCOUNT-NO
            OPTION(FAST 1)
            FOR READ ONLY
                                                         
T16114     END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ003
MFA-TR* MSQ004
MFA-TR* MSQ021
MFA-TR*    EXEC SQL                                                             
MFA-TR*        DECLARE UNMTRD-CURSOR CURSOR FOR                                 
MFA-TR*         SELECT CODE_SERVICE_TYPE                                        
MFA-TR*           FROM CSS_CUST_PLAN                                            
MFA-TR*          WHERE ACCOUNT_NO = :CP-ACCOUNT-NO                              
MFA-TR*       OPTIMIZE FOR 1 ROW FOR FETCH ONLY                                 
MFA-TR*        QUERYNO 7950                                                     
MFA-TR*    END-EXEC.                                                            
                                                                        
      ******************************************************************        
      * CURSOR FOR GETTING COMMUNICATION RECORDS                       *        
      ******************************************************************        
T31347     EXEC SQL                                                     
T31347        DECLARE COMM_DATA CURSOR FOR                              
T31347         SELECT REPLACE(REPLACE(CONVERT(CHAR(26), COMMUNICATION_ID
           , 121), ' ', '-'), ':', '.') COMMUNICATION_ID,                      
T31347                COMM_TYPE_CD,                                     
T31347                COMM_SUBTYPE_CODE                                 
T31347           FROM CSS_COMM_DATA WITH(READUNCOMMITTED)                       
T31347          WHERE ACCOUNT_NO = :KO-ACCOUNT-NO                       
C33441          ORDER BY COMMUNICATION_ID DESC                          
A36248            FOR READ ONLY                                 
P00641                                                      
T31347     END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ003
MFA-TR* MSQ004
MFA-TR* MSQ022
MFA-TR* MSQ061
MFA-TR*    EXEC SQL                                                             
MFA-TR*       DECLARE COMM_DATA CURSOR FOR                                      
MFA-TR*        SELECT COMMUNICATION_ID,                                         
MFA-TR*               COMM_TYPE_CD,                                             
MFA-TR*               COMM_SUBTYPE_CODE                                         
MFA-TR*          FROM CSS_COMM_DATA                                             
MFA-TR*         WHERE ACCOUNT_NO = :KO-ACCOUNT-NO                               
MFA-TR*         ORDER BY COMMUNICATION_ID DESC                                  
MFA-TR*           FOR FETCH ONLY WITH UR                                        
MFA-TR*        QUERYNO 7500                                                     
MFA-TR*    END-EXEC.                                                            
                                                                        
HPCCDM*EJECT                                                                    
CVT000     EXEC SQL                                                     00000010
CVT000         INCLUDE CWSX0010                                         00000020
CVT000     END-EXEC.                                                    00000030
CVT000                                                                  
CVT000 LINKAGE SECTION.                                                 
CVT000 01  LINK-ACCOUNT-NO-X        PIC X(13)                .          
CVT000 01  LINK-ITEM-ID             PIC S9(09) COMP          .          
CVT000 01  LINK-RECV-TYPE           PIC X(03)                .          
CVT000 01  LINK-PYMT-PRIORITY-LVL   PIC S9(04) COMP           .         
CVT000 01  LINK-DB-GL-NUMBER-X      PIC X(07)                .          
CVT000 01  LINK-CR-AMT-AR-DAY-00-X  PIC X(11)                .          
CVT000 01  LINK-CR-AMT-AR-DAY-30-X  PIC X(11)                .          
CVT000 01  LINK-CR-AMT-AR-DAY-60-X  PIC X(11)                .          
CVT000 01  LINK-CR-AMT-AR-DAY-90-X  PIC X(11)                .          
CVT000 01  LINK-CR-AMT-AR-TOTAL-X   PIC X(11)                .          
CVT000 01  LINK-DIST-RECV-TYPE      PIC X(03)                .          
CVT000 01  LINK-DIST-PYMT-PRI-LVL   PIC S9(04) COMP           .         
CVT000 01  LINK-DIST-ITEM-ID        PIC S9(09) COMP          .          
CVT000 01  LINK-RESP-AREA           PIC X(03)                .          
CVT000 01  LINK-USER-ID             PIC X(07)                .          
CVT000 01  LINK-AT-LAST-UPDATE-TS   PIC X(26)                .          
CVT000 01  LINK-AC-LAST-UPDATE-TS   PIC X(26)                .          
CVT000 01  LINK-TRAN-COMMENT        PIC X(210)               .          
CVT000 01  LINK-PRINCIPAL-AMT-X     PIC X(11)                .          
CVT000 01  LINK-STATE-TAX-AMT-X     PIC X(11)                .          
CVT000 01  LINK-CITY-TAX-AMT-X      PIC X(11)                .          
CVT000 01  LINK-OTHER-TAX-AMT-X     PIC X(11)                .          
CVT000 01  LINK-DEF-INT-AMT-X       PIC X(11)                .          
CVT000 01  LINK-EARNED-INT-AMT-X    PIC X(11)                .          
CVT000 01  LINK-CNT-NAME-CD         PIC S9(04) COMP          .          
CVT000 01  LINK-REVENUE-MONTH       PIC X(06)                .          
                                                                        
CVT000 PROCEDURE DIVISION USING                                         
CVT000          LINK-ACCOUNT-NO-X                                       
CVT000         ,LINK-ITEM-ID                                            
CVT000         ,LINK-RECV-TYPE                                          
CVT000         ,LINK-PYMT-PRIORITY-LVL                                  
CVT000         ,LINK-DB-GL-NUMBER-X                                     
CVT000         ,LINK-CR-AMT-AR-DAY-00-X                                 
CVT000         ,LINK-CR-AMT-AR-DAY-30-X                                 
CVT000         ,LINK-CR-AMT-AR-DAY-60-X                                 
CVT000         ,LINK-CR-AMT-AR-DAY-90-X                                 
CVT000         ,LINK-CR-AMT-AR-TOTAL-X                                  
CVT000         ,LINK-DIST-RECV-TYPE                                     
CVT000         ,LINK-DIST-PYMT-PRI-LVL                                  
CVT000         ,LINK-DIST-ITEM-ID                                       
CVT000         ,LINK-RESP-AREA                                          
CVT000         ,LINK-USER-ID                                            
CVT000         ,LINK-AT-LAST-UPDATE-TS                                  
CVT000         ,LINK-AC-LAST-UPDATE-TS                                  
CVT000         ,LINK-TRAN-COMMENT                                       
CVT000         ,LINK-PRINCIPAL-AMT-X                                    
CVT000         ,LINK-STATE-TAX-AMT-X                                    
CVT000         ,LINK-CITY-TAX-AMT-X                                     
CVT000         ,LINK-OTHER-TAX-AMT-X                                    
CVT000         ,LINK-DEF-INT-AMT-X                                      
CVT000         ,LINK-EARNED-INT-AMT-X                                   
CVT000         ,LINK-CNT-NAME-CD                                        
CVT000         ,LINK-REVENUE-MONTH                                      
CVT000         .                                                        

SCA006        SET WS-GL-SUB TO 1.
CVT000     EXEC SQL                                                     
CVT000         WHENEVER SQLWARNING                                      
CVT000             CONTINUE                                             
CVT000     END-EXEC.                                                    
CVT000                                                                  
CVT000     EXEC SQL                                                     
CVT000         WHENEVER SQLERROR                                        
CVT000             CONTINUE                                             
CVT000     END-EXEC.                                                    
CVT000                                                                  
CVT000     EXEC SQL                                                     
CVT000         WHENEVER NOT FOUND                                       
CVT000             CONTINUE                                             
CVT000     END-EXEC.                                                    
                                                                        
      *****************************************************************         
      * 0000-MAINLINE                                                           
      *     CONTROLS THE MAIN PATH OF THE PROGRAM                               
      *****************************************************************         
       0000-MAINLINE.                                                   
           PERFORM 0100-INITIALIZE     THRU 0100-EXIT.                  
           PERFORM 2000-PROCESS-OUTPUT THRU 2000-EXIT.                  
           PERFORM 9999-END-PROGRAM    THRU 9999-EXIT.                  
       0000-EXIT.                                                       
           EXIT.                                                        
                                                                        
      *****************************************************************         
      * 0100-INITIALIZE                                                         
      *****************************************************************         
       0100-INITIALIZE.                                                 
           MOVE '0100' TO ACTIVE-PARAGRAPH.                             
                                                                        
CVT000     EXEC SQL                                                     
CVT000       DECLARE C1 CURSOR  FOR                          
CVT000       SELECT                                                     
CVT000        :RS-RETURN-CODE              AS    RETURN_CODE            
CVT000       ,:RS-CANCELDNP-FLAG           AS    CANCELDNP_FLAG         
CVT000       ,:RS-AR-LOCKOUT-IND           AS    AR_LOCKOUT_IND         
CVT000       ,:RS-XFER-ACCT-NO             AS    XFER_ACCT_NO           
CVT000          FROM CIS.SYSDUMMY1                                   
CVT000     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*       :RS-RETURN-CODE              AS    RETURN_CODE                    
MFA-TR*      ,:RS-CANCELDNP-FLAG           AS    CANCELDNP_FLAG                 
MFA-TR*      ,:RS-AR-LOCKOUT-IND           AS    AR_LOCKOUT_IND                 
MFA-TR*      ,:RS-XFER-ACCT-NO             AS    XFER_ACCT_NO                   
MFA-TR*         FROM SYSIBM.SYSDUMMY1                                           
MFA-TR*    END-EXEC.                                                            
CVT000     MOVE LINK-ACCOUNT-NO-X         TO PARM-ACCOUNT-NO-X        . 
CVT000     MOVE LINK-ITEM-ID              TO PARM-ITEM-ID             . 
CVT000     MOVE LINK-RECV-TYPE            TO PARM-RECV-TYPE           . 
CVT000     MOVE LINK-PYMT-PRIORITY-LVL    TO PARM-PYMT-PRIORITY-LVL   . 
CVT000     MOVE LINK-DB-GL-NUMBER-X       TO PARM-DB-GL-NUMBER-X      . 
CVT000     MOVE LINK-CR-AMT-AR-DAY-00-X   TO PARM-CR-AMT-AR-DAY-00-X  . 
CVT000     MOVE LINK-CR-AMT-AR-DAY-30-X   TO PARM-CR-AMT-AR-DAY-30-X  . 
CVT000     MOVE LINK-CR-AMT-AR-DAY-60-X   TO PARM-CR-AMT-AR-DAY-60-X  . 
CVT000     MOVE LINK-CR-AMT-AR-DAY-90-X   TO PARM-CR-AMT-AR-DAY-90-X  . 
CVT000     MOVE LINK-CR-AMT-AR-TOTAL-X    TO PARM-CR-AMT-AR-TOTAL-X   . 
CVT000     MOVE LINK-DIST-RECV-TYPE       TO PARM-DIST-RECV-TYPE      . 
CVT000     MOVE LINK-DIST-PYMT-PRI-LVL    TO PARM-DIST-PYMT-PRI-LVL   . 
CVT000     MOVE LINK-DIST-ITEM-ID         TO PARM-DIST-ITEM-ID        . 
CVT000     MOVE LINK-RESP-AREA            TO PARM-RESP-AREA           . 
CVT000     MOVE LINK-USER-ID              TO PARM-USER-ID             . 
CVT000     MOVE LINK-AT-LAST-UPDATE-TS    TO PARM-AT-LAST-UPDATE-TS   . 
CVT000     MOVE LINK-AC-LAST-UPDATE-TS    TO PARM-AC-LAST-UPDATE-TS   . 
CVT000     MOVE LINK-TRAN-COMMENT         TO PARM-TRAN-COMMENT        . 
CVT000     MOVE LINK-PRINCIPAL-AMT-X      TO PARM-PRINCIPAL-AMT-X     . 
CVT000     MOVE LINK-STATE-TAX-AMT-X      TO PARM-STATE-TAX-AMT-X     . 
CVT000     MOVE LINK-CITY-TAX-AMT-X       TO PARM-CITY-TAX-AMT-X      . 
CVT000     MOVE LINK-OTHER-TAX-AMT-X      TO PARM-OTHER-TAX-AMT-X     . 
CVT000     MOVE LINK-DEF-INT-AMT-X        TO PARM-DEF-INT-AMT-X       . 
CVT000     MOVE LINK-EARNED-INT-AMT-X     TO PARM-EARNED-INT-AMT-X    . 
CVT000     MOVE LINK-CNT-NAME-CD          TO PARM-CNT-NAME-CD         . 
CVT000     MOVE LINK-REVENUE-MONTH        TO PARM-REVENUE-MONTH       . 
       0100-EXIT.                                                       
           EXIT.                                                        
                                                                        
      *****************************************************************         
      * 2000-PROCESS-OUTPUT.                                                    
      *     1. UPDATE DB2 DATA                                                  
      *     2. BUILD RESULT SET                                                 
      *     3. SEND RESULT SET                                                  
      *****************************************************************         
       2000-PROCESS-OUTPUT.                                             
           MOVE '2000' TO ACTIVE-PARAGRAPH.                             
           MOVE WS-N                   TO RS-CANCELDNP-FLAG.            
      ***********                                                               
      * DO NOT PROCEED IF SYSTEM IS LOCKED                                      
      ***********                                                               
           PERFORM 7999-SELECT-AL THRU 7999-SELECT-AL-EXIT              
           IF AL-AR-LOCKOUT-IND = 'Y'                                   
              MOVE AL-AR-LOCKOUT-IND        TO RS-AR-LOCKOUT-IND        
              MOVE 5000 TO RS-RETURN-CODE                               
              PERFORM 8100-SEND-RESULT THRU 8100-EXIT                   
              PERFORM 9999-END-PROGRAM      THRU 9999-EXIT              
           END-IF.                                                      
           UNSTRING PARM-ACCOUNT-NO-X   DELIMITED BY SPACES             
              INTO WS-ACCOUNT-NO-CHK                                    
           MOVE WS-ACCOUNT-NO-CHK     TO WS-ACCOUNT-NO-SEB-NUM          
           MOVE WS-ACCOUNT-NO-SEB TO XM-DIST-ACCT-NO                    
SEBSEB     PERFORM 9500-XREF-ACCOUNT THRU 9500-EXIT                     
SEBSEB     MOVE XM-ACCOUNT-NO TO AT-ACCOUNT-NO                          
SEBSEB     MOVE AT-ACCOUNT-NO TO PARM-ACCOUNT-NO                        
           UNSTRING PARM-CR-AMT-AR-TOTAL-X   DELIMITED BY SPACES        
              INTO WS-CR-AMT-AR-TOTAL-SEB                               
           COMPUTE PARM-CR-AMT-AR-TOTAL = WS-CR-AMT-AR-TOTAL-SEB / 100  
           END-COMPUTE.                                                 
T19996     PERFORM 7400-SELECT-MSTSUB THRU 7400-EXIT.                   
                                                                        
           PERFORM 7999-SELECT-TRANSFER-IND                             
              THRU 7999-SELECT-TRANSFER-IND-EXIT.                       
T19996     IF AT-ACCT-XFER-TO > ZERO AND AT-MST-SUB-ACCT-IND NOT = 'S'  
              MOVE 5000 TO RS-RETURN-CODE                               
              MOVE AT-ACCT-XFER-TO      TO RS-XFER-ACCT-NO              
              PERFORM 8100-SEND-RESULT  THRU 8100-EXIT                  
              PERFORM 9999-END-PROGRAM  THRU 9999-EXIT                  
           END-IF.                                                      
                                                                        
T31347     IF PARM-DB-GL-NUMBER =  675.0202                             
T31347        PERFORM 7500-GET-COMM-DATA      THRU 7500-EXIT            
T31347        IF WS-FREE-SWITCH                                         
T31347           NEXT SENTENCE                                          
T31347        ELSE                                                      
T31347           MOVE 0 TO RS-RETURN-CODE                               
T31347           PERFORM 8100-SEND-RESULT     THRU 8100-EXIT            
T31347           PERFORM 9999-END-PROGRAM     THRU 9999-EXIT            
T31347        END-IF                                                    
T31347     END-IF.                                                      
                                                                        
T33041     IF PARM-DB-GL-NUMBER =  675.0204                             
T33041        PERFORM 7500-GET-COMM-DATA      THRU 7500-EXIT            
T33041        IF WS-FREE-ESTABLISH OR WS-60-BILL-CREDIT                 
T33041           NEXT SENTENCE                                          
T33041        ELSE                                                      
T33041           MOVE 0 TO RS-RETURN-CODE                               
T33041           PERFORM 8100-SEND-RESULT     THRU 8100-EXIT            
T33041           PERFORM 9999-END-PROGRAM     THRU 9999-EXIT            
T33041        END-IF                                                    
T33041     END-IF.                                                      
                                                                        
           PERFORM 2200-PROCESS THRU 2200-EXIT.                         
A36248*                                                                         
A36248     IF WS-DNP-UPDATE-FL = 'Y'                                    
A36248        PERFORM 8999-ISSUE-COMMIT       THRU 8999-EXIT            
A36248        PERFORM 8555-CALL-MCSCB371      THRU 8555-EXIT            
A36248     END-IF.                                                      
                                                                        
       2000-EXIT.                                                       
           EXIT.                                                        
                                                                        
      *****************************************************************         
      * 2200-PROCESS                                                            
      *****************************************************************         
       2200-PROCESS.                                                    
                                                                        
           MOVE '2200'              TO ACTIVE-PARAGRAPH.                
                                                                        
      ***************                                                           
      * GET INFORMATION FROM ACCOUNT, PREMISE, AND CUSTOMER TABLE               
      ***************                                                           
           MOVE PARM-ACCOUNT-NO     TO AT-ACCOUNT-NO.                   
           PERFORM 7000-SELECT-AT-PR-CU THRU 7000-EXIT.                 
                                                                        
           MOVE AT-CODES-DATA-PRESENT TO WS-CODES-DATA-PRESENT.         
                                                                        
           IF CU-CODE-CUST-STATUS EQUAL WS-S                            
              MOVE WS-Y TO WS-CHRG-OFF-ACCT                             
           END-IF.                                                      
      ***************                                                           
      * SET RECONNECT FLAG                                                      
      ***************                                                           
      *    MOVE WS-N                      TO WS-PAR-RECONNECT-EXIST.            
           MOVE AT-ACCOUNT-NO TO DL-ACCOUNT-NO.                         
T19646     PERFORM 6799J-SELECT-RECONNECT THRU 6799J-EXIT.              
           IF WS-ACTIVE-RETURN-CODE EQUAL SUCCESSFUL-CALL               
              MOVE WS-Y       TO WS-PAR-RECONNECT-EXIST                 
           END-IF.                                                      
      ******************                                                        
      * GET G/L ACCOUNT NUMBER                                                  
      ******************                                                        
           MOVE PARM-RECV-TYPE TO WS-RECV-TYPE                          
           PERFORM 5800-DETERMINE-GL-NUMBERS THRU 5800-EXIT.            
                                                                        
      ******************                                                        
      * DEBIT CASH                                                              
      ******************                                                        
      *    MOVE WS-ACASH-GL-NO (WS-GL-SUB) TO WS-PAR-GEN-LEDG-DB.               
                                                                        
      ******************                                                        
      * MOVE NUMERIC FIELD AMONG WORKING STORAGE FIELDS BECAUSE THEY            
      * WERE PASSED AS CHARACTER, NOT NUMERIC.                                  
      ******************                                                        
           MOVE PARM-CR-AMT-AR-DAY-00     TO WS-PARM-CR-AMT-AR-DAY-00.  
           MOVE PARM-CR-AMT-AR-DAY-30     TO WS-PARM-CR-AMT-AR-DAY-30.  
           MOVE PARM-CR-AMT-AR-DAY-60     TO WS-PARM-CR-AMT-AR-DAY-60.  
           MOVE PARM-CR-AMT-AR-DAY-90     TO WS-PARM-CR-AMT-AR-DAY-90.  
           MOVE PARM-CR-AMT-AR-TOTAL      TO WS-PARM-CR-AMT-AR-TOTAL.   
T17253     MOVE PARM-ACCTING-PERIOD       TO WS-PAR-ACCT-PERIOD.        
                                                                        
           ADD WS-PARM-CR-AMT-AR-DAY-00                                 
               WS-PARM-CR-AMT-AR-DAY-30                                 
               WS-PARM-CR-AMT-AR-DAY-60                                 
               WS-PARM-CR-AMT-AR-DAY-90 GIVING WS-PARM-0-3-6-9-TOTAL.   
                                                                        
      ******************                                                        
      * GET AR-CNTL RECV 00/30/60/90 BUCKETS                                    
      ******************                                                        
           MOVE PARM-ACCOUNT-NO        TO AC-ACCOUNT-NO.                
           MOVE PARM-ITEM-ID           TO AC-ITEM-ID.                   
           MOVE PARM-PYMT-PRIORITY-LVL TO AC-PYMT-PRIORITY-LVL.         
           MOVE 'N'                    TO WS-AR-CNTL-EXISTS-FLAG.       
           PERFORM 7100-SELECT-AR-CNTL THRU 7100-EXIT.                  
           IF WS-ACTIVE-RETURN-CODE EQUAL NOT-FOUND                     
              IF WS-PARM-0-3-6-9-TOTAL GREATER THAN ZERO                
      ***>       FATAL ERROR - AR-CNTL NOT FOUND FOR EXISTING RECV              
                 MOVE PROGRAM-NAME         TO ABEND-PROGRAM             
                 MOVE '2200'               TO ACTIVE-PARAGRAPH          
                 MOVE 'SELECT'             TO ABEND-FUNCTION            
                 MOVE 'CSS_AR_CNTL'        TO TABLE-1                   
                 MOVE 'ACCOUNT_NO'         TO TABLE-ELEMENT-1           
                 MOVE 'ITEM_ID'            TO TABLE-ELEMENT-2           
                 MOVE 'PYMT_PRIORITY_LVL'  TO TABLE-ELEMENT-3           
                 MOVE AC-ACCOUNT-NO        TO HOSTVAR-ELEMENT-1         
                 MOVE AC-ITEM-ID           TO HOSTVAR-ELEMENT-2         
                 MOVE AC-PYMT-PRIORITY-LVL TO HOSTVAR-ELEMENT-3         
                 PERFORM 9700-PROCESS-ABEND   THRU 9700-EXIT            
              ELSE                                                      
      ***>       ADD MISC CREDIT FOR RECV THAT DOES NOT EXIST                   
                 MOVE W-LT-ADD-MISC-CREDIT TO WS-CREDIT-TYPE-FLAG       
                 MOVE ZERO                 TO WS-AC-AMT-AR-TOTAL
              END-IF        
           ELSE                                                         
      ***>    CREDITING EXISTING RECEIVABLE                                     
              MOVE W-LT-CREDIT-EXISTING-RECV TO WS-CREDIT-TYPE-FLAG     
              ADD AC-AMT-AR-DAY-00                                      
                  AC-AMT-AR-DAY-30                                      
                  AC-AMT-AR-DAY-60                                      
                  AC-AMT-AR-DAY-90 GIVING WS-AC-AMT-AR-TOTAL
           END-IF.           
                                                                        
      ******************                                                        
      * DETERMINE IF CPD10 CAN BE USED TO POST PAYMENT                          
      ******************                                                        
           MOVE WS-PARM-CR-AMT-AR-TOTAL TO WS-AMT-CASH                  
                                           WS-CREDIT-REMAINING.         
                                                                        
T16114     IF PARM-PYMT-PRIORITY-LVL = 30                               
T16114        MOVE AT-ACCOUNT-NO TO UT-ACCOUNT-NO                       
T16114        MOVE AT-ACCOUNT-NO TO CP-ACCOUNT-NO                       
T16114        SET HAVE-NOT-UTE   TO TRUE                                
T16114        SET HAVE-NOT-UTG   TO TRUE                                
T16114        PERFORM 7920-OPEN-UTIL-CURSOR             THRU 7920-EXIT  
T16114        PERFORM 7930-FETCH-UTIL-CURSOR            THRU 7930-EXIT  
T16114        PERFORM UNTIL WS-ACTIVE-RETURN-CODE = NOT-FOUND           
T16114        OR (HAVE-UTE AND HAVE-UTG)                                
T16114           IF UT-CODE-UTIL-TYPE = 'E'                             
T16114              SET HAVE-UTE TO TRUE                                
T16114           END-IF                                                 
T16114           IF UT-CODE-UTIL-TYPE = 'G'                             
T16114              SET HAVE-UTG TO TRUE                                
T16114           END-IF                                                 
T16114           IF UT-CODE-UTIL-TYPE = 'U'                             
T16114              PERFORM 7950-OPEN-UNMTRD-CURSOR   THRU 7950-EXIT    
T16114              PERFORM 7960-FETCH-UNMTRD-CURSOR  THRU 7960-EXIT    
T16114              PERFORM 7970-CLOSE-UNMTRD-CURSOR  THRU 7970-EXIT    
T16114              IF CP-CODE-SERVICE-TYPE = 'E'                       
T16114                 SET HAVE-UTE TO TRUE                             
T16114              END-IF                                              
T16114              IF CP-CODE-SERVICE-TYPE = 'G'                       
T16114                 SET HAVE-UTE TO TRUE                             
T16114              END-IF                                              
T16114           END-IF                                                 
T16114           PERFORM 7930-FETCH-UTIL-CURSOR THRU 7930-EXIT          
T16114        END-PERFORM                                               
T16114        PERFORM 7940-CLOSE-UTIL-CURSOR THRU 7940-EXIT             
T16114        MOVE WS-GL-EREV-LPC-KEY     TO GO-GL-ACCT-NAME            
T16114        PERFORM 7600-SELECT-GL-ACCOUNT THRU 7600-EXIT             
T16114        MOVE GO-GL-ACCT-NO          TO WS-SPLIT-GL-ACCT1          
T16114        MOVE WS-GL-GREV-LPC-KEY     TO GO-GL-ACCT-NAME            
T16114        PERFORM 7600-SELECT-GL-ACCOUNT THRU 7600-EXIT             
T16114        MOVE GO-GL-ACCT-NO          TO WS-SPLIT-GL-ACCT2          
T16114        IF HAVE-UTE AND HAVE-UTG                                  
T16114           IF AT-ELEC-REV-ALLOC-PCT EQUAL ZEROES                  
T16114              MOVE AT-COMPANY-NO   TO B1-COMPANY-NO               
T16114              MOVE AT-LOCAL-OFFICE TO B1-LOCAL-OFFICE             
T16114              PERFORM 6791F-SELECT-LOCAL-OFFICE THRU 6791F-EXIT   
T16114              MOVE B1-ELEC-REV-ALLOC-PCT TO WS-SPLIT-PERCENT      
T16114           ELSE                                                   
T16114              MOVE AT-ELEC-REV-ALLOC-PCT TO WS-SPLIT-PERCENT      
T16114           END-IF                                                 
T16114        END-IF                                                    
T16114     END-IF.                                                      
T16114                                                                  
T16114     IF PARM-PYMT-PRIORITY-LVL = 60                               
T16114        MOVE AT-ACCOUNT-NO                 TO CC-ACCOUNT-NO       
T16114        MOVE 60                         TO CC-PYMT-PRIORITY-LVL   
T16114        MOVE PARM-ITEM-ID                  TO CC-CCC-ITEM-ID      
T16114        MOVE AT-COMPANY-NO                 TO U7-COMPANY-NO       
A37061        MOVE AT-ACCOUNT-TYPE-CODE          TO                     
A37061                                           U7-RCNCT-ACCT-TYPE-CD  
T16114        IF CC-CCC-ITEM-ID > 0                                     
T16114           PERFORM 7910-SELECT-RCC            THRU 7910-EXIT      
T16114        ELSE                                                      
T16114           MOVE AT-ACCOUNT-NO TO UT-ACCOUNT-NO                    
T16114           MOVE AT-ACCOUNT-NO TO CP-ACCOUNT-NO                    
T16114           PERFORM 7920-OPEN-UTIL-CURSOR   THRU 7920-EXIT         
T16114           PERFORM 7930-FETCH-UTIL-CURSOR  THRU 7930-EXIT         
T16114           PERFORM UNTIL WS-ACTIVE-RETURN-CODE = NOT-FOUND        
T16114           OR (U7-RCNCT-ELEC-SVC-FL = 'Y' AND                     
T16114               U7-RCNCT-GAS-SVC-FL  = 'Y')                        
T16114              IF UT-CODE-UTIL-TYPE = 'E'                          
T16114                 MOVE 'Y' TO U7-RCNCT-ELEC-SVC-FL                 
T16114              END-IF                                              
T16114              IF UT-CODE-UTIL-TYPE = 'G'                          
T16114                 MOVE 'Y' TO U7-RCNCT-GAS-SVC-FL                  
T16114              END-IF                                              
T16114              IF UT-CODE-UTIL-TYPE = 'U'                          
T16114                 PERFORM 7950-OPEN-UNMTRD-CURSOR   THRU 7950-EXIT 
T16114                 PERFORM 7960-FETCH-UNMTRD-CURSOR  THRU 7960-EXIT 
T16114                 PERFORM 7970-CLOSE-UNMTRD-CURSOR  THRU 7970-EXIT 
T16114                 IF CP-CODE-SERVICE-TYPE = 'E'                    
T16114                    MOVE 'Y' TO U7-RCNCT-ELEC-SVC-FL              
T16114                 END-IF                                           
T16114                 IF CP-CODE-SERVICE-TYPE = 'G'                    
T16114                    MOVE 'Y' TO U7-RCNCT-GAS-SVC-FL               
T16114                 END-IF                                           
T16114              END-IF                                              
T16114              PERFORM 7930-FETCH-UTIL-CURSOR THRU 7930-EXIT       
T16114           END-PERFORM                                            
T16114           PERFORM 7940-CLOSE-UTIL-CURSOR THRU 7940-EXIT          
T16114        END-IF                                                    
T16114                                                                  
T16114        MOVE WS-GL-EREV-CCC-KEY        TO GO-GL-ACCT-NAME         
T16114        PERFORM 7600-SELECT-GL-ACCOUNT THRU 7600-EXIT             
T16114        MOVE GO-GL-ACCT-NO             TO WS-SPLIT-GL-ACCT1       
T16114                                                                  
T16114        MOVE WS-GL-GREV-CCC-KEY        TO GO-GL-ACCT-NAME         
T16114        PERFORM 7600-SELECT-GL-ACCOUNT THRU 7600-EXIT             
T16114        MOVE GO-GL-ACCT-NO             TO WS-SPLIT-GL-ACCT2       
T16114        IF U7-RCNCT-ELEC-SVC-FL = 'Y'                             
T16114        AND U7-RCNCT-GAS-SVC-FL  = 'Y'                            
T16114           MOVE 'PCT-ELEC-RCC-ALLOC' TO C8-DELINQ-CD              
T16114           PERFORM 6791D-SELECT-DELINQUENCY THRU 6791D-EXIT       
T16114           MOVE C8-DELINQ-VALUE TO WS-SPLIT-PERCENT               
T16114        END-IF                                                    
T16114     END-IF.                                                      
                                                                        
T13773     IF PARM-PYMT-PRIORITY-LVL = 100                              
T13773        NEXT SENTENCE                                             
           ELSE                                                         
              IF WS-AC-AMT-AR-TOTAL GREATER THAN WS-PARM-CR-AMT-AR-TOTAL
                 IF WS-PARM-0-3-6-9-TOTAL GREATER THAN ZERO             
                    IF WS-PARM-CR-AMT-AR-DAY-90 NOT = AC-AMT-AR-DAY-90  
                    OR WS-PARM-CR-AMT-AR-DAY-60 NOT = AC-AMT-AR-DAY-60  
                    OR WS-PARM-CR-AMT-AR-DAY-30 NOT = AC-AMT-AR-DAY-30  
                    OR WS-PARM-CR-AMT-AR-DAY-00 NOT = AC-AMT-AR-DAY-00  
                       MOVE WS-N TO WS-CPD10-USAGE-FLAG                 
                    END-IF                                              
                 END-IF                                                 
              END-IF                                                    
           END-IF.                                                      
      ******************                                                        
      * DETERMINE DIR\UND, LOAD DIRECTED PAYMENT, CALCULATE REMAINDER           
      ******************                                                        
           IF WS-PAR-RECONNECT-EXIST EQUAL WS-Y                         
T16114        PERFORM 2400-CREDIT-REM-WITH-SPLIT THRU 2400-EXIT         
           ELSE                                                         
              IF WS-PARM-0-3-6-9-TOTAL EQUAL ZERO                       
              AND WS-AC-AMT-AR-TOTAL EQUAL ZERO                         
                 MOVE WS-PARM-CR-AMT-AR-TOTAL TO WS-CREDIT-REMAINING    
                 IF PARM-DIST-RECV-TYPE = (WS-UNDIRECTED OR SPACES)     
      * FOR NON-CONTRACT PAYMENTS                                               
                    MOVE WS-N             TO WS-IS-THIS-DIRECTED-PYMT   
T16114              PERFORM 2400-CREDIT-REM-WITH-SPLIT THRU 2400-EXIT   
                 ELSE                                                   
      * FOR CONTRACT PAYMENTS                                                   
      * MOVE STATEMENTS ADDED BY MR                                             
T13034              MOVE 1                    TO WS-MAX-SUB             
                    MOVE PARM-CR-AMT-AR-TOTAL TO WS-DIR-PAY-AMT (1)     
T13034              MOVE PARM-DIST-PYMT-PRI-LVL TO                      
T13034                            WS-DIR-PAY-REC-TYPE(1)                
T13034              MOVE PARM-DIST-ITEM-ID TO WS-DIR-PAY-ITEM-ID(1)     
T13034              MOVE SPACES            TO WS-DIR-PAY-AHEAD-TYPE(1)  
T13034              MOVE SPACES            TO WS-DIR-PAY-CHRG-OFF(1)    
T13034              MOVE WS-D              TO WS-PAR-UPDATE-TYPE        
T13034              MOVE WS-YES            TO WS-IS-THIS-DIRECTED-PYMT  
                    PERFORM 2250-CREDIT-DIST-RECV THRU 2250-EXIT        
                 END-IF                                                 
              ELSE                                                      
                 MOVE 1                      TO WS-MAX-SUB              
                 MOVE PARM-PYMT-PRIORITY-LVL TO WS-DIR-PAY-REC-TYPE(1)  
                 MOVE PARM-ITEM-ID           TO WS-DIR-PAY-ITEM-ID(1)   
                 MOVE SPACES              TO WS-DIR-PAY-AHEAD-TYPE(1)   
                 MOVE WS-PAY-CHRG-OFF     TO WS-DIR-PAY-CHRG-OFF(1)     
                 MOVE WS-D                TO WS-PAR-UPDATE-TYPE         
                 MOVE WS-YES              TO WS-IS-THIS-DIRECTED-PYMT   
                 IF PARM-CR-AMT-AR-TOTAL NOT GREATER WS-AC-AMT-AR-TOTAL 
                    MOVE PARM-CR-AMT-AR-TOTAL TO WS-DIR-PAY-AMT(1)      
                    PERFORM 5000-UPDATE THRU 5000-EXIT                  
                    IF WS-CREDIT-REMAINING GREATER THAN ZERO            
                       MOVE WS-Y TO WS-CPD10-USAGE-FLAG                 
                       MOVE WS-CREDIT-REMAINING TO WS-AMT-CASH          
                                                   WS-DIR-PAY-AMT(1)    
                       PERFORM 5000-UPDATE THRU 5000-EXIT               
                    END-IF                                              
                 ELSE                                                   
      * IF RCC AND NOTHING IN 0,30,60,90 THEN PAY THE TRAN BALANCE.             
T13034              IF PARM-PYMT-PRIORITY-LVL = 100                     
T13034                PERFORM 2260-CREDIT-CONTRACT THRU 2260-EXIT       
                    ELSE                                                
T11360                IF ( PARM-PYMT-PRIORITY-LVL = ( 60 OR 129 ))      
T13034                  IF WS-AC-AMT-AR-TOTAL = WS-PARM-0-3-6-9-TOTAL   
T13034                    MOVE SPACES TO WS-DIR-PAY-AHEAD-TYPE(1)       
T13034                  ELSE                                            
T13034                    MOVE WS-P TO WS-DIR-PAY-AHEAD-TYPE(1)         
T13034                  END-IF                                          
                        MOVE WS-PARM-0-3-6-9-TOTAL TO WS-DIR-PAY-AMT(1) 
                        SUBTRACT WS-PARM-0-3-6-9-TOTAL FROM             
                                 WS-CREDIT-REMAINING                    
                      ELSE                                              
                        MOVE WS-AC-AMT-AR-TOTAL TO WS-DIR-PAY-AMT(1)    
                        SUBTRACT WS-AC-AMT-AR-TOTAL FROM                
                                 WS-CREDIT-REMAINING                    
                      END-IF                                            
T13034                PERFORM 5000-UPDATE THRU 5000-EXIT                
                      IF PARM-DIST-RECV-TYPE = (WS-UNDIRECTED OR SPACES)
      *                  SUBTRACT WS-CREDIT-REMAINING FROM WS-AMT-CASH          
T16114                   PERFORM 2400-CREDIT-REM-WITH-SPLIT             
T16114                      THRU 2400-EXIT                              
                      ELSE                                              
T13034                   MOVE 1 TO WS-MAX-SUB                           
T13034                   MOVE PARM-DIST-PYMT-PRI-LVL TO                 
T13034                          WS-DIR-PAY-REC-TYPE(1)                  
T13034                   MOVE PARM-DIST-ITEM-ID TO WS-DIR-PAY-ITEM-ID(1)
T13034                   MOVE SPACES TO WS-DIR-PAY-AHEAD-TYPE(1)        
T13034                   MOVE WS-PAY-CHRG-OFF TO WS-DIR-PAY-CHRG-OFF(1) 
T13034                   MOVE WS-D TO WS-PAR-UPDATE-TYPE                
T13034                   MOVE WS-YES TO WS-IS-THIS-DIRECTED-PYMT        
                         PERFORM 2250-CREDIT-DIST-RECV THRU 2250-EXIT   
                      END-IF                                            
                    END-IF                                              
                 END-IF                                                 
              END-IF                                                    
           END-IF.                                                      
                                                                        
           MOVE WS-Y                   TO CALC-DNP-BAL-SW               
                                          CALC-ARREARS-SW               
                                          CALC-BALANCE-SW.              
           MOVE WS-CURRENT-DATE        TO WS-HOLD-DATE.                 
T22359     MOVE PROGRAM-NAME           TO WS-CPD00068-CALLING-PGM.      
T19557     MOVE CWS00068-FIELDS        TO WS-CWS68-FIELDS-LK.           
T19557     MOVE WS-CODES-DATA-PRESENT  TO WS-CODES-DATA-PRESENT-LK.     
T19557     MOVE DCLCSS-ACCOUNT         TO WS-DCLCSS-ACCOUNT-LK.         
T19557     MOVE ABEND-FILE             TO WS-ABEND-FILE-LK.             
T19557     MOVE RS-RETURN-CODE         TO WS-RETURN-CODE-LK.            
T19557     MOVE SPACES                 TO ABEND-FUNCTION .              
T19557     PERFORM 9600-CALL-CPD00068  THRU 9600-EXIT.                  
A36248     MOVE WS-DATABASE-CPD68      TO WS-DATABASE.                  
A36248     MOVE WS-AMT-DNP-BAL         TO WS-CPD68-DNP-BAL.             
T19557     MOVE WS-CWS68-FIELDS-LK     TO CWS00068-FIELDS               
T19557     MOVE WS-ABEND-FILE-LK       TO ABEND-FILE                    
T19557     MOVE WS-DCLCSS-ACCOUNT-LK   TO DCLCSS-ACCOUNT                
T19557     MOVE WS-CODES-DATA-PRESENT-LK                                
T19557                                 TO WS-CODES-DATA-PRESENT         
T19557     MOVE WS-RETURN-CODE-LK      TO RS-RETURN-CODE                
T19557     MOVE RS-RETURN-CODE         TO  WS-ACTIVE-RETURN-CODE,       
T19557                                        SQLCODE.                  
T19557     IF ABEND-FUNCTION  > SPACES                                  
T19557        PERFORM 9700-PROCESS-ABEND                                
T19557                                 THRU 9700-EXIT                   
T19557     END-IF.                                                      
A36248     MOVE WS-DATABASE            TO WS-DATABASE-CPD68             
A36248*    IF WS-AMT-DNP-BAL  EQUAL ZEROS                                       
A36248     IF WS-CPD68-DNP-BAL EQUAL ZEROS                              
                MOVE WS-Y              TO RS-CANCELDNP-FLAG             
           ELSE                                                         
                MOVE WS-N              TO RS-CANCELDNP-FLAG             
A36248          IF CSR-DATABASE-CPD68                                   
A36248             MOVE 'Y'            TO WS-DNP-UPDATE-FL              
A36248          END-IF                                                  
           END-IF.                                                      
           PERFORM 8100-SEND-RESULT THRU 8100-EXIT.                     
                                                                        
       2200-EXIT.                                                       
           EXIT.                                                        
                                                                        
      *********************************************************                 
      * 2250-CREDIT-DIST-RECV                                 *                 
      *    CREDIT REMAINING CREDIT TO DIRECTED DISTRIBUTED    *                 
      *    RECEIVABLE TYPE.  ALL MONEY IS CREDITED TOWARD     *                 
      *    EXISTING RECV REGARDLESS OF THE RECV THAT WARRANTS *                 
      *    THE CREDIT.                                        *                 
      *********************************************************                 
       2250-CREDIT-DIST-RECV.                                           
                                                                        
           MOVE PARM-ACCOUNT-NO        TO AC-ACCOUNT-NO.                
           MOVE PARM-DIST-ITEM-ID      TO AC-ITEM-ID.                   
           MOVE PARM-DIST-PYMT-PRI-LVL TO AC-PYMT-PRIORITY-LVL.         
           MOVE 'N'                    TO WS-AR-CNTL-EXISTS-FLAG        
                                          WS-AR-CNTL-CHG-CHK-FLAG.      
                                                                        
           PERFORM 7100-SELECT-AR-CNTL THRU 7100-EXIT.                  
                                                                        
           ADD AC-AMT-AR-DAY-00 AC-AMT-AR-DAY-30                        
               AC-AMT-AR-DAY-60 AC-AMT-AR-DAY-90                        
                  GIVING WS-DIST-AC-AMT-AR-TOTAL.                       
                                                                        
T18179     IF AC-PYMT-PRIORITY-LVL = 100 AND                            
T19614     WS-PARM-CR-AMT-AR-TOTAL > AC-AMT-TRAN-BALANCE                
T18179        MOVE 5001 TO RS-RETURN-CODE                               
T18179        PERFORM 8100-SEND-RESULT THRU 8100-EXIT                   
T18179        PERFORM 9999-END-PROGRAM THRU 9999-EXIT                   
T18179     END-IF.                                                      
                                                                        
T18526     IF AC-PYMT-PRIORITY-LVL = 50 OR 70                           
T18526        MOVE  WS-CREDIT-REMAINING    TO  WS-DIST-AC-AMT-AR-TOTAL  
T18526     ELSE                                                         
T18526        IF AC-PYMT-PRIORITY-LVL < 50                              
T18526           ADD AC-TOT-SUMM-UNBILLED  TO  WS-DIST-AC-AMT-AR-TOTAL  
T18526        ELSE                                                      
T18526           MOVE AC-AMT-TRAN-BALANCE  TO  WS-DIST-AC-AMT-AR-TOTAL  
              END-IF                                                    
           END-IF                                                       
                                                                        
           IF WS-DIST-AC-AMT-AR-TOTAL GREATER THAN ZERO                 
NEWNEW*       ADD 1                       TO WS-MAX-SUB                         
              MOVE PARM-DIST-RECV-TYPE TO WS-RECV-TYPE                  
              PERFORM 5800-DETERMINE-GL-NUMBERS THRU 5800-EXIT          
              MOVE PARM-DIST-PYMT-PRI-LVL                               
                TO WS-DIR-PAY-REC-TYPE (WS-MAX-SUB)                     
              MOVE PARM-DIST-ITEM-ID TO WS-DIR-PAY-ITEM-ID (WS-MAX-SUB) 
              MOVE SPACES TO WS-DIR-PAY-AHEAD-TYPE (WS-MAX-SUB)         
              MOVE SPACES TO WS-DIR-PAY-CHRG-OFF(WS-MAX-SUB)            
              IF WS-CREDIT-REMAINING NOT GREATER WS-DIST-AC-AMT-AR-TOTAL
                 MOVE WS-CREDIT-REMAINING TO WS-DIR-PAY-AMT(WS-MAX-SUB) 
              ELSE                                                      
                 MOVE WS-DIST-AC-AMT-AR-TOTAL                           
                   TO WS-DIR-PAY-AMT(WS-MAX-SUB)                        
                 SUBTRACT WS-DIST-AC-AMT-AR-TOTAL                       
                     FROM WS-CREDIT-REMAINING                           
              END-IF                                                    
           END-IF                                                       
                                                                        
           IF WS-SPLIT-PERCENT > 0                                      
              MOVE WS-DIR-PAY-AMT(WS-MAX-SUB) TO WS-TOT-AMT-TO-SPLIT    
              COMPUTE WS-DIR-PAY-AMT(WS-MAX-SUB) =                      
                 (WS-TOT-AMT-TO-SPLIT * WS-SPLIT-PERCENT) / 100         
              END-COMPUTE                                               
              PERFORM 5000-UPDATE THRU 5000-EXIT                        
              COMPUTE WS-TOT-AMT-TO-SPLIT =                             
                 WS-TOT-AMT-TO-SPLIT - WS-DIR-PAY-AMT(WS-MAX-SUB)       
              END-COMPUTE                                               
              PERFORM 5000-UPDATE THRU 5000-EXIT                        
           ELSE                                                         
              PERFORM 5000-UPDATE THRU 5000-EXIT                        
           END-IF                                                       
                                                                        
           IF WS-CREDIT-REMAINING GREATER THAN ZERO                     
T16114        PERFORM 2400-CREDIT-REM-WITH-SPLIT THRU 2400-EXIT         
           END-IF.                                                      
                                                                        
       2250-EXIT.                                                       
           EXIT.                                                        
                                                                        
T13034*********************************************************                 
T13034* 2260-CREDIT-CONTRACT.                                 *                 
T13034*    CREDIT CONTRACT.                                   *                 
T13034*********************************************************                 
T13034 2260-CREDIT-CONTRACT.                                            
T13034                                                                  
T13034     MOVE WS-AC-AMT-AR-TOTAL     TO WS-AC-AMT-AR-TOTAL-CNT        
T13034     MOVE AC-ACCOUNT-NO          TO CT-ACCOUNT-NO                 
T13034                                    EA-ACCOUNT-NO.                
T13034     MOVE +100                   TO CT-PYMT-PRIORITY-LVL.         
T13034     MOVE AC-ITEM-ID             TO CT-CNT-ITEM-ID                
T13034                                    EA-CNT-ITEM-ID.               
T13034     PERFORM 7010-GET-INTEREST-INFO THRU 7010-EXIT.               
T13034     PERFORM 7700-OPEN-DET-CURSOR   THRU 7700-EXIT.               
T13034     PERFORM 7710-FETCH-DET-CURSOR  THRU 7710-EXIT.               
T13034     PERFORM 7720-CLOSE-DET-CURSOR  THRU 7720-EXIT.               
T13034                                                                  
T13034     MOVE EA-NOE-CODE            TO WS-105-NATURE-OF-EXPENDITURE  
T13034     MOVE EA-COST-CENTER         TO WS-105-COST-CENTER.           
T13034     MOVE EA-FUNCTION-CODE       TO WS-105-FUNCTION-CODE.         
T13034     MOVE EA-BNFT-COST-CENTER    TO WS-105-BENE-COST-CENTER.      
T13034     MOVE EA-WORK-ORDER-NO       TO WS-105-CODE-WORK-ORDER-NO.    
T13034     MOVE EA-PROPERTY-UNIT-CD    TO WS-105-CODE-PROPERTY-UNIT.    
T13034                                                                  
T13034                                                                  
T13034     MOVE 'Y'                    TO WS-PAR-JOURNAL-105.           
T13034     MOVE 'N'                    TO WS-JRNL-CNTL.                 
T13034     MOVE '01'                   TO GO-COMPANY-NO.                
T13034                                                                  
T13034     MOVE PARM-PRINCIPAL-AMT   TO WS-PRINCIPAL-AMT                
T13034     MOVE PARM-STATE-TAX-AMT   TO WS-STATE-TAX-AMT                
T13034     MOVE PARM-CITY-TAX-AMT    TO WS-CITY-TAX-AMT                 
T13034     MOVE PARM-OTHER-TAX-AMT   TO WS-OTHER-TAX-AMT                
T13034     MOVE PARM-DEF-INT-AMT     TO WS-DEF-INT-AMT                  
T13034     MOVE PARM-EARNED-INT-AMT  TO WS-EARNED-INT-AMT               
T13034                                                                  
T13034     MOVE 1                TO WS-MAX-SUB                          
T13034     MOVE PARM-CR-AMT-AR-TOTAL TO WS-DIR-PAY-AMT (1)              
T13034     MOVE PARM-PYMT-PRIORITY-LVL                                  
T13034                           TO WS-DIR-PAY-REC-TYPE (1)             
T13034     MOVE PARM-ITEM-ID     TO WS-DIR-PAY-ITEM-ID (1)              
T13034     MOVE SPACES           TO WS-DIR-PAY-AHEAD-TYPE(1)            
T13034     MOVE WS-PAY-CHRG-OFF  TO WS-DIR-PAY-CHRG-OFF (1)             
T13034     MOVE WS-D             TO WS-PAR-UPDATE-TYPE                  
T13034     MOVE WS-YES           TO WS-IS-THIS-DIRECTED-PYMT            
T13034                                                                  
T13034                                                                  
T13034     MOVE WS-PARM-0-3-6-9-TOTAL TO WS-REMAINING-CONTRACT          
T13034     SUBTRACT WS-PARM-0-3-6-9-TOTAL FROM WS-PARM-CR-AMT-AR-TOTAL  
T13034              GIVING WS-REMAINING-AMOUNT                          
T13034                                                                  
T13034     IF  WS-DEF-INT-AMT > 0                                       
T13034       SUBTRACT WS-DEF-INT-AMT FROM CT-AMT-DEF-INTEREST           
T13034                                    CT-SIMPLE-INT-FIN-CHG         
T13034       IF CT-AMT-DEF-INTEREST < 0                                 
T13034          MOVE 0 TO CT-AMT-DEF-INTEREST                           
T13034       END-IF                                                     
T13034       IF CT-SIMPLE-INT-FIN-CHG < 0                               
T13034          MOVE 0 TO CT-SIMPLE-INT-FIN-CHG                         
T13034       END-IF                                                     
T13034       PERFORM 7060-UPDATE-INTEREST THRU 7060-EXIT                
T13034     END-IF.                                                      
T13034                                                                  
T13034     IF WS-REMAINING-CONTRACT > 0 AND WS-DEF-INT-AMT > 0          
T13034        MOVE CT-GL-ACCT-NO-DEF-INT   TO WS-PAR-GEN-LEDG-DB        
T13034        IF WS-DEF-INT-AMT >= WS-REMAINING-CONTRACT                
T13034           MOVE WS-REMAINING-CONTRACT     TO WS-DIR-PAY-AMT (1)   
T13034           IF WS-DIR-PAY-AMT (1) > WS-AC-AMT-AR-TOTAL-CNT         
T13034              MOVE 'P'    TO      WS-DIR-PAY-AHEAD-TYPE(1)        
T13034           ELSE                                                   
T13034              MOVE SPACES TO      WS-DIR-PAY-AHEAD-TYPE(1)        
T13034           END-IF                                                 
T13034           SUBTRACT WS-DIR-PAY-AMT (1) FROM WS-AC-AMT-AR-TOTAL-CNT
T13034           SUBTRACT WS-REMAINING-CONTRACT FROM WS-DEF-INT-AMT     
T13034           PERFORM 5000-UPDATE            THRU 5000-EXIT          
T13034           MOVE 0                         TO WS-REMAINING-CONTRACT
T13034        ELSE                                                      
T13034           MOVE WS-DEF-INT-AMT      TO WS-DIR-PAY-AMT(1)          
T13034           IF WS-DIR-PAY-AMT(1) > WS-AC-AMT-AR-TOTAL-CNT          
T13034              MOVE 'P'    TO      WS-DIR-PAY-AHEAD-TYPE(1)        
T13034           ELSE                                                   
T13034              MOVE SPACES TO      WS-DIR-PAY-AHEAD-TYPE(1)        
T13034           END-IF                                                 
T13034           SUBTRACT WS-DIR-PAY-AMT(1) FROM WS-AC-AMT-AR-TOTAL-CNT 
T13034           PERFORM 5000-UPDATE        THRU 5000-EXIT              
T13034           SUBTRACT WS-DEF-INT-AMT  FROM WS-REMAINING-CONTRACT    
T13034           MOVE 0                     TO WS-DEF-INT-AMT           
T13034        END-IF                                                    
T13034        MOVE 'N'                    TO WS-PAR-VALIDATE-JRNL       
T13034     END-IF.                                                      
T13034                                                                  
T13034     IF WS-REMAINING-CONTRACT > 0 AND WS-PRINCIPAL-AMT > 0        
T13034        MOVE WS-PARM-DB-GL-NUMBER  TO WS-PAR-GEN-LEDG-DB          
T13034        IF WS-PRINCIPAL-AMT >= WS-REMAINING-CONTRACT              
T13034           MOVE WS-REMAINING-CONTRACT     TO WS-DIR-PAY-AMT(1)    
T13034           IF WS-DIR-PAY-AMT(1) > WS-AC-AMT-AR-TOTAL-CNT          
T13034              MOVE 'P'    TO      WS-DIR-PAY-AHEAD-TYPE(1)        
T13034           ELSE                                                   
T13034              MOVE SPACES TO      WS-DIR-PAY-AHEAD-TYPE(1)        
T13034           END-IF                                                 
T13034           SUBTRACT WS-DIR-PAY-AMT (1) FROM WS-AC-AMT-AR-TOTAL-CNT
T13034           SUBTRACT WS-REMAINING-CONTRACT FROM WS-PRINCIPAL-AMT   
T13034           PERFORM 5000-UPDATE            THRU 5000-EXIT          
T13034           MOVE 0                         TO WS-REMAINING-CONTRACT
T13034        ELSE                                                      
T13034           MOVE WS-PRINCIPAL-AMT      TO WS-DIR-PAY-AMT(1)        
T13034           IF WS-DIR-PAY-AMT(1) > WS-AC-AMT-AR-TOTAL-CNT          
T13034              MOVE 'P'    TO      WS-DIR-PAY-AHEAD-TYPE(1)        
T13034           ELSE                                                   
T13034              MOVE SPACES TO      WS-DIR-PAY-AHEAD-TYPE(1)        
T13034           END-IF                                                 
T13034           SUBTRACT WS-DIR-PAY-AMT(1) FROM WS-AC-AMT-AR-TOTAL-CNT 
T13034           PERFORM 5000-UPDATE        THRU 5000-EXIT              
T13034           SUBTRACT WS-PRINCIPAL-AMT  FROM WS-REMAINING-CONTRACT  
T13034           MOVE 0                     TO WS-PRINCIPAL-AMT         
T13034        END-IF                                                    
T13034        MOVE 'N'                    TO WS-PAR-VALIDATE-JRNL       
T13034     END-IF.                                                      
T13034                                                                  
T13034     IF WS-REMAINING-CONTRACT > 0 AND WS-STATE-TAX-AMT > 0        
T13034        MOVE 'TAX-STAT'           TO GO-GL-ACCT-NAME              
T13034        PERFORM 7300-SELECT-GL-ACCT THRU 7300-EXIT                
T13034        MOVE GO-GL-ACCT-NO        TO WS-PAR-GEN-LEDG-DB           
T13034        IF WS-STATE-TAX-AMT >= WS-REMAINING-CONTRACT              
T13034           MOVE WS-REMAINING-CONTRACT TO WS-DIR-PAY-AMT(1)        
T13034           IF WS-DIR-PAY-AMT(1) > WS-AC-AMT-AR-TOTAL-CNT          
T13034              MOVE 'P'    TO WS-DIR-PAY-AHEAD-TYPE(1)             
T13034           ELSE                                                   
T13034              MOVE SPACES TO WS-DIR-PAY-AHEAD-TYPE(1)             
T13034           END-IF                                                 
T13034           SUBTRACT WS-DIR-PAY-AMT(1) FROM WS-AC-AMT-AR-TOTAL-CNT 
T13034           SUBTRACT WS-REMAINING-CONTRACT FROM WS-STATE-TAX-AMT   
T13034           PERFORM 5000-UPDATE            THRU 5000-EXIT          
T13034           MOVE 0                        TO WS-REMAINING-CONTRACT 
T13034        ELSE                                                      
T13034           MOVE WS-STATE-TAX-AMT      TO WS-DIR-PAY-AMT(1)        
T13034           IF WS-DIR-PAY-AMT(1) > WS-AC-AMT-AR-TOTAL-CNT          
T13034              MOVE 'P'    TO      WS-DIR-PAY-AHEAD-TYPE(1)        
T13034           ELSE                                                   
T13034              MOVE SPACES TO      WS-DIR-PAY-AHEAD-TYPE(1)        
T13034           END-IF                                                 
T13034           SUBTRACT WS-DIR-PAY-AMT(1) FROM WS-AC-AMT-AR-TOTAL-CNT 
T13034           PERFORM 5000-UPDATE        THRU 5000-EXIT              
T13034           SUBTRACT WS-STATE-TAX-AMT  FROM WS-REMAINING-CONTRACT  
T13034           MOVE 0                     TO WS-STATE-TAX-AMT         
T13034        END-IF                                                    
T13034        MOVE 'N'                    TO WS-PAR-VALIDATE-JRNL       
T13034     END-IF.                                                      
T13034                                                                  
T13034     IF WS-REMAINING-CONTRACT > 0 AND WS-CITY-TAX-AMT > 0         
T13034        MOVE 'TAX-CITY'           TO GO-GL-ACCT-NAME              
T13034        PERFORM 7300-SELECT-GL-ACCT THRU 7300-EXIT                
T13034        MOVE GO-GL-ACCT-NO        TO WS-PAR-GEN-LEDG-DB           
T13034        IF WS-CITY-TAX-AMT >= WS-REMAINING-CONTRACT               
T13034           MOVE WS-REMAINING-CONTRACT     TO WS-DIR-PAY-AMT(1)    
T13034           IF WS-DIR-PAY-AMT(1) > WS-AC-AMT-AR-TOTAL-CNT          
T13034              MOVE 'P'    TO      WS-DIR-PAY-AHEAD-TYPE(1)        
T13034           ELSE                                                   
T13034              MOVE SPACES TO      WS-DIR-PAY-AHEAD-TYPE(1)        
T13034           END-IF                                                 
T13034           SUBTRACT WS-DIR-PAY-AMT(1) FROM WS-AC-AMT-AR-TOTAL-CNT 
T13034           SUBTRACT WS-REMAINING-CONTRACT FROM WS-CITY-TAX-AMT    
T13034           PERFORM 5000-UPDATE            THRU 5000-EXIT          
T13034           MOVE 0                         TO WS-REMAINING-CONTRACT
T13034        ELSE                                                      
T13034           MOVE WS-CITY-TAX-AMT         TO WS-DIR-PAY-AMT(1)      
T13034           IF WS-DIR-PAY-AMT(1) > WS-AC-AMT-AR-TOTAL-CNT          
T13034              MOVE 'P'    TO      WS-DIR-PAY-AHEAD-TYPE(1)        
T13034           ELSE                                                   
T13034             MOVE SPACES TO      WS-DIR-PAY-AHEAD-TYPE(1)         
T13034           END-IF                                                 
T13034           SUBTRACT WS-DIR-PAY-AMT (1) FROM WS-AC-AMT-AR-TOTAL-CNT
T13034           PERFORM 5000-UPDATE         THRU 5000-EXIT             
T13034           SUBTRACT WS-CITY-TAX-AMT    FROM WS-REMAINING-CONTRACT 
T13034           MOVE 0                      TO WS-CITY-TAX-AMT         
T13034        END-IF                                                    
T13034        MOVE 'N'                    TO WS-PAR-VALIDATE-JRNL       
T13034     END-IF.                                                      
T13034                                                                  
T13034     IF WS-REMAINING-CONTRACT > 0 AND WS-OTHER-TAX-AMT > 0        
T20099        IF NOT OTHER-TAX-GL-LOADED                                
T20099           PERFORM 7800-SELECT-OTHER-GL-ACCTS THRU 7800-EXIT      
T20099        END-IF                                                    
T13034        IF WS-OTHER-TAX-AMT >= WS-REMAINING-CONTRACT              
T20099           MOVE WS-REMAINING-CONTRACT  TO WS-TOT-TAX-OTHER        
T20099                                          WS-RMNG-TAX-OTHER       
T20099           PERFORM 7830-CALC-OTHER-TAX-AMT THRU 7830-EXIT         
T13034           MOVE 0                      TO WS-REMAINING-CONTRACT   
T13034        ELSE                                                      
T20099           MOVE WS-OTHER-TAX-AMT       TO WS-TOT-TAX-OTHER        
T20099                                          WS-RMNG-TAX-OTHER       
T20099           PERFORM 7830-CALC-OTHER-TAX-AMT THRU 7830-EXIT         
T13034           SUBTRACT WS-OTHER-TAX-AMT FROM WS-REMAINING-CONTRACT   
T13034           MOVE 0                      TO WS-OTHER-TAX-AMT        
T13034        END-IF                                                    
T13034        MOVE 'N'                       TO WS-PAR-VALIDATE-JRNL    
T13034     END-IF.                                                      
T13034                                                                  
T13034     IF WS-EARNED-INT-AMT > 0                                     
T13034        MOVE PARM-ITEM-ID            TO WS-PAR-TYPE-NO            
T13034                                        AC-ITEM-ID                
T13034        MOVE 'P'                     TO WS-PAR-PAY-AHEAD          
T13034        MOVE 100                     TO WS-PAR-TYPE               
T13034        MOVE WS-EARNED-INT-AMT       TO WS-PAR-AMT-POSTED         
T13034        MOVE CT-GL-ACCT-NO-ERN-INT   TO WS-PAR-GEN-LEDG-DB        
T13034        MOVE CT-GL-ACCT-NO-DEF-INT   TO WS-PAR-GEN-LEDG-CR        
T13034        MOVE 'Y'                     TO WS-PAR-JRNL-EARNED-INT    
T13034        PERFORM 6745-TRH-UPDATE-DTL-PP THRU 6745-EXIT             
T13034        MOVE 'N'                     TO WS-PAR-JRNL-EARNED-INT    
T13034     END-IF                                                       
T13034                                                                  
T13034     IF PARM-DIST-RECV-TYPE = (WS-UNDIRECTED OR SPACES)           
T13034        MOVE WS-N             TO WS-IS-THIS-DIRECTED-PYMT         
              MOVE WS-U             TO WS-PAR-UPDATE-TYPE               
              MOVE WS-NO            TO WS-IS-THIS-DIRECTED-PYMT         
              MOVE 1                TO C9-PMT-PRTY-SCHEDULE             
              PERFORM 6722B-OPEN-AR-PMT-PRTY  THRU 6722B-EXIT           
              PERFORM 6722C-FETCH-AR-PMT-PRTY THRU 6722C-EXIT           
              PERFORM 6722D-LOAD-AR-PMT-PRTY  THRU 6722D-EXIT           
                VARYING WS-PAR-SUB FROM 1 BY 1                          
                UNTIL WS-PAR-SUB GREATER THAN 52                        
                OR WS-ACTIVE-RETURN-CODE EQUAL NOT-FOUND                
              PERFORM 6722E-CLOSE-AR-PMT-PRTY THRU 6722E-EXIT           
T13034     ELSE                                                         
T13034        MOVE WS-Y                   TO WS-IS-THIS-DIRECTED-PYMT   
T13034        MOVE 1                      TO WS-MAX-SUB                 
T13034        MOVE PARM-DIST-PYMT-PRI-LVL TO WS-DIR-PAY-REC-TYPE(1)     
T13034        MOVE PARM-DIST-ITEM-ID      TO WS-DIR-PAY-ITEM-ID(1)      
T13034        MOVE SPACES                 TO WS-DIR-PAY-AHEAD-TYPE(1)   
T13034        MOVE WS-PAY-CHRG-OFF        TO WS-DIR-PAY-CHRG-OFF(1)     
T13034        MOVE WS-D                   TO WS-PAR-UPDATE-TYPE         
T13034        MOVE WS-YES                 TO WS-IS-THIS-DIRECTED-PYMT   
T13034     END-IF.                                                      
T13034     IF WS-REMAINING-AMOUNT > 0 AND WS-PRINCIPAL-AMT > 0          
T13034        MOVE WS-PARM-DB-GL-NUMBER  TO WS-PAR-GEN-LEDG-DB          
T13034        IF DIRECTED-PYMT                                          
T13034           MOVE WS-PRINCIPAL-AMT TO WS-DIR-PAY-AMT(1)             
T13034        ELSE                                                      
T13034           MOVE WS-PRINCIPAL-AMT TO WS-AMT-CASH                   
T13034        END-IF                                                    
T13034        PERFORM 5000-UPDATE        THRU 5000-EXIT                 
T13034        SUBTRACT WS-PRINCIPAL-AMT FROM WS-REMAINING-AMOUNT        
T13034        MOVE 'N'                    TO WS-PAR-VALIDATE-JRNL       
T13034     END-IF                                                       
T13034                                                                  
T13034     IF WS-REMAINING-AMOUNT > 0 AND WS-STATE-TAX-AMT > 0          
T13034        MOVE 'TAX-STAT'           TO GO-GL-ACCT-NAME              
T13034        PERFORM 7300-SELECT-GL-ACCT THRU 7300-EXIT                
T13034        MOVE GO-GL-ACCT-NO        TO WS-PAR-GEN-LEDG-DB           
T13034        IF DIRECTED-PYMT                                          
T13034           MOVE WS-STATE-TAX-AMT TO WS-DIR-PAY-AMT(1)             
T13034        ELSE                                                      
T13034           MOVE WS-STATE-TAX-AMT TO WS-AMT-CASH                   
T13034        END-IF                                                    
T13034        PERFORM 5000-UPDATE        THRU 5000-EXIT                 
T13034        SUBTRACT WS-STATE-TAX-AMT FROM WS-REMAINING-AMOUNT        
T13034        MOVE 'N'                    TO WS-PAR-VALIDATE-JRNL       
T13034     END-IF                                                       
T13034                                                                  
T13034     IF WS-REMAINING-AMOUNT > 0 AND WS-CITY-TAX-AMT > 0           
T13034        MOVE 'TAX-CITY'           TO GO-GL-ACCT-NAME              
T13034        PERFORM 7300-SELECT-GL-ACCT THRU 7300-EXIT                
T13034        MOVE GO-GL-ACCT-NO        TO WS-PAR-GEN-LEDG-DB           
T13034        IF DIRECTED-PYMT                                          
T13034           MOVE WS-CITY-TAX-AMT TO WS-DIR-PAY-AMT (1)             
T13034        ELSE                                                      
T13034           MOVE WS-CITY-TAX-AMT TO WS-AMT-CASH                    
T13034        END-IF                                                    
T13034        PERFORM 5000-UPDATE        THRU 5000-EXIT                 
T13034        SUBTRACT WS-CITY-TAX-AMT FROM WS-REMAINING-AMOUNT         
T13034        MOVE 'N'                    TO WS-PAR-VALIDATE-JRNL       
T13034     END-IF                                                       
T13034                                                                  
T13034     IF WS-REMAINING-AMOUNT > 0 AND WS-OTHER-TAX-AMT > 0          
T20099        IF NOT OTHER-TAX-GL-LOADED                                
T20099           PERFORM 7800-SELECT-OTHER-GL-ACCTS THRU 7800-EXIT      
T20099        END-IF                                                    
T20099        PERFORM 7835-CALC-RMNG-OTHER-TAX-AMT THRU 7835-EXIT       
T13034        SUBTRACT WS-OTHER-TAX-AMT FROM WS-REMAINING-AMOUNT        
T13034        MOVE 'N'                    TO WS-PAR-VALIDATE-JRNL       
T13034     END-IF.                                                      
T13034                                                                  
T13034     IF WS-REMAINING-AMOUNT > 0 AND WS-DEF-INT-AMT > 0            
T13034        MOVE CT-GL-ACCT-NO-DEF-INT   TO WS-PAR-GEN-LEDG-DB        
T13034        IF DIRECTED-PYMT                                          
T13034           MOVE WS-DEF-INT-AMT TO WS-DIR-PAY-AMT (1)              
T13034        ELSE                                                      
T13034           MOVE WS-DEF-INT-AMT TO WS-AMT-CASH                     
T13034        END-IF                                                    
T13034        PERFORM 5000-UPDATE        THRU 5000-EXIT                 
T13034        SUBTRACT WS-DEF-INT-AMT FROM WS-REMAINING-AMOUNT          
T13034        MOVE 'N'                    TO WS-PAR-VALIDATE-JRNL       
T13034     END-IF                                                       
T13034                                                                  
T13034     IF WS-REMAINING-AMOUNT > 0                                   
T13034        MOVE WS-PARM-DB-GL-NUMBER    TO WS-PAR-GEN-LEDG-DB        
T13034        IF DIRECTED-PYMT                                          
T13034           MOVE WS-REMAINING-AMOUNT  TO WS-DIR-PAY-AMT(1)         
T13034        ELSE                                                      
T13034           MOVE WS-REMAINING-AMOUNT  TO WS-AMT-CASH               
T13034        END-IF                                                    
T13034        PERFORM 5000-UPDATE        THRU 5000-EXIT                 
T13034        MOVE 'N'                    TO WS-PAR-VALIDATE-JRNL       
T13034     END-IF.                                                      
T13034                                                                  
T13034     MOVE WS-JRNL-CNTRL-ONLY TO WS-JRNL-OPERATION-RQST            
T13034     PERFORM 6400-ONLINE-JRNL-ROUTINE THRU 6400-EXIT              
T13034     IF WS-JRNL-RTRN-CODE NOT EQUAL SPACES                        
T13034        MOVE PROGRAM-NAME         TO ABEND-PROGRAM                
T13034        MOVE '5000'               TO ACTIVE-PARAGRAPH             
T13034        MOVE 'USERABEN'           TO ABEND-FUNCTION               
T13034        MOVE WS-YES               TO WS-USER-FORCE-ABEND          
T13034        MOVE 'JOURNAL ABEND'      TO DSNTIAR-MESSAGE-1            
T13034        PERFORM 9700-PROCESS-ABEND THRU 9700-EXIT                 
T13034     END-IF.                                                      
                                                                        
       2260-EXIT.                                                       
           EXIT.                                                        
                                                                        
      *********************************************************                 
      * 2300-CREDIT-REMAINING-UNDIR                           *                 
      *    CREDIT REMAINING CREDIT TO UNDIRECTED DISTRIBUTED  *                 
      *    RECEIVABLE TYPE.  ALL MONEY IS CREDITED TOWARD     *                 
      *    EXISTING RECV REGARDLESS OF THE RECV THAT WARRANTS *                 
      *    THE CREDIT.                                        *                 
      *********************************************************                 
       2300-CREDIT-REMAINING-UNDIR.                                     
                                                                        
      ********************************************************                  
      * LOAD THE PAYMENT PRIORITY TABLE                      *                  
      * USE PARM-UPDATE-TYPE TO DECIDE WHICH SET TO LOAD:    *                  
      * B FOR BILLED, A FOR ARREARS, AND U FOR UNDIRECTED.   *                  
      * SCHEDULE 1 IS FOR BILLED AND UNDIRECTED DUE TO THE   *                  
      * ORDER PAYMENT IS POSTED.  SCHEDULE 2 IS FOR ARREARS  *                  
      * WHICH PAYS OFF ALL 90 DAY FIRST, THEN 60 DAYS, ETC.  *                  
      ********************************************************                  
                                                                        
           MOVE WS-U             TO WS-PAR-UPDATE-TYPE                  
           MOVE WS-NO            TO WS-IS-THIS-DIRECTED-PYMT            
           MOVE 1                TO C9-PMT-PRTY-SCHEDULE.               
                                                                        
           PERFORM 6722B-OPEN-AR-PMT-PRTY  THRU 6722B-EXIT.             
           PERFORM 6722C-FETCH-AR-PMT-PRTY THRU 6722C-EXIT.             
           PERFORM 6722D-LOAD-AR-PMT-PRTY  THRU 6722D-EXIT              
              VARYING WS-PAR-SUB FROM 1 BY 1                            
              UNTIL WS-PAR-SUB GREATER THAN 52                          
              OR WS-ACTIVE-RETURN-CODE EQUAL NOT-FOUND.                 
           PERFORM 6722E-CLOSE-AR-PMT-PRTY THRU 6722E-EXIT.             
                                                                        
      ******************                                                        
      * PROCESS THE UPDATE FOR CREDIT REMAINING                                 
      ******************                                                        
                                                                        
           MOVE WS-CREDIT-REMAINING TO WS-AMT-CASH.                     
           PERFORM 5000-UPDATE THRU 5000-EXIT.                          
                                                                        
       2300-EXIT.                                                       
           EXIT.                                                        
                                                                        
T16114******************************************************************        
T16114* 2400-CREDIT-REM-WITH-SPLIT.                                    *        
T16114* SPLIT IT IF THE SPLIT IS TO BE DONE.                           *        
T16114******************************************************************        
T16114 2400-CREDIT-REM-WITH-SPLIT.                                      
T16114     IF WS-SPLIT-PERCENT > 0                                      
T16114        MOVE WS-CREDIT-REMAINING TO WS-TOT-AMT-TO-SPLIT           
T16114        COMPUTE WS-CREDIT-REMAINING =                             
T16114          (WS-TOT-AMT-TO-SPLIT * WS-SPLIT-PERCENT) / 100          
T16114        END-COMPUTE                                               
T16114        COMPUTE WS-SPLIT-CREDIT-REMAINING =                       
T16114           WS-TOT-AMT-TO-SPLIT - WS-CREDIT-REMAINING              
T16114        END-COMPUTE                                               
T16114        MOVE WS-SPLIT-GL-ACCT1       TO WS-GL-ACCT-DEBIT          
T16114                                        AU-GL-ACCT-DEBIT          
T16114                                        WS-PAR-GEN-LEDG-DB        
T16114        PERFORM 2300-CREDIT-REMAINING-UNDIR THRU 2300-EXIT        
T16114        MOVE WS-SPLIT-CREDIT-REMAINING  TO WS-CREDIT-REMAINING    
T16114        MOVE WS-SPLIT-GL-ACCT2       TO WS-GL-ACCT-DEBIT          
T16114                                        AU-GL-ACCT-DEBIT          
T16114                                        WS-PAR-GEN-LEDG-DB        
T16114        PERFORM 2300-CREDIT-REMAINING-UNDIR THRU 2300-EXIT        
T16114        MOVE WS-PARM-CR-AMT-AR-TOTAL TO AR-AMT-ORIG-ENTERED       
T16114        PERFORM 8200-UPDATE-AMT-ORIG        THRU 8200-EXIT        
T16114     ELSE                                                         
T16114        PERFORM 2300-CREDIT-REMAINING-UNDIR THRU 2300-EXIT        
T16114     END-IF.                                                      
                                                                        
T16114 2400-EXIT.                                                       
           EXIT.                                                        
                                                                        
      ************************************************************              
      * 5000-UPDATE                                              *              
      *    PROCESS THE APPLICABLE UPDATE OF THE CREDIT (PAYMENT) *              
      ************************************************************              
       5000-UPDATE.                                                     
                                                                        
           MOVE WS-AMT-CASH   TO WS-PAYMENT-AMOUNT                      
                                 WS-PAYMENT-AMOUNT-TOTAL                
                                 WS-CREDIT-REMAINING.                   
                                                                        
           MOVE ZERO          TO WS-AMT-CHECK                           
                                 WS-AMT-MONEY-ORDER                     
                                 WS-AMT-LIHEAP                          
                                 WS-AMT-CREDIT-CARD.                    
                                                                        
           MOVE WS-NO-ERROR   TO WS-PAR-MESSAGE-NO.                     
           MOVE '5000'        TO ACTIVE-PARAGRAPH.                      
                                                                        
           MOVE AT-COMPANY-NO TO WS-100-COMPANY-NO.                     
                                                                        
           MOVE 9             TO WS-TRAN-OPER-LEVEL.                    
           MOVE 1             TO WS-TRAN-OCAP-FIELD.                    
           MOVE 1             TO WS-TRAN-OCAP-VALUE.                    
           MOVE WS-C          TO WS-TRAN-JRNL-TYPE.                     
           MOVE WS-N          TO WS-TRAN-HOLD-EXEMPT-FLAG.              
                                                                        
           MOVE PARM-USER-ID       TO WS-JRNL-OL-TEMP-ID.               
           MOVE WS-JRNL-CK-OPER-ID TO WS-JRNL-OPERATION-RQST.           
           MOVE 'S396'          TO WS-100-CODE-TERMINAL-TRAN.           
CVT999*    MOVE 'S396'          TO WS-PAR-'S396'  .                             
           IF WS-PAR-VALIDATE-JRNL = 'Y'                                
             PERFORM 6400-ONLINE-JRNL-ROUTINE THRU 6400-EXIT            
           END-IF.                                                      
           MOVE WS-JRNL-OL-OPR-LOC TO WS-TERM-LOC.                      
                                                                        
           MOVE    '01'            TO WS-CD-COMPANY-NO                  
           MOVE    '998'           TO WS-CD-LOCAL-OFFICE                
           MOVE    '998'           TO WS-CD-REPORT-NO                   
           MOVE    WS-CURRENT-DATE TO WS-CD-REPORT-DATE                 
           MOVE    9999            TO WS-CASH-DRAWER-ID                 
                                                                        
           MOVE WS-CD-COMPANY-NO           TO WS-JRNL-OL-COMPANY.       
           MOVE WS-CD-LOCAL-OFFICE         TO WS-JRNL-OL-LOC-OFF.       
           MOVE WS-CD-REPORT-NO            TO WS-JRNL-OL-REPORT-NO.     
           MOVE WS-CD-REPORT-DATE          TO WS-JRNL-OL-REPORT-DT.     
           MOVE WS-CASH-DRAWER-ID          TO WS-JRNL-OL-CASH-DRWR.     
                                                                        
           MOVE WS-TERM-LOC                TO WS-JRNL-OL-TERM-LOC       
                                              WS-JRNL-OL-CASH-LOC       
                                              WS-JRNL-OL-OPR-LOC.       
                                                                        
           MOVE WS-JRNL-VALIDATE-OPER TO WS-JRNL-OPERATION-RQST.        
           MOVE WS-C                  TO WS-JRNL-SOURCE-CODE.           
                                                                        
           IF CASH-TRANSACTION                                          
              MOVE WS-JRNL-CASH-UPDATE     TO WS-JRNL-OL-AUTH-TYPE      
           ELSE                                                         
              MOVE WS-JRNL-NON-CASH-UPDATE TO WS-JRNL-OL-AUTH-TYPE
           END-IF.     
           IF WS-PAR-VALIDATE-JRNL = 'Y'                                
              PERFORM 6400-ONLINE-JRNL-ROUTINE  THRU 6400-EXIT          
           END-IF.                                                      
                                                                        
           MOVE WS-A            TO WS-100-JRNL-SORT-ID.                 
           MOVE AT-ACCOUNT-NO   TO WS-100-ACCT-NO.                      
           MOVE AT-CUSTOMER-NO  TO WS-100-CUSTOMER-NO.                  
           MOVE AT-PREMISE-NO   TO WS-100-PREMISE-NO.                   
           MOVE 'S396'          TO WS-100-CODE-TERMINAL-TRAN.           
           ADD 1                TO WS-100-JRNL-TRAN-APPL-NO.            
           MOVE WS-CURRENT-DATE TO WS-100-DATE-LAST-ACTION              
                                   AT-DATE-LAST-ACTION.                 
           MOVE WS-C            TO WS-100-CODE-ENTRY-SOURCE.            
           MOVE AT-LOCAL-OFFICE TO WS-100-LOCAL-OFFICE-CD.              
                                                                        
           MOVE WS-JRNL-OL-COMPANY      TO WS-PAR-COMPANY-NO.           
           MOVE WS-JRNL-OL-LOC-OFF      TO WS-PAR-LOCAL-OFFICE.         
           MOVE WS-JRNL-OL-REPORT-NO    TO WS-PAR-REPORT-NO.            
           MOVE WS-JRNL-OL-REPORT-DT    TO WS-PAR-REPORT-DATE.          
           MOVE WS-JRNL-OL-CASH-DRWR    TO WS-PAR-CASH-DRAWER.          
           MOVE WS-TERM-LOC             TO WS-PAR-ACCESS-LOC.           
           MOVE PARM-USER-ID            TO WS-PAR-OPERATOR-ID.          
           MOVE PF-RESP-AREA-ID         TO WS-PAR-RESP-AREA.            
           MOVE WS-I                    TO WS-PAR-CODE-TRAN-TYPE.       
      *    MOVE PANEL-NAME              TO WS-PAR-APPL-PROG-ID.                 
                                                                        
T16792     EVALUATE PARM-RECV-TYPE                                      
              WHEN CREDIT-CNT                                           
T11797           MOVE 'PANEL310E'    TO WS-PAR-APPL-PROG-ID             
              WHEN CREDIT-LPC                                           
                 MOVE 'PANEL310A'    TO WS-PAR-APPL-PROG-ID             
T17191           MOVE 'Y'            TO WS-PAR-CREDIT-LPC               
              WHEN CREDIT-LPN                                           
                 MOVE 'PANEL310B'    TO WS-PAR-APPL-PROG-ID             
              WHEN CREDIT-PJS                                           
                 MOVE 'PANEL310F'    TO WS-PAR-APPL-PROG-ID             
              WHEN CREDIT-NSC                                           
                 MOVE 'PANEL310C'    TO WS-PAR-APPL-PROG-ID             
              WHEN CREDIT-RCC                                           
                 MOVE 'PANEL310D'    TO WS-PAR-APPL-PROG-ID             
              WHEN CREDIT-CCA                                           
                 MOVE 'PANEL310G'    TO WS-PAR-APPL-PROG-ID             
              WHEN CREDIT-MIS                                           
T31347           IF WS-FREE-SWITCH                                      
T31347              MOVE 'PANEL310N' TO WS-PAR-APPL-PROG-ID             
T31347           ELSE                                                   
T33041              IF WS-FREE-ESTABLISH                                
T33041                 MOVE 'PANEL310P' TO WS-PAR-APPL-PROG-ID          
T33041              ELSE                                                
C34571                 IF WS-60-BILL-CREDIT                             
C34571                    MOVE 'PANEL310Y' TO WS-PAR-APPL-PROG-ID       
C34571                 ELSE                                             
                          MOVE 'PANEL310H' TO WS-PAR-APPL-PROG-ID       
C34571                 END-IF                                           
T33041              END-IF                                              
T31347           END-IF                                                 
T22179        WHEN CREDIT-RFD                                           
C29457           IF WS-EMC-RFND-2003                                    
C29457              MOVE 'PANEL310M' TO WS-PAR-APPL-PROG-ID             
C29457           ELSE                                                   
T22179              MOVE 'PANEL310R' TO WS-PAR-APPL-PROG-ID             
C29457           END-IF                                                 
T14840        WHEN CREDIT-REB                                           
T14840           MOVE 'PANEL310I'           TO WS-PAR-APPL-PROG-ID      
T14840           MOVE 'Y'                   TO WS-PAR-JOURNAL-105       
T14840           MOVE PARM-CNT-NAME-CD      TO K6-CNT-NAME-CD           
T14840           PERFORM 7730-SELECT-DFLT-CONTRACT THRU 7730-EXIT       
T14840           MOVE K6-REBATE-NOE-CODE TO WS-105-NATURE-OF-EXPENDITURE
T14840           MOVE K6-REBATE-COST-CENTER TO WS-105-COST-CENTER       
T14840           MOVE K6-REBATE-FNCTN-CODE  TO WS-105-FUNCTION-CODE     
T14840           MOVE K6-REBATE-GL-ACCT-NO  TO WS-PAR-GEN-LEDG-DB       
           END-EVALUATE.                                                
                                                                        
      *    MOVE PROGRAM-NAME            TO WS-PAR-APPL-PROG-ID.                 
      *    MOVE PARM-FACILITY-CODE      TO WS-PAR-PYMT-FACILITY-CD.             
           MOVE SPACES                  TO WS-PAR-PYMT-FACILITY-CD.     
                                                                        
           MOVE 210                     TO WS-PAR-AR-TRAN-COMMENT-LEN.  
           MOVE PARM-TRAN-COMMENT       TO WS-PAR-AR-TRAN-COMMENT-TEXT. 
                                                                        
           IF DIRECTED-PYMT                                             
      * SET UP WS-MAX-SUB IF WS-MAX-SUB=0 , SO THAT THE 5010 PAYMENT            
      * LOOP IS PERFORMED.                                                      
              IF WS-MAX-SUB = 0 THEN                                    
                 MOVE WS-SUB TO WS-MAX-SUB                              
              END-IF                                                    
              PERFORM 5010-PAYMENT-LOOP THRU 5010-EXIT                  
                 VARYING WS-SUB FROM 1 BY 1                             
                   UNTIL WS-SUB GREATER THAN WS-MAX-SUB                 
           ELSE                                                         
              IF CPD10-CAN-BE-USED                                      
                 PERFORM 6700-APPLY-PAYMENT THRU 6700-EXIT              
                 SUBTRACT WS-PAYMENT-AMOUNT-TOTAL                       
                     FROM WS-CREDIT-REMAINING                           
              ELSE                                                      
                 PERFORM 6800A-APPLY-PAYMENT THRU 6800A-EXIT            
              END-IF                                                    
              IF PYMT-WAS-NOT-SUCCESSFUL                                
T19646           IF RS-RETURN-CODE EQUAL ZERO                           
T19646              MOVE 9999 TO RS-RETURN-CODE                         
T19646           END-IF                                                 
T19646           PERFORM 8100-SEND-RESULT THRU 8100-EXIT                
T19646           PERFORM 9999-END-PROGRAM THRU 9999-EXIT                
              ELSE                                                      
                 IF WS-JRNL-CNTL = 'Y'                                  
                    MOVE WS-JRNL-CNTRL-ONLY TO WS-JRNL-OPERATION-RQST   
                    PERFORM 6400-ONLINE-JRNL-ROUTINE THRU 6400-EXIT     
                    IF WS-JRNL-RTRN-CODE NOT EQUAL SPACES               
                       MOVE PROGRAM-NAME         TO ABEND-PROGRAM       
                       MOVE '5000'               TO ACTIVE-PARAGRAPH    
                       MOVE 'USERABEN'           TO ABEND-FUNCTION      
                       MOVE WS-YES               TO WS-USER-FORCE-ABEND 
                       MOVE 'JOURNAL ABEND'      TO DSNTIAR-MESSAGE-1   
                       PERFORM 9700-PROCESS-ABEND THRU 9700-EXIT        
                    END-IF                                              
                 END-IF                                                 
              END-IF                                                    
           END-IF.                                                      
                                                                        
       5000-EXIT.                                                       
           EXIT.                                                        
                                                                        
      ********************************************************                  
      * 5010-PAYMENT-LOOP                                    *                  
      *   PROCESS THE LOOPING LOGIC TO POST TO MULTIPLE      *                  
      *   DIRECTED RECEIVABLES.  MAXIMUM OF TWO DIRECTED:    *                  
      *   1) CREDIT RECV THAT WARRENTS CREDIT UP TO THE      *                  
      *      TOTAL AMOUNT OWED                                                  
      *   2) CREDIT REMAINING CREDIT (OVER AND ABOVE) TO     *                  
      *      DIRECTED DISTRIBUTED RECEIVABLE.                *                  
      ********************************************************                  
       5010-PAYMENT-LOOP.                                               
                                                                        
           MOVE '5010' TO ACTIVE-PARAGRAPH.                             
                                                                        
           MOVE WS-DIR-PAY-AMT (WS-SUB)        TO WS-PAYMENT-AMOUNT.    
           MOVE WS-DIR-PAY-REC-TYPE (WS-SUB)   TO WS-PAR-TYPE.          
           MOVE WS-DIR-PAY-ITEM-ID (WS-SUB)    TO WS-PAR-TYPE-NO.       
           MOVE WS-DIR-PAY-AHEAD-TYPE (WS-SUB) TO WS-PAR-PAY-AHEAD.     
           MOVE WS-DIR-PAY-CHRG-OFF (WS-SUB)   TO WS-PAR-PAY-CHRG-OFF.  
                                                                        
           IF CPD10-CAN-BE-USED                                         
              PERFORM 6700-APPLY-PAYMENT THRU 6700-EXIT                 
      *       SUBTRACT WS-PAYMENT-AMOUNT ** WS-PAYMENT-AMOUNT IS                
      *                                     CHANGED BY CPD00010                 
              SUBTRACT WS-DIR-PAY-AMT (WS-SUB)                          
                  FROM WS-CREDIT-REMAINING                              
           ELSE                                                         
              PERFORM 6800A-APPLY-PAYMENT THRU 6800A-EXIT
           END-IF.              
                                                                        
           IF PYMT-WAS-NOT-SUCCESSFUL                                   
T19646        IF RS-RETURN-CODE EQUAL ZERO                              
T19646           MOVE 9999 TO RS-RETURN-CODE                            
T19646        END-IF                                                    
T19646        PERFORM 8100-SEND-RESULT THRU 8100-EXIT                   
T19646        PERFORM 9999-END-PROGRAM THRU 9999-EXIT                   
           END-IF.                                                      
                                                                        
      *    PERFORM 6705-UPDATE-ACCOUNT THRU 6705-EXIT.                          
           IF WS-JRNL-CNTL = 'Y'                                        
              MOVE WS-JRNL-CNTRL-ONLY TO WS-JRNL-OPERATION-RQST         
              PERFORM 6400-ONLINE-JRNL-ROUTINE THRU 6400-EXIT           
              IF WS-JRNL-RTRN-CODE NOT EQUAL SPACES                     
                 MOVE PROGRAM-NAME            TO ABEND-PROGRAM          
                 MOVE '5010'                  TO ACTIVE-PARAGRAPH       
                 MOVE 'USERABEN'              TO ABEND-FUNCTION         
                 MOVE WS-YES                  TO WS-USER-FORCE-ABEND    
                 MOVE SPACES                  TO DSNTIAR-MESSAGE-1      
                 PERFORM 9700-PROCESS-ABEND      THRU 9700-EXIT         
              END-IF                                                    
           END-IF.                                                      
                                                                        
       5010-EXIT.                                                       
           EXIT.                                                        
                                                                        
      *****************************************************************         
      * 5800-DETERMINE-GL-NUMBERS                                               
      * LOAD G/L NUMBERS                                                        
      *****************************************************************         
       5800-DETERMINE-GL-NUMBERS.                                       
                                                                        
           PERFORM 5805-LOAD-GL-NUMBERS THRU 5805-EXIT.                 
                                                                        
           MOVE PARM-DB-GL-NUMBER             TO WS-PARM-DB-GL-NUMBER   
C29457                                           WS-GL-DEBIT-ID-SW.     
           MOVE WS-PARM-DB-GL-NUMBER          TO WS-GL-ACCT-DEBIT       
                                                 AU-GL-ACCT-DEBIT       
                                                 WS-PAR-GEN-LEDG-DB.    
                                                                        
       5800-EXIT.                                                       
           EXIT.                                                        
                                                                        
      ******************************************************************        
      * 5805-LOAD-GL-NUMBERS.                                          *        
      * LOAD ALL G/L NUMBER, INCLUDEING CHARGED OFF.                   *        
      ******************************************************************        
       5805-LOAD-GL-NUMBERS.                                            
                                                                        
T24436     PERFORM 9350-LINK-SCSCO061      THRU 9350-EXIT.              
                                                                        
C24555     PERFORM VARYING WS-VALID-CO-SUB FROM 1 BY 1                  
C24555        UNTIL WS-VALID-CO-SUB > 5                                 
C24555           OR WS-VALID-CO-NO (WS-VALID-CO-SUB) = '01'             
C24555           OR WS-VALID-CO-NO (WS-VALID-CO-SUB) = WS-GL-99         
C24555     IF WS-VALID-CO-NO (WS-VALID-CO-SUB) = '01'                   
              MOVE WS-Y TO WS-COMPANY-IN-TABLE                          
           END-IF                                                       
           END-PERFORM.                                                 
                                                                        
       5805-EXIT.                                                       
           EXIT.                                                        
                                                                        
      *****************************************************************         
      * 6800A-APPLY-PAYMENT                                           *         
      *   PARAGRAGH CLONED FROM CPD000010 - 6700A TO WORK FOR MONEY   *         
      *   DIRECTED TO RECV-TYPE, AS WELL AS, INDIV AR-AGING BUCKETS   *         
      *****************************************************************         
       6800A-APPLY-PAYMENT.                                             
                                                                        
           MOVE WS-AMT-CASH         TO WS-PAYMENT-AMOUNT                
                                       WS-PAYMENT-AMOUNT-TOTAL          
      *                                WS-REMAINING-PYMT-AMT                    
                                       WS-PAR-ORIG-AMT-ENTERED          
                                       AT-LAST-PYMT-AMOUNT.             
                                                                        
           MOVE WS-PAR-YES          TO WS-WAS-PYMT-SUCCESSFUL           
                                       WS-PAR-FIRST-TIME.               
      ***********                                                               
      * VALIDATE OPERATOR FIRST                                                 
      ***********                                                               
           PERFORM 6792-VALIDATE-OPER THRU 6792-EXIT.                   
           IF PYMT-WAS-SUCCESSFUL                                       
              NEXT SENTENCE                                             
           ELSE                                                         
              MOVE WS-PAR-NO TO WS-WAS-PYMT-SUCCESSFUL                  
              MOVE WS-D0300  TO WS-PAR-MESSAGE-NO                       
              GO TO 6800A-EXIT                                          
           END-IF                                                       
      ***********                                                               
      * PROCESS DIRECTED AR-CNTL TO INDIVIDUAL BUCKETS                          
      ***********                                                               
                                                                        
           MOVE SPACES                TO WS-RVC-CHG-CREATED.            
           MOVE WS-PAR-NO             TO WS-UTL-CREATED.                
           MOVE SPACES                TO WS-DATE-BREAKDOWN.             
           MOVE AT-ACCOUNT-NO         TO AC-ACCOUNT-NO.                 
                                                                        
           PERFORM 6701-SELECT-ACCOUNT THRU 6701-EXIT.                  
                                                                        
           MOVE AT-CODES-DATA-PRESENT TO WS-CODES-DATA-PRESENT          
                                         WS-PAR-SEG-PRESENCE.           
           MOVE AT-TOTAL-AR-BALANCE   TO WS-PAR-HOLD-AR-BALANCE.        
                                                                        
           MOVE WS-CURRENT-DATE       TO WS-DATE-BREAKDOWN.             
                                                                        
           MOVE WS-PAYMENT-AMOUNT       TO WS-REMAINING-PYMT-AMT.       
           MOVE WS-PAYMENT-AMOUNT-TOTAL TO WS-PAR-ORIG-AMT-ENTERED      
                                           AT-LAST-PYMT-AMOUNT.         
                                                                        
           MOVE WS-PAR-YES TO WS-IS-THIS-DIRECTED-PYMT.                 
           PERFORM 6810A-DIRECTED-PYMT THRU 6810A-EXIT.                 
                                                                        
           IF PYMT-WAS-SUCCESSFUL                                       
              PERFORM 6793-CHECK-AR-CNTRL-FOR-DLET THRU 6793-EXIT       
              MOVE WS-CURRENT-DATE TO AT-DATE-LAST-ACTION               
              SUBTRACT WS-PAYMENT-AMOUNT FROM AT-TOTAL-AR-BALANCE       
              IF RVC-CHG-CREATED                                        
                 MOVE WS-PAR-A TO WS-CODE-RVC-ACCT                      
T19646        END-IF                                                    
T19646     ELSE                                                         
T19646        GO TO 6800A-EXIT                                          
T19646     END-IF.                                                      
                                                                        
           MOVE WS-CODES-DATA-PRESENT TO AT-CODES-DATA-PRESENT.         
           MOVE WS-CURRENT-DATE       TO AT-DATE-LAST-ACTION            
                                         AT-LAST-PYMT-DATE.             
                                                                        
           PERFORM 6705-UPDATE-ACCOUNT THRU 6705-EXIT.                  
                                                                        
       6800A-EXIT.                                                      
           EXIT.                                                        
                                                                        
      *****************************************************************         
      * 6810A-DIRECTED-PAYMENT                                        *         
      *   PARAGRAGH CLONED FROM CPD000010 - 6710A TO WORK FOR MONEY   *         
      *   DIRECTED TO RECV-TYPE, AS WELL AS, INDIV AR-AGING BUCKETS   *         
      *****************************************************************         
       6810A-DIRECTED-PYMT.                                             
                                                                        
           MOVE AT-ACCOUNT-NO  TO AC-ACCOUNT-NO.                        
T19646     IF WS-PAR-TYPE NOT EQUAL ZERO                                
T19646        MOVE WS-PAR-TYPE TO AC-PYMT-PRIORITY-LVL                  
T19646     ELSE                                                         
T19646        MOVE PARM-PYMT-PRIORITY-LVL TO AC-PYMT-PRIORITY-LVL       
T19646     END-IF.                                                      
           MOVE ZEROES         TO AC-ITEM-ID.                           
           PERFORM 6702-SELECT-AGING-SUMM THRU 6702-EXIT.               
                                                                        
           IF WS-ACTIVE-RETURN-CODE EQUAL NOT-FOUND                     
T19646        MOVE WS-ACTIVE-RETURN-CODE TO RS-RETURN-CODE              
              MOVE WS-PAR-NO TO WS-WAS-PYMT-SUCCESSFUL                  
              MOVE WS-D0297  TO WS-PAR-MESSAGE-NO                       
              GO TO 6810A-EXIT                                          
           ELSE                                                         
              MOVE AC-AMT-AR-DAY-00     TO WS-SUMM-AMT-AR-DAY-00        
              MOVE AC-AMT-AR-DAY-30     TO WS-SUMM-AMT-AR-DAY-30        
              MOVE AC-AMT-AR-DAY-60     TO WS-SUMM-AMT-AR-DAY-60        
              MOVE AC-AMT-AR-DAY-90     TO WS-SUMM-AMT-AR-DAY-90        
              MOVE AC-TOT-SUMM-UNBILLED TO WS-SUMM-TOT-SUMM-UNBILLED    
              MOVE AC-AMT-UNUSED-CR     TO WS-SUMM-AMT-UNUSED-CR
           END-IF.       
                                                                        
           IF PAR-TYPE-HAS-TRD                                          
              PERFORM 6811A-DETAIL-AGING-CONTROL THRU 6811A-EXIT        
              IF PYMT-WAS-SUCCESSFUL                                    
                 MOVE ZEROES TO AC-ITEM-ID                              
                 PERFORM 6706-UPDATE-AR-SUMMARY THRU 6706-EXIT          
              END-IF                                                    
           ELSE                                                         
              IF WS-PARM-CR-AMT-AR-DAY-90 GREATER THAN ZERO             
                 MOVE WS-PARM-CR-AMT-AR-DAY-90 TO WS-REMAINING-PYMT-AMT 
                 SUBTRACT WS-REMAINING-PYMT-AMT FROM WS-CREDIT-REMAINING
                 PERFORM 6789-UPDATE-AGING-90-SUMM THRU 6789-EXIT       
                    UNTIL WS-REMAINING-PYMT-AMT EQUAL ZEROES            
                       OR WS-SUMM-AMT-AR-DAY-90 EQUAL ZEROES            
              END-IF                                                    
              IF WS-PARM-CR-AMT-AR-DAY-60 GREATER THAN ZERO             
                 MOVE WS-PARM-CR-AMT-AR-DAY-60 TO WS-REMAINING-PYMT-AMT 
                 SUBTRACT WS-REMAINING-PYMT-AMT FROM WS-CREDIT-REMAINING
                 PERFORM 6786-UPDATE-AGING-60-SUMM THRU 6786-EXIT       
                   UNTIL WS-REMAINING-PYMT-AMT EQUAL ZEROES             
                      OR WS-SUMM-AMT-AR-DAY-60 EQUAL ZEROES             
              END-IF                                                    
              IF WS-PARM-CR-AMT-AR-DAY-30 GREATER THAN ZERO             
                 MOVE WS-PARM-CR-AMT-AR-DAY-30 TO WS-REMAINING-PYMT-AMT 
                 SUBTRACT WS-REMAINING-PYMT-AMT FROM WS-CREDIT-REMAINING
                 PERFORM 6783-UPDATE-AGING-30-SUMM THRU 6783-EXIT       
                    UNTIL WS-REMAINING-PYMT-AMT EQUAL ZEROES            
                       OR WS-SUMM-AMT-AR-DAY-30 EQUAL ZEROES            
              END-IF                                                    
              IF WS-PARM-CR-AMT-AR-DAY-00 GREATER THAN ZERO             
                 MOVE WS-PARM-CR-AMT-AR-DAY-00 TO WS-REMAINING-PYMT-AMT 
                 SUBTRACT WS-REMAINING-PYMT-AMT FROM WS-CREDIT-REMAINING
                 PERFORM 6780-UPDATE-AGING-00-SUMM THRU 6780-EXIT       
                    UNTIL WS-REMAINING-PYMT-AMT EQUAL ZEROES            
                       OR WS-SUMM-AMT-AR-DAY-00 EQUAL ZEROES            
              END-IF                                                    
              MOVE ZEROES TO AC-ITEM-ID                                 
              PERFORM 6706-UPDATE-AR-SUMMARY THRU 6706-EXIT
           END-IF.            
                                                                        
       6810A-EXIT.                                                      
           EXIT.                                                        
                                                                        
      *****************************************************************         
      * 6811A-DETAIL-AGING-CONTROL.                                   *         
      *  PARAGRAGH CLONED FROM CPD000010 - 6711A - TO WORK FOR MONEY  *         
      *  DIRECTED TO RECV-TYPE, AS WELL AS, INDIV AR-AGING BUCKETS    *         
      *****************************************************************         
       6811A-DETAIL-AGING-CONTROL.                                      
                                                                        
      *****************************************************************         
      *  THE FOLLOWING LOGIC WOULD ALLOW A CREDIT/PAYMENT TO BE                 
      *  PROCESSED AGAINST THE SUMMARY LEVEL OF A RECEIVABLE                    
      *****************************************************************         
      *                                                                         
      *    IF WS-PAR-TYPE-NO EQUAL ZEROES                                       
      *       MOVE ZEROES TO AC-ITEM-ID                                         
      *       PERFORM 6704A-OPEN-AGING-DETAIL  THRU 6704A-EXIT                  
      *       PERFORM 6713-PROCESS-ALL-DETAILS THRU 6713-EXIT                   
      *       PERFORM 6704C-CLOSE-AGING-DETAIL THRU 6704C-EXIT                  
      *       GO TO 6811A-EXIT                                                  
      *    ELSE                                                                 
           MOVE WS-PAR-TYPE-NO TO AC-ITEM-ID.                           
                                                                        
           PERFORM 6702A-SELECT-AGING-DETAIL THRU 6702A-EXIT.           
                                                                        
           IF WS-ACTIVE-RETURN-CODE EQUAL NOT-FOUND                     
              MOVE WS-D0297  TO WS-PAR-MESSAGE-NO                       
              MOVE WS-PAR-NO TO WS-WAS-PYMT-SUCCESSFUL                  
              GO TO 6711-EXIT                                           
           END-IF.                                                      
           IF WS-PARM-CR-AMT-AR-DAY-90 GREATER THAN ZERO                
              MOVE WS-PARM-CR-AMT-AR-DAY-90 TO WS-REMAINING-PYMT-AMT    
              SUBTRACT WS-REMAINING-PYMT-AMT FROM WS-CREDIT-REMAINING   
              PERFORM 6779-UPDATE-AGING-90-DETAIL THRU 6779-EXIT        
                 UNTIL (WS-REMAINING-PYMT-AMT EQUAL ZEROES)             
                    OR (AC-AMT-AR-DAY-90 EQUAL ZEROES)                  
           END-IF.                                                      
           IF WS-PARM-CR-AMT-AR-DAY-60 GREATER THAN ZERO                
              MOVE WS-PARM-CR-AMT-AR-DAY-60 TO WS-REMAINING-PYMT-AMT    
              SUBTRACT WS-REMAINING-PYMT-AMT FROM WS-CREDIT-REMAINING   
              PERFORM 6776-UPDATE-AGING-60-DETAIL THRU 6776-EXIT        
                 UNTIL (WS-REMAINING-PYMT-AMT EQUAL ZEROES)             
                    OR (AC-AMT-AR-DAY-60 EQUAL ZEROES)                  
           END-IF.                                                      
           IF WS-PARM-CR-AMT-AR-DAY-30 GREATER THAN ZERO                
              MOVE WS-PARM-CR-AMT-AR-DAY-30 TO WS-REMAINING-PYMT-AMT    
              SUBTRACT WS-REMAINING-PYMT-AMT FROM WS-CREDIT-REMAINING   
              PERFORM 6773-UPDATE-AGING-30-DETAIL THRU 6773-EXIT        
                 UNTIL (WS-REMAINING-PYMT-AMT EQUAL ZEROES)             
                    OR (AC-AMT-AR-DAY-30 EQUAL ZEROES)                  
           END-IF.                                                      
           IF WS-PARM-CR-AMT-AR-DAY-00 GREATER THAN ZERO                
              MOVE WS-PARM-CR-AMT-AR-DAY-00 TO WS-REMAINING-PYMT-AMT    
              SUBTRACT WS-REMAINING-PYMT-AMT FROM WS-CREDIT-REMAINING   
              PERFORM 6770-UPDATE-AGING-00-DETAIL THRU 6770-EXIT        
                 UNTIL (WS-REMAINING-PYMT-AMT EQUAL ZEROES)             
                    OR (AC-AMT-AR-DAY-00 EQUAL ZEROES)                  
           END-IF.                                                      
                                                                        
       6811A-EXIT.                                                      
           EXIT.                                                        
                                                                        
      *****************************************************************         
      * JOURNALING COPYBOOK PROCEDURE CODE                                      
      *****************************************************************         
                                                                        
           EXEC SQL                                                             
             INCLUDE CPD00003                                                   
           END-EXEC.                                                            
                                                                        
           EXEC SQL                                                             
A00956       INCLUDE CPD0006A                                                   
           END-EXEC.                                                            
                                                                        
           EXEC SQL                                                             
              INCLUDE CPD00008                                                  
           END-EXEC.                                                            
                                                                        
           EXEC SQL                                                             
              INCLUDE CPD0010S                                                  
           END-EXEC.                                                            
           COPY CPD00010.                                                       
           EXEC SQL                                                             
              INCLUDE CPD00073                                                  
           END-EXEC.                                                            
                                                                        
      *****************************************************************         
      * 7000-SELECT-AT-PR-CU.                                         *         
      *  DATABASE SELECTS                                             *         
      *****************************************************************         
       7000-SELECT-AT-PR-CU.                                            
           EXEC SQL                                                     
              SELECT AT.CUSTOMER_NO,                                    
A36248               AT.BILL_CYCLE,                                     
                     AT.CODE_ACCT_STAT,                                 
A37061               AT.ACCOUNT_TYPE_CODE,                              
                     AT.TOTAL_AR_BALANCE,                               
                     AT.DATE_LAST_ACTION,                               
                     AT.LOCAL_OFFICE,                                   
                     AT.PREMISE_NO,                                     
                     AT.CODES_DATA_PRESENT,                             
                     AT.COMPANY_NO,                                     
                     AT.AR_XFER_IND,                                    
                     AT.ACCT_XFER_TO,                                   
                     AT.BANKRUPTCY_IND,                                 
                     AT.CREDIT_GROUP,                                   
                     AT.NOTICE_EXEMPT_CD,                               
                     AT.CODE_DISC_OK,                                   
                     AT.DATE_BILL_DAY_00,                               
                     AT.DATE_BILL_DAY_30,                               
                     AT.DATE_BILL_DAY_60,                               
                     AT.DATE_BILL_DAY_90,                               
T16114               AT.ELEC_REV_ALLOC_PCT,                             
C28788               AT.IVR_EXEMPT_CD,                                  
                     PR.CODE_PREMISE_STAT,                              
                     PR.REV_DISTRICT_CD,                                
                     CU.CODE_EMPL_ACCT,                                 
                     CU.CODE_CUST_STATUS,                               
                     CAST(SYSDATETIMEOFFSET() AS DATE)                          
             INTO    :AT-CUSTOMER-NO,                                   
A36248               :AT-BILL-CYCLE,                                    
                     :AT-CODE-ACCT-STAT,                                
A37061               :AT-ACCOUNT-TYPE-CODE,                             
                     :AT-TOTAL-AR-BALANCE,                              
                     :AT-DATE-LAST-ACTION,                              
                     :AT-LOCAL-OFFICE,                                  
                     :AT-PREMISE-NO,                                    
                     :AT-CODES-DATA-PRESENT,                            
                     :AT-COMPANY-NO,                                    
                     :AT-AR-XFER-IND,                                   
                     :AT-ACCT-XFER-TO,                                  
                     :AT-BANKRUPTCY-IND,                                
                     :AT-CREDIT-GROUP,                                  
                     :AT-NOTICE-EXEMPT-CD,                              
                     :AT-CODE-DISC-OK,                                  
                     :AT-DATE-BILL-DAY-00 :WS-NULL-INDICATOR-1,         
                     :AT-DATE-BILL-DAY-30 :WS-NULL-INDICATOR-2,         
                     :AT-DATE-BILL-DAY-60 :WS-NULL-INDICATOR-3,         
                     :AT-DATE-BILL-DAY-90 :WS-NULL-INDICATOR-4,         
T16114               :AT-ELEC-REV-ALLOC-PCT,                            
C28788               :AT-IVR-EXEMPT-CD,                                 
                     :PR-CODE-PREMISE-STAT,                             
                     :PR-REV-DISTRICT-CD,                               
                     :CU-CODE-EMPL-ACCT,                                
                     :CU-CODE-CUST-STATUS,                              
                     :WS-CURRENT-DATE                                   
            FROM CSS_ACCOUNT AT WITH(READUNCOMMITTED), CSS_PREMISE PR
                           WITH(READUNCOMMITTED), CSS_CUSTOMER CU
                           WITH(READUNCOMMITTED)        
            WHERE AT.ACCOUNT_NO  = :AT-ACCOUNT-NO AND                   
                  AT.PREMISE_NO  = PR.PREMISE_NO  AND                   
                  AT.CUSTOMER_NO = CU.CUSTOMER_NO                       
A36248                                                           
P00641                                                      
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ003
MFA-TR* MSQ022
MFA-TR* MSQ028
MFA-TR*    EXEC SQL                                                             
MFA-TR*       SELECT AT.CUSTOMER_NO,                                            
MFA-TR*              AT.BILL_CYCLE,                                             
MFA-TR*              AT.CODE_ACCT_STAT,                                         
MFA-TR*              AT.ACCOUNT_TYPE_CODE,                                      
MFA-TR*              AT.TOTAL_AR_BALANCE,                                       
MFA-TR*              AT.DATE_LAST_ACTION,                                       
MFA-TR*              AT.LOCAL_OFFICE,                                           
MFA-TR*              AT.PREMISE_NO,                                             
MFA-TR*              AT.CODES_DATA_PRESENT,                                     
MFA-TR*              AT.COMPANY_NO,                                             
MFA-TR*              AT.AR_XFER_IND,                                            
MFA-TR*              AT.ACCT_XFER_TO,                                           
MFA-TR*              AT.BANKRUPTCY_IND,                                         
MFA-TR*              AT.CREDIT_GROUP,                                           
MFA-TR*              AT.NOTICE_EXEMPT_CD,                                       
MFA-TR*              AT.CODE_DISC_OK,                                           
MFA-TR*              AT.DATE_BILL_DAY_00,                                       
MFA-TR*              AT.DATE_BILL_DAY_30,                                       
MFA-TR*              AT.DATE_BILL_DAY_60,                                       
MFA-TR*              AT.DATE_BILL_DAY_90,                                       
MFA-TR*              AT.ELEC_REV_ALLOC_PCT,                                     
MFA-TR*              AT.IVR_EXEMPT_CD,                                          
MFA-TR*              PR.CODE_PREMISE_STAT,                                      
MFA-TR*              PR.REV_DISTRICT_CD,                                        
MFA-TR*              CU.CODE_EMPL_ACCT,                                         
MFA-TR*              CU.CODE_CUST_STATUS,                                       
MFA-TR*              CURRENT DATE                                               
MFA-TR*      INTO    :AT-CUSTOMER-NO,                                           
MFA-TR*              :AT-BILL-CYCLE,                                            
MFA-TR*              :AT-CODE-ACCT-STAT,                                        
MFA-TR*              :AT-ACCOUNT-TYPE-CODE,                                     
MFA-TR*              :AT-TOTAL-AR-BALANCE,                                      
MFA-TR*              :AT-DATE-LAST-ACTION,                                      
MFA-TR*              :AT-LOCAL-OFFICE,                                          
MFA-TR*              :AT-PREMISE-NO,                                            
MFA-TR*              :AT-CODES-DATA-PRESENT,                                    
MFA-TR*              :AT-COMPANY-NO,                                            
MFA-TR*              :AT-AR-XFER-IND,                                           
MFA-TR*              :AT-ACCT-XFER-TO,                                          
MFA-TR*              :AT-BANKRUPTCY-IND,                                        
MFA-TR*              :AT-CREDIT-GROUP,                                          
MFA-TR*              :AT-NOTICE-EXEMPT-CD,                                      
MFA-TR*              :AT-CODE-DISC-OK,                                          
MFA-TR*              :AT-DATE-BILL-DAY-00 :WS-NULL-INDICATOR-1,                 
MFA-TR*              :AT-DATE-BILL-DAY-30 :WS-NULL-INDICATOR-2,                 
MFA-TR*              :AT-DATE-BILL-DAY-60 :WS-NULL-INDICATOR-3,                 
MFA-TR*              :AT-DATE-BILL-DAY-90 :WS-NULL-INDICATOR-4,                 
MFA-TR*              :AT-ELEC-REV-ALLOC-PCT,                                    
MFA-TR*              :AT-IVR-EXEMPT-CD,                                         
MFA-TR*              :PR-CODE-PREMISE-STAT,                                     
MFA-TR*              :PR-REV-DISTRICT-CD,                                       
MFA-TR*              :CU-CODE-EMPL-ACCT,                                        
MFA-TR*              :CU-CODE-CUST-STATUS,                                      
MFA-TR*              :WS-CURRENT-DATE                                           
MFA-TR*     FROM CSS_ACCOUNT AT, CSS_PREMISE PR, CSS_CUSTOMER CU                
MFA-TR*     WHERE AT.ACCOUNT_NO  = :AT-ACCOUNT-NO AND                           
MFA-TR*           AT.PREMISE_NO  = PR.PREMISE_NO  AND                           
MFA-TR*           AT.CUSTOMER_NO = CU.CUSTOMER_NO                               
MFA-TR*      WITH UR                                                            
MFA-TR*      QUERYNO 7000                                                       
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 EQUAL SUCCESSFUL-CALL               
              NEXT SENTENCE                                             
           ELSE                                                         
              MOVE WS-ACTIVE-RETURN-CODE TO RS-RETURN-CODE              
              MOVE PROGRAM-NAME          TO ABEND-PROGRAM               
              MOVE '7000'                TO ACTIVE-PARAGRAPH            
              MOVE 'SELECT'              TO ABEND-FUNCTION              
              MOVE SPACES                TO ABEND-SQL-PREDICATES        
                                            ABEND-TABLES                
              MOVE 'CSS_ACCOUNT'         TO TABLE-1                     
CBSI          MOVE 'CSS_PREMISE'         TO TABLE-2                     
CBSI          MOVE 'CSS_CUSTOMER'        TO TABLE-3                     
CBSI          MOVE 'ACCOUNT_NO'          TO TABLE-ELEMENT-1             
              MOVE AT-ACCOUNT-NO         TO HOSTVAR-ELEMENT-1           
              PERFORM 9700-PROCESS-ABEND      THRU 9700-EXIT            
           END-IF.                                                      
       7000-EXIT.                                                       
           EXIT.                                                        
                                                                        
      *****************************************************************         
      * 7010-GET-INTEREST-INFO.                                                 
      *****************************************************************         
       7010-GET-INTEREST-INFO.                                          
           EXEC SQL                                                     
              SELECT CODE_CONTRACT_TYPE,                                
                     SIMPLE_INT_FIN_CHG,                                
                     AMT_DEF_INTEREST,                                  
                     GL_ACCT_NO_ERN_INT,                                
                     GL_ACCT_NO_DEF_INT                                 
                INTO :CT-CODE-CONTRACT-TYPE,                            
                     :CT-SIMPLE-INT-FIN-CHG,                            
                     :CT-AMT-DEF-INTEREST,                              
                     :CT-GL-ACCT-NO-ERN-INT,                            
                     :CT-GL-ACCT-NO-DEF-INT                             
                FROM CSS_CONTRACT WITH(READUNCOMMITTED)                         
               WHERE ACCOUNT_NO        = :CT-ACCOUNT-NO                 
                 AND PYMT_PRIORITY_LVL = :CT-PYMT-PRIORITY-LVL          
                 AND CNT_ITEM_ID       = :CT-CNT-ITEM-ID                
P00641                                                           
P00641                                                      
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ003
MFA-TR* MSQ022
MFA-TR*    EXEC SQL                                                             
MFA-TR*       SELECT CODE_CONTRACT_TYPE,                                        
MFA-TR*              SIMPLE_INT_FIN_CHG,                                        
MFA-TR*              AMT_DEF_INTEREST,                                          
MFA-TR*              GL_ACCT_NO_ERN_INT,                                        
MFA-TR*              GL_ACCT_NO_DEF_INT                                         
MFA-TR*         INTO :CT-CODE-CONTRACT-TYPE,                                    
MFA-TR*              :CT-SIMPLE-INT-FIN-CHG,                                    
MFA-TR*              :CT-AMT-DEF-INTEREST,                                      
MFA-TR*              :CT-GL-ACCT-NO-ERN-INT,                                    
MFA-TR*              :CT-GL-ACCT-NO-DEF-INT                                     
MFA-TR*         FROM CSS_CONTRACT                                               
MFA-TR*        WHERE ACCOUNT_NO        = :CT-ACCOUNT-NO                         
MFA-TR*          AND PYMT_PRIORITY_LVL = :CT-PYMT-PRIORITY-LVL                  
MFA-TR*          AND CNT_ITEM_ID       = :CT-CNT-ITEM-ID                        
MFA-TR*      WITH UR                                                            
MFA-TR*      QUERYNO 7010                                                       
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 EQUAL SUCCESSFUL-CALL OR NOT-FOUND  
              NEXT SENTENCE                                             
           ELSE                                                         
              MOVE PROGRAM-NAME              TO ABEND-PROGRAM           
CBSI          MOVE '7010'                    TO ACTIVE-PARAGRAPH        
              MOVE 'SELECT'                  TO ABEND-FUNCTION          
              MOVE 'CSS_CONTRACT'            TO TABLE-1                 
CBSI          MOVE 'ACCOUNT_NO'              TO TABLE-ELEMENT-1         
CBSI          MOVE 'CNT_ITEM_ID'             TO TABLE-ELEMENT-2         
CBSI          MOVE 'PYMT_PRIORITY_LVL'       TO TABLE-ELEMENT-3         
              MOVE CT-ACCOUNT-NO             TO HOSTVAR-ELEMENT-1       
              MOVE CT-CNT-ITEM-ID            TO HOSTVAR-ELEMENT-2       
CBSI          MOVE CT-PYMT-PRIORITY-LVL      TO HOSTVAR-ELEMENT-3       
              PERFORM 9700-PROCESS-ABEND      THRU 9700-EXIT            
           END-IF.                                                      
       7010-EXIT.                                                       
            EXIT.                                                       
                                                                        
      *****************************************************************         
      * 7060-UPDATE-INTEREST.                                                   
      *****************************************************************         
       7060-UPDATE-INTEREST.                                            
            EXEC SQL                                                    
             UPDATE CSS_CONTRACT                                        
             SET    AMT_DEF_INTEREST    = :CT-AMT-DEF-INTEREST,         
                    SIMPLE_INT_FIN_CHG  = :CT-SIMPLE-INT-FIN-CHG        
                    WHERE ACCOUNT_NO        = :CT-ACCOUNT-NO            
                    AND   PYMT_PRIORITY_LVL = :CT-PYMT-PRIORITY-LVL     
                    AND   CNT_ITEM_ID       = :CT-CNT-ITEM-ID           
            END-EXEC.                                                   

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

                                                                        
           MOVE SQLCODE TO WS-ACTIVE-RETURN-CODE.                       
           IF WS-ACTIVE-RETURN-CODE EQUAL SUCCESSFUL-CALL               
              NEXT SENTENCE                                             
           ELSE                                                         
              MOVE WS-ACTIVE-RETURN-CODE TO RS-RETURN-CODE              
              MOVE PROGRAM-NAME          TO ABEND-PROGRAM               
              MOVE '7060'                TO ACTIVE-PARAGRAPH            
              MOVE 'UPDATE'              TO ABEND-FUNCTION              
              MOVE SPACES                TO ABEND-SQL-PREDICATES        
                                            ABEND-TABLES                
              MOVE 'CSS_CONTRACT'        TO TABLE-1                     
CBSI          MOVE 'ACCOUNT_NO'          TO TABLE-ELEMENT-1             
CBSI          MOVE 'PYMT_PRIORITY_LVL'   TO TABLE-ELEMENT-2             
CBSI          MOVE 'CNT_ITEM_ID'         TO TABLE-ELEMENT-3             
CBSI          MOVE 'AMT_DEF_INTEREST'    TO TABLE-ELEMENT-4             
              MOVE AT-ACCOUNT-NO         TO HOSTVAR-ELEMENT-1           
CBSI          MOVE CT-PYMT-PRIORITY-LVL  TO HOSTVAR-ELEMENT-2           
CBSI          MOVE CT-CNT-ITEM-ID        TO HOSTVAR-ELEMENT-3           
CBSI          MOVE CT-AMT-DEF-INTEREST   TO HOSTVAR-ELEMENT-4-N         
              PERFORM 9700-PROCESS-ABEND      THRU 9700-EXIT            
           END-IF.                                                      
                                                                        
       7060-EXIT.                                                       
           EXIT.                                                        
                                                                        
      *****************************************************************         
      * 7100-SELECT-AR-CNTL                                                     
      *****************************************************************         
       7100-SELECT-AR-CNTL.                                             
           EXEC SQL                                                     
               SELECT 'YES',                                            
                      ACCOUNT_NO,                                       
                      ITEM_ID,                                          
                      PYMT_PRIORITY_LVL,                                
                      AMT_AR_DAY_00,                                    
                      AMT_AR_DAY_30,                                    
                      AMT_AR_DAY_60,                                    
                      AMT_AR_DAY_90,                                    
                      REPLACE(REPLACE(CONVERT(CHAR(26), LAST_UPDATE_TS
           , 121), ' ', '-'), ':', '.') LAST_UPDATE_TS,                        
T18526                TOT_SUMM_UNBILLED,                                
T18526                AMT_TRAN_BALANCE                                  
               INTO   :WS-AR-CNTL-EXISTS-FLAG,                          
                      :AC-ACCOUNT-NO,                                   
                      :AC-ITEM-ID,                                      
                      :AC-PYMT-PRIORITY-LVL,                            
                      :AC-AMT-AR-DAY-00,                                
                      :AC-AMT-AR-DAY-30,                                
                      :AC-AMT-AR-DAY-60,                                
                      :AC-AMT-AR-DAY-90,                                
                      :AC-LAST-UPDATE-TS,                               
T18526                :AC-TOT-SUMM-UNBILLED,                            
T18526                :AC-AMT-TRAN-BALANCE                              
               FROM   CSS_AR_CNTL WITH(READUNCOMMITTED)                         
               WHERE  ACCOUNT_NO        = :AC-ACCOUNT-NO                
               AND    ITEM_ID           = :AC-ITEM-ID                   
               AND    PYMT_PRIORITY_LVL = :AC-PYMT-PRIORITY-LVL         
P00641                                                           
P00641                                                      
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ003
MFA-TR* MSQ022
MFA-TR* MSQ061
MFA-TR*    EXEC SQL                                                             
MFA-TR*        SELECT 'YES',                                                    
MFA-TR*               ACCOUNT_NO,                                               
MFA-TR*               ITEM_ID,                                                  
MFA-TR*               PYMT_PRIORITY_LVL,                                        
MFA-TR*               AMT_AR_DAY_00,                                            
MFA-TR*               AMT_AR_DAY_30,                                            
MFA-TR*               AMT_AR_DAY_60,                                            
MFA-TR*               AMT_AR_DAY_90,                                            
MFA-TR*               LAST_UPDATE_TS,                                           
MFA-TR*               TOT_SUMM_UNBILLED,                                        
MFA-TR*               AMT_TRAN_BALANCE                                          
MFA-TR*        INTO   :WS-AR-CNTL-EXISTS-FLAG,                                  
MFA-TR*               :AC-ACCOUNT-NO,                                           
MFA-TR*               :AC-ITEM-ID,                                              
MFA-TR*               :AC-PYMT-PRIORITY-LVL,                                    
MFA-TR*               :AC-AMT-AR-DAY-00,                                        
MFA-TR*               :AC-AMT-AR-DAY-30,                                        
MFA-TR*               :AC-AMT-AR-DAY-60,                                        
MFA-TR*               :AC-AMT-AR-DAY-90,                                        
MFA-TR*               :AC-LAST-UPDATE-TS,                                       
MFA-TR*               :AC-TOT-SUMM-UNBILLED,                                    
MFA-TR*               :AC-AMT-TRAN-BALANCE                                      
MFA-TR*        FROM   CSS_AR_CNTL                                               
MFA-TR*        WHERE  ACCOUNT_NO        = :AC-ACCOUNT-NO                        
MFA-TR*        AND    ITEM_ID           = :AC-ITEM-ID                           
MFA-TR*        AND    PYMT_PRIORITY_LVL = :AC-PYMT-PRIORITY-LVL                 
MFA-TR*      WITH UR                                                            
MFA-TR*      QUERYNO 7100                                                       
MFA-TR*    END-EXEC.                                                            

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

                                                                        
           MOVE SQLCODE TO WS-ACTIVE-RETURN-CODE.                       
                                                                        
           IF WS-ACTIVE-RETURN-CODE = NOT-FOUND AND                     
              CHECKING-FOR-CREDIT-TYPE                                  
                 NEXT SENTENCE                                          
           ELSE                                                         
              IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL                
                 IF AR-CNTL-CHANGED-CHECK                               
                    IF AC-LAST-UPDATE-TS NOT = PARM-AC-LAST-UPDATE-TS   
      *******>         RECORD WAS UPDATED WHILE WE WERE CREDITING               
                       MOVE -2 TO SQLCODE                               
                       MOVE -2 TO WS-ACTIVE-RETURN-CODE                 
                       MOVE PROGRAM-NAME         TO ABEND-PROGRAM       
                       MOVE '7100'               TO ACTIVE-PARAGRAPH    
                       MOVE 'SELECT'             TO ABEND-FUNCTION      
                       MOVE 'CSS_AR_CNTL'        TO TABLE-1             
                       MOVE 'ACCOUNT_NO'         TO TABLE-ELEMENT-1     
                       MOVE 'ITEM_ID'            TO TABLE-ELEMENT-2     
                       MOVE 'PYMT_PRIORITY_LVL'  TO TABLE-ELEMENT-3     
                       MOVE AC-ACCOUNT-NO        TO HOSTVAR-ELEMENT-1   
                       MOVE AC-ITEM-ID           TO HOSTVAR-ELEMENT-2   
                       MOVE AC-PYMT-PRIORITY-LVL TO HOSTVAR-ELEMENT-3   
                       PERFORM 9700-PROCESS-ABEND THRU 9700-EXIT        
                    END-IF                                              
                 END-IF                                                 
              ELSE                                                      
                 MOVE PROGRAM-NAME         TO ABEND-PROGRAM             
                 MOVE '7100'               TO ACTIVE-PARAGRAPH          
                 MOVE 'SELECT'             TO ABEND-FUNCTION            
                 MOVE 'CSS_AR_CNTL'        TO TABLE-1                   
                 MOVE 'ACCOUNT_NO'         TO TABLE-ELEMENT-1           
                 MOVE 'ITEM_ID'            TO TABLE-ELEMENT-2           
                 MOVE 'PYMT_PRIORITY_LVL'  TO TABLE-ELEMENT-3           
                 MOVE AC-ACCOUNT-NO        TO HOSTVAR-ELEMENT-1         
                 MOVE AC-ITEM-ID           TO HOSTVAR-ELEMENT-2         
                 MOVE AC-PYMT-PRIORITY-LVL TO HOSTVAR-ELEMENT-3         
                 PERFORM 9700-PROCESS-ABEND   THRU 9700-EXIT            
              END-IF                                                    
           END-IF.                                                      
                                                                        
       7100-EXIT.                                                       
           EXIT.                                                        
                                                                        
T19996******************************************************************        
T19996* 7300-SELECT-GL-ACCT                                            *        
T19996******************************************************************        
T13034 7300-SELECT-GL-ACCT.                                             
T13034     EXEC SQL                                                     
T13034         SELECT GL_ACCT_NO                                        
T13034         INTO :GO-GL-ACCT-NO                                      
T13034         FROM CSS_GL_ACCT_NO WITH(READUNCOMMITTED)                        
MCR310         WHERE  COMPANY_NO        = '01'                          
T13034         AND    GL_ACCT_NAME      = :GO-GL-ACCT-NAME              
A36248                                                           
P00641                                                      
T13034     END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ003
MFA-TR* MSQ022
MFA-TR*    EXEC SQL                                                             
MFA-TR*        SELECT GL_ACCT_NO                                                
MFA-TR*        INTO :GO-GL-ACCT-NO                                              
MFA-TR*        FROM CSS_GL_ACCT_NO                                              
MFA-TR*        WHERE  COMPANY_NO        = '01'                                  
MFA-TR*        AND    GL_ACCT_NAME      = :GO-GL-ACCT-NAME                      
MFA-TR*        WITH UR                                                          
MFA-TR*      QUERYNO 7300                                                       
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

T13034                                                                  
T13034     MOVE SQLCODE TO WS-ACTIVE-RETURN-CODE                        
T13034                     RS-RETURN-CODE.                              
T13034     IF WS-ACTIVE-RETURN-CODE = NOT-FOUND OR SUCCESSFUL-CALL      
T13034        NEXT SENTENCE                                             
T13034     ELSE                                                         
T13034        MOVE PROGRAM-NAME          TO ABEND-PROGRAM               
T13034        MOVE '7300'                TO ACTIVE-PARAGRAPH            
T13034        MOVE 'SELECT'              TO ABEND-FUNCTION              
T13034        MOVE 'CSS_GL_ACCT_NO'      TO TABLE-1                     
CBSI          MOVE 'COMPANY_NO'          TO TABLE-ELEMENT-1             
CBSI          MOVE 'GL_ACCT_NAME'        TO TABLE-ELEMENT-2             
CBSI          MOVE 'ACCOUNT_NO'          TO TABLE-ELEMENT-3             
T13034        MOVE '01'                  TO HOSTVAR-ELEMENT-1           
T13034        MOVE GO-GL-ACCT-NAME       TO HOSTVAR-ELEMENT-2           
CBSI          MOVE PARM-ACCOUNT-NO       TO HOSTVAR-ELEMENT-3           
T13034        PERFORM 9700-PROCESS-ABEND THRU 9700-EXIT                 
           END-IF.                                                      
                                                                        
T13034 7300-EXIT.                                                       
T13034     EXIT.                                                        
                                                                        
T19996******************************************************************        
T19996* 7400-SELECT-MSTSUB.                                            *        
T19996******************************************************************        
T19996 7400-SELECT-MSTSUB.                                              
T19996                                                                  
T19996     EXEC SQL                                                     
T19996        SELECT MST_SUB_ACCT_IND                                   
T19996          INTO :AT-MST-SUB-ACCT-IND                               
T19996          FROM CSS_ACCOUNT WITH(READUNCOMMITTED)                          
T19996         WHERE ACCOUNT_NO  = :AT-ACCOUNT-NO                       
A36248                                                           
P00641                                                      
T19996     END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ003
MFA-TR* MSQ022
MFA-TR*    EXEC SQL                                                             
MFA-TR*       SELECT MST_SUB_ACCT_IND                                           
MFA-TR*         INTO :AT-MST-SUB-ACCT-IND                                       
MFA-TR*         FROM CSS_ACCOUNT                                                
MFA-TR*        WHERE ACCOUNT_NO  = :AT-ACCOUNT-NO                               
MFA-TR*         WITH UR                                                         
MFA-TR*      QUERYNO 7400                                                       
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

T19996                                                                  
T19996     MOVE SQLCODE TO WS-ACTIVE-RETURN-CODE.                       
T19996     IF WS-ACTIVE-RETURN-CODE EQUAL SUCCESSFUL-CALL               
T19996        NEXT SENTENCE                                             
T19996     ELSE                                                         
T19996        MOVE WS-ACTIVE-RETURN-CODE TO RS-RETURN-CODE              
T19996        MOVE PROGRAM-NAME          TO ABEND-PROGRAM               
T19996        MOVE '7400'                TO ACTIVE-PARAGRAPH            
T19996        MOVE 'SELECT'              TO ABEND-FUNCTION              
T19996        MOVE SPACES                TO ABEND-SQL-PREDICATES        
T19996                                      ABEND-TABLES                
T19996        MOVE 'CSS_ACCOUNT'         TO TABLE-1                     
T19996        MOVE 'ACCOUNT_NO'          TO TABLE-ELEMENT-1             
T19996        MOVE AT-ACCOUNT-NO         TO HOSTVAR-ELEMENT-1           
T19996        PERFORM 9700-PROCESS-ABEND      THRU 9700-EXIT            
T19996     END-IF.                                                      
T19996                                                                  
T19996 7400-EXIT.                                                       
T19996     EXIT.                                                        
                                                                        
T31347******************************************************************        
T31347* 7500-GET-COMM-DATA                                             *        
T31347* DETERMINE DATE OF 60 AND 90 DAYS AGO AND THEN CALL 7501-       *        
T31347* TO SEE IF A SPECIFIC COMMUNICATION SUBTYPE OCCURED WITHIN THAT *        
T31347* TIME PERIOD.                                                   *        
T31347******************************************************************        
       7500-GET-COMM-DATA.                                              
                                                                        
           EXEC SQL                                                     
T34097         SELECT
              DATEADD( DAY, -60, CAST(SYSDATETIMEOFFSET() AS DATE) ),
              DATEADD( DAY, -90, CAST(SYSDATETIMEOFFSET() AS DATE) )
            INTO
              :WS-60-DAYS-AGO-DT,
              :WS-90-DAYS-AGO-DT           
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ006
MFA-TR* MSQ028
MFA-TR* MSQ044
MFA-TR*    EXEC SQL                                                             
MFA-TR*        SET :WS-60-DAYS-AGO-DT = CURRENT DATE - 60 DAY                   
MFA-TR*           ,:WS-90-DAYS-AGO-DT = CURRENT DATE - 90 DAY                   
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

                                                                        
T34097     MOVE SQLCODE TO WS-ACTIVE-RETURN-CODE.                       
T34097     IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL                   
T34097        NEXT SENTENCE                                             
T34097     ELSE                                                         
T34097         MOVE PROGRAM-NAME                  TO ABEND-PROGRAM      
T34097         MOVE '7500'                        TO ACTIVE-PARAGRAPH   
T34097        PERFORM 9000-SEND-ERROR-RESULT  THRU 9000-EXIT            
T34097        PERFORM 9900-SQL-ERROR-ROUTINE  THRU 9900-EXIT            
           END-IF.                                                      
                                                                        
           MOVE WS-60-DAYS-AGO-DT         TO WS-60-DAYS-AGO(1:10)       
           MOVE '-00.00.00.000000'        TO WS-60-DAYS-AGO(11:16)      
                                                                        
C33041     MOVE WS-90-DAYS-AGO-DT         TO WS-90-DAYS-AGO(1:10)       
C33041     MOVE '-00.00.00.000000'        TO WS-90-DAYS-AGO(11:16)      
                                                                        
           MOVE AT-ACCOUNT-NO TO KO-ACCOUNT-NO                          
                                                                        
           EXEC SQL                                                     
             OPEN COMM_DATA                                             
           END-EXEC.                                                    

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

                                                                        
           MOVE SQLCODE TO WS-ACTIVE-RETURN-CODE.                       
                                                                        
           IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL                   
              CONTINUE                                                  
           ELSE                                                         
              MOVE PROGRAM-NAME         TO ABEND-PROGRAM                
              MOVE '7500'               TO ACTIVE-PARAGRAPH             
              MOVE 'OPEN'               TO ABEND-FUNCTION               
              MOVE 'CSS_COMM_DATA'      TO TABLE-1                      
              MOVE 'ACCOUNT-NO'         TO TABLE-ELEMENT-1              
              MOVE WS-ACCOUNT-NO-NUM    TO HOSTVAR-ELEMENT-1            
              PERFORM 9000-SEND-ERROR-RESULT  THRU 9000-EXIT            
              PERFORM 9900-SQL-ERROR-ROUTINE  THRU 9900-EXIT            
           END-IF.                                                      
                                                                        
           PERFORM 7501-FETCH-COMM-DATA THRU 7501-EXIT                  
C33041         UNTIL WS-ACTIVE-RETURN-CODE = NOT-FOUND                  
                                                                        
           EXEC SQL                                                     
               CLOSE COMM_DATA                                          
           END-EXEC.                                                    

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

                                                                        
           MOVE SQLCODE TO WS-ACTIVE-RETURN-CODE.                       
                                                                        
           IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL                   
              CONTINUE                                                  
           ELSE                                                         
              MOVE PROGRAM-NAME         TO ABEND-PROGRAM                
              MOVE '7500'               TO ACTIVE-PARAGRAPH             
              MOVE 'CLOSE'              TO ABEND-FUNCTION               
              MOVE 'CSS_COMM_DATA'      TO TABLE-1                      
              MOVE 'ACCOUNT-NO'        TO TABLE-ELEMENT-1               
              MOVE WS-ACCOUNT-NO-NUM   TO HOSTVAR-ELEMENT-1             
              PERFORM 9000-SEND-ERROR-RESULT  THRU 9000-EXIT            
              PERFORM 9900-SQL-ERROR-ROUTINE  THRU 9900-EXIT            
           END-IF.                                                      
                                                                        
       7500-EXIT.                                                       
           EXIT.                                                        
                                                                        
T31347******************************************************************        
T31347* 7501-FETCH-COMM-DATA                                           *        
T31347* FETCHES THE COMMUNICATION TYPE AND SUBTYPE TO SEE IF THEY      *        
T31347* INDICATE A FREE SWITCH-AWAY OR A NEW ACCOUNT CREDIT            *        
T31347******************************************************************        
       7501-FETCH-COMM-DATA.                                            
                                                                        
           EXEC SQL                                                     
             FETCH COMM_DATA                                            
              INTO :KO-COMMUNICATION-ID,                                
                   :KO-COMM-TYPE-CD,                                    
                   :KO-COMM-SUBTYPE-CODE                                
           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.                       
           EVALUATE WS-ACTIVE-RETURN-CODE                               
C33442* CURSOR WAS CHANGED TO RETURN THE MOST RECENT ROW FIRST.                 
C33442* ONCE A CERTAIN COMM TYPE AND SUBTYPE IS FOUND, THE FIELD                
C33442* WS-ACTIVE-RETURN-CODE IS SET TO NOT-FOUND TO END THE FETCH LOOP         
C33442* AND THUS PREVENT THE CUSTOMER FROM RECEIVING MORE THAN ONE              
C33442* CREDIT                                                                  
C33442* IF SUBTYPE 60 IS FOUND FIRST, CHANGE THE GL NO                          
C34039* IF SUBTYPE 65 IS FOUND, CHANGE THE GL NO AND AMOUNT                     
C34571* IF SUBTYPE 70 IS FOUND, CHANGE THE GL NO AND AMOUNT                     
C36211* CHANGE THE GL ACCT NO AND AMOUNT BASED ON TYPE AND SUBTYPE CODE         
C36211* REORGANIZED COMM TYPE '41' INTO EVALUATE                                
              WHEN SUCCESSFUL-CALL                                      
                 IF KO-COMM-TYPE-CD = '52' AND                          
                    KO-COMM-SUBTYPE-CODE = '01'                         
                    IF KO-COMMUNICATION-ID >= WS-60-DAYS-AGO            
                       MOVE 'Y' TO WS-ADD-SWITCH-FACTOR                 
C33442                 MOVE NOT-FOUND TO WS-ACTIVE-RETURN-CODE          
                    END-IF                                              
                 END-IF                                                 
                                                                        
C36211           IF KO-COMM-TYPE-CD = '49' AND                          
C36211              KO-COMM-SUBTYPE-CODE = '12'                         
C36211              IF KO-COMMUNICATION-ID >= WS-90-DAYS-AGO            
C36211                 MOVE 'Y' TO WS-ADD-NEWACCT-FACTOR                
C36211                 MOVE 675.0207  TO PARM-DB-GL-NUMBER              
C36211                 MOVE 10.00     TO PARM-CR-AMT-AR-TOTAL           
C36211                 MOVE NOT-FOUND TO WS-ACTIVE-RETURN-CODE          
C36211              END-IF                                              
C36211           END-IF                                                 
                                                                        
C33041           IF KO-COMM-TYPE-CD = '41'                              
C36211              EVALUATE KO-COMM-SUBTYPE-CODE                       
C36211              WHEN '54'                                           
C33041                 IF KO-COMMUNICATION-ID >= WS-90-DAYS-AGO         
C33041                    MOVE 'Y' TO WS-ADD-NEWACCT-FACTOR             
C33442                    MOVE NOT-FOUND TO WS-ACTIVE-RETURN-CODE       
C33041                 END-IF                                           
C36211              WHEN '60'                                           
C33442                 IF KO-COMMUNICATION-ID >= WS-90-DAYS-AGO         
C33442                    MOVE 'Y' TO WS-ADD-NEWACCT-FACTOR             
C33442                    MOVE 675.0205  TO PARM-DB-GL-NUMBER           
C33442                    MOVE NOT-FOUND TO WS-ACTIVE-RETURN-CODE       
C36211                 END-IF                                           
C36211              WHEN '61'                                           
C36211                 IF KO-COMMUNICATION-ID >= WS-90-DAYS-AGO         
C36211                    MOVE 'Y' TO WS-ADD-NEWACCT-FACTOR             
C36211                    MOVE 675.0207  TO PARM-DB-GL-NUMBER           
C36211                    MOVE 35.00     TO PARM-CR-AMT-AR-TOTAL        
C36211                    MOVE NOT-FOUND TO WS-ACTIVE-RETURN-CODE       
C36211                 END-IF                                           
C36211              WHEN '62'                                           
C36211                 IF KO-COMMUNICATION-ID >= WS-90-DAYS-AGO         
C36211                    MOVE 'Y' TO WS-ADD-NEWACCT-FACTOR             
C36211                    MOVE 675.0207  TO PARM-DB-GL-NUMBER           
C36211                    MOVE 40.00     TO PARM-CR-AMT-AR-TOTAL        
C36211                    MOVE NOT-FOUND TO WS-ACTIVE-RETURN-CODE       
C36211                 END-IF                                           
C36211              WHEN '65'                                           
C34039                 IF KO-COMMUNICATION-ID >= WS-90-DAYS-AGO         
C34039                    MOVE 'Y' TO WS-ADD-NEWACCT-FACTOR             
C34039                    MOVE 675.0206  TO PARM-DB-GL-NUMBER           
C34039                    MOVE 50.00     TO PARM-CR-AMT-AR-TOTAL        
C34039                    MOVE NOT-FOUND TO WS-ACTIVE-RETURN-CODE       
C34039                 END-IF                                           
C36211              WHEN '70'                                           
C34571                 IF KO-COMMUNICATION-ID >= WS-90-DAYS-AGO         
C34571                    MOVE 'Y'       TO WS-NEW-CREDIT-FACTOR        
C34571                    MOVE 675.0207  TO PARM-DB-GL-NUMBER           
C34571                    MOVE 60.00     TO PARM-CR-AMT-AR-TOTAL        
C34571                    MOVE NOT-FOUND TO WS-ACTIVE-RETURN-CODE       
C34571                 END-IF                                           
C36211              WHEN '75'                                           
C36211                 IF KO-COMMUNICATION-ID >= WS-90-DAYS-AGO         
C36211                    MOVE 'Y' TO WS-ADD-NEWACCT-FACTOR             
C36211                    MOVE 675.0207  TO PARM-DB-GL-NUMBER           
C36211                    MOVE 75.00     TO PARM-CR-AMT-AR-TOTAL        
C36211                    MOVE NOT-FOUND TO WS-ACTIVE-RETURN-CODE       
C36211                 END-IF                                           
C36211              WHEN '80'                                           
C36211                 IF KO-COMMUNICATION-ID >= WS-90-DAYS-AGO         
C36211                    MOVE 'Y' TO WS-ADD-NEWACCT-FACTOR             
C36211                    MOVE 675.0207  TO PARM-DB-GL-NUMBER           
C36211                    MOVE 100.00    TO PARM-CR-AMT-AR-TOTAL        
C36211                    MOVE NOT-FOUND TO WS-ACTIVE-RETURN-CODE       
C36211                 END-IF                                           
C36211              END-EVALUATE                                        
C36211           END-IF                                                 
              WHEN NOT-FOUND                                            
                 CONTINUE                                               
              WHEN OTHER                                                
                 MOVE PROGRAM-NAME       TO ABEND-PROGRAM               
                 MOVE '7501'             TO ACTIVE-PARAGRAPH            
                 MOVE 'FETCH'            TO ABEND-FUNCTION              
                 MOVE 'CSS_COMM_DATA'    TO TABLE-1                     
                 MOVE 'ACCOUNT_NO'       TO TABLE-ELEMENT-1             
                 MOVE WS-ACCOUNT-NO-NUM  TO HOSTVAR-ELEMENT-1           
                 PERFORM 9000-SEND-ERROR-RESULT THRU 9000-EXIT          
                 PERFORM 9900-SQL-ERROR-ROUTINE THRU 9900-EXIT          
           END-EVALUATE.                                                
                                                                        
       7501-EXIT.                                                       
           EXIT.                                                        
                                                                        
      ****************************************************************          
      * 7600-SELECT-GL-ACCOUNT                                       *          
      ****************************************************************          
       7600-SELECT-GL-ACCOUNT.                                          
                                                                        
           EXEC SQL                                                     
              SELECT GL_ACCT_NO                                         
              INTO  :GO-GL-ACCT-NO                                      
              FROM   CSS_GL_ACCT_NO WITH(READUNCOMMITTED)                       
MCR310        WHERE  COMPANY_NO   = '01'                                
              AND    GL_ACCT_NAME = :GO-GL-ACCT-NAME                    
A36248                                                           
P00641                                                      
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ003
MFA-TR* MSQ022
MFA-TR*    EXEC SQL                                                             
MFA-TR*       SELECT GL_ACCT_NO                                                 
MFA-TR*       INTO  :GO-GL-ACCT-NO                                              
MFA-TR*       FROM   CSS_GL_ACCT_NO                                             
MFA-TR*       WHERE  COMPANY_NO   = '01'                                        
MFA-TR*       AND    GL_ACCT_NAME = :GO-GL-ACCT-NAME                            
MFA-TR*       WITH UR                                                           
MFA-TR*      QUERYNO 7600                                                       
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                   
              NEXT SENTENCE                                             
           ELSE                                                         
              MOVE PROGRAM-NAME         TO ABEND-PROGRAM                
CBSI          MOVE '7600'               TO ACTIVE-PARAGRAPH             
              MOVE 'SELECT'             TO ABEND-FUNCTION               
CBSI          MOVE 'CSS_GL_ACCT_NO'     TO TABLE-1                      
              MOVE 'COMPANY_NO'         TO TABLE-ELEMENT-1              
              MOVE 'GL_ACCT_NAME'       TO TABLE-ELEMENT-2              
CBSI          MOVE 'ACCOUNT_NO'         TO TABLE-ELEMENT-3              
              MOVE '01'                 TO HOSTVAR-ELEMENT-1            
              MOVE GO-GL-ACCT-NAME      TO HOSTVAR-ELEMENT-2            
CBSI          MOVE PARM-ACCOUNT-NO      TO HOSTVAR-ELEMENT-3            
              PERFORM 9700-PROCESS-ABEND      THRU 9700-EXIT            
           END-IF.                                                      
                                                                        
       7600-EXIT.                                                       
           EXIT.                                                        
                                                                        
T13034******************************************************************        
T13034* 7700-OPEN-DET-CURSOR                                           *        
T13034*    OPEN A CURSOR FOR CONTRACT DETAIL                           *        
T13034******************************************************************        
T13034 7700-OPEN-DET-CURSOR.                                            
T13034     EXEC SQL                                                     
T13034         OPEN CNT-DETAIL                                          
T13034     END-EXEC.                                                    

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

T13034                                                                  
T13034     MOVE SQLCODE TO WS-ACTIVE-RETURN-CODE.                       
T13034     IF WS-ACTIVE-RETURN-CODE EQUAL SUCCESSFUL-CALL               
T13034        NEXT SENTENCE                                             
T13034     ELSE                                                         
T13034        MOVE PROGRAM-NAME              TO ABEND-PROGRAM           
T13034        MOVE '7700'                    TO ACTIVE-PARAGRAPH        
T13034        MOVE 'OPEN'                    TO ABEND-FUNCTION          
T13034        MOVE SPACES                    TO ABEND-TABLES            
T13034                                          ABEND-SQL-PREDICATES    
T13034        MOVE 'CSS_CNT_DETAIL'          TO TABLE-1                 
CBSI          MOVE 'ACCOUNT_NO'              TO TABLE-ELEMENT-1         
CBSI          MOVE 'CNT_ITEM_ID'             TO TABLE-ELEMENT-2         
T13034        MOVE EA-ACCOUNT-NO             TO HOSTVAR-ELEMENT-1       
CBSI          MOVE EA-CNT-ITEM-ID            TO HOSTVAR-ELEMENT-2       
T13034        PERFORM 9700-PROCESS-ABEND      THRU 9700-EXIT            
T13034     END-IF.                                                      
                                                                        
T13034 7700-EXIT.                                                       
T13034     EXIT.                                                        
                                                                        
T13034******************************************************************        
T13034* 7710-FETCH-DET-CURSOR                                          *        
T13034******************************************************************        
T13034 7710-FETCH-DET-CURSOR.                                           
T13034     EXEC SQL                                                     
T13034        FETCH CNT-DETAIL                                          
T13034        INTO  :EA-NOE-CODE,                                       
T13034              :EA-FUNCTION-CODE,                                  
T13034              :EA-COST-CENTER,                                    
T13034              :EA-BNFT-COST-CENTER,                               
T13034              :EA-WORK-ORDER-NO,                                  
T13034              :EA-PROPERTY-UNIT-CD                                
T13034     END-EXEC.                                                    

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

T13034                                                                  
T13034     MOVE SQLCODE TO WS-ACTIVE-RETURN-CODE.                       
T13034     IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL OR NOT-FOUND      
T13034        NEXT SENTENCE                                             
T13034     ELSE                                                         
T13034        MOVE PROGRAM-NAME              TO ABEND-PROGRAM           
T13034        MOVE '7710'                    TO ACTIVE-PARAGRAPH        
T13034        MOVE 'FETCH'                   TO ABEND-FUNCTION          
T13034        MOVE SPACES                    TO ABEND-TABLES            
T13034                                          ABEND-SQL-PREDICATES    
T13034        MOVE 'CSS_CNT_DETAIL'          TO TABLE-1                 
CBSI          MOVE 'ACCOUNT_NO'              TO TABLE-ELEMENT-1         
CBSI          MOVE 'CNT_ITEM_ID'             TO TABLE-ELEMENT-2         
T13034        MOVE EA-ACCOUNT-NO             TO HOSTVAR-ELEMENT-1       
CBSI          MOVE EA-CNT-ITEM-ID            TO HOSTVAR-ELEMENT-2       
T13034        PERFORM 9700-PROCESS-ABEND      THRU 9700-EXIT            
T13034     END-IF.                                                      
                                                                        
T13034 7710-EXIT.                                                       
T13034     EXIT.                                                        
                                                                        
T13034******************************************************************        
T13034* 7720-CLOSE-DET-CURSOR                                          *        
T13034******************************************************************        
T13034 7720-CLOSE-DET-CURSOR.                                           
T13034     EXEC SQL                                                     
T13034        CLOSE CNT-DETAIL                                          
T13034     END-EXEC.                                                    

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

T13034                                                                  
T13034     MOVE SQLCODE TO WS-ACTIVE-RETURN-CODE.                       
T13034     IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL                   
T13034        NEXT SENTENCE                                             
T13034     ELSE                                                         
T13034        MOVE PROGRAM-NAME              TO ABEND-PROGRAM           
T13034        MOVE '7720'                    TO ACTIVE-PARAGRAPH        
CBSI          MOVE 'CLOSE'                   TO ABEND-FUNCTION          
T13034        MOVE SPACES                    TO ABEND-TABLES            
T13034                                          ABEND-SQL-PREDICATES    
T13034        MOVE 'CSS_CNT_DETAIL'          TO TABLE-1                 
CBSI          MOVE 'ACCOUNT_NO'              TO TABLE-ELEMENT-1         
CBSI          MOVE 'CNT_ITEM_ID'             TO TABLE-ELEMENT-2         
T13034        MOVE EA-ACCOUNT-NO             TO HOSTVAR-ELEMENT-1       
CBSI          MOVE EA-CNT-ITEM-ID            TO HOSTVAR-ELEMENT-2       
T13034        PERFORM 9700-PROCESS-ABEND     THRU 9700-EXIT             
T13034     END-IF.                                                      
                                                                        
T13034 7720-EXIT.                                                       
T13034     EXIT.                                                        
                                                                        
T14840******************************************************************        
T14840* 7730-SELECT-DFLT-CONTRACT                                      *        
T14840******************************************************************        
T14840 7730-SELECT-DFLT-CONTRACT.                                       
T14840                                                                  
T14840     EXEC SQL                                                     
T14840           SELECT CODE_CONTRACT_TYPE,                             
T14840                  CNT_NAME_CD,                                    
T14840                  CODE_BILL_TYPE,                                 
T14840                  MONTHLY_CREDIT_AM,                              
T14840                  DFLT_REBATE_AMOUNT,                             
T14840                  REBATE_CD,                                      
T14840                  INTEREST_CD,                                    
T14840                  DFLT_INTRST_RT,                                 
T14840                  MIN_INTRST_RT,                                  
T14840                  MAX_INTRST_RT,                                  
T14840                  DFLT_TERM_MO_NM,                                
T14840                  MIN_TERM_MO_NM,                                 
T14840                  MAX_TERM_MO_NM,                                 
T14840                  SECURITY_CD,                                    
T14840                  CHARGE_TYPE_CD,                                 
T14840                  GL_ACCT_NO,                                     
T14840                  COST_CENTER,                                    
T14840                  FUNCTION_CODE,                                  
T14840                  NOE_CODE,                                       
T14840                  DFLT_CHARGE_AM,                                 
T14840                  COMPANY_NO,                                     
T14840                  INTRST_FNCTN_CODE,                              
T14840                  INTRST_NOE_CODE,                                
T14840                  INTRST_COST_CENTER,                             
T14840                  GL_ACCT_NO_ERN_INT,                             
T14840                  GL_ACCT_NO_DEF_INT,                             
T14840                  REBATE_FNCTN_CODE,                              
T14840                  REBATE_NOE_CODE,                                
T14840                  REBATE_COST_CENTER,                             
T14840                  REBATE_GL_ACCT_NO,                              
T14840                  WRT_OFF_WK_ORD_NO,                              
T14840                  WRT_OFF_FNCTN_CODE,                             
T14840                  WRT_OFF_NOE_CODE,                               
T14840                  WRT_OFF_COST_CNTR,                              
T14840                  WRT_OFF_GL_ACCT_NO                              
T14840           INTO   :K6-CODE-CONTRACT-TYPE,                         
T14840                  :K6-CNT-NAME-CD,                                
T14840                  :K6-CODE-BILL-TYPE,                             
T14840                  :K6-MONTHLY-CREDIT-AM,                          
T14840                  :K6-DFLT-REBATE-AMOUNT,                         
T14840                  :K6-REBATE-CD,                                  
T14840                  :K6-INTEREST-CD,                                
T14840                  :K6-DFLT-INTRST-RT,                             
T14840                  :K6-MIN-INTRST-RT,                              
T14840                  :K6-MAX-INTRST-RT,                              
T14840                  :K6-DFLT-TERM-MO-NM,                            
T14840                  :K6-MIN-TERM-MO-NM,                             
T14840                  :K6-MAX-TERM-MO-NM,                             
T14840                  :K6-SECURITY-CD,                                
T14840                  :K6-CHARGE-TYPE-CD,                             
T14840                  :K6-GL-ACCT-NO,                                 
T14840                  :K6-COST-CENTER,                                
T14840                  :K6-FUNCTION-CODE,                              
T14840                  :K6-NOE-CODE,                                   
T14840                  :K6-DFLT-CHARGE-AM,                             
T14840                  :K6-COMPANY-NO,                                 
T14840                  :K6-INTRST-FNCTN-CODE,                          
T14840                  :K6-INTRST-NOE-CODE,                            
T14840                  :K6-INTRST-COST-CENTER,                         
T14840                  :K6-GL-ACCT-NO-ERN-INT,                         
T14840                  :K6-GL-ACCT-NO-DEF-INT,                         
T14840                  :K6-REBATE-FNCTN-CODE,                          
T14840                  :K6-REBATE-NOE-CODE,                            
T14840                  :K6-REBATE-COST-CENTER,                         
T14840                  :K6-REBATE-GL-ACCT-NO,                          
T14840                  :K6-WRT-OFF-WK-ORD-NO,                          
T14840                  :K6-WRT-OFF-FNCTN-CODE,                         
T14840                  :K6-WRT-OFF-NOE-CODE,                           
T14840                  :K6-WRT-OFF-COST-CNTR,                          
T14840                  :K6-WRT-OFF-GL-ACCT-NO                          
T14840           FROM CSS_CONTRACT_INFO WITH(READUNCOMMITTED)                   
T14840           WHERE CNT_NAME_CD       = :K6-CNT-NAME-CD              
A36248                                                           
P00641                                                      
T14840     END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ003
MFA-TR* MSQ022
MFA-TR*    EXEC SQL                                                             
MFA-TR*          SELECT CODE_CONTRACT_TYPE,                                     
MFA-TR*                 CNT_NAME_CD,                                            
MFA-TR*                 CODE_BILL_TYPE,                                         
MFA-TR*                 MONTHLY_CREDIT_AM,                                      
MFA-TR*                 DFLT_REBATE_AMOUNT,                                     
MFA-TR*                 REBATE_CD,                                              
MFA-TR*                 INTEREST_CD,                                            
MFA-TR*                 DFLT_INTRST_RT,                                         
MFA-TR*                 MIN_INTRST_RT,                                          
MFA-TR*                 MAX_INTRST_RT,                                          
MFA-TR*                 DFLT_TERM_MO_NM,                                        
MFA-TR*                 MIN_TERM_MO_NM,                                         
MFA-TR*                 MAX_TERM_MO_NM,                                         
MFA-TR*                 SECURITY_CD,                                            
MFA-TR*                 CHARGE_TYPE_CD,                                         
MFA-TR*                 GL_ACCT_NO,                                             
MFA-TR*                 COST_CENTER,                                            
MFA-TR*                 FUNCTION_CODE,                                          
MFA-TR*                 NOE_CODE,                                               
MFA-TR*                 DFLT_CHARGE_AM,                                         
MFA-TR*                 COMPANY_NO,                                             
MFA-TR*                 INTRST_FNCTN_CODE,                                      
MFA-TR*                 INTRST_NOE_CODE,                                        
MFA-TR*                 INTRST_COST_CENTER,                                     
MFA-TR*                 GL_ACCT_NO_ERN_INT,                                     
MFA-TR*                 GL_ACCT_NO_DEF_INT,                                     
MFA-TR*                 REBATE_FNCTN_CODE,                                      
MFA-TR*                 REBATE_NOE_CODE,                                        
MFA-TR*                 REBATE_COST_CENTER,                                     
MFA-TR*                 REBATE_GL_ACCT_NO,                                      
MFA-TR*                 WRT_OFF_WK_ORD_NO,                                      
MFA-TR*                 WRT_OFF_FNCTN_CODE,                                     
MFA-TR*                 WRT_OFF_NOE_CODE,                                       
MFA-TR*                 WRT_OFF_COST_CNTR,                                      
MFA-TR*                 WRT_OFF_GL_ACCT_NO                                      
MFA-TR*          INTO   :K6-CODE-CONTRACT-TYPE,                                 
MFA-TR*                 :K6-CNT-NAME-CD,                                        
MFA-TR*                 :K6-CODE-BILL-TYPE,                                     
MFA-TR*                 :K6-MONTHLY-CREDIT-AM,                                  
MFA-TR*                 :K6-DFLT-REBATE-AMOUNT,                                 
MFA-TR*                 :K6-REBATE-CD,                                          
MFA-TR*                 :K6-INTEREST-CD,                                        
MFA-TR*                 :K6-DFLT-INTRST-RT,                                     
MFA-TR*                 :K6-MIN-INTRST-RT,                                      
MFA-TR*                 :K6-MAX-INTRST-RT,                                      
MFA-TR*                 :K6-DFLT-TERM-MO-NM,                                    
MFA-TR*                 :K6-MIN-TERM-MO-NM,                                     
MFA-TR*                 :K6-MAX-TERM-MO-NM,                                     
MFA-TR*                 :K6-SECURITY-CD,                                        
MFA-TR*                 :K6-CHARGE-TYPE-CD,                                     
MFA-TR*                 :K6-GL-ACCT-NO,                                         
MFA-TR*                 :K6-COST-CENTER,                                        
MFA-TR*                 :K6-FUNCTION-CODE,                                      
MFA-TR*                 :K6-NOE-CODE,                                           
MFA-TR*                 :K6-DFLT-CHARGE-AM,                                     
MFA-TR*                 :K6-COMPANY-NO,                                         
MFA-TR*                 :K6-INTRST-FNCTN-CODE,                                  
MFA-TR*                 :K6-INTRST-NOE-CODE,                                    
MFA-TR*                 :K6-INTRST-COST-CENTER,                                 
MFA-TR*                 :K6-GL-ACCT-NO-ERN-INT,                                 
MFA-TR*                 :K6-GL-ACCT-NO-DEF-INT,                                 
MFA-TR*                 :K6-REBATE-FNCTN-CODE,                                  
MFA-TR*                 :K6-REBATE-NOE-CODE,                                    
MFA-TR*                 :K6-REBATE-COST-CENTER,                                 
MFA-TR*                 :K6-REBATE-GL-ACCT-NO,                                  
MFA-TR*                 :K6-WRT-OFF-WK-ORD-NO,                                  
MFA-TR*                 :K6-WRT-OFF-FNCTN-CODE,                                 
MFA-TR*                 :K6-WRT-OFF-NOE-CODE,                                   
MFA-TR*                 :K6-WRT-OFF-COST-CNTR,                                  
MFA-TR*                 :K6-WRT-OFF-GL-ACCT-NO                                  
MFA-TR*          FROM CSS_CONTRACT_INFO                                         
MFA-TR*          WHERE CNT_NAME_CD       = :K6-CNT-NAME-CD                      
MFA-TR*          WITH UR                                                        
MFA-TR*      QUERYNO 7730                                                       
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

T14840                                                                  
T14840     MOVE SQLCODE TO WS-ACTIVE-RETURN-CODE                        
T14840                     RS-RETURN-CODE.                              
T14840                                                                  
T14840     IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL                   
T14840                         OR NOT-FOUND                             
T14840        NEXT SENTENCE                                             
T14840     ELSE                                                         
T14840        MOVE PROGRAM-NAME             TO ABEND-PROGRAM            
T14840        MOVE '7730'                   TO ACTIVE-PARAGRAPH         
CBSI          MOVE 'SELECT'                 TO ABEND-FUNCTION           
T14840        MOVE 'CSS_CONTRACT_INFO'      TO TABLE-1                  
CBSI          MOVE 'CNT_NAME_CD'            TO TABLE-ELEMENT-1          
CBSI          MOVE 'ACCOUNT_NO'             TO TABLE-ELEMENT-2          
CBSI          MOVE K6-CNT-NAME-CD           TO HOSTVAR-ELEMENT-1        
CBSI          MOVE PARM-ACCOUNT-NO          TO HOSTVAR-ELEMENT-2        
T13034        PERFORM 9700-PROCESS-ABEND    THRU 9700-EXIT              
T14840     END-IF.                                                      
T14840                                                                  
T14840 7730-EXIT.                                                       
T14840     EXIT.                                                        
                                                                        
T20099******************************************************************        
T20099* 7800-SELECT-OTHER-GL-ACCTS                                     *        
T20099*   RETRIEVING 'OTHER' GL ACCOUNT NUMBERS                        *        
T20099******************************************************************        
T20099 7800-SELECT-OTHER-GL-ACCTS.                                      
                                                                        
T20099     PERFORM 7820-SEL-CUR-REV-MONTH                               
T20099        THRU 7820-EXIT.                                           
T20099     STRING WS-REVENUE-MONTH-CHAR(2:4) DELIMITED BY SIZE          
T20099            '-'                        DELIMITED BY SIZE          
T20099            WS-REVENUE-MONTH-CHAR(6:2) DELIMITED BY SIZE          
T20099            '-01'                      DELIMITED BY SIZE          
T20099       INTO WS-REVENUE-DATE.                                      
T20099     PERFORM 7805-OPEN-OTHER-TAX-CURSOR                           
T20099        THRU 7805-EXIT.                                           
T20099     PERFORM 7810-FETCH-OTHER-TAX-CURSOR                          
T20099        THRU 7810-EXIT.                                           
T20099     PERFORM VARYING WS-SUB2 FROM 1 BY 1                          
T20099       UNTIL WS-SUB2 GREATER THAN WS-NBR-TAX-OTHER-MAX            
T20099          OR WS-ACTIVE-RETURN-CODE EQUAL NOT-FOUND                
T20099             MOVE WS-SUB2       TO WS-NBR-TAX-OTHER               
T20099             ADD  TR-TAX-RATE   TO WS-TOT-TAX-OTHER-RATE          
T20099             MOVE TR-TAX-RATE   TO WS-TAX-OTHER-RATE(WS-SUB2)     
T20099             MOVE SF-GL-ACCT-NO TO WS-TAX-OTHER-GL-NBR(WS-SUB2)   
T20099             PERFORM 7810-FETCH-OTHER-TAX-CURSOR                  
T20099                THRU 7810-EXIT                                    
T20099     END-PERFORM.                                                 
T20099     PERFORM 7815-CLOSE-OTHER-TAX-CURSOR                          
T20099        THRU 7815-EXIT.                                           
                                                                        
T20099     SET OTHER-TAX-GL-LOADED TO TRUE.                             
                                                                        
T20099 7800-EXIT.                                                       
T20099     EXIT.                                                        
                                                                        
T20099******************************************************************        
T20099* 7805-OPEN-OTHER-TAX-CURSOR                                     *        
T20099*  DEFINING CURSOR FOR 'OTHER TAX' GL NUMBER ASSIGNMENTS         *        
T20099*  OPENING CURSOR FOR 'OTHER TAX' GL NUMBER ASSIGNMENTS          *        
T20099******************************************************************        
T20099 7805-OPEN-OTHER-TAX-CURSOR.                                      
                                                                        
T20099     EXEC SQL                                                     
T20099          DECLARE OTHER_TAX_CSR CURSOR FOR                        
T20099           SELECT A.TAX_RATE,                                     
T20099                  A.TAX_CNTRL_NO,                                 
T20099                  A.TAX_ENTRY_SEQ_NO,                             
T20099                  C.GL_ACCT_NO                                    
T20099             FROM CSS_TAX_RATE A,                                 
T20099                  CSS_TAX_CNTL B,                                 
T20099                  CSS_SPCL_FCTR C                                 
T20099            WHERE A.DETAIL_ID     = :PR-REV-DISTRICT-CD           
T20099              AND ENERGY_TAX_FL   = 'N'                           
T20099              AND A.DATE_FROM    <= IIF(TRY_CONVERT(DATE, 
                                                       :WS-REVENUE-DATE
              ) IS NULL OR (PATINDEX('%.%', :WS-REVENUE-DATE
              ) <> 0) OR (LEN(:WS-REVENUE-DATE) <> 10), CIS.CHAR2DATE(
                                                       :WS-REVENUE-DATE
              ), CONVERT(DATE, :WS-REVENUE-DATE) )              
T20099              AND A.DATE_TO       > IIF(TRY_CONVERT(DATE, 
                                                       :WS-REVENUE-DATE
              ) IS NULL OR (PATINDEX('%.%', :WS-REVENUE-DATE
              ) <> 0) OR (LEN(:WS-REVENUE-DATE) <> 10), CIS.CHAR2DATE(
                                                       :WS-REVENUE-DATE
              ), CONVERT(DATE, :WS-REVENUE-DATE) )              
T20099              AND A.OPER_MODE     = B.OPER_MODE                   
T20099              AND A.TAX_CNTRL_NO  = B.TAX_CNTRL_NO                
T20099              AND B.FACTOR_ID     = C.FACTOR_ID                   
T20099            ORDER BY A.TAX_CNTRL_NO,                              
T20099                     A.TAX_ENTRY_SEQ_NO                           
T20099            FOR READ ONLY                                        
P00641                                                      
T20099     END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ003
MFA-TR* MSQ004
MFA-TR* MSQ054
MFA-TR*    EXEC SQL                                                             
MFA-TR*         DECLARE OTHER_TAX_CSR CURSOR FOR                                
MFA-TR*          SELECT A.TAX_RATE,                                             
MFA-TR*                 A.TAX_CNTRL_NO,                                         
MFA-TR*                 A.TAX_ENTRY_SEQ_NO,                                     
MFA-TR*                 C.GL_ACCT_NO                                            
MFA-TR*            FROM CSS_TAX_RATE A,                                         
MFA-TR*                 CSS_TAX_CNTL B,                                         
MFA-TR*                 CSS_SPCL_FCTR C                                         
MFA-TR*           WHERE A.DETAIL_ID     = :PR-REV-DISTRICT-CD                   
MFA-TR*             AND ENERGY_TAX_FL   = 'N'                                   
MFA-TR*             AND A.DATE_FROM    <= :WS-REVENUE-DATE                      
MFA-TR*             AND A.DATE_TO       > :WS-REVENUE-DATE                      
MFA-TR*             AND A.OPER_MODE     = B.OPER_MODE                           
MFA-TR*             AND A.TAX_CNTRL_NO  = B.TAX_CNTRL_NO                        
MFA-TR*             AND B.FACTOR_ID     = C.FACTOR_ID                           
MFA-TR*           ORDER BY A.TAX_CNTRL_NO,                                      
MFA-TR*                    A.TAX_ENTRY_SEQ_NO                                   
MFA-TR*           FOR FETCH ONLY                                                
MFA-TR*      QUERYNO 7805                                                       
MFA-TR*    END-EXEC.                                                            
                                                                        
T20099     EXEC SQL                                                     
T20099          OPEN OTHER_TAX_CSR                                      
T20099     END-EXEC.                                                    

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

                                                                        
T20099     MOVE SQLCODE TO WS-ACTIVE-RETURN-CODE                        
T20099                     RS-RETURN-CODE.                              
                                                                        
T20099     IF WS-ACTIVE-RETURN-CODE EQUAL SUCCESSFUL-CALL               
T20099        NEXT SENTENCE                                             
T20099     ELSE                                                         
T20099        MOVE PROGRAM-NAME               TO ABEND-PROGRAM          
T20099        MOVE '7805'                     TO ACTIVE-PARAGRAPH       
T20099        MOVE 'OPEN   '                  TO ABEND-FUNCTION         
T20099        MOVE SPACES                     TO ABEND-SQL-PREDICATES   
T20099                                           ABEND-TABLES           
T20099        MOVE 'CSS_TAX_RATE'             TO TABLE-1                
T20099        MOVE 'CSS_TAX_CNTL'             TO TABLE-2                
T20099        MOVE 'CSS_SPCL_FCTR'            TO TABLE-3                
A36248        MOVE 'ACCOUNT_NO'               TO TABLE-ELEMENT-1        
T20099        MOVE AT-ACCOUNT-NO              TO HOSTVAR-ELEMENT-1      
T20099        PERFORM 9700-PROCESS-ABEND THRU 9700-EXIT                 
T20099     END-IF.                                                      
                                                                        
T20099 7805-EXIT.                                                       
T20099     EXIT.                                                        
                                                                        
T20099******************************************************************        
T20099* 7810-FETCH-OTHER-TAX-CURSOR                                    *        
T20099*  FETCHING CURSOR FOR 'OTHER TAX' GL NUMBER ASSIGNMENTS         *        
T20099******************************************************************        
T20099 7810-FETCH-OTHER-TAX-CURSOR.                                     
                                                                        
T20099     EXEC SQL                                                     
T20099          FETCH OTHER_TAX_CSR                                     
T20099           INTO :TR-TAX-RATE,                                     
T20099                :TR-TAX-CNTRL-NO,                                 
T20099                :TR-TAX-ENTRY-SEQ-NO,                             
T20099                :SF-GL-ACCT-NO                                    
T20099     END-EXEC.                                                    

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

                                                                        
T20099     MOVE SQLCODE TO WS-ACTIVE-RETURN-CODE                        
T20099                     RS-RETURN-CODE.                              
                                                                        
T20099     IF WS-ACTIVE-RETURN-CODE EQUAL SUCCESSFUL-CALL OR            
T20099        (WS-ACTIVE-RETURN-CODE EQUAL NOT-FOUND AND                
T20099         WS-SUB2 NOT EQUAL ZERO)                                  
T20099           NEXT SENTENCE                                          
T20099     ELSE                                                         
T20099           MOVE PROGRAM-NAME            TO ABEND-PROGRAM          
T20099           MOVE '7810'                  TO ACTIVE-PARAGRAPH       
T20099           MOVE 'FETCH  '               TO ABEND-FUNCTION         
T20099           MOVE SPACES                  TO ABEND-SQL-PREDICATES   
T20099                                           ABEND-TABLES           
T20099           MOVE 'CSS_TAX_RATE'          TO TABLE-1                
T20099           MOVE 'CSS_TAX_CNTL'          TO TABLE-2                
T20099           MOVE 'CSS_SPCL_FCTR'         TO TABLE-3                
T20099           MOVE AT-ACCOUNT-NO           TO HOSTVAR-ELEMENT-1      
T20099           PERFORM 9700-PROCESS-ABEND THRU 9700-EXIT              
T20099     END-IF.                                                      
                                                                        
T20099 7810-EXIT.                                                       
T20099     EXIT.                                                        
                                                                        
T20099******************************************************************        
T20099* 7815-CLOSE-OTHER-TAX-CURSOR                                    *        
T20099*  CLOSING CURSOR FOR 'OTHER TAX' GL NUMBER ASSIGNMENTS          *        
T20099******************************************************************        
T20099 7815-CLOSE-OTHER-TAX-CURSOR.                                     
                                                                        
T20099     EXEC SQL                                                     
T20099          CLOSE OTHER_TAX_CSR                                     
T20099     END-EXEC.                                                    

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

                                                                        
T20099     MOVE SQLCODE TO WS-ACTIVE-RETURN-CODE                        
T20099                     RS-RETURN-CODE.                              
                                                                        
T20099     IF WS-ACTIVE-RETURN-CODE EQUAL SUCCESSFUL-CALL               
T20099        NEXT SENTENCE                                             
T20099     ELSE                                                         
T20099        MOVE PROGRAM-NAME               TO ABEND-PROGRAM          
T20099        MOVE '7815'                     TO ACTIVE-PARAGRAPH       
T20099        MOVE 'CLOSE  '                  TO ABEND-FUNCTION         
T20099        MOVE SPACES                     TO ABEND-SQL-PREDICATES   
T20099                                           ABEND-TABLES           
T20099        MOVE 'CSS_TAX_RATE'             TO TABLE-1                
T20099        MOVE 'CSS_TAX_CNTL'             TO TABLE-2                
T20099        MOVE 'CSS_SPCL_FCTR'            TO TABLE-3                
T20099        MOVE AT-ACCOUNT-NO              TO HOSTVAR-ELEMENT-1      
T20099        PERFORM 9700-PROCESS-ABEND THRU 9700-EXIT                 
T20099     END-IF.                                                      
                                                                        
T20099 7815-EXIT.                                                       
T20099     EXIT.                                                        
                                                                        
T20099******************************************************************        
T20099* 7820-SEL-CUR-REV-MONTH                                         *        
T20099*     SELECTS CSS_BILL_WINDOW FOR REV MONTH OF CURRENT DATE      *        
T20099******************************************************************        
T20099 7820-SEL-CUR-REV-MONTH.                                          
                                                                        
T20099     EXEC SQL                                                     
T20099        SELECT MIN(CIS.DECIMAL2CHAR(B.REVENUE_MONTH))                     
T20099          INTO :WS-REVENUE-MONTH-CHAR                             
A36248          FROM CSS_BILL_WINDOW B WITH(READUNCOMMITTED)                    
A36248         WHERE B.DATE_EXTRACT   >= CAST(SYSDATETIMEOFFSET() 
           AS DATE)                   
A36248           AND B.BILL_CYCLE      = :AT-BILL-CYCLE                 
T20099           AND B.CODE_BILL_COND  = 'C'                            
A36248                                                           
P00641                                                      
T20099     END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ003
MFA-TR* MSQ022
MFA-TR* MSQ028
MFA-TR* MSQ029
MFA-TR*    EXEC SQL                                                             
MFA-TR*       SELECT MIN(CHAR(B.REVENUE_MONTH))                                 
MFA-TR*         INTO :WS-REVENUE-MONTH-CHAR                                     
MFA-TR*         FROM CSS_BILL_WINDOW B                                          
MFA-TR*        WHERE B.DATE_EXTRACT   >= CURRENT DATE                           
MFA-TR*          AND B.BILL_CYCLE      = :AT-BILL-CYCLE                         
MFA-TR*          AND B.CODE_BILL_COND  = 'C'                                    
MFA-TR*         WITH UR                                                         
MFA-TR*      QUERYNO 7820                                                       
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

                                                                        
T20099     MOVE SQLCODE TO WS-ACTIVE-RETURN-CODE                        
T20099                     RS-RETURN-CODE.                              
                                                                        
T20099     IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL OR NOT-FOUND      
T20099        NEXT SENTENCE                                             
T20099     ELSE                                                         
T20099        MOVE PROGRAM-NAME               TO ABEND-PROGRAM          
T20099        MOVE '7820'                     TO ACTIVE-PARAGRAPH       
T20099        MOVE 'SELECT '                  TO ABEND-FUNCTION         
T20099        MOVE SPACES                     TO ABEND-SQL-PREDICATES   
T20099                                           ABEND-TABLES           
T20099        MOVE 'CSS_BILL_WINDOW'          TO TABLE-1                
A36248        MOVE 'BILL_CYCLE'               TO TABLE-ELEMENT-1        
A36248        MOVE AT-BILL-CYCLE              TO HOSTVAR-ELEMENT-1      
T20099        PERFORM 9700-PROCESS-ABEND THRU 9700-EXIT                 
T20099     END-IF.                                                      
                                                                        
T20099 7820-EXIT.                                                       
T20099     EXIT.                                                        
                                                                        
T20099******************************************************************        
T20099* 7830-CALC-OTHER-TAX-AMT                                        *        
T20099*     CALCULATES AND APPLIES 'OTHER' TAXES                       *        
T20099******************************************************************        
T20099 7830-CALC-OTHER-TAX-AMT.                                         
                                                                        
T20099     IF WS-TOT-TAX-OTHER > WS-AC-AMT-AR-TOTAL-CNT                 
T20099        MOVE 'P'    TO WS-DIR-PAY-AHEAD-TYPE(1)                   
T20099     ELSE                                                         
T20099        MOVE SPACES TO WS-DIR-PAY-AHEAD-TYPE(1)                   
T20099     END-IF.                                                      
                                                                        
T20099     PERFORM VARYING WS-SUB2 FROM 1 BY 1                          
T20099     UNTIL WS-SUB2 GREATER THAN WS-NBR-TAX-OTHER                  
T20099        MOVE WS-TAX-OTHER-GL-NBR(WS-SUB2) TO WS-PAR-GEN-LEDG-DB   
T20099        IF WS-SUB2 NOT EQUAL WS-NBR-TAX-OTHER                     
T20099           COMPUTE WS-DIR-PAY-AMT(1) ROUNDED =                    
T20099              WS-TOT-TAX-OTHER * (WS-TAX-OTHER-RATE(WS-SUB2) /    
T20099                                  WS-TOT-TAX-OTHER-RATE)          
T20099           END-COMPUTE                                            
T20099           SUBTRACT WS-DIR-PAY-AMT(1) FROM WS-RMNG-TAX-OTHER      
T20099        ELSE                                                      
T20099           MOVE WS-RMNG-TAX-OTHER       TO WS-DIR-PAY-AMT(1)      
T20099        END-IF                                                    
T20099        SUBTRACT WS-DIR-PAY-AMT(1) FROM WS-AC-AMT-AR-TOTAL-CNT    
T20099        IF WS-OTHER-TAX-AMT >= WS-REMAINING-CONTRACT              
T20099           SUBTRACT WS-DIR-PAY-AMT(1) FROM WS-OTHER-TAX-AMT       
T20099        END-IF                                                    
T20099        PERFORM 5000-UPDATE THRU 5000-EXIT                        
T20099     END-PERFORM.                                                 
                                                                        
T20099 7830-EXIT.                                                       
T20099     EXIT.                                                        
                                                                        
T20099******************************************************************        
T20099* 7835-CALC-RMNG-OTHER-TAX-AMT                                   *        
T20099*     CALCULATES AND APPLIES 'OTHER' TAXES FOR REMAINING AMOUNTS *        
T20099******************************************************************        
T20099 7835-CALC-RMNG-OTHER-TAX-AMT.                                    
T20099                                                                  
T20099     MOVE WS-OTHER-TAX-AMT TO WS-TOT-TAX-OTHER                    
T20099                              WS-RMNG-TAX-OTHER.                  
T20099                                                                  
T20099     PERFORM VARYING WS-SUB2 FROM 1 BY 1                          
T20099     UNTIL WS-SUB2 GREATER THAN WS-NBR-TAX-OTHER                  
T20099        MOVE WS-TAX-OTHER-GL-NBR(WS-SUB2) TO WS-PAR-GEN-LEDG-DB   
T20099        IF DIRECTED-PYMT                                          
T20099           IF WS-SUB2 NOT EQUAL WS-NBR-TAX-OTHER                  
T20099              COMPUTE WS-DIR-PAY-AMT(1) ROUNDED =                 
T20099                 WS-TOT-TAX-OTHER * (WS-TAX-OTHER-RATE(WS-SUB2) / 
T20099                 WS-TOT-TAX-OTHER-RATE)                           
T20099              END-COMPUTE                                         
T20099              SUBTRACT WS-DIR-PAY-AMT(1) FROM WS-RMNG-TAX-OTHER   
T20099           ELSE                                                   
T20099              MOVE WS-RMNG-TAX-OTHER TO WS-DIR-PAY-AMT(1)         
T20099           END-IF                                                 
T20099        ELSE                                                      
T20099           IF WS-SUB2 NOT EQUAL WS-NBR-TAX-OTHER                  
T20099              COMPUTE WS-AMT-CASH ROUNDED =                       
T20099                 WS-TOT-TAX-OTHER * (WS-TAX-OTHER-RATE(WS-SUB2) / 
T20099                 WS-TOT-TAX-OTHER-RATE)                           
T20099              END-COMPUTE                                         
T20099              SUBTRACT WS-AMT-CASH FROM WS-RMNG-TAX-OTHER         
T20099           ELSE                                                   
T20099              MOVE WS-RMNG-TAX-OTHER TO WS-AMT-CASH               
T20099           END-IF                                                 
T20099        END-IF                                                    
T20099        PERFORM 5000-UPDATE THRU 5000-EXIT                        
T20099     END-PERFORM.                                                 
                                                                        
T20099 7835-EXIT.                                                       
T20099     EXIT.                                                        
                                                                        
T16114******************************************************************        
T16114* 7910-SELECT-RCC.                                               *        
T16114******************************************************************        
T16114 7910-SELECT-RCC.                                                 
T16114                                                                  
T16114     EXEC SQL                                                     
T16114        SELECT U7.RCNCT_ELEC_SVC_FL,                              
T16114               U7.RCNCT_GAS_SVC_FL                                
T16114          INTO :U7-RCNCT-ELEC-SVC-FL,                             
T16114               :U7-RCNCT-GAS-SVC-FL                               
T16114          FROM CSS_CONNECT_CHRG   CC,                             
T16114               CSS_RECONNECT_CHRG U7                              
T16114         WHERE CC.ACCOUNT_NO        = :CC-ACCOUNT-NO              
T16114           AND CC.PYMT_PRIORITY_LVL = :CC-PYMT-PRIORITY-LVL       
T16114           AND CC.CCC_ITEM_ID       = :CC-CCC-ITEM-ID             
T16114           AND U7.COMPANY_NO        = :U7-COMPANY-NO              
T16114           AND CC.RCNCT_TYPE_NO     = U7.RCNCT_TYPE_NO            
A37061           AND U7.RCNCT_ACCT_TYPE_CD= :U7-RCNCT-ACCT-TYPE-CD      
P00641                                                      
T16114     END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ003
MFA-TR*    EXEC SQL                                                             
MFA-TR*       SELECT U7.RCNCT_ELEC_SVC_FL,                                      
MFA-TR*              U7.RCNCT_GAS_SVC_FL                                        
MFA-TR*         INTO :U7-RCNCT-ELEC-SVC-FL,                                     
MFA-TR*              :U7-RCNCT-GAS-SVC-FL                                       
MFA-TR*         FROM CSS_CONNECT_CHRG   CC,                                     
MFA-TR*              CSS_RECONNECT_CHRG U7                                      
MFA-TR*        WHERE CC.ACCOUNT_NO        = :CC-ACCOUNT-NO                      
MFA-TR*          AND CC.PYMT_PRIORITY_LVL = :CC-PYMT-PRIORITY-LVL               
MFA-TR*          AND CC.CCC_ITEM_ID       = :CC-CCC-ITEM-ID                     
MFA-TR*          AND U7.COMPANY_NO        = :U7-COMPANY-NO                      
MFA-TR*          AND CC.RCNCT_TYPE_NO     = U7.RCNCT_TYPE_NO                    
MFA-TR*          AND U7.RCNCT_ACCT_TYPE_CD= :U7-RCNCT-ACCT-TYPE-CD              
MFA-TR*      QUERYNO 7910                                                       
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

T16114                                                                  
T16114     MOVE SQLCODE TO WS-ACTIVE-RETURN-CODE.                       
T16114                                                                  
T16114     IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL                   
T16114         NEXT SENTENCE                                            
T16114     ELSE                                                         
T16114         MOVE WS-ACTIVE-RETURN-CODE     TO RS-RETURN-CODE         
T16114         MOVE PROGRAM-NAME              TO ABEND-PROGRAM          
T16114         MOVE '7910'                    TO ACTIVE-PARAGRAPH       
T16114         MOVE 'SELECT'                  TO ABEND-FUNCTION         
T16114         MOVE 'CSS_CONNECT_CHRG'        TO TABLE-1                
T16114         MOVE 'CSS_RECONNECT_CHRG'      TO TABLE-2                
T16114         MOVE 'ACCOUNT_NO'              TO TABLE-ELEMENT-1        
T16114         MOVE 'PYMT_PRIORITY_LVL'       TO TABLE-ELEMENT-2        
T16114         MOVE 'CCC_ITEM_ID'             TO TABLE-ELEMENT-3        
CBSI           MOVE 'COMPANY_NO'              TO TABLE-ELEMENT-4        
T16114         MOVE CC-ACCOUNT-NO             TO HOSTVAR-ELEMENT-1      
T16114         MOVE CC-PYMT-PRIORITY-LVL      TO HOSTVAR-ELEMENT-2      
T16114         MOVE CC-CCC-ITEM-ID            TO HOSTVAR-ELEMENT-3      
CBSI           MOVE U7-COMPANY-NO             TO HOSTVAR-ELEMENT-4      
T16114         PERFORM 9000-SEND-ERROR-RESULT THRU 9000-EXIT            
T16114         PERFORM 9900-SQL-ERROR-ROUTINE THRU 9900-EXIT            
T16114     END-IF.                                                      
T16114                                                                  
T16114 7910-EXIT.                                                       
T16114     EXIT.                                                        
                                                                        
T16114******************************************************************        
T16114* 7920-OPEN-UTIL-CURSOR                                          *        
T16114******************************************************************        
T16114 7920-OPEN-UTIL-CURSOR.                                           
T16114                                                                  
T16114     EXEC SQL                                                     
T16114        OPEN UTIL-CURSOR                                          
T16114     END-EXEC.                                                    

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

T16114                                                                  
T16114     MOVE SQLCODE TO WS-ACTIVE-RETURN-CODE.                       
T16114                                                                  
T16114     IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL                   
T16114         NEXT SENTENCE                                            
T16114     ELSE                                                         
T16114         MOVE PROGRAM-NAME              TO ABEND-PROGRAM          
T16114         MOVE '7920'                    TO ACTIVE-PARAGRAPH       
T16114         MOVE 'OPEN'                    TO ABEND-FUNCTION         
CBSI           MOVE 'CSS_UTIL_ENVRNMT'        TO TABLE-1                
CBSI           MOVE 'ACCOUNT_NO'              TO TABLE-ELEMENT-1        
CBSI           MOVE UT-ACCOUNT-NO             TO HOSTVAR-ELEMENT-1      
T16114         PERFORM 9000-SEND-ERROR-RESULT THRU 9000-EXIT            
T16114         PERFORM 9900-SQL-ERROR-ROUTINE THRU 9900-EXIT            
T16114     END-IF.                                                      
T16114                                                                  
T16114 7920-EXIT.                                                       
T16114     EXIT.                                                        
                                                                        
T16114******************************************************************        
T16114* 7930-FETCH-UTIL-CURSOR                                         *        
T16114******************************************************************        
T16114 7930-FETCH-UTIL-CURSOR.                                          
T16114                                                                  
T16114     EXEC SQL                                                     
T16114        FETCH UTIL-CURSOR                                         
T16114         INTO :UT-CODE-UTIL-TYPE,                                 
T16114              :UT-IC-NO                                           
T16114     END-EXEC.                                                    

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

T16114                                                                  
T16114     MOVE SQLCODE TO WS-ACTIVE-RETURN-CODE.                       
T16114                                                                  
T16114     IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL OR NOT-FOUND      
T16114         NEXT SENTENCE                                            
T16114     ELSE                                                         
T16114         MOVE PROGRAM-NAME              TO ABEND-PROGRAM          
T16114         MOVE '7930'                    TO ACTIVE-PARAGRAPH       
T16114         MOVE 'FETCH'                   TO ABEND-FUNCTION         
CBSI           MOVE 'CSS_UTIL_ENVRNMT'        TO TABLE-1                
CBSI           MOVE 'ACCOUNT_NO'              TO TABLE-ELEMENT-1        
CBSI           MOVE UT-ACCOUNT-NO             TO HOSTVAR-ELEMENT-1      
T16114         PERFORM 9000-SEND-ERROR-RESULT THRU 9000-EXIT            
T16114         PERFORM 9900-SQL-ERROR-ROUTINE THRU 9900-EXIT            
T16114     END-IF.                                                      
T16114                                                                  
T16114 7930-EXIT.                                                       
T16114     EXIT.                                                        
                                                                        
T16114******************************************************************        
T16114* 7940-CLOSE-UTIL-CURSOR                                         *        
T16114******************************************************************        
T16114 7940-CLOSE-UTIL-CURSOR.                                          
T16114                                                                  
T16114     EXEC SQL                                                     
T16114        CLOSE UTIL-CURSOR                                         
T16114     END-EXEC.                                                    

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

T16114                                                                  
T16114     MOVE SQLCODE TO WS-ACTIVE-RETURN-CODE.                       
T16114                                                                  
T16114     IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL                   
T16114         NEXT SENTENCE                                            
T16114     ELSE                                                         
T16114         MOVE PROGRAM-NAME              TO ABEND-PROGRAM          
T16114         MOVE '7940'                    TO ACTIVE-PARAGRAPH       
T16114         MOVE 'CLOSE'                   TO ABEND-FUNCTION         
CBSI           MOVE 'CSS_UTIL_ENVRNMT'        TO TABLE-1                
CBSI           MOVE 'ACCOUNT_NO'              TO TABLE-ELEMENT-1        
CBSI           MOVE UT-ACCOUNT-NO             TO HOSTVAR-ELEMENT-1      
T16114         PERFORM 9000-SEND-ERROR-RESULT THRU 9000-EXIT            
T16114         PERFORM 9900-SQL-ERROR-ROUTINE THRU 9900-EXIT            
T16114     END-IF.                                                      
T16114                                                                  
T16114 7940-EXIT.                                                       
T16114     EXIT.                                                        
                                                                        
T16114******************************************************************        
T16114* 7950-OPEN-UNMTRD-CURSOR                                        *        
T16114******************************************************************        
T16114 7950-OPEN-UNMTRD-CURSOR.                                         
T16114                                                                  
T16114     EXEC SQL                                                     
T16114        OPEN UNMTRD-CURSOR                                        
T16114     END-EXEC.                                                    

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

T16114                                                                  
T16114     MOVE SQLCODE TO WS-ACTIVE-RETURN-CODE.                       
T16114                                                                  
T16114     IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL                   
T16114        NEXT SENTENCE                                             
T16114     ELSE                                                         
T16114        MOVE PROGRAM-NAME              TO ABEND-PROGRAM           
T16114        MOVE '7950'                    TO ACTIVE-PARAGRAPH        
T16114        MOVE 'OPEN'                    TO ABEND-FUNCTION          
CBSI          MOVE 'CSS_CUST_PLAN'           TO TABLE-1                 
CBSI          MOVE 'ACCOUNT_NO'              TO TABLE-ELEMENT-1         
CBSI          MOVE CP-ACCOUNT-NO             TO HOSTVAR-ELEMENT-1       
T16114        PERFORM 9000-SEND-ERROR-RESULT THRU 9000-EXIT             
T16114        PERFORM 9900-SQL-ERROR-ROUTINE THRU 9900-EXIT             
T16114     END-IF.                                                      
T16114                                                                  
T16114 7950-EXIT.                                                       
T16114     EXIT.                                                        
                                                                        
T16114******************************************************************        
T16114* 7960-FETCH-UNMTRD-CURSOR                                       *        
T16114******************************************************************        
T16114 7960-FETCH-UNMTRD-CURSOR.                                        
T16114                                                                  
T16114     EXEC SQL                                                     
T16114        FETCH UNMTRD-CURSOR                                       
T16114         INTO :CP-CODE-SERVICE-TYPE                               
T16114     END-EXEC.                                                    

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

T16114                                                                  
T16114     MOVE SQLCODE TO WS-ACTIVE-RETURN-CODE.                       
T16114                                                                  
T16114     IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL OR NOT-FOUND      
T16114        NEXT SENTENCE                                             
T16114     ELSE                                                         
T16114        MOVE PROGRAM-NAME              TO ABEND-PROGRAM           
T16114        MOVE '7960'                    TO ACTIVE-PARAGRAPH        
T16114        MOVE 'FETCH'                   TO ABEND-FUNCTION          
CBSI          MOVE 'CSS_CUST_PLAN'           TO TABLE-1                 
CBSI          MOVE 'ACCOUNT_NO'              TO TABLE-ELEMENT-1         
CBSI          MOVE CP-ACCOUNT-NO             TO HOSTVAR-ELEMENT-1       
T16114        PERFORM 9000-SEND-ERROR-RESULT THRU 9000-EXIT             
T16114        PERFORM 9900-SQL-ERROR-ROUTINE THRU 9900-EXIT             
T16114     END-IF.                                                      
T16114                                                                  
T16114 7960-EXIT.                                                       
T16114     EXIT.                                                        
                                                                        
T16114******************************************************************        
T16114* 7970-CLOSE-UNMTRD-CURSOR                                       *        
T16114******************************************************************        
T16114 7970-CLOSE-UNMTRD-CURSOR.                                        
T16114                                                                  
T16114     EXEC SQL                                                     
T16114        CLOSE UNMTRD-CURSOR                                       
T16114     END-EXEC.                                                    

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

T16114                                                                  
T16114     MOVE SQLCODE TO WS-ACTIVE-RETURN-CODE.                       
T16114                                                                  
T16114     IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL                   
T16114        NEXT SENTENCE                                             
PCR212     ELSE                                                         
T16114        MOVE PROGRAM-NAME              TO ABEND-PROGRAM           
T16114        MOVE '7970'                    TO ACTIVE-PARAGRAPH        
T16114        MOVE 'CLOSE'                   TO ABEND-FUNCTION          
CBSI          MOVE 'CSS_CUST_PLAN'           TO TABLE-1                 
CBSI          MOVE 'ACCOUNT_NO'              TO TABLE-ELEMENT-1         
CBSI          MOVE CP-ACCOUNT-NO             TO HOSTVAR-ELEMENT-1       
T16114        PERFORM 9000-SEND-ERROR-RESULT THRU 9000-EXIT             
T16114        PERFORM 9900-SQL-ERROR-ROUTINE THRU 9900-EXIT             
T16114     END-IF.                                                      
T16114                                                                  
T16114 7970-EXIT.                                                       
T16114     EXIT.                                                        
                                                                        
T16561******************************************************************        
T16561* 8200-UPDATE-AMT-ORIG.                                          *        
T16561******************************************************************        
T16561 8200-UPDATE-AMT-ORIG.                                            
                                                                        
T16561     MOVE '8200' TO ACTIVE-PARAGRAPH.                             
T16561     EXEC SQL                                                     
T16561         UPDATE CSS_AR_TRANS_HIST                                 
T16561            SET AMT_ORIG_ENTERED  = :AR-AMT-ORIG-ENTERED          
T16561          WHERE ACCOUNT_NO        = :AR-ACCOUNT-NO                
T16561            AND TRANS_HIST_SEQ_NO = CIS.CHAR2TIMESTAMP(
                                                  :AR-TRANS-HIST-SEQ-NO
              )         
T16561     END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ054
MFA-TR*    EXEC SQL                                                             
MFA-TR*        UPDATE CSS_AR_TRANS_HIST                                         
MFA-TR*           SET AMT_ORIG_ENTERED  = :AR-AMT-ORIG-ENTERED                  
MFA-TR*         WHERE ACCOUNT_NO        = :AR-ACCOUNT-NO                        
MFA-TR*           AND TRANS_HIST_SEQ_NO = :AR-TRANS-HIST-SEQ-NO                 
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

V16561                                                                  
T16561     MOVE SQLCODE TO WS-ACTIVE-RETURN-CODE.                       
T16561     IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL                   
T16561         NEXT SENTENCE                                            
T16561     ELSE                                                         
T16561         MOVE PROGRAM-NAME              TO ABEND-PROGRAM          
T16561         MOVE '8200'                    TO ACTIVE-PARAGRAPH       
T16561         MOVE 'UPDATE'                  TO ABEND-FUNCTION         
T16561         MOVE 'CSS_AR_TRANS_HIST'       TO TABLE-1                
CBSI           MOVE 'ACCOUNT_NO'              TO TABLE-ELEMENT-1        
CBSI           MOVE 'AMT_ORIG_ENTERED'        TO TABLE-ELEMENT-2        
CBSI           MOVE AR-ACCOUNT-NO             TO HOSTVAR-ELEMENT-1      
CBSI           MOVE AR-AMT-ORIG-ENTERED       TO WS-AMT-ORIG-ENTERED-ED 
CBSI           MOVE WS-AMT-ORIG-ENTERED-ED    TO HOSTVAR-ELEMENT-2      
T16561         PERFORM 9000-SEND-ERROR-RESULT THRU 9000-EXIT            
T16561         PERFORM 9900-SQL-ERROR-ROUTINE THRU 9900-EXIT            
T16561     END-IF.                                                      
T16561                                                                  
T16561 8200-EXIT.                                                       
T16561     EXIT.                                                        
A36248*                                                                         
A36248*****************************************************************         
A36248*8555-CALL-MCSCB371.                                            *         
A36248*FOR CSR, MCSCB371 UPDATES DNP-BALANCE RETURNED BY CPD00068.    *         
A36248*IF MCSCB371 FAILS, INSERT 'U' ROW IN CSS_SO_DNP_CANCEL TABLE   *         
A36248*TO BE PROCESSED BY BATCH PROGRAM.                              *         
A36248*****************************************************************         
A36248 8555-CALL-MCSCB371.                                              
A36248     MOVE SPACES                       TO ABEND-FUNCTION.         
A36248     MOVE ZERO                         TO RS-RETURN-CODE.         
A36248*                                                                         
A36248     CALL MCSCB371    USING  AT-ACCOUNT-NO,                       
A36248                             AT-DATE-BILL-DAY-00,                 
A36248                             AT-CREDIT-GROUP,                     
A36248                             WS-CPD68-DNP-BAL,                    
A36248                             ABEND-FILE,                          
A36248                             RS-RETURN-CODE.                      
A36248*                                                                         
A36248     MOVE RS-RETURN-CODE               TO WS-ACTIVE-RETURN-CODE   
A36248     IF ABEND-FUNCTION > SPACES OR WS-ACTIVE-RETURN-CODE NOT      
A36248                                EQUAL SUCCESSFUL-CALL             
A36248        PERFORM 8610-INSERT-SO-DNP-CANCEL THRU 8610-EXIT          
A36248     END-IF.                                                      
A36248*                                                                         
A36248 8555-EXIT.                                                       
A36248     EXIT.                                                        
                                                                        
PCR307******************************************************************        
PCR307* 8610-INSERT-SO-DNP-CANCEL.                                     *        
PCR307******************************************************************        
PCR307 8610-INSERT-SO-DNP-CANCEL.                                       
PCR307                                                                  
PCR307     MOVE WS-U                         TO XK-SO-UPDT-ACTION-FL.   
T17816     MOVE AT-ACCOUNT-NO                TO XK-ACCOUNT-NO.          
PCR307                                                                  
PCR307     EXEC SQL                                                     
PCR307        INSERT INTO CSS_SO_DNP_CANCEL                             
PCR307          ( ACCOUNT_NO,                                           
PCR307            SO_UPDT_ACTION_FL )                                   
PCR307        VALUES ( :XK-ACCOUNT-NO,                                  
PCR307                 :XK-SO-UPDT-ACTION-FL )                          
PCR307     END-EXEC.                                                    

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

PCR307                                                                  
PCR307     MOVE SQLCODE TO WS-ACTIVE-RETURN-CODE                        
PCR307                     RS-RETURN-CODE.                              
PCR307     IF WS-ACTIVE-RETURN-CODE EQUAL SUCCESSFUL-CALL OR            
PCR307        WS-ACTIVE-RETURN-CODE EQUAL -803                          
PCR307        MOVE ZERO TO WS-ACTIVE-RETURN-CODE                        
PCR307                     RS-RETURN-CODE                               
PCR307     ELSE                                                         
PCR307        MOVE PROGRAM-NAME              TO ABEND-PROGRAM           
PCR307        MOVE '8610'                    TO ACTIVE-PARAGRAPH        
PCR307        MOVE 'INSERT'                  TO ABEND-FUNCTION          
PCR307        MOVE SPACES                    TO ABEND-SQL-PREDICATES    
PCR307                                          ABEND-TABLES            
PCR307        MOVE 'CSS_SO_DNP_CANCEL'       TO TABLE-1                 
CBSI          MOVE 'ACCOUNT_NO'              TO TABLE-ELEMENT-1         
PCR307        MOVE XK-ACCOUNT-NO             TO HOSTVAR-ELEMENT-1       
PCR307        PERFORM 9700-PROCESS-ABEND           THRU 9700-EXIT       
PCR307     END-IF.                                                      
PCR307 8610-EXIT.                                                       
PCR307     EXIT.                                                        
                                                                        
A36248*****************************************************************         
A36248*8999-ISSUE-COMMIT.                                                       
A36248*****************************************************************         
A36248 8999-ISSUE-COMMIT.                                               
A36248     EXEC SQL                                                             
A36248         INCLUDE CPD00047                                                 
A36248     END-EXEC.                                                            
                                                    
A36248 8999-EXIT.                                                       
A36248     EXIT.                                                        
A36248*                                                                         
SEBSEB******************************************************************        
SEBSEB* 9500-XREF-ACCOUNT.                                             *        
SEBSEB******************************************************************        
SEBSEB 9500-XREF-ACCOUNT.                                               
SEBSEB                                                                  
T16114     EXEC SQL                                                     
T16114        SELECT ACCOUNT_NO                                         
T16114          INTO :XM-ACCOUNT-NO                                     
T16114          FROM CSS_MKT_XREF_ACCT WITH(READUNCOMMITTED)                    
T16114         WHERE DIST_ACCT_NO         = :XM-DIST-ACCT-NO            
P00641                                                           
P00641                                                      
T16114     END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ003
MFA-TR* MSQ022
MFA-TR*    EXEC SQL                                                             
MFA-TR*       SELECT ACCOUNT_NO                                                 
MFA-TR*         INTO :XM-ACCOUNT-NO                                             
MFA-TR*         FROM CSS_MKT_XREF_ACCT                                          
MFA-TR*        WHERE DIST_ACCT_NO         = :XM-DIST-ACCT-NO                    
MFA-TR*      WITH UR                                                            
MFA-TR*      QUERYNO 9500                                                       
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

T16114                                                                  
T16114     MOVE SQLCODE TO WS-ACTIVE-RETURN-CODE.                       
T16114                                                                  
T16114     IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL                   
T16114        NEXT SENTENCE                                             
T16114     ELSE                                                         
T16114        MOVE WS-ACTIVE-RETURN-CODE     TO RS-RETURN-CODE          
T16114        MOVE PROGRAM-NAME              TO ABEND-PROGRAM           
T16114        MOVE '9500'                    TO ACTIVE-PARAGRAPH        
T16114        PERFORM 9000-SEND-ERROR-RESULT THRU 9000-EXIT             
T16114        PERFORM 9900-SQL-ERROR-ROUTINE THRU 9900-EXIT             
T16114     END-IF.                                                      
T16114                                                                  
T16114 9500-EXIT.                                                       
T16114     EXIT.                                                        
                                                                        
T24436******************************************************************        
T24436* 9350-LINK-SCSCO061.                                            *        
T24436* LOADING GL NUMBERS - CALLS THE SUBPROGRAM SCSCO061             *        
T24436******************************************************************        
T24436 9350-LINK-SCSCO061.                                              
T24436                                                                  
T24436     MOVE SPACES                 TO ABEND-FUNCTION.               
T24436     PERFORM 9400-CALL-CPD00061  THRU 9400-EXIT.                  
T24436     MOVE RS-RETURN-CODE                TO WS-ACTIVE-RETURN-CODE, 
T24436                                           SQLCODE.               
T24436     IF ABEND-FUNCTION  > SPACES                                  
T24436        PERFORM 9700-PROCESS-ABEND      THRU 9700-EXIT            
T24436     END-IF.                                                      
T24436                                                                  
T24436 9350-EXIT.                                                       
T24436     EXIT.                                                        
T24436                                                                  
T24436******************************************************************        
T24436* 9400-CALL-CPD00061 - CALLS THE COPYBOOK CPD00061               *        
T24436******************************************************************        
T24436 9400-CALL-CPD00061.                                              
T24436                                                                  
REARCH     CALL MCSCO061  USING  WS-GL-ACCT-NAME                        
REARCH                           WS-GL-ACCT-MAJOR-FIELDS                
REARCH                           WS-VALID-COMPANY-NOS                   
REARCH                           WS-GL-NAME-INFO                        
REARCH                           WS-GL-ACCT-NO-TABLE                    
REARCH                           ABEND-FILE                             
REARCH                           RS-RETURN-CODE.                        
REARCH     MOVE RS-RETURN-CODE            TO WS-ACTIVE-RETURN-CODE,     
REARCH                                       S-RETURN-CODE.             
REARCH     IF ABEND-FUNCTION  > SPACES                                  
REARCH        IF ABEND-FUNCTION EQUAL 'BADDATA'                         
REARCH           MOVE -1                  TO RS-RETURN-CODE,            
REARCH                                       WS-ACTIVE-RETURN-CODE      
REARCH        END-IF                                                    
REARCH        PERFORM 9700-PROCESS-ABEND    THRU 9700-EXIT              
REARCH     END-IF.                                                      
T24436                                                                  
T24436 9400-EXIT.                                                       
T24436     EXIT.                                                        
                                                                        
T19557******************************************************************        
T19557* 9600-CALL-CPD00068.                                            *        
T19557******************************************************************        
T19557 9600-CALL-CPD00068.                                              
T19557                                                                  
CVT000         CALL MCSCB068   USING CWS00068-FIELDS,                   
CVT000                               WS-CODES-DATA-PRESENT,             
CVT000                               DCLCSS-ACCOUNT,                    
CVT000                               ABEND-FILE,                        
CVT000                               RS-RETURN-CODE.                    
T19557                                                                  
T19557 9600-EXIT.                                                       
T19557     EXIT.                                                        
      *****************************************************************         
      * COPYBOOK PROCEDURE CODE                                                 
      *****************************************************************         
                                                                        
           EXEC SQL                                                             
              INCLUDE CPD00075                                                  
           END-EXEC.                                                            
                                                                        
           EXEC SQL                                                             
              INCLUDE CPD00307                                                  
           END-EXEC.                                                            
                                                                        
           EXEC SQL                                                             
              INCLUDE CPD0023C                                                  
           END-EXEC.                                                            
                                                                        
      *****************************************************************         
      * 9900 - JOURNALING / ERROR HANDLING ROUTINE                              
      *****************************************************************         
           EXEC SQL                                                             
              INCLUDE CPDSP300                                                  
           END-EXEC.                                                            
                                                                        
NONUTL     EXEC SQL                                                             
NONUTL        INCLUDE CPD00312                                                  
NONUTL     END-EXEC.                                                            
                                                                        
CVT000 8100-SEND-RESULT.                                                
CVT000       ADD 1 TO CTR-ROWS.                                         
CVT000 8100-EXIT.                                                       
CVT000        EXIT.                                                     
CVT000     EXEC SQL                                                     00000100
CVT000         INCLUDE CPD00321                                         00000200
CVT000     END-EXEC.                                                    00000300
