       IDENTIFICATION DIVISION.                                         
       PROGRAM-ID.    CSR02294.                                         
COB303 DATE-WRITTEN.  DECEMBER 16, 1994.                                
       DATE-COMPILED.                                                   
                                                                        
      ***************************************************************** 00060000
      *                                                                 00070000
      *                SOUTH CAROLINA ELECTRIC & GAS                    00080000
      *                                                                 00090000
      *  THIS PROGRAM IS EXECUTED VIA A REMOTE PROCEDURE CALL (RPC).    00100000
      *                                                                 00110000
      *  TRANID:        S294                                            00120000
      *  PROGRAM:       S294                                            00130000
      *  CALLING SP:    PA_S294                                         00140000
      *                                                                 00150000
      ***************************************************************** 00160000
      *                 P R O G R A M  S U M M A R Y                    00170000
      *                                                                 00180000
      *  THIS PROGRAM UPDATES THE CSS_ACCOUNT, CSS_AR_CNTL,             00190000
      *  CSS_AR_TRANS_HIST, CSS_AR_TRN_HST_DET, AND THE                 00200000
      *  CSS_CONNECT_CHRG TABLES WITH MISCELLANEOUS CHARGES             00210000
      *  BASED ON THE RECEIVABLE TYPE GIVEN.                            00220000
      *                                                                 00230000
      ***************************************************************** 00240000
      *                                                                 00250000
      *                     PROGRAM MODIFICATION LOG                    00260000
      *                                                                 00270000
      *    DATE    INITIALS   COMMENTS                                  00280000
      *  --------  --------   ---------------------------------------   00290000
      *  12/19/94    MLR      ORIGINAL CODE                             00300000
      *  04/17/95    ECC      PROCEDURE CODED PER MODIFIED DESIGN       00310000
      *  07/26/95    MB       VALUE SET TO WS-PAR-EIBTRNID              00320000
      *  01/22/96    DMD      TPR 2065 - SET WS-CODE-EPP-OFFER, EPP-    00330000
      *                       OFFER-DATE AND EPP-OFFER-AMOUNT TO        00340000
      *                       SPACES SO THAT AUTOMATIC ENROLLMENT IN    00350000
      *                       EPP IS NOT TRIGGERED IN CPD00010          00360000
      *  03/28/96    LMB      TPR 2508 - ADDED TBLIEAP                  00370000
      *  03/28/96    LMB      TPR 2585 - ADDED TBNSFHST, TBCRPROF       00380000
      *  07/26/96    JEP      TPR 4893 - REMOVED REFERENCES TO CPD00068 00390000
      *                       CWS00068, TBCRCOLL AND TBDELQ.            00400000
      *  09/23/96    PD       PCR 305 ADDED CJF00105 FOR CPD10 CHANGES  00410000
      *  09/30/96    PD       COMMENTED CODE FOR CIAC FOR PCR072.      *00420000
      *  10/09/96    JRX      ADD CANCELDNP-FLAG TO THE RESULT SET     *00430000
      *  02/04/97    PD       MAKE DIRECTED PYMT FOR RCC AMT.          *00440000
      ** 03/19/97     PD      ADD DCLGEN TBWOARGM FOR CPD73 CHANGES.  * 00450000
      ** 03/31/97    MJG      ADDED TWO DCLGENS FOR CPD00068 CHANGES. * 00460000
      ** 04/07/97    PD       MADE THE PAYMENT ON UNBILLED RCC AS A   * 00470000
      **                      PRE PAYMENT WHICH DOES NOT CHANGE THE   * 00480000
      **                      AR BALANCE OF THE ACCOUNT, BUT ONLY     * 00490000
      **                      CHANGES THE RCC AR-TRAN-BALANCE.        * 00500000
      *  05/08/97    PP       PCR404 CHANGES.                         * 00510000
      *  06/05/97    PP       PROPER POPULATION OF PROGRAM ID.        * 00520000
T11360*  06/18/97    CHANDRA  IF THE BILLED BALANCE IS ZERO FOR       * 00530000
T11360*                       PPTY 60/100/129, THEN PAY THE TRAN      * 00540000
T11360*                       BALANCE                                 * 00550000
T11797*  06/24/97    PP       PANEL310D CHANGED TO PANEL310E          * 00560000
NONUTL**  7/11/97    CHANDRA  ADDED CPD00312, CWS10016, TBHLDAY       * 00570000
T12460*  08/01/97    EMS      ADDED CSS_DNP DCLGEN FOR CPD68 CHANGES  * 00580000
T13034*  11/03/97    PD       JOURNAL DETAIL WHILE CREDITING CNT.     * 00590000
T13773*  11/14/97    PD       ALWAYS USE CPD10 TO CREDIT CNT.         * 00600000
T14840*  02/26/98    PD/KTB   CHANGES TO PROCESS REBATE ONLY CONTRACTS* 00610000
T16114*  04/28/98    PD       SPLIT THE JOURNAL FOR LPC AND RCC EVEN  * 00620000
T16114*                       THOSE RECEIVABLES ARE NOT PRESENT.      * 00630000
T16561*  05/26/98    PD       CHANGE AMT-ORIG-ENTERED WITH THE TOTAL  * 00640000
T16561*                       TRANSACTION AMOUNT.                     * 00650000
T16792*  06/12/98    VIJI     TPR 16792 - CHANGED WS-RECV-TYPE TO     * 00660000
      *                       PARM-RECV-TYPE SO THAT "MISC CREDIT"    * 00670000
      *                       SHOWS UP AS DESCRIPTION FOR A DIRECTED  * 00680000
      *                       UTE CREDIT MISC CHARGES.                * 00690000
T17032*  07/13/98    PD       DO NOT GO UNDIRECTED IF ACCOUNT HAS     * 00700000
T17032*                       A PAID RECONNECT.                       * 00710000
T17253*  07/31/98    SV       ADD ACCTING PERIOD TO PANEL310          * 00720000
T17191*  08/04/98    SV       USE CREDIT-LPC FLAG FOR CORRECT SPLITTING 00730000
      *                       OF THE RECEIVABLES                      * 00740000
PCR307*    09/03/98  AMG      IF THE PAYMENT IS NOT ENOUGH TO CANCEL  * 00750000
PCR307*                       THE DNP, THEN INSERT A ROW INTO         * 00760000
PCR307*                       CSS_SO_DNP_CANCEL WITH A FLAG OF 'U'    * 00770000
T17816*  09/16/98    PRA      MOVE AT-ACCOUNT-NO TO XK-ACCOUNT-NO     * 00780000
      *                       INSTEAD OF WS-ACCOUNT-NO                * 00790000
T18179*  10/19/98    SV       WHILE DOING MISC CREDIT, CHECK THAT THE * 00800000
      *                       CREDIT AMOUNT IS NOT MORE THAN BILLED   * 00810000
      *                       BALANCE OF CONTRACT.                    * 00820000
T17071*  11/19/98    MDJ      ADDED INCLUDE TBCSTALT FOR CUST_ALERT IN* 00830000
      *                       CPD00068.                               * 00840000
T18526*   12/01/98    SV      HANDLE EXTRA CREDIT APPLIED TO THE      * 00850000
      *                       RECEIVABLES.                            * 00860000
CBSI  *  12/15/98    CBSI     ABEND LOG MODIFIED TO INCLUDE ALL THE    *00870000
CBSI  *              MADRAS   ABEND PARAMETERS                         *00880000
T19614*   4/7/99     BAB      UPDATE T18179 TO ALLOW CR AMOUNT UP     * 00890000
      *                       TO TRAN BALANCE OF CONTRACT             * 00900000
T19646*   4/22/99    BAB      MODIFIED SO THAT LPC CREDIT ON ACCOUNT  * 00910000
      *                       WITH RECONNECT WOULD PROCESS (BAD PPL   * 00920000
      *                       SENT TO CSS_AR_CNTL SELECT).  ALSO,     * 00930000
      *                       UPDATED SO IF FAILED, WOULD RETURN CODE * 00940000
      *                       TO DESKTOP INDICATING FAILURE RATHER    * 00950000
      *                       THAN SUCCESS.                           * 00960000
T19996*   5/24/99    FB       ALLOW MARKETING CONTRACTS ON SUB        * 00970000
      *                       ACCOUNTS.                               * 00980000
T20099*   5/28/99    BB       UPDATE TAX PROCESSING TO ACCOMODATE FOR * 00990000
      *                       MULTIPLE 'OTHER' TAXES.                 * 01000000
T19886*   7/30/99    CBSI     INSERTED A ROW INTO CSS_AR_CNTL WHEN CIA* 01010000
T19886*              MADRAS   IS SELECTED FROM THE DROPDOWN FOR AN    * 01020000
T19886*                       ACCOUNT WHICH DOESN'T HAVE A CIA        * 01030000
T20081*  08/31/99    CBSI     CHANGES TO COMPUTE DNP AMOUNT CORRECTLY * 01040000
      *              CHENNAI  WHEN 3300-CALC... PARA IS CALLED        * 01050000
T21170*  11/25/99    CBSI     SEND A MESSAGE TO THE PANEL  WHEN AN    * 01060000
T21170*              CHENNAI  ACCT HAS A RECONNECT AGREEMENT INSTEAD  * 01070000
T21170*                       OF SENDING THE PAYMENT AS UNDIRECTED    * 01080000
T21113*  12/01/99    CBSI     CALL SUB ROUTINE SCSCA182 AND CHECK IF  * 01090000
T21113*              CHENNAI  THE PARM-AT-LAST-UPDATE-TS AND THE ONE  * 01100000
T21113*                       OBTAINED FROM THE SUB ROUTINE ARE SAME, * 01110000
T21113*                       IF THEY ARE SAME UPDATES AR_CNTL ELSE   * 01120000
T21113*                       SEND ERROR MSG TO THE PANEL             * 01130000
T19557*  03/30/00    CBSI     COPYBOOK CDP00068 CHANGED TO SUB PROGRAM* 01140000
T19557*              CHENNAI  SCSCO068.                               * 01150000
T22096*  04/18/00    KSB      DO NOT DO DATETIMESTAMP CHECK FOR       * 01160000
T22096*                       REBATE ONLY CONTRACTS                   * 01170000
T22359*  06/21/00    MDJ      MADE CHANGES TO KEEP IDENTITY OF PROGRAM *01180000
      *                       CALLING SCSCO068 OR SCSCB068.  THERE IS  *01190000
      *                       SPECIFIC LOGIC IN CPD00068 FOR CERTAIN   *01200000
      *                       PROGRAMS WHICH WAS NOT BEING EXECUTED    *01210000
      *                       PROPERLY BECAUSE THE PROGRAM NAME WAS    *01220000
      *                       ALWAYS SCSCO068 OR SCSCB068.             *01230000
T22491*  08/18/00    BAB      DEPOSIT INTEREST CREDIT AND GMA ADJSTMNT *01240000
DEPINT*                       MOD SO THAT CORRECT APPL-PROG-ID IS USED *01250000
C22830*  10/23/00    BAB      POST APARTMENT CREDIT MOD SO THAT        *01260000
      *                       CORRECT APPL-PROG-ID IS USED             *01270000
T24008*  06/05/01    BAB      ADT TRANSFER MOD SO THAT CORRECT         *01280000
      *                       APPL-PROG-ID IS USED                     *01290000
T23501*  05/02/01    VD88125  DELINQUENCY TABLE CHANGES TO SUPPORT     *01300000
T23501*                       MULTI-COMPANY AND PSNC CONVERSION.       *01310000
T23748*  05/22/01    VD88125  MADE CHANGES TO RETRIEVE COMPANY-NO AS 01*01320000
T23748*                      INSTEADOF AT-COMPANY-NO FROM CSS_GL_ACCT_NO01330000
T23235*  06/25/01    SS82048  MCR-57 CHANGES TO INCLUDE NEW COLUMN     *01340000
      *                       RCNCT_ACCT_TYPE_CD IN WHERE CLAUSE OF    *01350000
      *                       SELECT ON CSS_RECONNECT_CHRG             *01360000
T24367*  07/11/01    SFH      ADDED LOGIC TO SEND CANCEL NOT FLAG TO   *01370000
      *                       PANEL 310.                               *01380000
T24555*  08/07/01    SFH      REPLACED WS-GL-SUB WITH WS-VALID-CO-SUB  *01390000
      *                       AS AN INDEX TO WS-VALID-CO-NO. THIS WILL *01400000
      *                       PREVENT A SUBSCRIPT OUT OF BOUNDS ERROR. *01410000
T25607*  09/11/01    SK88120  IF THE ACCOUNT IS NOT HAVING A ROW IN    *01420000
      *                       CSS_UTIL_ENVRNMT ,WS_ACCT_TYPE_CD IS *    01430000
      *                       NOT BEING POPULATED . MADE CHANGES TO    *01440000
      *                       RETRIEVE ACCT_TYPE_CODE FROM CSS_ACCOUNT *01450000
      *                       FOR THOSE TYPE OF ACCOUNTS.              *01460000
T24436*  10/13/01    NVM      ADDED LOGIC TO INCLUDE SUB PROGRAM       *01470000
T24436*                       SCSCO061 FOR CPD00061 COPYBOOK CONVERSION*01480000
T23264*  11/27/01    ESM      ADDED CODE FOR JAMES ISLAND REFUND.      *01490000
C23197*  03/01/02    JS83520  CHANGED PARA 2200- TO GIVE ERR MSG FOR A *01491000
C23197*                       DIRECTED COURTESY ADJUSTMENT TO A         01492000
C23197*                       RECEIVABLE WITH NO CHARGE.                01493000
C22282*  03/01/02    JS83520  INCLUDED 9900- PARA IF RS-RETURN-CODE    *01494000
C22282*                       SET TO 9999 IN 5000- AND 5010-           *01495000
C25426*  04/02/02    VD88125  DEPOSIT INTEREST CREDIT MOD SO THAT      *01496000
C25426*                       CORRECT APPL-PROG-ID IS USED             *01497000
C26130*  06/20/02    MDJ      REMOVED LOGIC THAT MOVED SPACES TO       *01498000
      *                       WS-CODE-EPP-OFFER, MOVED LOW VALUES TO   *01499000
      *                       EPP-OFFER-DATE AND ZERO TO EPP-OFFER-AMT.*01499100
C28201*  01/08/03    BASKAR   DO NOT ALLOW CREDIT CNT WHEN JRNL FL IS  *01499200
C28201*                       'C' IN SUMMARY CNT TABLE.                *01499300
C24880*  03/18/03    SRIDEVI  CREATED A NEW APPL-PROGRAM-ID IN CASE OF *01499400
C24880*                       A CONNECTION CHARGE DFA WHICH CAN BE     *01499500
C24880*                       CREDITED USING THE CREDIT EXIST RCV TAB  *01499600
C28632*  03/21/03    SRIDEVI  REMOVED LOGIC THAT SET EPP-OFFER FIELDS  *01499700
C28632*                       TO ZERO.  CPD10 WILL NOT SET UP AUTO EPP *01499800
C28632*                       OFFER IF CALLING PROGRAM = S294, S396 OR *01499900
C28632*                       S998.                                    *01500000
C28788*  07/07/03    MDJ      GET IVR-EXEMPT-CD FOR CPD00068.          *01500100
C30454*  03/16/04    BB18179  SEB SALES TAX MOD SO THAT CORRECT        *01500200
      *                       APPL-PROG-ID IS USED                     *01500300
C30304*  03/18/04    JS83520  INITIALIZE WS-PAR-TYPE-NO IN PARA 2260-   01500400
C30304*                       TO INITIALIZE ITEM_NO                     01500500
T29700*  10/15/04    COVANSYS MOVED '01' TO GO-COMPANY-NO IN PARA      *01500600
T29700*              CHENNAI  2260- FOR TAX-STAT AND ADDED TO PERFORM  *01500700
T29700*                       2260- FOR BILLED CONTRACT                *01500800
T30135*  05/09/05    CB18344  ADDED APPL-PROG-ID INFORMATION FOR 2 NEW *01500900
T30135*                       MISCELLANEOUS CREDITS -                  *01501000
T30135*                       INTEREST SUBDIVISION LIGHT AND INTEREST  *01501100
T30135*                       FRANCHISE FEE.                           *01501200
REARCH*  10/20/05    CVNS     RPC TO COBOL SP CONVERSION               *01501300
REARCH*              CHENNAI                                           *01501400
T34116*  04/04/06    SK88120  CHANGED GL-ACCT FIELD TYPE TO FIX PANEL\ *01501500
T34116*                       BTCH PROGAM ISSUE.                       *01501600
T34116*  04/07/06    SK88120  MADE CHANGES TO POPULATE TRANSACTION COMM*01501700
T34116*                       ENTS CORRECTLY.                          *01501800
T34116*  04/24/06    SK88120  PROGRAM-ID CHANGED TO S294 . THIS IS A   *01501900
T34116*                       TEMPORARY FIX. CHANGES WILL BE MADE TO   *01502000
T34116*                       CPD00010 AND THIS WILL BE CHANGED AS     *01502100
T34116*                       CSR02294.                                *01502200
T34116*  04/24/06    SK88120  PROGRAM-ID CHANGED BACK TO CSR02294      *01502300
T33431** 04/25/06   SK88120        COG PROJECT CHANGES -               *01502700
T33431**                           A- ADD NEW COPYBOOKS                *01502800
T33431**                           B- CHANGE IN CPD00073               *01502900
T33431**                                                               *01503000
C34569*  04/08/08    JC91900  ADDED NEW REC TYPE FOR CRM CREDIT.       *01503100
APP221*  03/12/09    MJ13662  CPD00068 WORKING STORAGE FIELDS WERE     *01503200
APP221*                       GETTING OVERLAID.                        *01503300
A00962*  03/23/09    VP94820  INITIALIZED WS-PAR-TYPE-NO TO ZEROS TO   *01503310
A00962*                       AVOID LOOPING IN CERTAIN CASES.          *01503320
A00956*  03/26/09    VP94820  REPLACE CPD00006 WITH CPD0006A AND       *01503330
A00956*                       CWS00013 WITH CWS0013B.                  *01503330
A37061*  04/02/09    VP94820  USE ACCT-TYPE INSTED REVENUE-CLASS.      *        
A36248*  06/11/09    LG41184  CALL NEW SUBPROGRAM MCSCB371 TO UPDATE   *        
A36248*                       DNP BALANCE REAL TIME FOR CSR.           *        
A37302*  07/09/09    LG41184  DCLGEN TBRVCACT REMOVED.                 *        
A00755*  09/17/09    SK42147  DURING MISC CREDIT PROCESS, GL SELECTED  *        
A00755*                       BY USER IS GETTING OVERRIDE FOR RCC      *        
A00755*                       DIRECTED CREDIT, FIX TO NOT TO OVERRIDE  *        
ACT184*  09/14/11    BD09555  ADD "SYSTEM" TO CHECK                    *        
A03707*  09/14/11    VP43661  ENERGYWISE REBATE CHECK REVERSAL CHANGES *        
A03707*  11/16/11    VP43661  REPLACE K6-GL-ACCT-NO WITH EA-GL-ACCT-NO *        
ACT033*  05/01/12    BD09555  ADD "SYSTEM" TO CHECK FOR TRANSFERRING   *        
ACT033*                       AMOUNTS TO A NON-SUB ACCOUNT.            *        
P00794*  08/11/14    SS7F226  ADDED LOGIC FOR PSNC AND SEB TO INSERT   *        
P00794*                       'RECCHGTAX' AS FACTOR ID INTO FIXED_FCTR *        
P00794*                       AND INSERT FCTOR AND DURTION IN MNT TBLS *        
P00774* 08/15/15     WR19680  DELETE CODE TO THAT PREVENTED A MISC.    *        
P00774*                       CREDIT FROM BEING CREATED IF A RECONNECT *        
P00774*                       AGREEMENT EXISTS.                        *        
P00774* 09/10/15              MODIFIED CODE TO CALL MCS03413 TO HANDLE *        
P00774*                       OF DNP AND NOTICE ORDERS VERSUS SENDING  *        
P00774*                       FLAGS BACK TO POWERBUILDER FOR IT TO BE  *        
P00774*                       HANDLED THERE.                           *        
P00774* 09/15/15              ADD CHANGES TO HANDLE DIFFERENT          *        
P00774*                       APPL PROGRAM IDS FOR MISC. CREDIT        *        
A04860* 02/17/16     MS7M727  WORK QUEUE CHANGE TO REPLACE THE         *        
A04860*              ACT087   CSS_WQ_ITEMS_MF WITH CSS_WQ_ITEMS        *        
A05460* 08/02/16     SM93554  REMOVE ALL THE LOGIC AS PART OF UN-USED  *        
      *              ACT245   CSS_MSE_CNT_SUMM TABLE.                  *        
ACT278* 09/16/16     TP7R341  REMOVE UNUSED COLUMNS FROM CONTRACT AND  *        
ACT278*  A05460               CONTRACT DETAIL/INFO TABLES              *        
ACT278* 09/16/16     TP7R341  REMOVE UNUSED COLUMNS FROM CONTRACT AND  *        
ACT278*  A05460               CONTRACT DETAIL/INFO TABLES              *        
A05744* 06/02/17     AD7F921  FOR NON SCEG ACCOUNTS MOVE GL ACCOUNT NO *        
A05744*  A05744      ACT020   241.0123 FOR TAX-STAT AND                *        
A05744*                       241.0207 FOR OTHER TAXES.                *        
      ******************************************************************01503400
      ***************************************************************** 01503500
      *                                                                 01503600
      *                ---- BASIC SEQUENCE STRUCTURE ----               01503700
      *                                                                 01503800
      *  0000 - 0999  MAIN CONTROL PATH AND INITIALIZATION              01503900
      *  1000 - 1999  INPUT PROCESSING CONTROL PATH                     01504000
      *  2000 - 2999  OUTPUT PROCESSING CONTROL PATH                    01504100
      *  3000 - 4999  NOT USED                                          01504200
      *  5000 - 5999  COMMON PROGRAM MODULES                            01504300
      *  6000 - 6999  COMMON SYSTEM MODULES                             01505000
      *  7000 - 7999  INPUT MODULES                                     01506000
      *  8000 - 8999  OUTPUT MODULES                                    01507000
      *  9000 - 9999  TERMINATION,ABEND, MESSAGING MODULES              01508000
      *                                                                 01509000
      ***************************************************************** 01510000
                                                                        
       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 'CSR02294'.
MSQ017     COPY MFASQLM.
                                                                        
       01  WS-START                                   PIC X(40) VALUE   
REARCH     'WORKING STORAGE FOR CSR02294 STARTS HERE'.                  
                                                                        
      ***************************************************************** 01600000
      *    COBOL WORKING STORAGE COPY BOOKS                             01610000
      ***************************************************************** 01620000
                                                                        
           COPY CWS00004.                                               01660000
           COPY CWS00007.                                               01670000
ACT087     COPY CWS00077.                                                       
           EXEC SQL                                                     01690000
              INCLUDE CWS00008                                          01700000
           END-EXEC.                                                    01710000
REARCH     EXEC SQL                                                     01731000
REARCH        INCLUDE CWSX0010                                          01732000
REARCH     END-EXEC.                                                    01733000
           COPY CWS00056.                                               01750000
           COPY CWS00303.                                               01760000
           COPY CWS00100.                                               01770000
T33431     COPY CWSCA225.                                               01771000
T19557     COPY CWS0068L.                                               01780000
           COPY CJF00101.                                               01790000
           COPY CJF00102.                                               01800000
           COPY CJF00105.                                               01810000
                                                                        
      ***************************************************************** 01830000
      *    WORK AREAS                                                   01840000
      ***************************************************************** 01850000
                                                                        
       01  WS-MISC.                                                     
REARCH     05  MCSCA182                 PIC X(08) VALUE 'MCSCA182'.     
REARCH     05  MCSCO061                 PIC X(08) VALUE 'MCSCO061'.     
REARCH     05  MCSCB068                 PIC X(8)  VALUE 'MCSCB068'.     
A36248     05  MCSCB371                 PIC X(8)  VALUE 'MCSCB371'.     
P00774     05  MCS03413                 PIC X(8)  VALUE 'MCS03413'.     
REARCH     05  EIBTRNID                 PIC X(04) VALUE 'S294'.         
REARCH     05  PROGRAM-NAME             PIC X(08) VALUE 'CSR02294'.     
T33431     05  MCSCB225                 PIC X(8) VALUE  'MCSCB225'.     
T33431     05  WS-COG-TRAN-TYPE-CD-73   PIC X(1) VALUE  'I'.            
           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'.            
ACT087     05  WS-WQ-CALL-PGM           PIC X(08)  VALUE 'MCSCB077'.    
ACT087     05  MCSCB077                 PIC X(08)  VALUE 'MCSCB077'.    
ACT087     05  SCSCB077                 PIC X(08)  VALUE 'SCSCB077'.    
           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.       
A36248     05  WS-DNP-UPDATE-FL         PIC X(01)  VALUE 'N'.           
P00774     05  WS-DNP-RET-CODE          PIC S9(4) VALUE 0 COMP.         
P00774     05  WS-UPDATE-ACTION-FL      PIC X(01) VALUE SPACES.         
P00774     05  WS-FACILITY-CODE         PIC X(01) VALUE SPACES.         
           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).                     
           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.        
T21113     05  WS-LAST-UPDATE-TS        PIC  X(26) VALUE SPACES.        
T19557     05  WS-EIBRESP               PIC S9(8)                       
T19557                                  COMP SYNC VALUE ZERO.           
           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'.             
ACT087     05  WS-CPD0010S-CALL-TYPE       PIC X(01)  VALUE 'O'.        
ACT087         88 WS-CPD0010S-ONLINE-CALL        VALUE 'O'.             
ACT087         88 WS-CPD0010S-BATCH-CALL         VALUE 'B'.             
           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.   
P00794     05  WS-DATABASE             PIC 9(01) VALUE ZERO.            
P00794         88 CSR-DATABASE                   VALUE 1.               
P00794         88 SEB-DATABASE                   VALUE 2.               
P00794     05  WS-COMPANY-NO           PIC X(02) VALUE '  '.            
P00794         88 SCEG                           VALUE '01'.            
P00794         88 PSNC                           VALUE '26'.            
P00794     05  WS-REVENUE-MONTH        PIC X(06).                       
P00794     05  FILLER REDEFINES WS-REVENUE-MONTH.                       
P00794         10  WS-REVMTH-CCYY      PIC 9(04).                       
P00794         10  WS-REVMTH-MM        PIC 9(02).                       
P00794     05 WS-RCC-COMMENT           PIC X(50) VALUE                  
P00794         'INSERT RCC - CHARGE AMOUNT TO BE TAXED ONLY.'.          
P00794     05  WS-FACT-VAL-Z           PIC ------------9.9999.          
COB305     05 WS-FACTOR-TEXT        PIC S9(9)V9(4) USAGE COMP-3 VALUE 0.     
P00794     05  WS-NULL-IND-FF          PIC S9(04) COMP VALUE 0.         
P00794     05  WS-NULL-VALUE           PIC S9(04) COMP VALUE 0.         
P00794     05  WS-EFF-DATE-FROM.                                        
P00794         10  WS-EFF-DATE-FROM-YYYY PIC X(4) VALUE SPACES.         
P00794         10  WS-DASH-1             PIC X(1) VALUE '-'.            
P00794         10  WS-EFF-DATE-FROM-MM   PIC X(2) VALUE SPACES.         
P00794         10  WS-DASH-2             PIC X(1) VALUE '-'.            
P00794         10  WS-EFF-DATE-FROM-DD   PIC X(2) VALUE '01'.           
T23235     05  WS-ACCT-TYPE-CD         PIC X(01) VALUE SPACES.          
T23235     05  WS-CLASS                PIC X(01) VALUE SPACES.          
      *                                                                 03200000
                                                                        
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'.           
P00774     05  CREDIT-MI1              PIC X(03) VALUE 'MI1'.           
P00774     05  CREDIT-MI2              PIC X(03) VALUE 'MI2'.           
P00774     05  CREDIT-MI3              PIC X(03) VALUE 'MI3'.           
P00774     05  CREDIT-MI4              PIC X(03) VALUE 'MI4'.           
P00774     05  CREDIT-MI5              PIC X(03) VALUE 'MI5'.           
P00774     05  CREDIT-MI6              PIC X(03) VALUE 'MI6'.           
T14840     05  CREDIT-REB              PIC X(03) VALUE 'REB'.           
C24880     05  CREDIT-DFA              PIC X(03) VALUE 'DFA'.           
T30135     05  CREDIT-ISL              PIC X(03) VALUE 'ISL'.           
T30135     05  CREDIT-IFF              PIC X(03) VALUE 'IFF'.           
C34569     05  CREDIT-CRM              PIC X(03) VALUE 'CRM'.           
A03707     05  CREDIT-DSM              PIC X(03) VALUE 'DSM'.           
                                                                        
      *** USED TO CONVERT TO COMP-3                                     03380000
COB305     05 WS-PARM-DB-GL-NUMBER        PIC S9(03)V9999 COMP-3 
COB305       VALUE 0.         
COB305     05 WS-PARM-CR-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                                     03460000
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.                   
T20081     05  WS-SPLIT-CREDIT          PIC X(01) VALUE SPACES.         
T22491     05  WS-CREDIT-IND            PIC X(07) VALUE SPACES.         
DEPINT         88  DEPOSIT-INT-CREDIT             VALUE 'DEPINTC'.      
T22491         88  GMA-ADJUSTMENT                 VALUE 'GMADJST'.      
C22830         88  POST-APT-CREDIT                VALUE 'POSTAPT'.      
T24008         88  ADT-XFER-CREDIT                VALUE 'ADTXFER'.      
T23264         88  JAMES-ISL-CREDIT               VALUE 'JAMESIS'.      
C30454         88  SEB-SALES-TAX-CREDIT           VALUE 'SEBSLTX'.      
                                                                        
       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.       
T21113     05  WS-1                     PIC S9(01) VALUE +1.            
REARCH*    05  SCSCA182                 PIC  X(08) VALUE 'SCSCA182'.    03810000
                                                                        
       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.                
                                                                        
REARCH 01  PARM-FIELDS.                                                 
REARCH*    05  PARM-L                   PIC S9(9) COMP.                 04020000
REARCH*    05  PARM-ID1                 PIC S9(9) COMP VALUE 1.         04030000
REARCH     05  PARM-ACCOUNT-NO-X.                                       
REARCH         10 PARM-ACCOUNT-NO       PIC 9(13).                      
REARCH*    05  PARM-ITEM-ID             PIC S9(09) COMP.                04060000
REARCH*    05  PARM-RECV-TYPE           PIC X(03).                      04070000
REARCH*    05  PARM-PYMT-PRIORITY-LVL   PIC 9(04) COMP VALUE ZERO.      04080000
REARCH     05  PARM-DB-GL-NUMBER-X.                                     
REARCH         10  PARM-DB-GL-NUMBER    PIC 9(03)V9999.                 
REARCH     05  PARM-CR-AMT-AR-DAY-00-X.                                 
REARCH         10  PARM-CR-AMT-AR-DAY-00 PIC S9(09)V99.                 
REARCH     05  PARM-CR-AMT-AR-DAY-30-X.                                 
REARCH         10  PARM-CR-AMT-AR-DAY-30 PIC S9(09)V99.                 
REARCH     05  PARM-CR-AMT-AR-DAY-60-X.                                 
REARCH         10  PARM-CR-AMT-AR-DAY-60 PIC S9(09)V99.                 
REARCH     05  PARM-CR-AMT-AR-DAY-90-X.                                 
REARCH         10  PARM-CR-AMT-AR-DAY-90 PIC S9(09)V99.                 
REARCH     05  PARM-CR-AMT-AR-TOTAL-X.                                  
REARCH         10  PARM-CR-AMT-AR-TOTAL  PIC S9(09)V99.                 
REARCH*    05  PARM-DIST-RECV-TYPE      PIC X(03).                      04210000
REARCH*    05  PARM-DIST-PYMT-PRI-LVL   PIC 9(04) COMP.                 04220000
REARCH*    05  PARM-DIST-ITEM-ID        PIC S9(09) COMP VALUE ZERO.     04230000
REARCH*    05  PARM-RESP-AREA           PIC X(03).                      04240000
REARCH*    05  PARM-USER-ID             PIC X(07).                      04250000
REARCH*    05  PARM-AT-LAST-UPDATE-TS   PIC X(26).                      04260000
REARCH*    05  PARM-AC-LAST-UPDATE-TS   PIC X(26).                      04270000
REARCH     05  PARM-TRAN-COMMENT.                                       
REARCH         49  PARM-TRAN-COMMENT-LEN  PIC S9(4) COMP SYNC VALUE +0. 
REARCH         49  PARM-TRAN-COMMENT-TEXT PIC X(210) VALUE SPACES.      
REARCH     05  PARM-PRINCIPAL-AMT-X.                                    
REARCH         10  PARM-PRINCIPAL-AMT    PIC S9(09)V99.                 
REARCH     05  PARM-STATE-TAX-AMT-X.                                    
REARCH         10  PARM-STATE-TAX-AMT    PIC S9(09)V99.                 
REARCH     05  PARM-CITY-TAX-AMT-X.                                     
REARCH         10  PARM-CITY-TAX-AMT    PIC S9(09)V99.                  
REARCH     05  PARM-OTHER-TAX-AMT-X.                                    
REARCH         10  PARM-OTHER-TAX-AMT    PIC S9(09)V99.                 
REARCH     05  PARM-DEF-INT-AMT-X.                                      
REARCH         10  PARM-DEF-INT-AMT    PIC S9(09)V99.                   
REARCH     05  PARM-EARNED-INT-AMT-X.                                   
REARCH         10  PARM-EARNED-INT-AMT    PIC S9(09)V99.                
REARCH*    05  PARM-CNT-NAME-CD        PIC S9(04) COMP VALUE 0.         04430000
REARCH     05  PARM-REVENUE-MONTH.                                      
REARCH         10 PARM-ACCTING-PERIOD     PIC S9(6).                    
                                                                        
       01  COUNTER-FIELDS.                                              
           05  CTR-COLUMN              PIC S9(9) COMP VALUE 1.          
           05  CTR-ROWS                PIC S9(9) COMP VALUE 0.          
                                                                        
       01  WORK-FIELDS.                                                 
           05  MAX-LENGTH-PARM         PIC S9(9) COMP.                  
           05  WRKLEN1                 PIC S9(9) COMP.                  
           05  WRKLEN2                 PIC S9(9) COMP.                  
           05  WRK-DONE-STATUS         PIC S9(9) COMP.                  
                                                                        
                                                                        
       01  FILLER  PIC X(32) VALUE 'THIS IS THE ROW RETURN AREA.'.      
       01  TDS-RETURN-FIELDS.                                           
           05  RS-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.          
T24367     05  RS-CANCELNOT-FLAG       PIC X(01) VALUE SPACES.          
                                                                        
REARCH 01  GTT-RETURN-FIELDS.                                           
REARCH     05  S-RETURN-CODE          PIC S9(9) COMP VALUE 0.           
REARCH     05  S-CANCELDNP-FLAG       PIC X(01) VALUE SPACES.           
REARCH     05  S-AR-LOCKOUT-IND       PIC X(01) VALUE SPACES.           
REARCH     05  S-XFER-ACCT-NO         PIC X(13) VALUE SPACES.           
REARCH     05  S-CANCELNOT-FLAG       PIC X(01) VALUE SPACES.           
                                                                        
REARCH 01  CSRERLOG-P.                                                  
REARCH     10  S-SP-NAME                 PIC X(18) VALUE SPACES.        
REARCH     10  S-SQLCODE                 PIC S9(9) COMP VALUE 0.        
REARCH     10  S-SQLSTATE                PIC X(5)  VALUE ' '.           
REARCH     10  S-TABLE-NAME              PIC X(18) VALUE SPACES.        
REARCH     10  S-HOST-VARIABLES.                                        
REARCH         49  S-HOST-VARIABLES-L    PIC S9(4) USAGE COMP.          
REARCH         49  S-HOST-VARIABLES-V    PIC X(255).                    
REARCH     10  S-SQL-STATEMENT.                                         
REARCH         49  S-SQL-STATEMENT-L     PIC S9(4) USAGE COMP.          
REARCH         49  S-SQL-STATEMENT-V     PIC X(255).                    
REARCH     10  S-SQL-DESCRIPTION.                                       
REARCH         49  S-SQL-DESCRIPTION-L   PIC S9(4) USAGE COMP.          
REARCH         49  S-SQL-DESCRIPTION-V   PIC X(255).                    
REARCH     10  WS-ABEND-SQLERRMC.                                       
REARCH         49  WS-ABEND-SQLERRMC-L   PIC S9(4) USAGE COMP.          
REARCH         49  WS-ABEND-SQLERRMC-V   PIC X(255).                    
REARCH     10  WS-SQLSTATE               PIC X(05) VALUE SPACES.        
      *                                                                         
      ***************************************************************** 04811000
      * DATABASE DEFINITION                                             04820000
      ***************************************************************** 04830000
                                                                        
           EXEC SQL                                                     04850000
              INCLUDE SQLCA                                             04860000
           END-EXEC.                                                    04870000
                                                                        
           EXEC SQL                                                     04890000
              INCLUDE TBCNTINF                                          04900000
           END-EXEC.                                                    04910000
                                                                        
                                                                        
           EXEC SQL                                                     04940000
              INCLUDE TBCNTDET                                          04950000
           END-EXEC.                                                    04960000
                                                                        
                                                                        
C26130     EXEC SQL                                                     04990000
C26130        INCLUDE TBMNHDT                                           05000000
C26130     END-EXEC.                                                    05010000
                                                                        
C26130     EXEC SQL                                                     05030000
C26130        INCLUDE TBMNHIST                                          05040000
C26130     END-EXEC.                                                    05050000
                                                                        
T12460     EXEC SQL                                                     05070000
              INCLUDE TBCHGOFF                                          05080000
           END-EXEC.                                                    05090000
                                                                        
           EXEC SQL                                                     05110000
              INCLUDE TBACCT                                            05120000
           END-EXEC.                                                    05130000
                                                                        
           EXEC SQL                                                     05150000
              INCLUDE TBCUST                                            05160000
           END-EXEC.                                                    05170000
                                                                        
           EXEC SQL                                                     05190000
              INCLUDE TBPREM                                            05200000
           END-EXEC.                                                    05210000
                                                                        
           EXEC SQL                                                     05230000
              INCLUDE TBARCNTL                                          05240000
           END-EXEC.                                                    05250000
                                                                        
           EXEC SQL                                                     05310000
              INCLUDE TBCNTRCT                                          05320000
           END-EXEC.                                                    05330000
                                                                        
           EXEC SQL                                                     05350000
              INCLUDE TBARHIST                                          05360000
           END-EXEC.                                                    05370000
                                                                        
           EXEC SQL                                                     05390000
              INCLUDE TBARHDT                                           05400000
           END-EXEC.                                                    05410000
                                                                        
           EXEC SQL                                                     05430000
              INCLUDE TBCDCNTL                                          05440000
           END-EXEC.                                                    05450000
                                                                        
           EXEC SQL                                                     05470000
              INCLUDE TBCDJRNL                                          05480000
           END-EXEC.                                                    05490000
                                                                        
           EXEC SQL                                                     05510000
              INCLUDE TBBJCNTL                                          05520000
           END-EXEC.                                                    05530000
                                                                        
           EXEC SQL                                                     05550000
              INCLUDE TBBTJRNL                                          05560000
           END-EXEC.                                                    05570000
                                                                        
           EXEC SQL                                                     05590000
              INCLUDE TBMSJRNL                                          05600000
           END-EXEC.                                                    05610000
                                                                        
           EXEC SQL                                                     05630000
              INCLUDE TBUSRPRF                                          05640000
           END-EXEC.                                                    05650000
                                                                        
           EXEC SQL                                                     05670000
              INCLUDE TBPRJSHR                                          05680000
           END-EXEC.                                                    05690000
                                                                        
           EXEC SQL                                                     05710000
              INCLUDE TBDFAACT                                          05720000
           END-EXEC.                                                    05730000
                                                                        
           EXEC SQL                                                     05750000
              INCLUDE TBDFARCV                                          05760000
           END-EXEC.                                                    05770000
                                                                        
           EXEC SQL                                                     05790000
              INCLUDE TBARPMT                                           05800000
           END-EXEC.                                                    05810000
                                                                        
           EXEC SQL                                                     05830000
              INCLUDE TBGLATNO                                          05840000
           END-EXEC.                                                    05850000
                                                                        
           EXEC SQL                                                     05870000
              INCLUDE TBDEPHST                                          05880000
           END-EXEC.                                                    05890000
                                                                        
           EXEC SQL                                                     05910000
              INCLUDE TBRECNCT                                          05920000
           END-EXEC.                                                    05930000
                                                                        
                                                                        
           EXEC SQL                                                     05960000
              INCLUDE TBARLOCK                                          05970000
           END-EXEC.                                                    05980000
                                                                        
                                                                        
           EXEC SQL                                                     06040000
              INCLUDE TBLIEAP                                           06050000
           END-EXEC.                                                    06060000
                                                                        
           EXEC SQL                                                     06080000
              INCLUDE TBCRPROF                                          06090000
           END-EXEC.                                                    06100000
                                                                        
PCR307     EXEC SQL                                                     06120000
PCR307        INCLUDE TBSODNPC                                          06130000
PCR307     END-EXEC.                                                    06140000
      ***********CSS_DELINQUENCY************************                06150000
           EXEC SQL                                                     06160000
              INCLUDE TBDELQ                                            06170000
           END-EXEC.                                                    06180000
T16114***********CSS_CUST_PLAN**************************                06190000
T16114     EXEC SQL                                                     06200000
T16114        INCLUDE TBCSTPLN                                          06210000
T16114     END-EXEC.                                                    06220000
T16114***********CSS_UTIL_ENVRNMT***********************                06230000
T16114     EXEC SQL                                                     06240000
T16114        INCLUDE TBUTLENV                                          06250000
T16114     END-EXEC.                                                    06260000
      ***********CSS_LOCAL_OFFICE***********************                06270000
           EXEC SQL                                                     06280000
              INCLUDE TBLOCOFC                                          06290000
           END-EXEC.                                                    06300000
      ***********CSS_RECONNECT_CHRG*********************                06310000
           EXEC SQL                                                     06320000
              INCLUDE TBRCNCHR                                          06330000
           END-EXEC.                                                    06340000
      ***********CSS_CONNECT_CHRG***********************                06350000
           EXEC SQL                                                     06360000
              INCLUDE TBCCCHRG                                          06370000
           END-EXEC.                                                    06380000
      ******************************************************************06390000
      *    CSS_WO_ARRANGEMENT                                           06400000
      ******************************************************************06410000
                                                                        
           EXEC SQL                                                     06430000
               INCLUDE TBWOARGM                                         06440000
           END-EXEC.                                                    06450000
P00794******************************************************************        
P00794*  CSS_FIXED_FCTR.       FF                                      *        
P00794******************************************************************        
P00794     EXEC SQL                                                             
P00794         INCLUDE TBFXDFCT                                                 
P00794     END-EXEC.                                                            
P00794*                                                                         
P00794******************************************************************        
P00794*  CSS_BILL_WINDOW.      BN                                      *        
P00794******************************************************************        
P00794     EXEC SQL                                                             
P00794         INCLUDE TBBILWDW                                                 
P00794     END-EXEC.                                                            
P00794*                                                                         
HPCCDM*EJECT                                                            06460000
                                                                        
T33431     EXEC SQL                                                     06474100
T33431       INCLUDE TBJBPARM                                           06474200
T33431     END-EXEC.                                                    06474300
      ***********CPD00068*******************************                06475000
           EXEC SQL                                                     06476000
              INCLUDE CWS00068                                          06477000
T33431     END-EXEC.                                                    06474300
                                                                        
           EXEC SQL                                                     06480000
A00956        INCLUDE CWS0013B                                          06490000
           END-EXEC.                                                    06500000
                                                                        
           EXEC SQL                                                     06520000
              INCLUDE CWS00017                                          06530000
           END-EXEC.                                                    06540000
                                                                        
                                                                        
      *                                                                 06391000
           EXEC SQL                                                     06560000
              INCLUDE CWS00061                                          06570000
           END-EXEC.                                                    06580000
T24436**INCLUDED THE COPYBOOK FOR LINK RECORD CPD00061                  06590000
T24436     EXEC SQL                                                     06600000
T24436        INCLUDE CWS0061L                                          06610000
T24436     END-EXEC.                                                    06620000
                                                                        
           EXEC SQL                                                     06640000
              INCLUDE CWS00073                                          06650000
           END-EXEC.                                                    06660000
NONUTL******************************************************************06680000
NONUTL*    HOLIDAY CHECK                                                06690000
NONUTL******************************************************************06700000
NONUTL     EXEC SQL                                                     06710000
NONUTL         INCLUDE CWS10016                                         06720000
NONUTL     END-EXEC.                                                    06730000
HPCCDM*EJECT                                                            06740000
                                                                        
           EXEC SQL                                                     06760000
              INCLUDE TBBGTPLN                                          06770000
           END-EXEC.                                                    06780000
                                                                        
           EXEC SQL                                                     06800000
              INCLUDE TBBGTHST                                          06810000
           END-EXEC.                                                    06820000
                                                                        
           EXEC SQL                                                     06840000
              INCLUDE TBDEPHND                                          06850000
           END-EXEC.                                                    06860000
                                                                        
NONUTL******************************************************************06880000
NONUTL*    CSS_HOLIDAY                                                  06890000
NONUTL******************************************************************06900000
NONUTL     EXEC SQL                                                     06910000
NONUTL         INCLUDE TBHLDAY                                          06920000
NONUTL     END-EXEC.                                                    06930000
HPCCDM*EJECT                                                            06940000
T20099*****                                                             06950000
T20099*  CSS_TAX_RATE                                                   06960000
T20099*****                                                             06970000
           EXEC SQL                                                     06980000
T20099        INCLUDE TBTXRATE                                          06990000
T20099     END-EXEC.                                                    07000000
T20099                                                                  
T20099*****                                                             07020000
T20099*  CSS_SPCL_FCTR                                                  07030000
T20099*****                                                             07040000
T20099     EXEC SQL                                                     07050000
T20099        INCLUDE TBSPLFTR                                          07060000
T20099     END-EXEC.                                                    07070000
T20099                                                                  
                                                                        
T21113 COPY CWS00182.                                                   07100000
                                                                        
T13034     EXEC SQL                                                     
T13034       DECLARE CNT-DETAIL       CURSOR   FOR                      
ACT278       SELECT  COST_CENTER                                        
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                                    
T13034     END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ004
MFA-TR* MSQ022
MFA-TR*    EXEC SQL                                                     07210000
MFA-TR*      DECLARE CNT-DETAIL       CURSOR   FOR                      07220000
MFA-TR*      SELECT  COST_CENTER                                        07250000
MFA-TR*      FROM CSS_CNT_DETAIL                                        07290000
MFA-TR*      WHERE ACCOUNT_NO          = :EA-ACCOUNT-NO                 07300000
MFA-TR*        AND CNT_ITEM_ID         = :EA-CNT-ITEM-ID                07310000
MFA-TR*        FOR FETCH ONLY WITH UR                                           
MFA-TR*    END-EXEC.                                                    07320000
                                                                        
T16114     EXEC SQL 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                                 
T16114     END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ004
MFA-TR* MSQ022
MFA-TR*    EXEC SQL DECLARE UTIL-CURSOR CURSOR FOR                      07340000
MFA-TR*        SELECT CODE_UTIL_TYPE,                                   07350000
MFA-TR*               IC_NO                                             07360000
MFA-TR*          FROM CSS_UTIL_ENVRNMT                                  07370000
MFA-TR*         WHERE ACCOUNT_NO = :UT-ACCOUNT-NO                       07380000
MFA-TR*           FOR FETCH ONLY WITH UR                                        
MFA-TR*    END-EXEC.                                                    07390000
T16114                                                                  
T16114     EXEC SQL 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* MSQ004
MFA-TR* MSQ021
MFA-TR*    EXEC SQL DECLARE UNMTRD-CURSOR CURSOR FOR                    07410000
MFA-TR*       SELECT CODE_SERVICE_TYPE                                  07420000
MFA-TR*         FROM CSS_CUST_PLAN                                      07430000
MFA-TR*        WHERE ACCOUNT_NO = :CP-ACCOUNT-NO                        07440000
MFA-TR*     OPTIMIZE FOR 1 ROW FOR FETCH ONLY                           07450000
MFA-TR*    END-EXEC.                                                    07460000
                                                                        
HPCCDM*EJECT                                                            07480000
T21113*                                                                 07490000
REARCH LINKAGE SECTION.                                                 
REARCH 01  PARM-ACCOUNT-NO-X-TEMP        PIC X(13).                     
REARCH 01  PARM-ITEM-ID                  PIC S9(09) COMP.               
REARCH 01  PARM-RECV-TYPE                PIC X(03).                     
REARCH 01  PARM-PYMT-PRIORITY-LVL        PIC 9(04) COMP VALUE ZERO.     
REARCH*01  PARM-DB-GL-NUMBER-X-TEMP      PIC 9(03)V9999 COMP-3.         07589000
T34116 01  PARM-DB-GL-NUMBER-X-TEMP      PIC X(07).                     
REARCH*01  PARM-CR-AMT-AR-DAY-00-X-TEMP  PIC S9(9)V99.                  07589200
REARCH*01  PARM-CR-AMT-AR-DAY-30-X-TEMP  PIC S9(09)V99.                 07589400
REARCH*01  PARM-CR-AMT-AR-DAY-60-X-TEMP  PIC S9(09)V99.                 07589600
REARCH*01  PARM-CR-AMT-AR-DAY-90-X-TEMP  PIC S9(09)V99.                 07589800
REARCH*01  PARM-CR-AMT-AR-TOTAL-X-TEMP   PIC S9(09)V99 .                07590000
REARCH 01  PARM-CR-AMT-AR-DAY-00-X-TEMP  PIC X(11).                     
REARCH 01  PARM-CR-AMT-AR-DAY-30-X-TEMP  PIC X(11).                     
REARCH 01  PARM-CR-AMT-AR-DAY-60-X-TEMP  PIC X(11).                     
REARCH 01  PARM-CR-AMT-AR-DAY-90-X-TEMP  PIC X(11).                     
REARCH 01  PARM-CR-AMT-AR-TOTAL-X-TEMP   PIC X(11).                     
REARCH 01  PARM-DIST-RECV-TYPE           PIC X(03).                     
REARCH 01  PARM-DIST-PYMT-PRI-LVL        PIC 9(04) COMP.                
REARCH 01  PARM-DIST-ITEM-ID             PIC S9(09) COMP VALUE ZERO.    
REARCH 01  PARM-RESP-AREA                PIC X(03).                     
REARCH 01  PARM-USER-ID                  PIC X(07).                     
REARCH 01  PARM-AT-LAST-UPDATE-TS        PIC X(26).                     
REARCH 01  PARM-AC-LAST-UPDATE-TS        PIC X(26).                     
REARCH 01  PARM-TRAN-COMNT-LEN           PIC S9(4) COMP SYNC VALUE +0.  
REARCH 01  PARM-TRAN-COMNT-TEXT          PIC X(210) VALUE SPACES.       
REARCH*01  PARM-PRINCIPAL-AMT-X-TEMP     PIC S9(09)V99.                 07591300
REARCH*01  PARM-STATE-TAX-AMT-X-TEMP     PIC S9(09)V99.                 07591500
REARCH*01  PARM-CITY-TAX-AMT-X-TEMP      PIC S9(09)V99.                 07591700
REARCH*01  PARM-OTHER-TAX-AMT-X-TEMP     PIC S9(09)V99.                 07591900
REARCH*01  PARM-DEF-INT-AMT-X-TEMP       PIC S9(09)V99.                 07592100
REARCH*01  PARM-EARNED-INT-AMT-X-TEMP    PIC S9(09)V99.                 07592300
REARCH 01  PARM-PRINCIPAL-AMT-X-TEMP     PIC X(11).                     
REARCH 01  PARM-STATE-TAX-AMT-X-TEMP     PIC X(11).                     
REARCH 01  PARM-CITY-TAX-AMT-X-TEMP      PIC X(11).                     
REARCH 01  PARM-OTHER-TAX-AMT-X-TEMP     PIC X(11).                     
REARCH 01  PARM-DEF-INT-AMT-X-TEMP       PIC X(11).                     
REARCH 01  PARM-EARNED-INT-AMT-X-TEMP    PIC X(11).                     
REARCH 01  PARM-CNT-NAME-CD              PIC S9(04) COMP VALUE 0.       
REARCH 01  PARM-REVENUE-MONTH-TEMP       PIC X(06).                     
REARCH PROCEDURE DIVISION USING  PARM-ACCOUNT-NO-X-TEMP                 
REARCH                           PARM-ITEM-ID                           
REARCH                           PARM-RECV-TYPE                         
REARCH                           PARM-PYMT-PRIORITY-LVL                 
REARCH                           PARM-DB-GL-NUMBER-X-TEMP               
REARCH                           PARM-CR-AMT-AR-DAY-00-X-TEMP           
REARCH                           PARM-CR-AMT-AR-DAY-30-X-TEMP           
REARCH                           PARM-CR-AMT-AR-DAY-60-X-TEMP           
REARCH                           PARM-CR-AMT-AR-DAY-90-X-TEMP           
REARCH                           PARM-CR-AMT-AR-TOTAL-X-TEMP            
REARCH                           PARM-DIST-RECV-TYPE                    
REARCH                           PARM-DIST-PYMT-PRI-LVL                 
REARCH                           PARM-DIST-ITEM-ID                      
REARCH                           PARM-RESP-AREA                         
REARCH                           PARM-USER-ID                           
REARCH                           PARM-AT-LAST-UPDATE-TS                 
REARCH                           PARM-AC-LAST-UPDATE-TS                 
REARCH                           PARM-TRAN-COMNT-LEN                    
REARCH                           PARM-TRAN-COMNT-TEXT                   
REARCH                           PARM-PRINCIPAL-AMT-X-TEMP              
REARCH                           PARM-STATE-TAX-AMT-X-TEMP              
REARCH                           PARM-CITY-TAX-AMT-X-TEMP               
REARCH                           PARM-OTHER-TAX-AMT-X-TEMP              
REARCH                           PARM-DEF-INT-AMT-X-TEMP                
REARCH                           PARM-EARNED-INT-AMT-X-TEMP             
REARCH                           PARM-CNT-NAME-CD                       
REARCH                           PARM-REVENUE-MONTH-TEMP.               

SCA006        SET WS-GL-SUB TO 1.
                                                                        
      ***************************************************************** 07610000
      * 0000-MAINLINE                                                   07620000
      *     CONTROLS THE MAIN PATH OF THE PROGRAM                       07630000
      ***************************************************************** 07640000
                                                                        
       0000-MAINLINE.                                                   
           PERFORM 0100-INITIALIZE     THRU 0100-EXIT.                  
           PERFORM 1000-PROCESS-INPUT  THRU 1000-EXIT.                  
           PERFORM 2000-PROCESS-OUTPUT THRU 2000-EXIT.                  
           PERFORM 9999-END-PROGRAM    THRU 9999-EXIT.                  
       0000-EXIT.                                                       
           EXIT.                                                        
                                                                        
      ***************************************************************** 07740000
      * 0100-INITIALIZE                                                 07750000
      *                                                                 07760000
      ***************************************************************** 07810000
                                                                        
       0100-INITIALIZE.                                                 
           MOVE '0100' TO ACTIVE-PARAGRAPH.                             
           EXEC SQL WHENEVER SQLWARNING CONTINUE END-EXEC.              
           EXEC SQL WHENEVER SQLERROR CONTINUE END-EXEC.                
           EXEC SQL WHENEVER NOT FOUND CONTINUE END-EXEC.               
                                                                        
REARCH     PERFORM 0100A-DECLARE-GTT          THRU 0100A-EXIT.          
REARCH     EXEC SQL                                                     
REARCH         DECLARE C1 CURSOR  FOR                        
REARCH         SELECT                                                   
REARCH            RETURN_CODE                                           
REARCH           ,LTRIM(RTRIM(CANCELDNP_FLAG))    AS CANCELDNP_FLAG            
REARCH           ,LTRIM(RTRIM(AR_LOCKOUT_IND))    AS AR_LOCKOUT_IND            
REARCH           ,LTRIM(RTRIM(AT_ACCT_XFER_TO))   AS AT_ACCT_XFER_TO           
REARCH           ,LTRIM(RTRIM(CANCELNOT_FLAG))    AS CANCELNOT_FLAG            
REARCH         FROM #CSR02294_R1                                 
REARCH     END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ029
MFA-TR* MSQ049
MFA-TR*    EXEC SQL                                                     08022000
MFA-TR*        DECLARE C1 CURSOR WITH RETURN FOR                        08023000
MFA-TR*        SELECT                                                   08024000
MFA-TR*           RETURN_CODE                                           08025000
MFA-TR*          ,STRIP(CANCELDNP_FLAG)    AS CANCELDNP_FLAG            08026000
MFA-TR*          ,STRIP(AR_LOCKOUT_IND)    AS AR_LOCKOUT_IND            08027000
MFA-TR*          ,STRIP(AT_ACCT_XFER_TO)   AS AT_ACCT_XFER_TO           08028000
MFA-TR*          ,STRIP(CANCELNOT_FLAG)    AS CANCELNOT_FLAG            08029000
MFA-TR*        FROM SESSION.CSR02294_R1                                 08029600
MFA-TR*    END-EXEC.                                                    08029700
REARCH     MOVE PARM-ACCOUNT-NO-X-TEMP       TO PARM-ACCOUNT-NO-X.      
REARCH     MOVE PARM-DB-GL-NUMBER-X-TEMP     TO PARM-DB-GL-NUMBER-X.    
REARCH     MOVE PARM-CR-AMT-AR-DAY-00-X-TEMP TO PARM-CR-AMT-AR-DAY-00-X.
REARCH     MOVE PARM-CR-AMT-AR-DAY-30-X-TEMP TO PARM-CR-AMT-AR-DAY-30-X.
REARCH     MOVE PARM-CR-AMT-AR-DAY-60-X-TEMP TO PARM-CR-AMT-AR-DAY-60-X.
REARCH     MOVE PARM-CR-AMT-AR-DAY-90-X-TEMP TO PARM-CR-AMT-AR-DAY-90-X.
REARCH     MOVE PARM-CR-AMT-AR-TOTAL-X-TEMP  TO PARM-CR-AMT-AR-TOTAL-X. 
REARCH     MOVE PARM-PRINCIPAL-AMT-X-TEMP    TO PARM-PRINCIPAL-AMT-X.   
REARCH     MOVE PARM-STATE-TAX-AMT-X-TEMP    TO PARM-STATE-TAX-AMT-X.   
REARCH     MOVE PARM-CITY-TAX-AMT-X-TEMP     TO PARM-CITY-TAX-AMT-X.    
REARCH     MOVE PARM-OTHER-TAX-AMT-X-TEMP    TO PARM-OTHER-TAX-AMT-X.   
REARCH     MOVE PARM-DEF-INT-AMT-X-TEMP      TO PARM-DEF-INT-AMT-X.     
REARCH     MOVE PARM-EARNED-INT-AMT-X-TEMP   TO PARM-EARNED-INT-AMT-X.  
REARCH     MOVE PARM-REVENUE-MONTH-TEMP      TO PARM-REVENUE-MONTH.     
       0100-EXIT.                                                       
           EXIT.                                                        
                                                                        
REARCH******************************************************************08040100
REARCH*0100A-DECLARE-GTT.                                              *08040200
REARCH******************************************************************08040300
                                                                        
REARCH 0100A-DECLARE-GTT.                                               
REARCH     EXEC SQL
             CALL CIS.DROP_TEMP_TABLE('#CSR02294_R1')
           END-EXEC
           EXEC SQL
             CREATE TABLE #CSR02294_R1
              (                                                          
REARCH          RETURN_CODE         INT                             
REARCH         ,CANCELDNP_FLAG CHAR(01)  COLLATE LATIN1_GENERAL_100_BIN2        
REARCH         ,AR_LOCKOUT_IND CHAR(01)  COLLATE LATIN1_GENERAL_100_BIN2        
REARCH         ,AT_ACCT_XFER_TO CHAR(13)  COLLATE 
                             LATIN1_GENERAL_100_BIN2                           
REARCH         ,CANCELNOT_FLAG CHAR(01)  COLLATE LATIN1_GENERAL_100_BIN2        
A36248       )
           END-EXEC.                                                    

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

REARCH     MOVE SQLSTATE TO WS-SQLSTATE.                                
REARCH     MOVE SQLCODE  TO WS-ACTIVE-RETURN-CODE.                      
REARCH                                                                  
REARCH     IF WS-SQLSTATE = '42710'                                     
REARCH        PERFORM 8000A-DELETE-GTT-ROWS THRU 8000A-EXIT             
REARCH     ELSE                                                         
REARCH         IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL               
REARCH             NEXT SENTENCE                                        
REARCH         ELSE                                                     
REARCH            MOVE PROGRAM-NAME         TO ABEND-PROGRAM            
REARCH            MOVE SQLCODE              TO ABEND-SQLCODE            
REARCH            MOVE SQLSTATE             TO ABEND-SQLSTATE           
REARCH            MOVE '0100A'              TO ACTIVE-PARAGRAPH         
REARCH            MOVE 'DECLARE GTT'        TO ABEND-FUNCTION           
REARCH            MOVE SPACES               TO ABEND-SQL-PREDICATES     
REARCH                                         ABEND-TABLES             
REARCH            MOVE 'CSR02294_R1'        TO TABLE-1                  
REARCH            MOVE SPACES               TO TABLE-ELEMENT-1          
REARCH            MOVE SPACES               TO HOSTVAR-ELEMENT-1        
REARCH            PERFORM 9900-SQL-ERROR-ROUTINE  THRU  9900-EXIT       
REARCH         END-IF                                                   
REARCH     END-IF.                                                      
REARCH 0100A-EXIT.                                                      
REARCH         EXIT.                                                    
                                                                        
      ***************************************************************** 08100000
      * 1000-PROCESS-INPUT.                                             08110000
      *                                                                 08120000
      *     1. RECEIVE PARMS.                                           08130000
      *                                                                 08140000
      ***************************************************************** 08150000
                                                                        
       1000-PROCESS-INPUT.                                              
           MOVE PARM-USER-ID TO WS-CREDIT-IND                           
T22491*    IF DEPOSIT-INT-CREDIT OR GMA-ADJUSTMENT                      08200000
C25426     IF GMA-ADJUSTMENT                                            
T22491        MOVE 'BB18179'  TO PARM-USER-ID                           
C22830     ELSE                                                         
T23264       IF POST-APT-CREDIT OR ADT-XFER-CREDIT OR JAMES-ISL-CREDIT  
C25426          OR DEPOSIT-INT-CREDIT                                   
C30454          OR SEB-SALES-TAX-CREDIT                                 
C22830          MOVE 'SYSTEM' TO PARM-USER-ID                           
C22830       END-IF                                                     
T22491     END-IF.                                                      
       1000-EXIT.                                                       
           EXIT.                                                        
                                                                        
      ***************************************************************** 11270000
      * 2000-PROCESS-OUTPUT.                                            11280000
      *                                                                 11290000
      *     1. UPDATE DB2 DATA                                          11310000
      *     2. BUILD RESULT SET                                         11320000
      *     3. SEND RESULT SET                                          11330000
      *                                                                 11340000
      ***************************************************************** 11350000
                                                                        
       2000-PROCESS-OUTPUT.                                             
           MOVE '2000' TO ACTIVE-PARAGRAPH.                             
           MOVE WS-N                   TO RS-CANCELDNP-FLAG             
T24367                                    RS-CANCELNOT-FLAG.            
                                                                        
      ***********                                                       11430000
      * DO NOT PROCEED IF SYSTEM IS LOCKED                              11440000
      ***********                                                       11450000
                                                                        
           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                               
REARCH        PERFORM 2000A-MOVE-RESULT     THRU 2000A-EXIT             
              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 PARM-ACCOUNT-NO                    
           MOVE PARM-ACCOUNT-NO     TO AT-ACCOUNT-NO.                   
                                                                        
T19996     PERFORM 7400-SELECT-MSTSUB THRU 7400-EXIT.                   
                                                                        
           PERFORM 7999-SELECT-TRANSFER-IND                             
              THRU 7999-SELECT-TRANSFER-IND-EXIT.                       
           IF AT-ACCT-XFER-TO > ZERO AND                                
T19996        AT-MST-SUB-ACCT-IND NOT = 'S' AND                         
ACT033        PARM-USER-ID NOT = 'SYSTEM'                               
                  MOVE 5000 TO RS-RETURN-CODE                           
                  MOVE AT-ACCT-XFER-TO      TO RS-XFER-ACCT-NO          
REARCH            PERFORM 2000A-MOVE-RESULT THRU 2000A-EXIT             
                  PERFORM 8100-SEND-RESULT  THRU 8100-EXIT              
                  PERFORM 9999-END-PROGRAM  THRU 9999-EXIT              
           END-IF.                                                      
T21113*                                                                 11680000
T21113     INITIALIZE SCSCA182-LINK-RECORD.                             
T21113     MOVE PARM-ACCOUNT-NO             TO SCSCA182-ACCOUNT-NO.     
T21113*                                                                 11710000
T21113     PERFORM 9200-LINK-SCSCA182       THRU 9200-EXIT.             
T21113     IF  SCSCA182-RETURN-CODE NOT EQUAL ZERO                      
T21113         MOVE PROGRAM-NAME            TO ABEND-PROGRAM            
T21113         MOVE SCSCA182-RETURN-CODE    TO WS-ACTIVE-RETURN-CODE    
T21113                                         SQLCODE                  
T21113         PERFORM 9000-SEND-ERROR-RESULT                           
T21113                                      THRU 9000-EXIT              
T21113         PERFORM 9900-SQL-ERROR-ROUTINE                           
T21113                                      THRU 9900-EXIT              
T21113     ELSE                                                         
T21113         MOVE SCSCA182-LAST-UPDATE-TS TO WS-LAST-UPDATE-TS        
T21113         IF  PARM-AT-LAST-UPDATE-TS = WS-LAST-UPDATE-TS           
T22096             OR PARM-RECV-TYPE = 'REB'                            
ACT184             OR PARM-USER-ID = 'SYSTEM'                           
T21113             NEXT SENTENCE                                        
T21113         ELSE                                                     
T21113             MOVE 5272                 TO RS-RETURN-CODE          
REARCH             PERFORM 2000A-MOVE-RESULT THRU 2000A-EXIT            
T21113             PERFORM 8100-SEND-RESULT  THRU 8100-EXIT             
T21113             GO TO 2000-EXIT                                      
T21113         END-IF                                                   
T21113     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.                                                        
REARCH******************************************************************11971000
REARCH*2000A-MOVE-RESULT.                                              *11972000
REARCH******************************************************************11973000
REARCH 2000A-MOVE-RESULT.                                               
REARCH        MOVE  RS-RETURN-CODE      TO S-RETURN-CODE.               
REARCH        MOVE  RS-CANCELDNP-FLAG   TO S-CANCELDNP-FLAG.            
REARCH        MOVE  RS-AR-LOCKOUT-IND   TO S-AR-LOCKOUT-IND.            
REARCH        MOVE  RS-XFER-ACCT-NO     TO S-XFER-ACCT-NO.              
REARCH        MOVE  RS-CANCELNOT-FLAG   TO S-CANCELNOT-FLAG.            
REARCH 2000A-EXIT.                                                      
REARCH     EXIT.                                                        
                                                                        
      ***************************************************************** 13170000
      * 2200-PROCESS                                                    13180000
      *                                                                 13190000
      ***************************************************************** 13200000
       2200-PROCESS.                                                    
                                                                        
           MOVE '2200'              TO ACTIVE-PARAGRAPH.                
                                                                        
      ***************                                                   13250000
      * GET INFORMATION FROM ACCOUNT, PREMISE, AND CUSTOMER TABLE       13260000
      ***************                                                   13270000
           MOVE PARM-ACCOUNT-NO     TO AT-ACCOUNT-NO.                   
                                                                        
           PERFORM 7000-SELECT-AT-PR-CU THRU 7000-EXIT.                 
C23197     IF AT-TOTAL-AR-BALANCE EQUAL ZEROES AND                      
C23197                  PARM-RECV-TYPE = 'CCA' AND                      
C23197                  (PARM-DIST-RECV-TYPE EQUAL 'UTE' OR             
C23197                  PARM-DIST-RECV-TYPE EQUAL 'UTG') AND            
C23197                  PARM-CR-AMT-AR-TOTAL-X GREATER THAN ZEROES      
C23197        MOVE 5309                     TO RS-RETURN-CODE           
REARCH        PERFORM 2000A-MOVE-RESULT     THRU 2000A-EXIT             
C23197        PERFORM 8100-SEND-RESULT      THRU 8100-EXIT              
C23197        PERFORM 9999-END-PROGRAM      THRU 9999-EXIT              
C23197     END-IF                                                       
                                                                        
      ******************                                                13570000
      * GET G/L ACCOUNT NUMBER                                          13580000
      ******************                                                13590000
           MOVE PARM-RECV-TYPE TO WS-RECV-TYPE                          
           PERFORM 5800-DETERMINE-GL-NUMBERS THRU 5800-EXIT.            
A03707*                                                                 13620000
A03707******************                                                13620000
A03707* ENERGYWISE REBATE CHECK REVERSAL FROM PANEL270, NO NEED TO APPLY13620000
A03707* THE CREDIT TO THE ACCOUNT                                       13620000
A03707******************                                                13620000
A03707*                                                                 13620000
A03707     IF PARM-RECV-TYPE = CREDIT-DSM                               
A03707        PERFORM 2270-REFUND-REVERSAL THRU 2270-EXIT               
A03707        GO TO 2200-EXIT                                           
A03707     END-IF.                                                      
A03707*                                                                 13620000
           IF CU-CODE-CUST-STATUS EQUAL WS-S                            
              MOVE WS-Y TO WS-CHRG-OFF-ACCT
           END-IF.                            
                                                                        
      ***************                                                   13410000
      * SET RECONNECT FLAG                                              13420000
      ***************                                                   13430000
           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                 
P00774     END-IF.                                                      
      ******************                                                13680000
      * MOVE NUMERIC FIELD AMONG WORKING STORAGE FIELDS BECAUSE THEY    13690000
      * WERE PASSED AS CHARACTER, NOT NUMERIC.                          13700000
      ******************                                                13710000
           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.   
                                                                        
      ******************                                                13840000
      * GET AR-CNTL RECV 00/30/60/90 BUCKETS                            13850000
      ******************                                                13860000
           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      13940000
                 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           14070000
                 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                             14110000
              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.           
                                                                        
      ******************                                                14180000
      * DETERMINE IF CPD10 CAN BE USED TO POST PAYMENT                  14190000
      ******************                                                14200000
           MOVE WS-PARM-CR-AMT-AR-TOTAL TO WS-AMT-CASH                  
P00794                                     WS-CREDIT-REMAINING          
P00794                                     FF-FACTOR.                   
                                                                        
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                                                                  
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                                 
T16114                                TO B1-LOCAL-OFFICE                
T16114             PERFORM 6791F-SELECT-LOCAL-OFFICE                    
T16114                                        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    
T23235                                                 UT-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    
T16114           IF CC-CCC-ITEM-ID > 0                                  
A37061              IF AT-ACCOUNT-TYPE-CODE = 'R'                       
A37061                 MOVE 'R'           TO WS-ACCT-TYPE-CD            
A37061              ELSE                                                
A37061                IF AT-ACCOUNT-TYPE-CODE = 'C'                     
A37061                   MOVE 'C'          TO WS-ACCT-TYPE-CD           
A37061                ELSE                                              
A37061                   MOVE 'I'          TO WS-ACCT-TYPE-CD           
A37061                END-IF                                            
A37061              END-IF                                              
A37061              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' AND                      
T16114              U7-RCNCT-GAS-SVC-FL  = 'Y'                          
T16114              MOVE 'PCT-ELEC-RCC-ALLOC'                           
T16114                                TO C8-DELINQ-CD                   
T23501              MOVE AT-COMPANY-NO  TO C8-COMPANY-NO                
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.                
                                                                        
      ******************                                                15750000
      * DETERMINE DIR\UND, LOAD DIRECTED PAYMENT, CALCULATE REMAINDER   15760000
      ******************                                                15770000
           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                                       15850000
                       MOVE WS-N             TO WS-IS-THIS-DIRECTED-PYMT
T16114                 PERFORM 2400-CREDIT-REM-WITH-SPLIT               
T16114                    THRU 2400-EXIT                                
                    ELSE                                                
      * FOR CONTRACT PAYMENTS                                           15900000
      * MOVE STATEMENTS ADDED BY MR                                     15910000
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                   
T13034                            WS-DIR-PAY-ITEM-ID (1)                
T13034                 MOVE SPACES              TO                      
T13034                            WS-DIR-PAY-AHEAD-TYPE (1)             
T13034                 MOVE SPACES                 TO                   
T13034                            WS-DIR-PAY-CHRG-OFF (1)               
T13034                 MOVE WS-D                   TO                   
T13034                            WS-PAR-UPDATE-TYPE                    
T13034                 MOVE WS-YES                 TO                   
T13034                            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 
T29700            IF PARM-PYMT-PRIORITY-LVL = 100                       
T29700               PERFORM 2260-CREDIT-CONTRACT THRU 2260-EXIT        
T29700            ELSE                                                  
                    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                                              
T29700            END-IF                                                
                 ELSE                                                   
      * IF RCC AND NOTHING IN 0,30,60,90 THEN PAY THE TRAN BALANCE.     16290000
T13034            IF PARM-PYMT-PRIORITY-LVL = 100                       
T13034               PERFORM 2260-CREDIT-CONTRACT THRU 2260-EXIT        
                  ELSE                                                  
T11360              IF ( PARM-PYMT-PRIORITY-LVL =                       
T11360                                     ( 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    16500000
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                     
T13034                          WS-DIR-PAY-ITEM-ID (1)                  
T13034               MOVE SPACES              TO                        
T13034                          WS-DIR-PAY-AHEAD-TYPE (1)               
T13034               MOVE WS-PAY-CHRG-OFF        TO                     
T13034                          WS-DIR-PAY-CHRG-OFF (1)                 
T13034               MOVE WS-D                   TO                     
T13034                          WS-PAR-UPDATE-TYPE                      
T13034               MOVE WS-YES                 TO                     
T13034                          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               
T20081                                    CALC-PAST-DUE-SW              
                                          CALC-ARREARS-SW               
                                          CALC-BALANCE-SW               
T24367                                    CALC-NOT-BAL-SW.              
           MOVE WS-CURRENT-DATE        TO WS-HOLD-DATE                  
T20081                                    WS-CL-DATE-NOTICE-MAIL        
T20081                                    WS-CL-DATE-NOTICE-DUE.        
T22359     MOVE PROGRAM-NAME               TO WS-CPD00068-CALLING-PGM.  
T19557     MOVE SPACES                     TO ABEND-FUNCTION .          
T19557     PERFORM 9500-CALL-CPD00068      THRU 9500-EXIT.              
T19557     MOVE RS-RETURN-CODE             TO  WS-ACTIVE-RETURN-CODE,   
T19557                                        SQLCODE.                  
T19557     IF ABEND-FUNCTION  > SPACES                                  
T19557        PERFORM 9700-PROCESS-ABEND   THRU 9700-EXIT               
T19557     END-IF.                                                      
P00794*                                                                 03790000
P00794     IF PARM-PYMT-PRIORITY-LVL = 60                               
P00794        MOVE ZERO                      TO WS-DATABASE             
P00794        MOVE '01'                      TO C8-COMPANY-NO           
P00794        MOVE 'DATABASE'                TO C8-DELINQ-CD            
P00794        PERFORM 6791D-SELECT-DELINQUENCY                          
P00794                                        THRU 6791D-EXIT           
P00794        MOVE C8-DELINQ-VALUE           TO WS-DATABASE             
P00794*                                                                 03790000
P00794        MOVE AT-COMPANY-NO             TO WS-COMPANY-NO           
P00794        IF SEB-DATABASE OR PSNC                                   
P00794           MOVE AT-ACCOUNT-NO          TO FF-ACCOUNT-NO           
P00794*                                                                 03790000
P00794           PERFORM 7640-GET-UTIL-ENV    THRU 7640-EXIT            
P00794*                                                                 03790000
P00794           PERFORM 7650-GET-MIN-REV-MO  THRU 7650-EXIT            
P00794*                                                                 03790000
P00794           PERFORM 2850-SETUP-VAL-FXD-FCTR                        
P00794                                        THRU 2850-EXIT            
P00794*                                                                 03790000
P00794           PERFORM 2900-SETUP-VAL-MNT-TRAN                        
P00794                                        THRU 2900-EXIT            
P00794*                                                                         
P00794        END-IF                                                    
P00794     END-IF.                                                      
P00794*                                                                         
P00774     MOVE AT-CODES-DATA-PRESENT TO WS-CODES-DATA-PRESENT          
P00774     IF WS-CODE-PENDING-DNP = 'A'                                 
T20081       MOVE WS-AMT-DNP-BAL         TO WS-LIMIT-CHECK-AMT          
T20081       IF WS-NOTICE-DNP-LIMIT NOT NUMERIC                         
T20081          OR WS-NOTICE-DNP-LIMIT < 0                              
T20081          MOVE ZEROS               TO WS-NOTICE-DNP-LIMIT         
T20081       END-IF                                                     
T20081*                                                                 17050000
T20081       MOVE AT-ACCOUNT-NO          TO DL-ACCOUNT-NO               
T20081       PERFORM 7200-SELECT-RECONNECT   THRU 7200-EXIT             
T20081*                                                                 17080000
T20081       IF  WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL                
T20081           COMPUTE WS-AMT-DNP-BAL =                               
T20081                  DL-AMT-TOT-RECONNECT - DL-RECNCT-COLLECT-AMT    
T20081           END-COMPUTE                                            
T20081           IF  WS-AMT-DNP-BAL < 0                                 
T20081               MOVE 0              TO WS-AMT-DNP-BAL              
T20081           END-IF                                                 
T20081           ADD WS-AMT-UN-CR-CIA    TO   WS-AMT-DNP-BAL            
T20081           IF  WS-AMT-DNP-BAL <= 0                                
P00774               PERFORM 2950-PROCESS-DNP-RECONNECT THRU            
P00774                       2950-EXIT                                  
T20081           ELSE                                                   
A36248               IF CSR-DATABASE-CPD68                              
A36248                  MOVE 'Y'         TO WS-DNP-UPDATE-FL            
A36248               END-IF                                             
T20081           END-IF                                                 
             ELSE                                                       
T20081           ADD   WS-AMT-UN-CR-CIA  TO   WS-AMT-DNP-BAL            
T20081           IF  WS-AMT-DNP-BAL <= WS-NOTICE-DNP-LIMIT              
P00774               PERFORM 2950-PROCESS-DNP-RECONNECT THRU            
P00774                       2950-EXIT                                  
T20081           ELSE                                                   
A36248               IF CSR-DATABASE-CPD68                              
A36248                  MOVE 'Y'         TO WS-DNP-UPDATE-FL            
A36248               END-IF                                             
                 END-IF                                                 
P00774       END-IF                                                     
P00774     END-IF.                                                      
                                                                        
                                                                        
REARCH     PERFORM 2000A-MOVE-RESULT THRU 2000A-EXIT.                   
           PERFORM 8100-SEND-RESULT  THRU 8100-EXIT.                    
                                                                        
       2200-EXIT.                                                       
           EXIT.                                                        
                                                                        
P00774*--------------------------------------------------------------*  00182300
P00774* CALLS SUB PROGRAMS MCS03413 TO HANDLE DNP/RECONNECT REAL TIME*  00182400
P00774*--------------------------------------------------------------*  00182500
P00774 2950-PROCESS-DNP-RECONNECT.                                      
P00774                                                                  
ACT285     MOVE AT-ACCOUNT-NO               TO WS-ACCOUNT-NO-NUM        
ACT285     MOVE 'M'                         TO WS-UPDATE-ACTION-FL      
P00774     MOVE SPACE                       TO WS-FACILITY-CODE         
ACT285     MOVE 0                           TO WS-DNP-RET-CODE          
P00774     MOVE SPACES                      TO ABEND-FILE               
ACT285                                                                  
P00774     PERFORM 9800-CALL-MCS03413                                   
P00774        THRU 9800-EXIT                                            
ACT285                                                                  
ACT285     IF WS-DNP-RET-CODE > 0                                       
ACT285        MOVE WS-DNP-RET-CODE          TO S-RETURN-CODE            
P00774     END-IF                                                       
P00774     .                                                            
ACT285 2950-EXIT.                                                       
ACT285     EXIT.                                                        
                                                                        
                                                                        
      *********************************************************         17470000
      * 2250-CREDIT-DIST-RECV                                 *         17480000
      *                                                       *         17490000
      *    CREDIT REMAINING CREDIT TO DIRECTED DISTRIBUTED    *         17500000
      *    RECEIVABLE TYPE.  ALL MONEY IS CREDITED TOWARD     *         17510000
      *    EXISTING RECV REGARDLESS OF THE RECV THAT WARRENTS *         17520000
      *    THE CREDIT.                                        *         17530000
      *                                                       *         17540000
      *********************************************************         17550000
       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                           
REARCH            PERFORM 2000A-MOVE-RESULT     THRU 2000A-EXIT         
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                 17860000
              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*********************************************************         18230000
T13034* 2260-CREDIT-CONTRACT.                                 *         18240000
T13034*                                                       *         18250000
T13034*    CREDIT CONTRACT.                                   *         18260000
T13034*                                                       *         18270000
T13034*********************************************************         18280000
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-COST-CENTER         TO WS-105-COST-CENTER.           
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                          
T13034                WS-PARM-CR-AMT-AR-TOTAL GIVING                    
T13034                WS-REMAINING-AMOUNT                               
T13034                                                                  
T13034     IF  WS-DEF-INT-AMT > 0                                       
T13034       SUBTRACT WS-DEF-INT-AMT     FROM CT-AMT-DEF-INTEREST       
C30304                                        CT-SIMPLE-INT-FIN-CHG     
C30304*      ADD WS-DEF-INT-AMT          TO CT-INTRST-YTD               18800000
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               
T29700       MOVE '01'                 TO GO-COMPANY-NO                 
A05744       IF AT-COMPANY-NO = '01'                                    
A05744          PERFORM 7300-SELECT-GL-ACCT THRU 7300-EXIT              
A05744          MOVE GO-GL-ACCT-NO     TO WS-PAR-GEN-LEDG-DB            
A05744       ELSE                                                       
A05744          MOVE 241.0123             TO WS-PAR-GEN-LEDG-DB         
A05744       END-IF                                                     
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               
A05744       MOVE '01'                 TO GO-COMPANY-NO                 
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                     
T20099              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                        
T20099              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                        
T20099              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             
C30304        MOVE ZEROES           TO WS-PAR-TYPE-NO                   
                                                                        
              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                            
T13034                    WS-DIR-PAY-REC-TYPE (1)                       
T13034        MOVE PARM-DIST-ITEM-ID      TO                            
T13034                    WS-DIR-PAY-ITEM-ID (1)                        
T13034        MOVE SPACES              TO                               
T13034                    WS-DIR-PAY-AHEAD-TYPE (1)                     
T13034        MOVE WS-PAY-CHRG-OFF        TO                            
T13034                    WS-DIR-PAY-CHRG-OFF (1)                       
T13034        MOVE WS-D                   TO                            
T13034                    WS-PAR-UPDATE-TYPE                            
T13034        MOVE WS-YES                 TO                            
T13034                    WS-IS-THIS-DIRECTED-PYMT                      
T13034     END-IF.                                                      
T13034     IF WS-REMAINING-AMOUNT > 0                                   
T13034      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                                   
T13034      AND WS-STATE-TAX-AMT > 0                                    
T13034         MOVE 'TAX-STAT'           TO GO-GL-ACCT-NAME             
T29700         MOVE '01'                 TO GO-COMPANY-NO               
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                                   
T13034      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                     
T20099              THRU 7800-EXIT                                      
T20099        END-IF                                                    
T20099        PERFORM 7835-CALC-RMNG-OTHER-TAX-AMT                      
T20099           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                                   
T13034      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                                                                  
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.                                                        
A03707*                                                                         
A03707*********************************************************         21560000
A03707* 2270-REFUND-REVERSAL                                  *         21570000
A03707*    WRITE JOURNALS AND AR TRANS HIST, DO NOT CREDIT    *         21590000
A03707*    MONEY TO THE ACCOUNT.                              *         21600000
A03707*********************************************************         21640000
A03707*                                                                         
A03707 2270-REFUND-REVERSAL.                                            
A03707*                                                                 21560000
A03707     MOVE '2270'                      TO ACTIVE-PARAGRAPH.        
A03707*                                                                         
A03707     PERFORM 6000-VALIDATE-JRNL       THRU 6000-EXIT.             
A03707*                                                                         
A03707     MOVE AT-ACCOUNT-NO               TO CT-ACCOUNT-NO.           
A03707     MOVE PARM-ITEM-ID                TO CT-CNT-ITEM-ID.          
A03707     PERFORM 7020-SEL-CNT-INFO        THRU 7020-EXIT.             
A03707     MOVE EA-GL-ACCT-NO               TO WS-PARM-CR-GL-NUMBER.    
A03707*                                                                         
A03707     PERFORM 6010-SET-AR-TRAS-HST-VARS                            
A03707                                      THRU 6010-EXIT.             
A03707     PERFORM 6500-ONLINE-LOAD-AR-TRAN-HIST                        
A03707                                      THRU 6500-EXIT.             
A03707*                                                                 18740000
A03707     PERFORM 6020-SET-100-JRNL-VARS   THRU 6020-EXIT.             
A03707     PERFORM 6030-SET-101-JRNL-VARS   THRU 6030-EXIT.             
A03707*                                                                 21560000
A03707     MOVE WS-JRNL-ONLY                TO WS-JRNL-OPERATION-RQST.  
A03707     PERFORM 6400-ONLINE-JRNL-ROUTINE THRU 6400-EXIT.             
A03707*                                                                 21560000
A03707     IF WS-JRNL-RTRN-CODE NOT = SPACES                            
A03707        MOVE PROGRAM-NAME             TO ABEND-PROGRAM            
A03707        MOVE '2270'                   TO ACTIVE-PARAGRAPH         
A03707        MOVE 'USERABEN'               TO ABEND-FUNCTION           
A03707        MOVE WS-YES                   TO WS-USER-FORCE-ABEND      
A03707        MOVE 'JOURNAL ABEND'          TO DSNTIAR-MESSAGE-1        
A03707        PERFORM 9700-PROCESS-ABEND    THRU 9700-EXIT              
A03707     END-IF.                                                      
A03707*                                                                         
A03707     PERFORM 2000A-MOVE-RESULT        THRU 2000A-EXIT.            
A03707     PERFORM 8100-SEND-RESULT         THRU 8100-EXIT.             
A03707*                                                                         
A03707 2270-EXIT.                                                       
A03707     EXIT.                                                        
A03707*                                                                 21560000
      *********************************************************         21560000
      * 2300-CREDIT-REMAINING-UNDIR                           *         21570000
      *                                                       *         21580000
      *    CREDIT REMAINING CREDIT TO UNDIRECTED DISTRIBUTED  *         21590000
      *    RECEIVABLE TYPE.  ALL MONEY IS CREDITED TOWARD     *         21600000
      *    EXISTING RECV REGARDLESS OF THE RECV THAT WARRENTS *         21610000
      *    THE CREDIT.                                        *         21620000
      *                                                       *         21630000
      *********************************************************         21640000
       2300-CREDIT-REMAINING-UNDIR.                                     
                                                                        
      ********************************************************          21670000
      * LOAD THE PAYMENT PRIORITY TABLE                      *          21680000
      * USE PARM-UPDATE-TYPE TO DECIDE WHICH SET TO LOAD:    *          21690000
      * B FOR BILLED, A FOR ARREARS, AND U FOR UNDIRECTED.   *          21700000
      * SCHEDULE 1 IS FOR BILLED AND UNDIRECTED DUE TO THE   *          21710000
      * ORDER PAYMENT IS POSTED.  SCHEDULE 2 IS FOR ARREARS  *          21720000
      * WHICH PAYS OFF ALL 90 DAY FIRST, THEN 60 DAYS, ETC.  *          21730000
      ********************************************************          21740000
                                                                        
           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.             
                                                                        
      ******************                                                21880000
      * PROCESS THE UPDATE FOR CREDIT REMAINING                         21890000
      ******************                                                21900000
                                                                        
           MOVE WS-CREDIT-REMAINING TO WS-AMT-CASH.                     
           PERFORM 5000-UPDATE THRU 5000-EXIT.                          
                                                                        
       2300-EXIT.                                                       
           EXIT.                                                        
                                                                        
      ******************                                                21980000
      * SPLIT IT IF THE SPLIT IS TO BE DONE.                            21990000
      ******************                                                22000000
T16114 2400-CREDIT-REM-WITH-SPLIT.                                      
T16114     IF WS-SPLIT-PERCENT > 0                                      
T20081        IF  WS-PAR-RECONNECT-EXIST = WS-Y                         
T20081            MOVE WS-Y            TO WS-SPLIT-CREDIT               
T20081        END-IF                                                    
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.                                                       
                                                                        
                                                                        
P00794******************************************************************        
P00794* 2850-SETUP-VAL-FXD-FCTR.                                                
P00794******************************************************************        
P00794 2850-SETUP-VAL-FXD-FCTR.                                         
P00794                                                                  
P00794     MOVE UT-IC-NO                     TO FF-IC-NO.               
P00794     MOVE UT-CODE-UTIL-TYPE            TO FF-CODE-UTIL-TYPE.      
P00794*                                                                         
P00794     COMPUTE FF-FACTOR = ( FF-FACTOR * -1 ).                      
P00794*                                                                         
P00794     PERFORM 7750-GET-MAX-SEQ-NO        THRU 7750-EXIT.           
P00794     ADD 1                             TO FF-FIXED-FCTR-SEQ-NO.   
P00794     MOVE 'RECCHGTAX'                  TO FF-FACTOR-ID.           
P00794     MOVE '10'                         TO FF-CMPNT-ID-CD.         
P00794     MOVE 'B'                          TO FF-CODE-SEASON.         
P00794     MOVE 'R'                          TO FF-INSTR-USE-TYPE-CD.   
P00794     MOVE 0                            TO FF-CODE-TIME-PERIOD.    
P00794     MOVE BN-REVENUE-MONTH             TO WS-REVENUE-MONTH.       
P00794     MOVE WS-REVMTH-CCYY               TO WS-EFF-DATE-FROM-YYYY.  
P00794     MOVE WS-REVMTH-MM                 TO WS-EFF-DATE-FROM-MM.    
P00794     MOVE WS-EFF-DATE-FROM             TO FF-EFF-DATE-FROM.       
P00794     MOVE '2999-12-31'                 TO FF-EFF-DATE-TO.         
P00794     MOVE '00'                         TO FF-FIXED-FCTR-TYP-CD.   
P00794     MOVE 0                            TO FF-FAC-CHRG-BASE-AM.    
P00794     MOVE 0                            TO FF-RT-PKG-OPT-SEQ-NO.   
P00794     MOVE 1                            TO FF-DURATION-REMAIN-NO.  
P00794     MOVE 0                            TO WS-NULL-VALUE.          
P00794     MOVE WS-CURRENT-TIMESTAMP         TO FF-LAST-UPDATE-TS.      
P00794                                                                  
P00794     PERFORM 8250-INSERT-FACTOR         THRU 8250-EXIT.           
P00794*                                                                         
P00794 2850-EXIT.                                                       
P00794     EXIT.                                                        
P00794*                                                                         
P00794* 2900-SETUP-VAL-MNT-TRAN.                                                
P00794******************************************************************        
P00794 2900-SETUP-VAL-MNT-TRAN.                                         
P00794                                                                  
P00794********** DATA FOR CSS_MNT_TRANS_HIST                                    
P00794     MOVE WS-CURRENT-TIMESTAMP         TO MH-TRANS-HIST-SEQ-NO    
P00794     MOVE WS-CURRENT-DATE              TO MH-DATE-TRANS           
P00794     MOVE 'F'                          TO MH-CODE-TRAN-TYPE       
P00794     MOVE SPACES                       TO MH-RESP-AREA-ID         
P00794     MOVE AT-ACCOUNT-NO                TO MH-ACCOUNT-NO           
P00794     MOVE AT-CUSTOMER-NO               TO MH-CUSTOMER-NO          
P00794     MOVE AT-PREMISE-NO                TO MH-PREMISE-NO           
P00794     MOVE 'SYSTEM'                     TO MH-USER-ID              
P00794     MOVE +50                          TO MH-TRAN-COMMENT-LEN     
P00794     MOVE WS-RCC-COMMENT               TO MH-TRAN-COMMENT-TEXT    
P00794     MOVE 'PCSCA099'                   TO MH-APPL-PROGRAM-ID      
P00794     MOVE +0                           TO MH-ENTITY-KEY-DESC-LEN  
P00794     MOVE SPACES                       TO MH-ENTITY-KEY-DESC-TEXT 
P00794********** DATA FOR CSS_MT_TRN_HST_DET                                    
P00794     MOVE WS-CURRENT-TIMESTAMP         TO MI-TRANS-HIST-SEQ-NO    
P00794     MOVE 1                            TO MI-TRAN-APPL-NO         
P00794     MOVE 'FACTOR VALUE'               TO MI-COLUMN-DESC          
P00794     MOVE SPACES                       TO MI-TABLE-ID             
P00794     MOVE 7                            TO MI-PRV-COLUMN-VALUE-LEN 
P00794     MOVE '**NEW**'                    TO MI-PRV-COLUMN-VALUE-TEXT
P00794     MOVE FF-FACTOR                    TO WS-FACTOR-TEXT          
P00794     MOVE WS-FACTOR-TEXT               TO WS-FACT-VAL-Z           
P00794     MOVE WS-FACT-VAL-Z                TO MI-CHG-COLUMN-VALUE-TEXT
P00794     MOVE LENGTH OF MI-CHG-COLUMN-VALUE-TEXT                      
P00794                                       TO MI-CHG-COLUMN-VALUE-LEN 
P00794*                                                                         
P00794     PERFORM 8300-INSERT-MN-TRANS-HIST  THRU 8300-EXIT            
P00794     PERFORM 8400-INSERT-MN-TRN-HST-DET THRU 8400-EXIT            
P00794*                                                                         
P00794     MOVE WS-CURRENT-TIMESTAMP         TO MI-TRANS-HIST-SEQ-NO    
P00794     MOVE 2                            TO MI-TRAN-APPL-NO         
P00794     MOVE 'DURATION'                   TO MI-COLUMN-DESC          
P00794     MOVE +7                           TO MI-PRV-COLUMN-VALUE-LEN 
P00794     MOVE '**NEW**'                    TO MI-PRV-COLUMN-VALUE-TEXT
P00794     MOVE +01                          TO MI-CHG-COLUMN-VALUE-LEN 
P00794     MOVE '1'                          TO MI-CHG-COLUMN-VALUE-TEXT
P00794     MOVE SPACES                       TO MI-TABLE-ID             
P00794     PERFORM 8400-INSERT-MN-TRN-HST-DET THRU 8400-EXIT.           
P00794                                                                  
P00794 2900-EXIT.                                                       
P00794     EXIT.                                                        
P00794*                                                                         
      ************************************************************      22300000
      * 5000-UPDATE                                              *      22310000
      *                                                          *      22320000
      *    PROCESS THE APPLICABLE UPDATE OF THE CREDIT (PAYMENT) *      22330000
      *                                                          *      22340000
      ************************************************************      22350000
       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 EIBTRNID        TO WS-100-CODE-TERMINAL-TRAN.           
           MOVE EIBTRNID        TO WS-PAR-EIBTRNID.                     
           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 EIBTRNID        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.         23140000
                                                                        
A00755*** DETAULAT IS YES SO THAT GL# WILL NOT GET OVERRIDE BY RCC GL.          
A00755*** IN CASE OF CREDIT-RCC ONLY GL # WILL GET CHANGE TO USE SPLIT          
A00755     MOVE WS-PAR-YES              TO WS-PAR-CREATED-RCC-CREDIT-SW 
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          
A00755              MOVE 'N'            TO WS-PAR-CREATED-RCC-CREDIT-SW 
               WHEN CREDIT-CCA                                          
T22491              IF DEPOSIT-INT-CREDIT                               
DEPINT                 MOVE 'DEPINTCR'    TO WS-PAR-APPL-PROG-ID        
T22491              ELSE                                                
T22491                IF GMA-ADJUSTMENT                                 
T22491                   MOVE 'GMAADJMT'  TO WS-PAR-APPL-PROG-ID        
T22491                ELSE                                              
                         MOVE 'PANEL310G' TO WS-PAR-APPL-PROG-ID        
                      END-IF                                            
T22491              END-IF                                              
C22830              IF POST-APT-CREDIT                                  
C22830                 MOVE 'PANEL310J'   TO WS-PAR-APPL-PROG-ID        
C22830              END-IF                                              
T23264              IF JAMES-ISL-CREDIT                                 
T23264                 MOVE 'PANEL310L'   TO WS-PAR-APPL-PROG-ID        
T23264              END-IF                                              
C24880         WHEN CREDIT-DFA                                          
C24880              MOVE 'PANEL310H'    TO WS-PAR-APPL-PROG-ID          
               WHEN CREDIT-MIS                                          
                    MOVE 'PANEL310H'    TO WS-PAR-APPL-PROG-ID          
T24008              IF ADT-XFER-CREDIT                                  
T24008                 MOVE 'PANEL310K' TO WS-PAR-APPL-PROG-ID          
T24008              END-IF                                              
C30454              IF SEB-SALES-TAX-CREDIT                             
C30454                 MOVE 'PANEL310T' TO WS-PAR-APPL-PROG-ID          
C30454              END-IF                                              
P00774         WHEN CREDIT-MI1                                          
P00774              MOVE 'PANEL3101'    TO WS-PAR-APPL-PROG-ID          
P00774         WHEN CREDIT-MI2                                          
P00774              MOVE 'PANEL3102'    TO WS-PAR-APPL-PROG-ID          
P00774         WHEN CREDIT-MI3                                          
P00774              MOVE 'PANEL3103'    TO WS-PAR-APPL-PROG-ID          
P00774         WHEN CREDIT-MI4                                          
P00774              MOVE 'PANEL3104'    TO WS-PAR-APPL-PROG-ID          
P00774         WHEN CREDIT-MI5                                          
P00774              MOVE 'PANEL3105'    TO WS-PAR-APPL-PROG-ID          
P00774         WHEN CREDIT-MI6                                          
P00774              MOVE 'PANEL3106'    TO WS-PAR-APPL-PROG-ID          
C34569         WHEN CREDIT-CRM                                          
C34569              MOVE 'CRMCR'        TO WS-PAR-APPL-PROG-ID          
T30135         WHEN CREDIT-ISL                                          
T30135              MOVE 'PANEL310V'    TO WS-PAR-APPL-PROG-ID          
T30135         WHEN CREDIT-IFF                                          
T30135              MOVE 'PANEL310W'    TO WS-PAR-APPL-PROG-ID          
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    
           END-EVALUATE.                                                
                                                                        
      *    MOVE PROGRAM-NAME            TO WS-PAR-APPL-PROG-ID.         23600000
      *    MOVE PARM-FACILITY-CODE      TO WS-PAR-PYMT-FACILITY-CD.     23610000
           MOVE SPACES                  TO WS-PAR-PYMT-FACILITY-CD.     
                                                                        
T34116     MOVE PARM-TRAN-COMNT-LEN     TO WS-PAR-AR-TRAN-COMMENT-LEN.  
T34116     MOVE PARM-TRAN-COMNT-TEXT    TO WS-PAR-AR-TRAN-COMMENT-TEXT. 
T34116**   MOVE PARM-TRAN-COMMENT-LEN   TO WS-PAR-AR-TRAN-COMMENT-LEN.  23651000
T34116**   MOVE PARM-TRAN-COMMENT-TEXT  TO WS-PAR-AR-TRAN-COMMENT-TEXT. 23652000
                                                                        
           IF DIRECTED-PYMT                                             
      * SET UP WS-MAX-SUB IF WS-MAX-SUB=0 , SO THAT THE 5010 PAYMENT    23680000
      * LOOP IS PERFORMED.                                              23690000
              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                                                         
A00962        MOVE ZERO TO WS-PAR-TYPE-NO                               
              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                                                 
C22282           MOVE WS-PAR-MESSAGE-NO(2:4) TO WS-ACTIVE-RETURN-CODE   
C22282           MOVE PROGRAM-NAME           TO ABEND-PROGRAM           
C22282           MOVE '5000'                 TO ACTIVE-PARAGRAPH        
C22282           MOVE 'SELECT'               TO ABEND-FUNCTION          
C22282           PERFORM 9000-SEND-ERROR-RESULT   THRU 9000-EXIT        
C22282           PERFORM 9900-SQL-ERROR-ROUTINE   THRU 9900-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.                                                        
                                                                        
                                                                        
      ********************************************************          24140000
      * 5010-PAYMENT-LOOP                                    *          24150000
      *                                                      *          24160000
      *   PROCESS THE LOOPING LOGIC TO POST TO MULTIPLE      *          24170000
      *   DIRECTED RECEIVABLES.  MAXIMUM OF TWO DIRECTED:    *          24180000
      *   1) CREDIT RECV THAT WARRENTS CREDIT UP TO THE      *          24190000
      *      TOTAL AMOUNT OWED                                          24200000
      *   2) CREDIT REMAINING CREDIT (OVER AND ABOVE) TO     *          24210000
      *      DIRECTED DISTRIBUTED RECEIVABLE.                *          24220000
      ********************************************************          24230000
       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        24360000
      *                                     CHANGED BY CPD00010         24370000
              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                                                    
C22282        MOVE WS-PAR-MESSAGE-NO(2:4)    TO WS-ACTIVE-RETURN-CODE   
C22282        MOVE PROGRAM-NAME              TO ABEND-PROGRAM           
C22282        MOVE '5010'                    TO ACTIVE-PARAGRAPH        
C22282        MOVE 'SELECT'                  TO ABEND-FUNCTION          
C22282        PERFORM 9000-SEND-ERROR-RESULT  THRU 9000-EXIT            
C22282        PERFORM 9900-SQL-ERROR-ROUTINE  THRU 9900-EXIT            
           END-IF.                                                      
                                                                        
      *    PERFORM 6705-UPDATE-ACCOUNT THRU 6705-EXIT.                  24550000
           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.                                                        
                                                                        
                                                                        
      ***************************************************************** 24730000
      * 5800-DETERMINE-GL-NUMBERS                                       24740000
      *                                                                 24750000
      ***************************************************************** 24760000
       5800-DETERMINE-GL-NUMBERS.                                       
                                                                        
      ******************                                                24790000
      * LOAD G/L NUMBERS                                                24800000
      ******************                                                24810000
           PERFORM 5805-LOAD-GL-NUMBERS THRU 5805-EXIT.                 
                                                                        
           MOVE PARM-DB-GL-NUMBER             TO WS-PARM-DB-GL-NUMBER.  
           MOVE WS-PARM-DB-GL-NUMBER          TO WS-GL-ACCT-DEBIT       
                                                 AU-GL-ACCT-DEBIT       
                                                 WS-PAR-GEN-LEDG-DB.    
                                                                        
       5800-EXIT.                                                       
           EXIT.                                                        
                                                                        
                                                                        
      **************************************************                25330000
      * LOAD ALL G/L NUMBER, INCLUDEING CHARGED OFF.   *                25340000
      **************************************************                25350000
       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 AT-COMPANY-NO = WS-VALID-CO-NO (WS-VALID-CO-SUB)    
C24555              OR WS-VALID-CO-NO (WS-VALID-CO-SUB) = WS-GL-99      
C24555     IF AT-COMPANY-NO = WS-VALID-CO-NO (WS-VALID-CO-SUB)          
              MOVE WS-Y TO WS-COMPANY-IN-TABLE                          
           END-IF                                                       
           END-PERFORM.                                                 
                                                                        
       5805-EXIT.                                                       
           EXIT.                                                        
                                                                        
A03707*                                                                         
A03707******************************************************************25330000
A03707* 6000-VALIDATE-JRNL                                             *25340000
A03707******************************************************************25350000
A03707*                                                                         
A03707 6000-VALIDATE-JRNL.                                              
A03707*                                                                         
A03707     MOVE AT-COMPANY-NO              TO WS-100-COMPANY-NO.        
A03707     MOVE 9                          TO WS-TRAN-OPER-LEVEL.       
A03707     MOVE 1                          TO WS-TRAN-OCAP-FIELD.       
A03707     MOVE 1                          TO WS-TRAN-OCAP-VALUE.       
A03707     MOVE WS-C                       TO WS-TRAN-JRNL-TYPE.        
A03707     MOVE WS-N                       TO WS-TRAN-HOLD-EXEMPT-FLAG. 
A03707     MOVE PARM-USER-ID               TO WS-JRNL-OL-TEMP-ID.       
A03707     MOVE WS-JRNL-CK-OPER-ID         TO WS-JRNL-OPERATION-RQST.   
A03707     MOVE EIBTRNID                   TO WS-100-CODE-TERMINAL-TRAN.
A03707     MOVE EIBTRNID                   TO WS-PAR-EIBTRNID.          
A03707*                                                                         
A03707     PERFORM 6400-ONLINE-JRNL-ROUTINE THRU 6400-EXIT.             
A03707*                                                                         
A03707     MOVE WS-JRNL-OL-OPR-LOC         TO WS-TERM-LOC.              
A03707     MOVE '01'                       TO WS-CD-COMPANY-NO          
A03707     MOVE '998'                      TO WS-CD-LOCAL-OFFICE        
A03707     MOVE '998'                      TO WS-CD-REPORT-NO           
A03707     MOVE WS-CURRENT-DATE            TO WS-CD-REPORT-DATE         
A03707     MOVE 9999                       TO WS-CASH-DRAWER-ID         
A03707     MOVE WS-CD-COMPANY-NO           TO WS-JRNL-OL-COMPANY.       
A03707     MOVE WS-CD-LOCAL-OFFICE         TO WS-JRNL-OL-LOC-OFF.       
A03707     MOVE WS-CD-REPORT-NO            TO WS-JRNL-OL-REPORT-NO.     
A03707     MOVE WS-CD-REPORT-DATE          TO WS-JRNL-OL-REPORT-DT.     
A03707     MOVE WS-CASH-DRAWER-ID          TO WS-JRNL-OL-CASH-DRWR.     
A03707     MOVE WS-TERM-LOC                TO WS-JRNL-OL-TERM-LOC       
A03707                                        WS-JRNL-OL-CASH-LOC       
A03707                                        WS-JRNL-OL-OPR-LOC.       
A03707     MOVE WS-JRNL-VALIDATE-OPER      TO WS-JRNL-OPERATION-RQST.   
A03707     MOVE WS-C                       TO WS-JRNL-SOURCE-CODE.      
A03707*                                                                 22850000
A03707     IF CASH-TRANSACTION                                          
A03707        MOVE WS-JRNL-CASH-UPDATE     TO WS-JRNL-OL-AUTH-TYPE      
A03707     ELSE                                                         
A03707        MOVE WS-JRNL-NON-CASH-UPDATE TO WS-JRNL-OL-AUTH-TYPE      
A03707     END-IF.                                                      
A03707*                                                                 22850000
A03707     PERFORM 6400-ONLINE-JRNL-ROUTINE  THRU 6400-EXIT.            
A03707*                                                                 22930000
A03707 6000-EXIT.                                                       
A03707     EXIT.                                                        
A03707*                                                                 25580000
A03707******************************************************************18210000
A03707* 6010-SET-AR-TRAS-HST-VARS.                                     *18220000
A03707******************************************************************18240000
A03707*                                                                 25580000
A03707 6010-SET-AR-TRAS-HST-VARS.                                       
A03707*                                                                 18260000
A03707* AR TRANS HIST                                                   18260000
A03707     MOVE AT-ACCOUNT-NO              TO AR-ACCOUNT-NO.            
A03707     MOVE WS-CURRENT-TIMESTAMP       TO AR-TRANS-HIST-SEQ-NO.     
A03707     MOVE WS-CURRENT-DATE            TO AR-DATE-TRANS.            
A03707     MOVE 'A'                        TO AR-CODE-TRAN-TYPE.        
A03707     MOVE PARM-CR-AMT-AR-TOTAL       TO AR-AMT-ORIG-ENTERED.      
A03707     MOVE AT-TOTAL-AR-BALANCE        TO AR-AMT-BILLED-UNPAID.     
A03707     MOVE 'PANEL270A'                TO AR-APPL-PROGRAM-ID        
A03707     MOVE PF-RESP-AREA-ID            TO AR-RESP-AREA-ID.          
A03707     MOVE SPACES                     TO AR-PYMT-FACILITY-CD.      
A03707     MOVE PARM-USER-ID               TO AR-USER-ID.               
A03707     MOVE AT-COMPANY-NO              TO AR-COMPANY-NO.            
A03707*                                                                 18470000
A03707     MOVE WS-CD-COMPANY-NO           TO AR-CASH-COMPANY-NO.       
A03707     MOVE WS-CD-LOCAL-OFFICE         TO AR-CASH-LOCAL-OFFICE.     
A03707     MOVE WS-CD-REPORT-NO            TO AR-CASH-REPORT-NO.        
A03707     MOVE WS-CD-REPORT-DATE          TO AR-DATE-CASH-REPORT.      
A03707     MOVE WS-CASH-DRAWER-ID          TO AR-CASH-DRAWER-ID.        
A03707*                                                                 18470000
A03707     MOVE PARM-TRAN-COMNT-LEN        TO AR-TRAN-COMMENT-LEN.      
A03707     MOVE PARM-TRAN-COMNT-TEXT       TO AR-TRAN-COMMENT-TEXT.     
A03707     MOVE 'Y'                        TO AR-RECORD-ONLY-FL         
A03707     MOVE -1                         TO WS-DATE-ORIG-PYMT-IND.    
A03707* AR TRANS DETAILS                                                18260000
A03707     MOVE AR-ACCOUNT-NO              TO AU-ACCOUNT-NO.            
A03707     MOVE AR-TRANS-HIST-SEQ-NO       TO AU-TRANS-HIST-SEQ-NO.     
A03707     MOVE AR-AMT-ORIG-ENTERED        TO AU-AMT-POSTED             
A03707                                        AU-CURRENCY-AMT.          
A03707     MOVE 'P'                        TO AU-CODE-AR-AGE.           
A03707     MOVE 1                          TO AU-TRAN-APPL-NO.          
A03707     MOVE PARM-ITEM-ID               TO AU-ITEM-ID.               
A03707     MOVE SPACES                     TO AU-CODE-CONTRACT-TYPE     
A03707                                        AU-CURRENCY-TYPE.         
A03707     MOVE WS-PARM-DB-GL-NUMBER       TO AU-GL-ACCT-DEBIT.         
A03707     MOVE WS-PARM-CR-GL-NUMBER       TO AU-GL-ACCT-CREDIT.        
A03707*                                                                 18720000
A03707 6010-EXIT.                                                       
A03707     EXIT.                                                        
A03707*                                                                 18780000
A03707******************************************************************25330000
A03707* 6020-SET-100-JRNL-VARS                                         *25340000
A03707******************************************************************25350000
A03707*                                                                         
A03707 6020-SET-100-JRNL-VARS.                                          
A03707*                                                                         
A03707     MOVE 'A'                        TO WS-100-JRNL-SORT-ID.      
A03707     MOVE AT-COMPANY-NO              TO WS-100-COMPANY-NO.        
A03707     MOVE AT-ACCOUNT-NO              TO WS-100-ACCT-NO.           
A03707     MOVE AT-CUSTOMER-NO             TO WS-100-CUSTOMER-NO.       
A03707     MOVE AT-PREMISE-NO              TO WS-100-PREMISE-NO.        
A03707     MOVE AU-TRAN-APPL-NO            TO WS-100-JRNL-TRAN-APPL-NO. 
A03707     MOVE AT-DATE-LAST-ACTION        TO WS-100-DATE-LAST-ACTION.  
A03707     MOVE 'C'                        TO WS-100-CODE-ENTRY-SOURCE. 
A03707     MOVE AT-LOCAL-OFFICE            TO WS-100-LOCAL-OFFICE-CD    
A03707                                        WS-JRNL-OL-CASH-LOC.      
A03707     MOVE SPACES                     TO WS-100-TRANS-ERRORS.      
A03707*                                                                 22930000
A03707 6020-EXIT.                                                       
A03707     EXIT.                                                        
A03707*                                                                 22930000
A03707******************************************************************25330000
A03707* 6030-SET-101-JRNL-VARS                                         *25340000
A03707******************************************************************25350000
A03707*                                                                         
A03707 6030-SET-101-JRNL-VARS.                                          
A03707*                                                                         
A03707     MOVE 101                        TO WS-101-JRNL-FORMAT-NO.    
A03707     MOVE SPACES                     TO WS-101-CASH-DRAWER-USED.  
A03707     MOVE AU-GL-ACCT-CREDIT          TO WS-101-ACCT-GEN-LED-CR.   
A03707     MOVE AU-GL-ACCT-DEBIT           TO WS-101-ACCT-GEN-LED-DR.   
A03707     MOVE AU-AMT-POSTED              TO WS-101-AMOUNT-ENTERED     
A03707                                        WS-101-AMT-POSTED.        
A03707     MOVE AU-CODE-AR-AGE             TO WS-101-AR-AGE.            
A03707     MOVE WS-CURRENT-DATE            TO WS-101-DATE-AR-BILLED.    
A03707     MOVE AU-ITEM-ID                 TO WS-101-ITEM-ID-NO.        
A03707     MOVE 0                          TO WS-101-DETAIL-END-BAL.    
A03707     MOVE 0                          TO WS-101-DETAIL-END-AR-BAL  
A03707     MOVE SPACES                     TO WS-101-FUNCTION-CODE.     
A03707     MOVE PR-REV-DISTRICT-CD         TO                           
A03707                                     WS-101-CODE-REVENUE-DISTRICT.
A03707     MOVE CU-CODE-EMPL-ACCT          TO WS-101-CODE-EMPL-ACCT.    
A03707     MOVE AT-CODE-COMPANY-ACCT       TO WS-101-CODE-COMPANY-ACCT. 
A03707     MOVE AT-CODE-ACCT-STAT          TO WS-101-CODE-ACCOUNT-STATUS
A03707     MOVE PR-CODE-PREMISE-STAT       TO WS-101-CODE-PREMISE-STATUS
A03707*                                                                         
A03707     MOVE AU-CURRENCY-TYPE           TO WS-JRNL-CURRENCY-TYPE.    
A03707     MOVE AR-PYMT-FACILITY-CD        TO WS-JRNL-CODE-PYMT-FACILITY
A03707     MOVE AU-GL-ACCT-DEBIT           TO WS-GEN-LED-NO-AR-TEST.    
A03707     MOVE AU-CURRENCY-AMT            TO WS-JRNL-GEN-LEG-CREDIT-AMT
A03707                                        WS-JRNL-GEN-LEG-DEBIT-AMT.
A03707     MOVE WS-JRNL-CASH-UPDATE        TO WS-JRNL-OL-AUTH-TYPE.     
A03707     MOVE EIBTRNID                   TO WS-100-CODE-TERMINAL-TRAN.
A03707*                                                                         
A03707     MOVE CJF00101                   TO WS-100-USER-DEFINED-AREA. 
A03707*                                                                         
A03707 6030-EXIT.                                                       
A03707     EXIT.                                                        
A03707*                                                                 25580000
      ***************************************************************** 25590000
      * 6800A-APPLY-PAYMENT                                             25600000
      *                                                                 25610000
      * PARAGRAGH CLONED FROM CPD000010 - 6700A TO WORK FOR MONEY       25620000
      * DIRECTED TO RECV-TYPE, AS WELL AS, INDIV AR-AGING BUCKETS       25630000
      *                                                                 25640000
      ***************************************************************** 25650000
       6800A-APPLY-PAYMENT.                                             
                                                                        
           MOVE WS-AMT-CASH         TO WS-PAYMENT-AMOUNT                
                                       WS-PAYMENT-AMOUNT-TOTAL          
      *                                WS-REMAINING-PYMT-AMT            25700000
                                       WS-PAR-ORIG-AMT-ENTERED          
                                       AT-LAST-PYMT-AMOUNT.             
                                                                        
           MOVE WS-PAR-YES          TO WS-WAS-PYMT-SUCCESSFUL           
                                       WS-PAR-FIRST-TIME.               
                                                                        
      ***********                                                       25770000
      * VALIDATE OPERATOR FIRST                                         25780000
      ***********                                                       25790000
                                                                        
           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.                                         
                                                                        
      ***********                                                       25890000
      * PROCESS DIRECTED AR-CNTL TO INDIVIDUAL BUCKETS                  25900000
      ***********                                                       25910000
                                                                        
           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.                                                        
                                                                        
                                                                        
      ***************************************************************** 26350000
      * 6810A-DIRECTED-PAYMENT                                          26360000
      *                                                                 26370000
      * PARAGRAGH CLONED FROM CPD000010 - 6710A TO WORK FOR MONEY       26380000
      * DIRECTED TO RECV-TYPE, AS WELL AS, INDIV AR-AGING BUCKETS       26390000
      *                                                                 26400000
      ***************************************************************** 26410000
       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             
T20081           IF  WS-SPLIT-CREDIT EQUAL WS-Y                         
T20081               MOVE WS-CREDIT-REMAINING     TO                    
T20081                       WS-REMAINING-PYMT-AMT                      
T20081           ELSE                                                   
T20081              MOVE WS-PARM-CR-AMT-AR-DAY-90 TO                    
T20081                  WS-REMAINING-PYMT-AMT                           
T20081              SUBTRACT WS-REMAINING-PYMT-AMT FROM                 
T20081                  WS-CREDIT-REMAINING                             
T20081           END-IF                                                 
                 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             
T20081           IF  WS-SPLIT-CREDIT EQUAL WS-Y                         
T20081               MOVE WS-CREDIT-REMAINING     TO                    
T20081                       WS-REMAINING-PYMT-AMT                      
T20081           ELSE                                                   
T20081              MOVE WS-PARM-CR-AMT-AR-DAY-60 TO                    
T20081                  WS-REMAINING-PYMT-AMT                           
T20081              SUBTRACT WS-REMAINING-PYMT-AMT FROM                 
T20081                  WS-CREDIT-REMAINING                             
T20081           END-IF                                                 
                 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             
T20081           IF  WS-SPLIT-CREDIT EQUAL WS-Y                         
T20081               MOVE WS-CREDIT-REMAINING      TO                   
T20081                       WS-REMAINING-PYMT-AMT                      
T20081           ELSE                                                   
T20081              MOVE WS-PARM-CR-AMT-AR-DAY-30 TO                    
T20081                  WS-REMAINING-PYMT-AMT                           
T20081              SUBTRACT WS-REMAINING-PYMT-AMT FROM                 
T20081                  WS-CREDIT-REMAINING                             
T20081           END-IF                                                 
                 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             
T20081           IF  WS-SPLIT-CREDIT EQUAL WS-Y                         
T20081               MOVE WS-CREDIT-REMAINING     TO                    
T20081                       WS-REMAINING-PYMT-AMT                      
T20081           ELSE                                                   
T20081              MOVE WS-PARM-CR-AMT-AR-DAY-00 TO                    
T20081                  WS-REMAINING-PYMT-AMT                           
T20081              SUBTRACT WS-REMAINING-PYMT-AMT FROM                 
T20081                  WS-CREDIT-REMAINING                             
T20081           END-IF                                                 
                 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.                                                        
                                                                        
                                                                        
      ***************************************************************** 27360000
      * 6811A-DETAIL-AGING-CONTROL.                                     27370000
      *                                                                 27380000
      * PARAGRAGH CLONED FROM CPD000010 - 6711A - TO WORK FOR MONEY     27390000
      * DIRECTED TO RECV-TYPE, AS WELL AS, INDIV AR-AGING BUCKETS       27400000
      *                                                                 27410000
      ***************************************************************** 27420000
       6811A-DETAIL-AGING-CONTROL.                                      
                                                                        
      ***************************************************************** 27450000
      *  THE FOLLOWING LOGIC WOULD ALLOW A CREDIT/PAYMENT TO BE         27460000
      *  PROCESSED AGAINST THE SUMMARY LEVEL OF A RECEIVABLE            27470000
      ***************************************************************** 27480000
      *                                                                 27490000
      *    IF WS-PAR-TYPE-NO EQUAL ZEROES                               27500000
      *       MOVE ZEROES TO AC-ITEM-ID                                 27510000
      *       PERFORM 6704A-OPEN-AGING-DETAIL  THRU 6704A-EXIT          27520000
      *       PERFORM 6713-PROCESS-ALL-DETAILS THRU 6713-EXIT           27530000
      *       PERFORM 6704C-CLOSE-AGING-DETAIL THRU 6704C-EXIT          27540000
      *       GO TO 6811A-EXIT                                          27550000
      *    ELSE                                                         27560000
              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.                                                        
                                                                        
                                                                        
      ***************************************************************** 27980000
      *                                                                 27990000
      * JOURNALING COPYBOOK PROCEDURE CODE                              28000000
      *                                                                 28010000
      ***************************************************************** 28020000
                                                                        
           EXEC SQL                                                     28040000
             INCLUDE CPD00003                                           28050000
           END-EXEC.                                                    28060000
                                                                        
           EXEC SQL                                                     28080000
A00956       INCLUDE CPD0006A                                           28090000
           END-EXEC.                                                    28100000
                                                                        
           EXEC SQL                                                     28120000
              INCLUDE CPD00008                                          28130000
           END-EXEC.                                                    28140000
                                                                        
                                                                        
           EXEC SQL                                                     28160000
              INCLUDE CPD0010S                                          28170000
           END-EXEC.                                                    28180000
                                                                        
           COPY CPD00010.                                               28190000
                                                                        
           EXEC SQL                                                     28200000
              INCLUDE CPD00073                                          28210000
           END-EXEC.                                                    28220000
                                                                        
      ***************************************************************** 28240000
      *                                                                 28250000
      * DATABASE SELECTS                                                28260000
      *                                                                 28270000
      ***************************************************************** 28280000
                                                                        
       7000-SELECT-AT-PR-CU.                                            
           EXEC SQL                                                     
              SELECT AT.CUSTOMER_NO,                                    
A36248               AT.BILL_CYCLE,                                     
                     AT.CODE_ACCT_STAT,                                 
A36248               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),                         
A03707               REPLACE(REPLACE(CONVERT(CHAR(26), 
           CIS.CURRENT$TIMESTAMP(), 121), ' ', '-'), ':', '.')                 
             INTO    :AT-CUSTOMER-NO,                                   
A36248               :AT-BILL-CYCLE,                                    
                     :AT-CODE-ACCT-STAT,                                
A36248               :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,                                  
A03707               :WS-CURRENT-TIMESTAMP                              
            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                                                           
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ022
MFA-TR* MSQ028
MFA-TR* MSQ061
MFA-TR*    EXEC SQL                                                     28310000
MFA-TR*       SELECT AT.CUSTOMER_NO,                                    28320000
MFA-TR*              AT.BILL_CYCLE,                                             
MFA-TR*              AT.CODE_ACCT_STAT,                                 28330000
MFA-TR*              AT.ACCOUNT_TYPE_CODE,                                      
MFA-TR*              AT.TOTAL_AR_BALANCE,                               28340000
MFA-TR*              AT.DATE_LAST_ACTION,                               28350000
MFA-TR*              AT.LOCAL_OFFICE,                                   28360000
MFA-TR*              AT.PREMISE_NO,                                     28370000
MFA-TR*              AT.CODES_DATA_PRESENT,                             28380000
MFA-TR*              AT.COMPANY_NO,                                     28390000
MFA-TR*              AT.AR_XFER_IND,                                    28400000
MFA-TR*              AT.ACCT_XFER_TO,                                   28410000
MFA-TR*              AT.BANKRUPTCY_IND,                                 28420000
MFA-TR*              AT.CREDIT_GROUP,                                   28430000
MFA-TR*              AT.NOTICE_EXEMPT_CD,                               28440000
MFA-TR*              AT.CODE_DISC_OK,                                   28450000
MFA-TR*              AT.DATE_BILL_DAY_00,                               28460000
MFA-TR*              AT.DATE_BILL_DAY_30,                               28470000
MFA-TR*              AT.DATE_BILL_DAY_60,                               28480000
MFA-TR*              AT.DATE_BILL_DAY_90,                               28490000
MFA-TR*              AT.ELEC_REV_ALLOC_PCT,                             28500000
MFA-TR*              AT.IVR_EXEMPT_CD,                                  28510000
MFA-TR*              PR.CODE_PREMISE_STAT,                              28520000
MFA-TR*              PR.REV_DISTRICT_CD,                                28530000
MFA-TR*              CU.CODE_EMPL_ACCT,                                 28540000
MFA-TR*              CU.CODE_CUST_STATUS,                               28550000
MFA-TR*              CURRENT DATE,                                      28560000
MFA-TR*              CURRENT TIMESTAMP                                          
MFA-TR*      INTO    :AT-CUSTOMER-NO,                                   28570000
MFA-TR*              :AT-BILL-CYCLE,                                            
MFA-TR*              :AT-CODE-ACCT-STAT,                                28580000
MFA-TR*              :AT-ACCOUNT-TYPE-CODE,                                     
MFA-TR*              :AT-TOTAL-AR-BALANCE,                              28590000
MFA-TR*              :AT-DATE-LAST-ACTION,                              28600000
MFA-TR*              :AT-LOCAL-OFFICE,                                  28610000
MFA-TR*              :AT-PREMISE-NO,                                    28620000
MFA-TR*              :AT-CODES-DATA-PRESENT,                            28630000
MFA-TR*              :AT-COMPANY-NO,                                    28640000
MFA-TR*              :AT-AR-XFER-IND,                                   28650000
MFA-TR*              :AT-ACCT-XFER-TO,                                  28660000
MFA-TR*              :AT-BANKRUPTCY-IND,                                28670000
MFA-TR*              :AT-CREDIT-GROUP,                                  28680000
MFA-TR*              :AT-NOTICE-EXEMPT-CD,                              28690000
MFA-TR*              :AT-CODE-DISC-OK,                                  28700000
MFA-TR*              :AT-DATE-BILL-DAY-00 :WS-NULL-INDICATOR-1,         28710000
MFA-TR*              :AT-DATE-BILL-DAY-30 :WS-NULL-INDICATOR-2,         28720000
MFA-TR*              :AT-DATE-BILL-DAY-60 :WS-NULL-INDICATOR-3,         28730000
MFA-TR*              :AT-DATE-BILL-DAY-90 :WS-NULL-INDICATOR-4,         28740000
MFA-TR*              :AT-ELEC-REV-ALLOC-PCT,                            28750000
MFA-TR*              :AT-IVR-EXEMPT-CD,                                 28760000
MFA-TR*              :PR-CODE-PREMISE-STAT,                             28770000
MFA-TR*              :PR-REV-DISTRICT-CD,                               28780000
MFA-TR*              :CU-CODE-EMPL-ACCT,                                28790000
MFA-TR*              :CU-CODE-CUST-STATUS,                              28800000
MFA-TR*              :WS-CURRENT-DATE,                                  28810000
MFA-TR*              :WS-CURRENT-TIMESTAMP                                      
MFA-TR*     FROM CSS_ACCOUNT AT, CSS_PREMISE PR, CSS_CUSTOMER CU        28820000
MFA-TR*     WHERE AT.ACCOUNT_NO  = :AT-ACCOUNT-NO AND                   28830000
MFA-TR*           AT.PREMISE_NO  = PR.PREMISE_NO  AND                   28840000
MFA-TR*           AT.CUSTOMER_NO = CU.CUSTOMER_NO                       28850000
MFA-TR*      WITH UR                                                            
MFA-TR*    END-EXEC.                                                    28860000

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.                                          
           EXEC SQL                                                     
              SELECT CODE_CONTRACT_TYPE,                                
                     SIMPLE_INT_FIN_CHG,                                
                     AMT_DEF_INTEREST,                                  
                     GL_ACCT_NO_ERN_INT,                                
                     GL_ACCT_NO_DEF_INT                                 
C30304*              INTRST_YTD                                         29160000
                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                             
C30304*              :CT-INTRST-YTD                                     29211000
                FROM CSS_CONTRACT                                       
               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 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.                                                       
                                                                        
A03707*                                                                 29420000
A03707***************************************************************** 29390000
A03707* 7020-SEL-CNT-INFO                                               29400000
A 3707***************************************************************** 29410000
A03707*                                                                 29420000
A03707 7020-SEL-CNT-INFO.                                               
A03707*                                                                 29420000
A03707     EXEC SQL                                                     
A03707        SELECT                                                    
A03707               GL_ACCT_NO                                         
A03707          INTO                                                    
A03707               :EA-GL-ACCT-NO                                     
A03707          FROM                                                    
A03707               CSS_CONTRACT   CT WITH(READUNCOMMITTED)                    
A03707              ,CSS_CNT_DETAIL EA WITH(READUNCOMMITTED)                    
A03707         WHERE                                                    
A03707               CT.ACCOUNT_NO        = :CT-ACCOUNT-NO              
A03707           AND CT.CNT_ITEM_ID       = :CT-CNT-ITEM-ID             
A03707           AND CT.PYMT_PRIORITY_LVL = 100                         
A03707           AND CT.ACCOUNT_NO        = EA.ACCOUNT_NO               
A03707           AND CT.CNT_ITEM_ID       = EA.CNT_ITEM_ID              
A03707                                                           
A03707                                                      
A03707     END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ003
MFA-TR* MSQ022
MFA-TR*    EXEC SQL                                                     29440000
MFA-TR*       SELECT                                                    29110000
MFA-TR*              GL_ACCT_NO                                         29120000
MFA-TR*         INTO                                                    29170000
MFA-TR*              :EA-GL-ACCT-NO                                     29180000
MFA-TR*         FROM                                                    29212000
MFA-TR*              CSS_CONTRACT   CT                                  29212000
MFA-TR*             ,CSS_CNT_DETAIL EA                                  29212000
MFA-TR*        WHERE                                                    29213000
MFA-TR*              CT.ACCOUNT_NO        = :CT-ACCOUNT-NO              29213000
MFA-TR*          AND CT.CNT_ITEM_ID       = :CT-CNT-ITEM-ID             29215000
MFA-TR*          AND CT.PYMT_PRIORITY_LVL = 100                         29214000
MFA-TR*          AND CT.ACCOUNT_NO        = EA.ACCOUNT_NO               29213000
MFA-TR*          AND CT.CNT_ITEM_ID       = EA.CNT_ITEM_ID              29215000
MFA-TR*         WITH UR                                                 29215000
MFA-TR*      QUERYNO 7020                                               29215000
MFA-TR*    END-EXEC.                                                    29216000

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

A03707*                                                                 29420000
A03707     IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL                   
A03707        NEXT SENTENCE                                             
A03707     ELSE                                                         
A03707        MOVE WS-ACTIVE-RETURN-CODE    TO RS-RETURN-CODE           
A03707        MOVE PROGRAM-NAME             TO ABEND-PROGRAM            
A03707        MOVE '7020'                   TO ACTIVE-PARAGRAPH         
A03707        MOVE 'SELECT'                 TO ABEND-FUNCTION           
A03707        MOVE 'CSS_CONTRACT'           TO TABLE-1                  
A03707        MOVE 'CSS_CONTRACT_INFO'      TO TABLE-2                  
A03707        MOVE 'ACCOUNT_NO'             TO TABLE-ELEMENT-1          
A03707        MOVE 'CNT_ITEM_ID'            TO TABLE-ELEMENT-1          
A03707        MOVE CT-ACCOUNT-NO            TO HOSTVAR-ELEMENT-1        
A03707        MOVE CT-CNT-ITEM-ID           TO HOSTVAR-ELEMENT-1        
A03707        PERFORM 9700-PROCESS-ABEND    THRU 9700-EXIT              
A03707     END-IF.                                                      
A03707*                                                                 34070000
A03707 7020-EXIT.                                                       
A03707     EXIT.                                                        
A03707*                                                                 34070000
      ***************************************************************** 29390000
      * 7060-UPDATE-INTEREST.                                           29400000
      ***************************************************************** 29410000
                                                                        
       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        
C30304*             INTRST_YTD          = :CT-INTRST-YTD                29480000
                    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.                                                        
                                                                        
      ***************************************************************** 30090000
      * 7100-SELECT-AR-CNTL                                             30100000
      ***************************************************************** 30110000
                                                                        
       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                                       
               WHERE  ACCOUNT_NO        = :AC-ACCOUNT-NO                
               AND    ITEM_ID           = :AC-ITEM-ID                   
               AND    PYMT_PRIORITY_LVL = :AC-PYMT-PRIORITY-LVL         
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ061
MFA-TR*    EXEC SQL                                                     30140000
MFA-TR*        SELECT 'YES',                                            30150000
MFA-TR*               ACCOUNT_NO,                                       30160000
MFA-TR*               ITEM_ID,                                          30170000
MFA-TR*               PYMT_PRIORITY_LVL,                                30180000
MFA-TR*               AMT_AR_DAY_00,                                    30190000
MFA-TR*               AMT_AR_DAY_30,                                    30200000
MFA-TR*               AMT_AR_DAY_60,                                    30210000
MFA-TR*               AMT_AR_DAY_90,                                    30220000
MFA-TR*               LAST_UPDATE_TS,                                   30230000
MFA-TR*               TOT_SUMM_UNBILLED,                                30240000
MFA-TR*               AMT_TRAN_BALANCE                                  30250000
MFA-TR*        INTO   :WS-AR-CNTL-EXISTS-FLAG,                          30260000
MFA-TR*               :AC-ACCOUNT-NO,                                   30270000
MFA-TR*               :AC-ITEM-ID,                                      30280000
MFA-TR*               :AC-PYMT-PRIORITY-LVL,                            30290000
MFA-TR*               :AC-AMT-AR-DAY-00,                                30300000
MFA-TR*               :AC-AMT-AR-DAY-30,                                30310000
MFA-TR*               :AC-AMT-AR-DAY-60,                                30320000
MFA-TR*               :AC-AMT-AR-DAY-90,                                30330000
MFA-TR*               :AC-LAST-UPDATE-TS,                               30340000
MFA-TR*               :AC-TOT-SUMM-UNBILLED,                            30350000
MFA-TR*               :AC-AMT-TRAN-BALANCE                              30360000
MFA-TR*        FROM   CSS_AR_CNTL                                       30370000
MFA-TR*        WHERE  ACCOUNT_NO        = :AC-ACCOUNT-NO                30380000
MFA-TR*        AND    ITEM_ID           = :AC-ITEM-ID                   30390000
MFA-TR*        AND    PYMT_PRIORITY_LVL = :AC-PYMT-PRIORITY-LVL         30400000
MFA-TR*    END-EXEC.                                                    30420000

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                                                         
T19886       IF WS-ACTIVE-RETURN-CODE = NOT-FOUND                       
T19886          IF AC-PYMT-PRIORITY-LVL EQUAL 70                        
T19886             MOVE 0                        TO AC-ITEM-ID          
T19886             MOVE ZEROS                    TO AC-AMT-AR-DAY-00    
T19886                                              AC-AMT-AR-DAY-30    
T19886                                              AC-AMT-AR-DAY-60    
T19886                                              AC-AMT-AR-DAY-90    
T19886                                              AC-AMT-UNUSED-CR    
T19886                                              AC-AMT-TRAN-BALANCE 
T19886                                              AC-TOT-SUMM-UNBILLED
T19886             PERFORM 8620-INSERT-AR-CNTL   THRU 8620-EXIT         
T19886             MOVE 1                        TO AC-ITEM-ID          
T19886             PERFORM 8620-INSERT-AR-CNTL   THRU 8620-EXIT         
T19886          END-IF                                                  
T19886       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       30680000
                       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                                                    
T19886       END-IF                                                     
           END-IF.                                                      
                                                                        
       7100-EXIT.                                                       
           EXIT.                                                        
                                                                        
                                                                        
      ***************************************************************** 31040000
      * 7200-SELECT-RECONNECT                                           31050000
      ***************************************************************** 31060000
       7200-SELECT-RECONNECT.                                           
           EXEC SQL                                                     
               SELECT AMT_TOT_RECONNECT,                                
T20081                RECNCT_COLLECT_AMT                                
                 INTO :DL-AMT-TOT-RECONNECT,                            
T20081                :DL-RECNCT-COLLECT-AMT                            
              FROM CSS_RECONNECT                                        
              WHERE ACCOUNT_NO = :DL-ACCOUNT-NO                         
           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 WS-ACTIVE-RETURN-CODE TO RS-RETURN-CODE              
              MOVE PROGRAM-NAME          TO ABEND-PROGRAM               
CBSI          MOVE '7200'                TO ACTIVE-PARAGRAPH            
              MOVE 'SELECT'              TO ABEND-FUNCTION              
              MOVE SPACES                TO ABEND-SQL-PREDICATES        
                                            ABEND-TABLES                
              MOVE 'CSS_RECONNECT'       TO TABLE-1                     
CBSI          MOVE 'ACCOUNT_NO'          TO TABLE-ELEMENT-1             
              MOVE DL-ACCOUNT-NO         TO HOSTVAR-ELEMENT-1           
              PERFORM 9700-PROCESS-ABEND      THRU 9700-EXIT            
           END-IF.                                                      
       7200-EXIT.                                                       
           EXIT.                                                        
                                                                        
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)                        
T13034         WHERE  COMPANY_NO        = :GO-COMPANY-NO                
T13034         AND    GL_ACCT_NAME      = :GO-GL-ACCT-NAME              
A36248                                                           
T13034     END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ022
MFA-TR*    EXEC SQL                                                     31380000
MFA-TR*        SELECT GL_ACCT_NO                                        31390000
MFA-TR*        INTO :GO-GL-ACCT-NO                                      31400000
MFA-TR*        FROM CSS_GL_ACCT_NO                                      31410000
MFA-TR*        WHERE  COMPANY_NO        = :GO-COMPANY-NO                31420000
MFA-TR*        AND    GL_ACCT_NAME      = :GO-GL-ACCT-NAME              31430000
MFA-TR*        WITH UR                                                          
MFA-TR*    END-EXEC.                                                    31440000

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 GO-COMPANY-NO         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 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                                                           
T19996     END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ022
MFA-TR*    EXEC SQL                                                     31670000
MFA-TR*       SELECT MST_SUB_ACCT_IND                                   31680000
MFA-TR*         INTO :AT-MST-SUB-ACCT-IND                               31690000
MFA-TR*         FROM CSS_ACCOUNT                                        31700000
MFA-TR*        WHERE ACCOUNT_NO  = :AT-ACCOUNT-NO                       31710000
MFA-TR*         WITH UR                                                         
MFA-TR*    END-EXEC.                                                    31720000

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.                                                        
                                                                        
       7600-SELECT-GL-ACCOUNT.                                          
      ****************************************************************  31940000
      * 7600-SELECT-GL-ACCOUNT                                      *   31950000
      ****************************************************************  31960000
                                                                        
           EXEC SQL                                                     
              SELECT GL_ACCT_NO                                         
              INTO  :GO-GL-ACCT-NO                                      
              FROM   CSS_GL_ACCT_NO WITH(READUNCOMMITTED)                       
T23748*       WHERE  COMPANY_NO   = :AT-COMPANY-NO                      32020000
T23748        WHERE  COMPANY_NO   = '01'                                
              AND    GL_ACCT_NAME = :GO-GL-ACCT-NAME                    
A36248                                                           
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ022
MFA-TR*    EXEC SQL                                                     31980000
MFA-TR*       SELECT GL_ACCT_NO                                         31990000
MFA-TR*       INTO  :GO-GL-ACCT-NO                                      32000000
MFA-TR*       FROM   CSS_GL_ACCT_NO                                     32010000
MFA-TR*       WHERE  COMPANY_NO   = :AT-COMPANY-NO                      32020000
MFA-TR*       WHERE  COMPANY_NO   = '01'                                32030000
MFA-TR*       AND    GL_ACCT_NAME = :GO-GL-ACCT-NAME                    32040000
MFA-TR*       WITH UR                                                           
MFA-TR*    END-EXEC.                                                    32050000

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              
T23748*       MOVE AT-COMPANY-NO        TO HOSTVAR-ELEMENT-1            32190000
T23748        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.                                                        
P00794*                                                                         
P00794******************************************************************        
P00794* 7640-GET-UTIL-ENV.                                             *        
P00794******************************************************************        
P00794*                                                                         
P00794 7640-GET-UTIL-ENV.                                               
P00794*                                                                         
P00794     EXEC SQL                                                     
P00794        SELECT TOP(1) IC_NO,
              CODE_UTIL_TYPE                                     
P00794          INTO :UT-IC-NO,                                         
P00794               :UT-CODE-UTIL-TYPE                                 
P00794          FROM CSS_UTIL_ENVRNMT UT WITH(READUNCOMMITTED)                  
P00794         WHERE ACCOUNT_NO = :UT-ACCOUNT-NO                        
P00794                                     
P00794                                                      
P00794     END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ003
MFA-TR* MSQ020
MFA-TR* MSQ022
MFA-TR*    EXEC SQL                                                             
MFA-TR*       SELECT IC_NO,                                                     
MFA-TR*              CODE_UTIL_TYPE                                             
MFA-TR*         INTO :UT-IC-NO,                                                 
MFA-TR*              :UT-CODE-UTIL-TYPE                                         
MFA-TR*         FROM CSS_UTIL_ENVRNMT UT                                        
MFA-TR*        WHERE ACCOUNT_NO = :UT-ACCOUNT-NO                                
MFA-TR*        FETCH FIRST 1 ROW ONLY WITH UR                                   
MFA-TR*      QUERYNO 7640                                                       
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

P00794                                                                  
P00794     MOVE SQLCODE                      TO WS-ACTIVE-RETURN-CODE.  
P00794     IF  WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL                  
P00794         CONTINUE                                                 
P00794     ELSE                                                         
P00794         MOVE WS-ACTIVE-RETURN-CODE    TO RS-RETURN-CODE          
P00794         MOVE PROGRAM-NAME             TO ABEND-PROGRAM           
P00794         MOVE '7640'                   TO ACTIVE-PARAGRAPH        
P00794         MOVE 'SELECT'                 TO ABEND-FUNCTION          
P00794         MOVE 'CSS_UTIL_ENVRNMT'       TO TABLE-1                 
P00794         MOVE 'ACCOUNT_NO'             TO TABLE-ELEMENT-1         
P00794         MOVE UT-ACCOUNT-NO            TO HOSTVAR-ELEMENT-1       
P00794         PERFORM 9000-SEND-ERROR-RESULT THRU 9000-EXIT            
P00794         PERFORM 9900-SQL-ERROR-ROUTINE THRU 9900-EXIT            
P00794     END-IF.                                                      
P00794*                                                                         
P00794 7640-EXIT.                                                       
P00794     EXIT.                                                        
P00794*                                                                         
P00794*                                                                         
P00794******************************************************************        
P00794* 7650-GET-MIN-REV-MO.                                           *        
P00794******************************************************************        
P00794*                                                                         
P00794 7650-GET-MIN-REV-MO.                                             
P00794*                                                                         
P00794     EXEC SQL                                                     
P00794        SELECT MIN(REVENUE_MONTH)                                 
P00794          INTO :BN-REVENUE-MONTH                                  
P00794          FROM CSS_BILL_WINDOW BN WITH(READUNCOMMITTED)                   
P00794         WHERE BN.DATE_EXTRACT = IIF(TRY_CONVERT(DATE, 
                                                       :WS-CURRENT-DATE
              ) IS NULL OR (PATINDEX('%.%', :WS-CURRENT-DATE
              ) <> 0) OR (LEN(:WS-CURRENT-DATE) <> 10), CIS.CHAR2DATE(
                                                       :WS-CURRENT-DATE
              ), CONVERT(DATE, :WS-CURRENT-DATE) )                 
P00794                                                           
P00794                                                      
P00794     END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ003
MFA-TR* MSQ022
MFA-TR* MSQ054
MFA-TR*    EXEC SQL                                                             
MFA-TR*       SELECT MIN(REVENUE_MONTH)                                         
MFA-TR*         INTO :BN-REVENUE-MONTH                                          
MFA-TR*         FROM CSS_BILL_WINDOW BN                                         
MFA-TR*        WHERE BN.DATE_EXTRACT = :WS-CURRENT-DATE                         
MFA-TR*        WITH UR                                                          
MFA-TR*      QUERYNO 7650                                                       
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

P00794                                                                  
P00794     MOVE SQLCODE                      TO WS-ACTIVE-RETURN-CODE.  
P00794     IF  WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL                  
P00794         CONTINUE                                                 
P00794     ELSE                                                         
P00794         MOVE WS-ACTIVE-RETURN-CODE    TO RS-RETURN-CODE          
P00794         MOVE PROGRAM-NAME             TO ABEND-PROGRAM           
P00794         MOVE '7650'                   TO ACTIVE-PARAGRAPH        
P00794         MOVE 'SELECT'                 TO ABEND-FUNCTION          
P00794         MOVE 'CSS_BILL_WINDOW'        TO TABLE-1                 
P00794         MOVE 'CURRENT-DATE'           TO TABLE-ELEMENT-1         
P00794         MOVE WS-CURRENT-DATE          TO HOSTVAR-ELEMENT-1       
P00794         PERFORM 9000-SEND-ERROR-RESULT THRU 9000-EXIT            
P00794         PERFORM 9900-SQL-ERROR-ROUTINE THRU 9900-EXIT            
P00794     END-IF.                                                      
P00794*                                                                         
P00794 7650-EXIT.                                                       
P00794     EXIT.                                                        
P00794*                                                                         
T13034***************************************************************   32290000
T13034* OPEN A CURSOR FOR CONTRACT DETAIL                           *   32300000
T13034***************************************************************   32310000
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     EXEC SQL                                                     
T13034        FETCH CNT-DETAIL                                          
ACT278        INTO  :EA-COST-CENTER                                     
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     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******************************************************************33100000
T14840* 7730-SELECT-DFLT-CONTRACT                                      *33110000
T14840******************************************************************33120000
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                  DFLT_CHARGE_AM,                                 
T14840                  COMPANY_NO,                                     
T14840                  GL_ACCT_NO_ERN_INT,                             
T14840                  GL_ACCT_NO_DEF_INT,                             
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-DFLT-CHARGE-AM,                             
T14840                  :K6-COMPANY-NO,                                 
T14840                  :K6-GL-ACCT-NO-ERN-INT,                         
T14840                  :K6-GL-ACCT-NO-DEF-INT,                         
T14840                  :K6-WRT-OFF-GL-ACCT-NO                          
T14840           FROM CSS_CONTRACT_INFO WITH(READUNCOMMITTED)                   
T14840           WHERE CNT_NAME_CD       = :K6-CNT-NAME-CD              
A36248                                                           
T14840     END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ022
MFA-TR*    EXEC SQL                                                     33150000
MFA-TR*          SELECT CODE_CONTRACT_TYPE,                             33160000
MFA-TR*                 CNT_NAME_CD,                                    33170000
MFA-TR*                 CODE_BILL_TYPE,                                 33180000
MFA-TR*                 MONTHLY_CREDIT_AM,                              33190000
MFA-TR*                 DFLT_REBATE_AMOUNT,                             33200000
MFA-TR*                 REBATE_CD,                                      33210000
MFA-TR*                 INTEREST_CD,                                    33220000
MFA-TR*                 DFLT_INTRST_RT,                                 33230000
MFA-TR*                 MIN_INTRST_RT,                                  33240000
MFA-TR*                 MAX_INTRST_RT,                                  33250000
MFA-TR*                 DFLT_TERM_MO_NM,                                33260000
MFA-TR*                 MIN_TERM_MO_NM,                                 33270000
MFA-TR*                 MAX_TERM_MO_NM,                                 33280000
MFA-TR*                 SECURITY_CD,                                    33290000
MFA-TR*                 CHARGE_TYPE_CD,                                 33300000
MFA-TR*                 GL_ACCT_NO,                                     33310000
MFA-TR*                 COST_CENTER,                                    33320000
MFA-TR*                 DFLT_CHARGE_AM,                                 33350000
MFA-TR*                 COMPANY_NO,                                     33350000
MFA-TR*                 GL_ACCT_NO_ERN_INT,                             33400000
MFA-TR*                 GL_ACCT_NO_DEF_INT,                             33410000
MFA-TR*                 WRT_OFF_GL_ACCT_NO                              33500000
MFA-TR*          INTO   :K6-CODE-CONTRACT-TYPE,                         33510000
MFA-TR*                 :K6-CNT-NAME-CD,                                33520000
MFA-TR*                 :K6-CODE-BILL-TYPE,                             33530000
MFA-TR*                 :K6-MONTHLY-CREDIT-AM,                          33540000
MFA-TR*                 :K6-DFLT-REBATE-AMOUNT,                         33550000
MFA-TR*                 :K6-REBATE-CD,                                  33560000
MFA-TR*                 :K6-INTEREST-CD,                                33570000
MFA-TR*                 :K6-DFLT-INTRST-RT,                             33580000
MFA-TR*                 :K6-MIN-INTRST-RT,                              33590000
MFA-TR*                 :K6-MAX-INTRST-RT,                              33600000
MFA-TR*                 :K6-DFLT-TERM-MO-NM,                            33610000
MFA-TR*                 :K6-MIN-TERM-MO-NM,                             33620000
MFA-TR*                 :K6-MAX-TERM-MO-NM,                             33630000
MFA-TR*                 :K6-SECURITY-CD,                                33640000
MFA-TR*                 :K6-CHARGE-TYPE-CD,                             33650000
MFA-TR*                 :K6-GL-ACCT-NO,                                 33660000
MFA-TR*                 :K6-COST-CENTER,                                33670000
MFA-TR*                 :K6-DFLT-CHARGE-AM,                             33700000
MFA-TR*                 :K6-COMPANY-NO,                                 33700000
MFA-TR*                 :K6-GL-ACCT-NO-ERN-INT,                         33750000
MFA-TR*                 :K6-GL-ACCT-NO-DEF-INT,                         33760000
MFA-TR*                 :K6-WRT-OFF-GL-ACCT-NO                          33850000
MFA-TR*          FROM CSS_CONTRACT_INFO                                 33860000
MFA-TR*          WHERE CNT_NAME_CD       = :K6-CNT-NAME-CD              33870000
MFA-TR*          WITH UR                                                        
MFA-TR*    END-EXEC.                                                    33880000

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.                                                        
P00794*                                                                         
P00794******************************************************************        
P00794* 7750-GET-MAX-SEQ-NO.                                                    
P00794******************************************************************        
P00794*                                                                         
P00794 7750-GET-MAX-SEQ-NO.                                             
P00794                                                                  
P00794     EXEC SQL                                                     
P00794        SELECT MAX(FIXED_FCTR_SEQ_NO)                             
P00794          INTO :FF-FIXED-FCTR-SEQ-NO :WS-NULL-IND-FF               
P00794          FROM CSS_FIXED_FCTR FF WITH(READUNCOMMITTED)                    
P00794         WHERE FF.ACCOUNT_NO     = :FF-ACCOUNT-NO                 
P00794           AND FF.CODE_UTIL_TYPE = :FF-CODE-UTIL-TYPE             
P00794           AND FF.IC_NO          = :FF-IC-NO                      
P00794                                                           
P00794                                                      
P00794     END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ003
MFA-TR* MSQ022
MFA-TR*    EXEC SQL                                                             
MFA-TR*       SELECT MAX(FIXED_FCTR_SEQ_NO)                                     
MFA-TR*         INTO :FF-FIXED-FCTR-SEQ-NO:WS-NULL-IND-FF                       
MFA-TR*         FROM CSS_FIXED_FCTR FF                                          
MFA-TR*        WHERE FF.ACCOUNT_NO     = :FF-ACCOUNT-NO                         
MFA-TR*          AND FF.CODE_UTIL_TYPE = :FF-CODE-UTIL-TYPE                     
MFA-TR*          AND FF.IC_NO          = :FF-IC-NO                              
MFA-TR*        WITH UR                                                          
MFA-TR*      QUERYNO 7750                                                       
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

P00794                                                                  
P00794     MOVE SQLCODE                      TO WS-ACTIVE-RETURN-CODE.  
P00794                                                                  
P00794     EVALUATE WS-ACTIVE-RETURN-CODE                               
P00794         WHEN SUCCESSFUL-CALL                                     
P00794              CONTINUE                                            
P00794         WHEN NOT-FOUND                                           
P00794             IF WS-NULL-IND-FF < 0                                
P00794                MOVE 0 TO FF-FIXED-FCTR-SEQ-NO                    
P00794             END-IF                                               
P00794         WHEN OTHER                                               
P00794          MOVE WS-ACTIVE-RETURN-CODE   TO RS-RETURN-CODE          
P00794          MOVE PROGRAM-NAME            TO ABEND-PROGRAM           
P00794          MOVE '7750'                  TO ACTIVE-PARAGRAPH        
P00794          MOVE 'SELECT'                TO ABEND-FUNCTION          
P00794          MOVE 'CSS_FIXED_FACTOR'      TO TABLE-1                 
P00794          MOVE 'FF-ACCOUNT-NO'         TO TABLE-ELEMENT-1         
P00794          MOVE 'FF-CODE-UTIL-TYPE'     TO TABLE-ELEMENT-2         
P00794          MOVE 'FF-IC-NO'              TO TABLE-ELEMENT-3         
P00794          MOVE FF-ACCOUNT-NO           TO HOSTVAR-ELEMENT-1       
P00794          MOVE FF-CODE-UTIL-TYPE       TO HOSTVAR-ELEMENT-2       
P00794          MOVE FF-IC-NO                TO HOSTVAR-ELEMENT-3       
P00794          PERFORM 9000-SEND-ERROR-RESULT                          
P00794                                        THRU 9000-EXIT            
P00794          PERFORM 9900-SQL-ERROR-ROUTINE                          
P00794                                        THRU 9900-EXIT            
P00794     END-EVALUATE.                                                
P00794                                                                  
P00794 7750-EXIT.                                                       
P00794     EXIT.                                                        
P00794*                                                                         
T20099******************************************************************34110000
T20099* 7800-SELECT-OTHER-GL-ACCTS                                     *34120000
T20099*                                                                *34130000
T20099*   RETRIEVING 'OTHER' GL ACCOUNT NUMBERS                        *34140000
T20099******************************************************************34150000
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******************************************************************34470000
T20099* 7805-OPEN-OTHER-TAX-CURSOR                                     *34480000
T20099*                                                                *34490000
T20099*  DEFINING CURSOR FOR 'OTHER TAX' GL NUMBER ASSIGNMENTS         *34500000
T20099*  OPENING CURSOR FOR 'OTHER TAX' GL NUMBER ASSIGNMENTS          *34510000
T20099******************************************************************34520000
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 WITH(READUNCOMMITTED),                   
T20099                  CSS_TAX_CNTL B WITH(READUNCOMMITTED),                   
T20099                  CSS_SPCL_FCTR C WITH(READUNCOMMITTED)                   
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                           
A36248            FOR READ ONLY                                 
T20099     END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ004
MFA-TR* MSQ022
MFA-TR* MSQ054
MFA-TR*    EXEC SQL                                                     34550000
MFA-TR*         DECLARE OTHER_TAX_CSR CURSOR FOR                        34560000
MFA-TR*          SELECT A.TAX_RATE,                                     34570000
MFA-TR*                 A.TAX_CNTRL_NO,                                 34580000
MFA-TR*                 A.TAX_ENTRY_SEQ_NO,                             34590000
MFA-TR*                 C.GL_ACCT_NO                                    34600000
MFA-TR*            FROM CSS_TAX_RATE A,                                 34610000
MFA-TR*                 CSS_TAX_CNTL B,                                 34620000
MFA-TR*                 CSS_SPCL_FCTR C                                 34630000
MFA-TR*           WHERE A.DETAIL_ID     = :PR-REV-DISTRICT-CD           34640000
MFA-TR*             AND ENERGY_TAX_FL   = 'N'                           34650000
MFA-TR*             AND A.DATE_FROM    <= :WS-REVENUE-DATE              34660000
MFA-TR*             AND A.DATE_TO       > :WS-REVENUE-DATE              34670000
MFA-TR*             AND A.OPER_MODE     = B.OPER_MODE                   34680000
MFA-TR*             AND A.TAX_CNTRL_NO  = B.TAX_CNTRL_NO                34690000
MFA-TR*             AND B.FACTOR_ID     = C.FACTOR_ID                   34700000
MFA-TR*           ORDER BY A.TAX_CNTRL_NO,                              34710000
MFA-TR*                    A.TAX_ENTRY_SEQ_NO                           34720000
MFA-TR*           FOR FETCH ONLY WITH UR                                34730000
MFA-TR*    END-EXEC.                                                    34740000
                                                                        
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                
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******************************************************************35010000
T20099* 7810-FETCH-OTHER-TAX-CURSOR                                    *35020000
T20099*                                                                *35030000
T20099*  FETCHING CURSOR FOR 'OTHER TAX' GL NUMBER ASSIGNMENTS         *35040000
T20099******************************************************************35050000
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******************************************************************35390000
T20099* 7815-CLOSE-OTHER-TAX-CURSOR                                    *35400000
T20099*                                                                *35410000
T20099*  CLOSING CURSOR FOR 'OTHER TAX' GL NUMBER ASSIGNMENTS          *35420000
T20099******************************************************************35430000
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                
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 7815-EXIT.                                                       
T20099     EXIT.                                                        
                                                                        
T20099******************************************************************35710000
T20099* 7820-SEL-CUR-REV-MONTH                                         *35720000
T20099*                                                                *35730000
T20099*     SELECTS CSS_BILL_WINDOW FOR REV MONTH OF CURRENT DATE      *35740000
T20099******************************************************************35750000
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                                                           
T20099     END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ022
MFA-TR* MSQ028
MFA-TR* MSQ029
MFA-TR*    EXEC SQL                                                     35780000
MFA-TR*       SELECT MIN(CHAR(B.REVENUE_MONTH))                         35790000
MFA-TR*         INTO :WS-REVENUE-MONTH-CHAR                             35800000
MFA-TR*         FROM CSS_BILL_WINDOW B                                  35820000
MFA-TR*        WHERE B.DATE_EXTRACT   >= CURRENT DATE                   35830000
MFA-TR*          AND B.BILL_CYCLE      = :AT-BILL-CYCLE                 35850000
MFA-TR*          AND B.CODE_BILL_COND  = 'C'                            35860000
MFA-TR*         WITH UR                                                         
MFA-TR*    END-EXEC.                                                    35870000

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******************************************************************36090000
T20099* 7830-CALC-OTHER-TAX-AMT                                        *36100000
T20099*                                                                *36110000
T20099*     CALCULATES AND APPLIES 'OTHER' TAXES                       *36120000
T20099******************************************************************36130000
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                
A05744             IF AT-COMPANY-NO = '01'                              
A05744                MOVE WS-TAX-OTHER-GL-NBR(WS-SUB2)                 
A05744                TO WS-PAR-GEN-LEDG-DB                             
A05744             ELSE                                                 
A05744                MOVE 241.0207  TO WS-PAR-GEN-LEDG-DB              
A05744             END-IF                                               
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)                           
T20099                 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******************************************************************36470000
T20099* 7835-CALC-RMNG-OTHER-TAX-AMT                                   *36480000
T20099*                                                                *36490000
T20099*     CALCULATES AND APPLIES 'OTHER' TAXES FOR REMAINING AMOUNTS *36500000
T20099******************************************************************36510000
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)                    
T20099               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)                     
T20099                       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 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 WITH(READUNCOMMITTED),               
T16114               CSS_RECONNECT_CHRG U7 WITH(READUNCOMMITTED)                
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            
T23235           AND U7.RCNCT_ACCT_TYPE_CD = :WS-ACCT-TYPE-CD           
A36248                                                           
T16114     END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ022
MFA-TR*    EXEC SQL                                                     36920000
MFA-TR*       SELECT U7.RCNCT_ELEC_SVC_FL,                              36930000
MFA-TR*              U7.RCNCT_GAS_SVC_FL                                36940000
MFA-TR*         INTO :U7-RCNCT-ELEC-SVC-FL,                             36950000
MFA-TR*              :U7-RCNCT-GAS-SVC-FL                               36960000
MFA-TR*         FROM CSS_CONNECT_CHRG   CC,                             36970000
MFA-TR*              CSS_RECONNECT_CHRG U7                              36980000
MFA-TR*        WHERE CC.ACCOUNT_NO        = :CC-ACCOUNT-NO              36990000
MFA-TR*          AND CC.PYMT_PRIORITY_LVL = :CC-PYMT-PRIORITY-LVL       37000000
MFA-TR*          AND CC.CCC_ITEM_ID       = :CC-CCC-ITEM-ID             37010000
MFA-TR*          AND U7.COMPANY_NO        = :U7-COMPANY-NO              37020000
MFA-TR*          AND CC.RCNCT_TYPE_NO     = U7.RCNCT_TYPE_NO            37030000
MFA-TR*          AND U7.RCNCT_ACCT_TYPE_CD = :WS-ACCT-TYPE-CD           37040000
MFA-TR*         WITH UR                                                         
MFA-TR*    END-EXEC.                                                    37050000

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     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     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     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     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     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     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.                                                        
                                                                        
                                                                        
REARCH******************************************************************40074300
REARCH* 8000A-DELETE-GTT-ROWS.                                         *40074400
REARCH******************************************************************40074500
REARCH 8000A-DELETE-GTT-ROWS.                                           
REARCH     MOVE                                                         
REARCH     'DELETE ROWS'                                                
REARCH         TO S-SQL-STATEMENT-V.                                    
REARCH      EXEC SQL                                                    
REARCH          DELETE FROM #CSR02294_R1                         
REARCH      END-EXEC.                                                   

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ049
MFA-TR*     EXEC SQL                                                    40075000
MFA-TR*         DELETE FROM SESSION.CSR02294_R1                         40075100
MFA-TR*     END-EXEC.                                                   40075200

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

REARCH      MOVE SQLCODE TO WS-ACTIVE-RETURN-CODE.                      
REARCH      IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL OR NOT-FOUND     
REARCH          NEXT SENTENCE                                           
REARCH      ELSE                                                        
REARCH         MOVE PROGRAM-NAME         TO ABEND-PROGRAM               
REARCH         MOVE SQLCODE              TO ABEND-SQLCODE               
REARCH         MOVE SQLSTATE             TO ABEND-SQLSTATE              
REARCH         MOVE '8000A'              TO ACTIVE-PARAGRAPH            
REARCH         MOVE 'DELETE'             TO ABEND-FUNCTION              
REARCH         MOVE SPACES               TO ABEND-SQL-PREDICATES        
REARCH                                      ABEND-TABLES                
REARCH         MOVE 'CSR02294_R1'        TO TABLE-1                     
REARCH         MOVE SPACES               TO TABLE-ELEMENT-1             
REARCH         MOVE SPACES               TO HOSTVAR-ELEMENT-1           
REARCH         PERFORM 9900-SQL-ERROR-ROUTINE  THRU 9900-EXIT           
REARCH     END-IF.                                                      
REARCH 8000A-EXIT.                                                      
REARCH     EXIT.                                                        
REARCH                                                                  
REARCH******************************************************************40077200
REARCH*8100-SEND-RESULT.                                               *40077300
REARCH******************************************************************40077400
REARCH 8100-SEND-RESULT.                                                
REARCH     EXEC SQL                                                     
REARCH       INSERT INTO #CSR02294_R1                            
REARCH       (                                                          
REARCH        RETURN_CODE                                               
REARCH       ,CANCELDNP_FLAG                                            
REARCH       ,AR_LOCKOUT_IND                                            
REARCH       ,AT_ACCT_XFER_TO                                           
REARCH       ,CANCELNOT_FLAG                                            
REARCH       )                                                          
REARCH       VALUES                                                     
REARCH       (                                                          
REARCH        :S-RETURN-CODE                                            
REARCH       ,:S-CANCELDNP-FLAG                                         
REARCH       ,:S-AR-LOCKOUT-IND                                         
REARCH       ,:S-XFER-ACCT-NO                                           
REARCH       ,:S-CANCELNOT-FLAG                                         
REARCH       )                                                          
REARCH     END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ049
MFA-TR*    EXEC SQL                                                     40077600
MFA-TR*      INSERT INTO SESSION.CSR02294_R1                            40077700
MFA-TR*      (                                                          40077800
MFA-TR*       RETURN_CODE                                               40077900
MFA-TR*      ,CANCELDNP_FLAG                                            40078000
MFA-TR*      ,AR_LOCKOUT_IND                                            40078100
MFA-TR*      ,AT_ACCT_XFER_TO                                           40078200
MFA-TR*      ,CANCELNOT_FLAG                                            40078300
MFA-TR*      )                                                          40078400
MFA-TR*      VALUES                                                     40078500
MFA-TR*      (                                                          40078600
MFA-TR*       :S-RETURN-CODE                                            40078700
MFA-TR*      ,:S-CANCELDNP-FLAG                                         40078800
MFA-TR*      ,:S-AR-LOCKOUT-IND                                         40078900
MFA-TR*      ,:S-XFER-ACCT-NO                                           40079000
MFA-TR*      ,:S-CANCELNOT-FLAG                                         40079100
MFA-TR*      )                                                          40079200
MFA-TR*    END-EXEC.                                                    40079300

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

REARCH     MOVE SQLCODE                 TO WS-ACTIVE-RETURN-CODE.       
REARCH                                                                  
REARCH     IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL                   
REARCH        NEXT SENTENCE                                             
REARCH     ELSE                                                         
REARCH        MOVE PROGRAM-NAME         TO ABEND-PROGRAM                
REARCH        MOVE SQLCODE              TO ABEND-SQLCODE                
REARCH        MOVE SQLSTATE             TO ABEND-SQLSTATE               
REARCH        MOVE '8100'               TO ACTIVE-PARAGRAPH             
REARCH        MOVE 'INSERT'             TO ABEND-FUNCTION               
REARCH        MOVE 'CSR02294_R1'        TO TABLE-1                      
REARCH        PERFORM 9900-SQL-ERROR-ROUTINE  THRU 9900-EXIT            
REARCH     END-IF.                                                      
REARCH                                                                  
REARCH     ADD 1 TO CTR-ROWS.                                           
REARCH 8100-EXIT.                                                       
REARCH      EXIT.                                                       
REARCH                                                                  
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                                                     40081400
MFA-TR*        UPDATE CSS_AR_TRANS_HIST                                 40081500
MFA-TR*           SET AMT_ORIG_ENTERED  = :AR-AMT-ORIG-ENTERED          40081600
MFA-TR*         WHERE ACCOUNT_NO        = :AR-ACCOUNT-NO                40081700
MFA-TR*           AND TRANS_HIST_SEQ_NO = :AR-TRANS-HIST-SEQ-NO         40081800
MFA-TR*    END-EXEC.                                                    40081900

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 8200-EXIT.                                                       
T16561     EXIT.                                                        
T16114                                                                  
P00794*****************************************************************         
P00794* 8250-INSERT-FACTOR.                                           *         
P00794*****************************************************************         
P00794 8250-INSERT-FACTOR.                                              
P00794                                                                  
P00794     EXEC SQL                                                     
P00794         INSERT INTO CSS_FIXED_FCTR                               
P00794                (ACCOUNT_NO        ,                              
P00794                 CODE_UTIL_TYPE    ,                              
P00794                 IC_NO             ,                              
P00794                 FIXED_FCTR_SEQ_NO ,                              
P00794                 FACTOR_ID         ,                              
P00794                 EFF_DATE_FROM     ,                              
P00794                 CMPNT_ID_CD       ,                              
P00794                 CODE_SEASON       ,                              
P00794                 INSTR_USE_TYPE_CD ,                              
P00794                 CODE_TIME_PERIOD  ,                              
P00794                 EFF_DATE_TO       ,                              
P00794                 FIXED_FCTR_TYP_CD ,                              
P00794                 FACTOR            ,                              
P00794                 FAC_CHRG_BASE_AM  ,                              
P00794                 LAST_UPDATE_TS    ,                              
P00794                 DURATION_REMAIN_NO,                              
P00794                 RT_PKG_OPT_SEQ_NO)                               
P00794         VALUES                                                   
P00794                (:FF-ACCOUNT-NO       ,                           
P00794                 :FF-CODE-UTIL-TYPE   ,                           
P00794                 :FF-IC-NO            ,                           
P00794                 :FF-FIXED-FCTR-SEQ-NO,                           
P00794                 :FF-FACTOR-ID        ,                           
P00794                 IIF(TRY_CONVERT(DATE, :FF-EFF-DATE-FROM
              ) IS NULL OR (PATINDEX('%.%', :FF-EFF-DATE-FROM
              ) <> 0) OR (LEN(:FF-EFF-DATE-FROM) <> 10), CIS.CHAR2DATE(
                                                      :FF-EFF-DATE-FROM
              ), CONVERT(DATE, :FF-EFF-DATE-FROM) )    ,                       
P00794                 :FF-CMPNT-ID-CD      ,                           
P00794                 :FF-CODE-SEASON      ,                           
P00794                 :FF-INSTR-USE-TYPE-CD,                           
P00794                 :FF-CODE-TIME-PERIOD ,                           
P00794                 IIF(TRY_CONVERT(DATE, :FF-EFF-DATE-TO
              ) IS NULL OR (PATINDEX('%.%', :FF-EFF-DATE-TO
              ) <> 0) OR (LEN(:FF-EFF-DATE-TO) <> 10), CIS.CHAR2DATE(
                                                        :FF-EFF-DATE-TO
              ), CONVERT(DATE, :FF-EFF-DATE-TO) )      ,                       
P00794                 :FF-FIXED-FCTR-TYP-CD,                           
P00794                 :FF-FACTOR           ,                           
P00794                 :FF-FAC-CHRG-BASE-AM ,                           
P00794                 CIS.CHAR2TIMESTAMP(:FF-LAST-UPDATE-TS)   ,               
P00794                 :FF-DURATION-REMAIN-NO :WS-NULL-VALUE,           
P00794                 :FF-RT-PKG-OPT-SEQ-NO)                           
P00794                                                                  
P00794     END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ054
MFA-TR*    EXEC SQL                                                             
MFA-TR*        INSERT INTO CSS_FIXED_FCTR                                       
MFA-TR*               (ACCOUNT_NO        ,                                      
MFA-TR*                CODE_UTIL_TYPE    ,                                      
MFA-TR*                IC_NO             ,                                      
MFA-TR*                FIXED_FCTR_SEQ_NO ,                                      
MFA-TR*                FACTOR_ID         ,                                      
MFA-TR*                EFF_DATE_FROM     ,                                      
MFA-TR*                CMPNT_ID_CD       ,                                      
MFA-TR*                CODE_SEASON       ,                                      
MFA-TR*                INSTR_USE_TYPE_CD ,                                      
MFA-TR*                CODE_TIME_PERIOD  ,                                      
MFA-TR*                EFF_DATE_TO       ,                                      
MFA-TR*                FIXED_FCTR_TYP_CD ,                                      
MFA-TR*                FACTOR            ,                                      
MFA-TR*                FAC_CHRG_BASE_AM  ,                                      
MFA-TR*                LAST_UPDATE_TS    ,                                      
MFA-TR*                DURATION_REMAIN_NO,                                      
MFA-TR*                RT_PKG_OPT_SEQ_NO)                                       
MFA-TR*        VALUES                                                           
MFA-TR*               (:FF-ACCOUNT-NO       ,                                   
MFA-TR*                :FF-CODE-UTIL-TYPE   ,                                   
MFA-TR*                :FF-IC-NO            ,                                   
MFA-TR*                :FF-FIXED-FCTR-SEQ-NO,                                   
MFA-TR*                :FF-FACTOR-ID        ,                                   
MFA-TR*                :FF-EFF-DATE-FROM    ,                                   
MFA-TR*                :FF-CMPNT-ID-CD      ,                                   
MFA-TR*                :FF-CODE-SEASON      ,                                   
MFA-TR*                :FF-INSTR-USE-TYPE-CD,                                   
MFA-TR*                :FF-CODE-TIME-PERIOD ,                                   
MFA-TR*                :FF-EFF-DATE-TO      ,                                   
MFA-TR*                :FF-FIXED-FCTR-TYP-CD,                                   
MFA-TR*                :FF-FACTOR           ,                                   
MFA-TR*                :FF-FAC-CHRG-BASE-AM ,                                   
MFA-TR*                :FF-LAST-UPDATE-TS   ,                                   
MFA-TR*                :FF-DURATION-REMAIN-NO :WS-NULL-VALUE,                   
MFA-TR*                :FF-RT-PKG-OPT-SEQ-NO)                                   
MFA-TR*                                                                         
MFA-TR*    END-EXEC.                                                            

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

P00794                                                                  
P00794     MOVE SQLCODE TO WS-ACTIVE-RETURN-CODE.                       
P00794                                                                  
P00794     IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL                   
P00794        CONTINUE                                                  
P00794     ELSE                                                         
P00794          MOVE WS-ACTIVE-RETURN-CODE     TO RS-RETURN-CODE        
P00794          MOVE PROGRAM-NAME              TO ABEND-PROGRAM         
P00794          MOVE '8250'                    TO ACTIVE-PARAGRAPH      
P00794          MOVE 'INSERT'                  TO ABEND-FUNCTION        
P00794          MOVE 'CSS_FIXED_FACTOR'        TO TABLE-1               
P00794          MOVE 'FF-ACCOUNT-NO'           TO TABLE-ELEMENT-1       
P00794          MOVE 'FF-CODE-UTIL-TYPE'       TO TABLE-ELEMENT-2       
P00794          MOVE 'FF-IC-NO'                TO TABLE-ELEMENT-3       
P00794          MOVE FF-ACCOUNT-NO             TO HOSTVAR-ELEMENT-1     
P00794          MOVE FF-CODE-UTIL-TYPE         TO HOSTVAR-ELEMENT-2     
P00794          MOVE FF-IC-NO                  TO HOSTVAR-ELEMENT-3     
P00794          PERFORM 9000-SEND-ERROR-RESULT THRU 9000-EXIT           
P00794          PERFORM 9900-SQL-ERROR-ROUTINE THRU 9900-EXIT           
P00794     END-IF.                                                      
P00794                                                                  
P00794 8250-EXIT.                                                       
P00794     EXIT.                                                        
P00794*                                                                         
P00794******************************************************************        
P00794* 8300-INSERT-MN-TRANS-HIST.                                              
P00794* INSERT A ROW INTO CSS_MNT_TRANS_HIST.                          *        
P00794******************************************************************        
P00794*                                                                         
P00794 8300-INSERT-MN-TRANS-HIST.                                       
P00794*                                                                         
P00794     EXEC SQL                                                     
P00794          INSERT INTO CSS_MNT_TRANS_HIST                          
P00794               ( TRANS_HIST_SEQ_NO,                               
P00794                 DATE_TRANS,                                      
P00794                 CODE_TRAN_TYPE,                                  
P00794                 RESP_AREA_ID,                                    
P00794                 ACCOUNT_NO,                                      
P00794                 CUSTOMER_NO,                                     
P00794                 PREMISE_NO,                                      
P00794                 USER_ID,                                         
P00794                 APPL_PROGRAM_ID,                                 
P00794                 TRAN_COMMENT,                                    
P00794                 ENTITY_KEY_DESC)                                 
P00794          VALUES                                                  
P00794               ( CIS.CHAR2TIMESTAMP(:MH-TRANS-HIST-SEQ-NO),               
P00794                 IIF(TRY_CONVERT(DATE, :MH-DATE-TRANS
              ) IS NULL OR (PATINDEX('%.%', :MH-DATE-TRANS
              ) <> 0) OR (LEN(:MH-DATE-TRANS) <> 10), CIS.CHAR2DATE(
                                                         :MH-DATE-TRANS
              ), CONVERT(DATE, :MH-DATE-TRANS) ),                              
P00794                 :MH-CODE-TRAN-TYPE,                              
P00794                 :MH-RESP-AREA-ID,                                
P00794                 :MH-ACCOUNT-NO,                                  
P00794                 :MH-CUSTOMER-NO,                                 
P00794                 :MH-PREMISE-NO,                                  
P00794                 :MH-USER-ID,                                     
P00794                 :MH-APPL-PROGRAM-ID,                             
P00794                 :MH-TRAN-COMMENT,                                
P00794                 :MH-ENTITY-KEY-DESC)                             
P00794     END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ054
MFA-TR*    EXEC SQL                                                             
MFA-TR*         INSERT INTO CSS_MNT_TRANS_HIST                                  
MFA-TR*              ( TRANS_HIST_SEQ_NO,                                       
MFA-TR*                DATE_TRANS,                                              
MFA-TR*                CODE_TRAN_TYPE,                                          
MFA-TR*                RESP_AREA_ID,                                            
MFA-TR*                ACCOUNT_NO,                                              
MFA-TR*                CUSTOMER_NO,                                             
MFA-TR*                PREMISE_NO,                                              
MFA-TR*                USER_ID,                                                 
MFA-TR*                APPL_PROGRAM_ID,                                         
MFA-TR*                TRAN_COMMENT,                                            
MFA-TR*                ENTITY_KEY_DESC)                                         
MFA-TR*         VALUES                                                          
MFA-TR*              ( :MH-TRANS-HIST-SEQ-NO,                                   
MFA-TR*                :MH-DATE-TRANS,                                          
MFA-TR*                :MH-CODE-TRAN-TYPE,                                      
MFA-TR*                :MH-RESP-AREA-ID,                                        
MFA-TR*                :MH-ACCOUNT-NO,                                          
MFA-TR*                :MH-CUSTOMER-NO,                                         
MFA-TR*                :MH-PREMISE-NO,                                          
MFA-TR*                :MH-USER-ID,                                             
MFA-TR*                :MH-APPL-PROGRAM-ID,                                     
MFA-TR*                :MH-TRAN-COMMENT,                                        
MFA-TR*                :MH-ENTITY-KEY-DESC)                                     
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

P00794*                                                                         
P00794     MOVE SQLCODE                    TO WS-ACTIVE-RETURN-CODE.    
P00794*                                                                         
P00794     IF  WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL                  
P00794         CONTINUE                                                 
P00794     ELSE                                                         
P00794          MOVE WS-ACTIVE-RETURN-CODE     TO RS-RETURN-CODE        
P00794          MOVE PROGRAM-NAME              TO ABEND-PROGRAM         
P00794          MOVE '8300'                    TO ACTIVE-PARAGRAPH      
P00794          MOVE 'INSERT'                  TO ABEND-FUNCTION        
P00794          MOVE 'CSS_MNT_TRANS_HIST'      TO TABLE-1               
P00794          MOVE 'MH-ACCOUNT-NO'           TO TABLE-ELEMENT-1       
P00794          MOVE 'MH-TRANS-HIST-SEQ-NO'    TO TABLE-ELEMENT-2       
P00794          MOVE 'MH-DATE-TRANS'           TO TABLE-ELEMENT-3       
P00794          MOVE MH-ACCOUNT-NO             TO HOSTVAR-ELEMENT-1     
P00794          MOVE MH-TRANS-HIST-SEQ-NO      TO HOSTVAR-ELEMENT-2     
P00794          MOVE MH-DATE-TRANS             TO HOSTVAR-ELEMENT-3     
P00794          PERFORM 9000-SEND-ERROR-RESULT THRU 9000-EXIT           
P00794          PERFORM 9900-SQL-ERROR-ROUTINE THRU 9900-EXIT           
P00794     END-IF.                                                      
P00794*                                                                         
P00794 8300-EXIT.                                                       
P00794     EXIT.                                                        
P00794*                                                                         
P00794******************************************************************        
P00794* 8400-INSERT-MN-TRN-HST-DET.                                             
P00794* INSERT A ROW INTO CSS_MT_TRN_HST_DET.                          *        
P00794******************************************************************        
P00794*                                                                         
P00794 8400-INSERT-MN-TRN-HST-DET.                                      
P00794*                                                                         
P00794     EXEC SQL                                                     
P00794          INSERT INTO CSS_MT_TRN_HST_DET                          
P00794               ( TRANS_HIST_SEQ_NO,                               
P00794                 TRAN_APPL_NO,                                    
P00794                 COLUMN_DESC,                                     
P00794                 TABLE_ID,                                        
P00794                 PRV_COLUMN_VALUE,                                
P00794                 CHG_COLUMN_VALUE)                                
P00794          VALUES                                                  
P00794               ( CIS.CHAR2TIMESTAMP(:MI-TRANS-HIST-SEQ-NO),               
P00794                 :MI-TRAN-APPL-NO,                                
P00794                 :MI-COLUMN-DESC,                                 
P00794                 :MI-TABLE-ID,                                    
P00794                 :MI-PRV-COLUMN-VALUE,                            
P00794                 :MI-CHG-COLUMN-VALUE)                            
P00794     END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ054
MFA-TR*    EXEC SQL                                                             
MFA-TR*         INSERT INTO CSS_MT_TRN_HST_DET                                  
MFA-TR*              ( TRANS_HIST_SEQ_NO,                                       
MFA-TR*                TRAN_APPL_NO,                                            
MFA-TR*                COLUMN_DESC,                                             
MFA-TR*                TABLE_ID,                                                
MFA-TR*                PRV_COLUMN_VALUE,                                        
MFA-TR*                CHG_COLUMN_VALUE)                                        
MFA-TR*         VALUES                                                          
MFA-TR*              ( :MI-TRANS-HIST-SEQ-NO,                                   
MFA-TR*                :MI-TRAN-APPL-NO,                                        
MFA-TR*                :MI-COLUMN-DESC,                                         
MFA-TR*                :MI-TABLE-ID,                                            
MFA-TR*                :MI-PRV-COLUMN-VALUE,                                    
MFA-TR*                :MI-CHG-COLUMN-VALUE)                                    
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

P00794*                                                                         
P00794     MOVE SQLCODE                    TO WS-ACTIVE-RETURN-CODE.    
P00794*                                                                         
P00794     IF  WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL                  
P00794         CONTINUE                                                 
P00794     ELSE                                                         
P00794         MOVE WS-ACTIVE-RETURN-CODE     TO RS-RETURN-CODE         
P00794         MOVE PROGRAM-NAME              TO ABEND-PROGRAM          
P00794         MOVE '8400'                    TO ACTIVE-PARAGRAPH       
P00794         MOVE 'INSERT'                  TO ABEND-FUNCTION         
P00794         MOVE 'CSS_MT_TRN_HST_DET'      TO TABLE-1                
P00794         MOVE 'MH-TRANS-HIST-SEQ-NO'    TO TABLE-ELEMENT-1        
P00794         MOVE 'MI-TRAN-APPL-NO'         TO TABLE-ELEMENT-3        
P00794         MOVE MI-TRANS-HIST-SEQ-NO      TO HOSTVAR-ELEMENT-2      
P00794         MOVE MI-TRAN-APPL-NO           TO HOSTVAR-ELEMENT-3      
P00794         PERFORM 9000-SEND-ERROR-RESULT THRU 9000-EXIT            
P00794         PERFORM 9900-SQL-ERROR-ROUTINE THRU 9900-EXIT            
P00794     END-IF.                                                      
P00794*                                                                         
P00794 8400-EXIT.                                                       
P00794     EXIT.                                                        
P00794*                                                                         
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     MOVE WS-LIMIT-CHECK-AMT           TO WS-AMT-DNP-BAL.         
A36248*                                                                         
A36248     CALL MCSCB371    USING  AT-ACCOUNT-NO,                       
A36248                             AT-DATE-BILL-DAY-00,                 
A36248                             AT-CREDIT-GROUP,                     
A36248                             WS-AMT-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 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.                                                        
                                                                        
T19886******************************************************************40590000
T19886* INSERTS A SUMMARY ROW AND A DETAIL ROW WHEN CIA IS SELECTED FROM40600000
T19886* THE DROPDOWN FOR AN ACCOUNT THAT DOESN'T HAVE A CIA             40610000
T19886******************************************************************40620000
T19886*                                                                 40630000
T19886 8620-INSERT-AR-CNTL.                                             
T19886*                                                                 40650000
T19886     EXEC SQL                                                     
T19886         INSERT INTO CSS_AR_CNTL                                  
T19886               ( ACCOUNT_NO                                       
T19886                ,PYMT_PRIORITY_LVL                                
T19886                ,ITEM_ID                                          
T19886                ,AMT_AR_DAY_00                                    
T19886                ,AMT_AR_DAY_30                                    
T19886                ,AMT_AR_DAY_60                                    
T19886                ,AMT_AR_DAY_90                                    
T19886                ,AMT_UNUSED_CR                                    
T19886                ,AMT_TRAN_BALANCE                                 
T19886                ,TOT_SUMM_UNBILLED                                
T19886                ,LAST_UPDATE_TS )                                 
T19886        VALUES ( :AC-ACCOUNT-NO                                   
T19886                ,:AC-PYMT-PRIORITY-LVL                            
T19886                ,:AC-ITEM-ID                                      
T19886                ,:AC-AMT-AR-DAY-00                                
T19886                ,:AC-AMT-AR-DAY-30                                
T19886                ,:AC-AMT-AR-DAY-60                                
T19886                ,:AC-AMT-AR-DAY-90                                
T19886                ,:AC-AMT-UNUSED-CR                                
T19886                ,:AC-AMT-TRAN-BALANCE                             
T19886                ,:AC-TOT-SUMM-UNBILLED                            
T19886                ,CIS.CURRENT$TIMESTAMP())                               
T19886     END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ028
MFA-TR*    EXEC SQL                                                     40660000
MFA-TR*        INSERT INTO CSS_AR_CNTL                                  40670000
MFA-TR*              ( ACCOUNT_NO                                       40680000
MFA-TR*               ,PYMT_PRIORITY_LVL                                40690000
MFA-TR*               ,ITEM_ID                                          40700000
MFA-TR*               ,AMT_AR_DAY_00                                    40710000
MFA-TR*               ,AMT_AR_DAY_30                                    40720000
MFA-TR*               ,AMT_AR_DAY_60                                    40730000
MFA-TR*               ,AMT_AR_DAY_90                                    40740000
MFA-TR*               ,AMT_UNUSED_CR                                    40750000
MFA-TR*               ,AMT_TRAN_BALANCE                                 40760000
MFA-TR*               ,TOT_SUMM_UNBILLED                                40770000
MFA-TR*               ,LAST_UPDATE_TS )                                 40780000
MFA-TR*       VALUES ( :AC-ACCOUNT-NO                                   40790000
MFA-TR*               ,:AC-PYMT-PRIORITY-LVL                            40800000
MFA-TR*               ,:AC-ITEM-ID                                      40810000
MFA-TR*               ,:AC-AMT-AR-DAY-00                                40820000
MFA-TR*               ,:AC-AMT-AR-DAY-30                                40830000
MFA-TR*               ,:AC-AMT-AR-DAY-60                                40840000
MFA-TR*               ,:AC-AMT-AR-DAY-90                                40850000
MFA-TR*               ,:AC-AMT-UNUSED-CR                                40860000
MFA-TR*               ,:AC-AMT-TRAN-BALANCE                             40870000
MFA-TR*               ,:AC-TOT-SUMM-UNBILLED                            40880000
MFA-TR*               ,CURRENT TIMESTAMP)                               40890000
MFA-TR*    END-EXEC.                                                    40900000

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

T19886                                                                  
T19886     MOVE SQLCODE                      TO WS-ACTIVE-RETURN-CODE   
T19886                                          RS-RETURN-CODE.         
T19886     IF WS-ACTIVE-RETURN-CODE EQUAL SUCCESSFUL-CALL               
T19886        NEXT SENTENCE                                             
T19886     ELSE                                                         
T19886        MOVE PROGRAM-NAME              TO ABEND-PROGRAM           
T19886        MOVE '8620'                    TO ACTIVE-PARAGRAPH        
T19886        MOVE 'INSERT'                  TO ABEND-FUNCTION          
T19886        MOVE SPACES                    TO ABEND-SQL-PREDICATES    
T19886                                          ABEND-TABLES            
T19886        MOVE 'CSS_AR_CNTL'             TO TABLE-1                 
T19886        MOVE 'ACCOUNT_NO'              TO TABLE-ELEMENT-1         
T19886        MOVE 'PYMT_PRIORITY_LVL'       TO TABLE-ELEMENT-2         
T19886        MOVE 'ITEM_ID'                 TO TABLE-ELEMENT-3         
T19886        MOVE AC-ACCOUNT-NO             TO HOSTVAR-ELEMENT-1       
T19886        MOVE AC-PYMT-PRIORITY-LVL      TO HOSTVAR-ELEMENT-2       
T19886        MOVE AC-ITEM-ID                TO HOSTVAR-ELEMENT-3       
T19886        PERFORM 9700-PROCESS-ABEND     THRU 9700-EXIT             
T19886     END-IF.                                                      
T19886*                                                                 41110000
T19886 8620-EXIT.                                                       
T19886     EXIT.                                                        
T19886*                                                                 41140000
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*                                                                         
      ***************************************************************** 41150000
      *                                                                 41160000
      * COPYBOOK PROCEDURE CODE                                         41170000
      *                                                                 41180000
      ***************************************************************** 41190000
                                                                        
           EXEC SQL                                                     41210000
              INCLUDE CPD00075                                          41220000
           END-EXEC.                                                    41230000
                                                                        
           EXEC SQL                                                     41250000
              INCLUDE CPD00307                                          41260000
           END-EXEC.                                                    41270000
                                                                        
           EXEC SQL                                                     41340000
              INCLUDE CPD0023C                                          41350000
           END-EXEC.                                                    41360000
      ***************************************************************** 41370000
T21113*  CALLS THE SUBPROGRAM SCSCA182                                  41380000
T21113***************************************************************** 41390000
T21113*                                                                 41400000
T21113 9200-LINK-SCSCA182.                                              
T21113*                                                                 41420000
T21113     MOVE '9200'                        TO ACTIVE-PARAGRAPH.      
                                                                        
REARCH     CALL MCSCA182  USING    SCSCA182-ACCOUNT-NO                  
REARCH                            ,SCSCA182-RETURN-CODE                 
REARCH                            ,SCSCA182-LAST-UPDATE-TS              
REARCH                            ,ABEND-FILE.                          
T21113                                                                  
T21113 9200-EXIT.                                                       
T21113     EXIT.                                                        
T21113*                                                                 41610000
T24436******************************************************************41770000
T24436* LOADING GL NUMBERS - CALLS THE SUBPROGRAM SCSCO061             *41780000
T24436******************************************************************41790000
T24436* 9350-LINK-SCSCO061.                                            *41800000
T24436******************************************************************41810000
T24436*                                                                 41820000
T24436 9350-LINK-SCSCO061.                                              
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*                                                                 42160000
T24436******************************************************************42170000
T24436* 9400-CALL-CPD00061 - CALLS THE COPYBOOK CPD00061               *42180000
T24436******************************************************************42190000
T24436*                                                                 42200000
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.             
T24436                                                                  
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 2000A-MOVE-RESULT     THRU 2000A-EXIT              
REARCH       PERFORM 9700-PROCESS-ABEND    THRU 9700-EXIT               
REARCH     END-IF.                                                      
                                                                        
T24436 9400-EXIT.                                                       
T24436     EXIT.                                                        
T24436*                                                                 42440000
T19557******************************************************************42450000
T19557* CALLS THE SUBPROGRAM SCSCO068                                   42460000
T19557******************************************************************42470000
T19557 9500-CALL-CPD00068.                                              
T19557                                                                  
REARCH      CALL MCSCB068  USING  CWS00068-FIELDS                       
REARCH                            WS-CODES-DATA-PRESENT                 
REARCH                            DCLCSS-ACCOUNT                        
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 S-RETURN-CODE,                    
REARCH                                WS-ACTIVE-RETURN-CODE             
REARCH          END-IF                                                  
REARCH          PERFORM 2000A-MOVE-RESULT  THRU 2000A-EXIT              
REARCH          PERFORM 9700-PROCESS-ABEND THRU 9700-EXIT               
REARCH      END-IF.                                                     
T19557                                                                  
T19557 9500-EXIT.                                                       
T19557     EXIT.                                                        
                                                                        
P00774*---------------------------------------------------------------* 00329700
P00774* CANCEL DNP OR DNPFB                                           * 00329800
P00774*---------------------------------------------------------------* 00329900
P00774 9800-CALL-MCS03413.                                              
ACT285                                                                  
P00774     CALL MCS03413 USING   WS-ACCOUNT-NO-NUM                      
ACT285                          ,WS-UPDATE-ACTION-FL                    
ACT285                          ,WS-FACILITY-CODE                       
ACT285                          ,WS-DNP-RET-CODE                        
ACT285                          ,ABEND-FILE                             
P00774     .                                                            
P00774 9800-EXIT.                                                       
P00774     EXIT.                                                        
P00774                                                                  
      ***************************************************************** 42710000
      * 9900 - JOURNALING / ERROR HANDLING ROUTINE                      42720000
      ***************************************************************** 42730000
           EXEC SQL                                                     42761000
               INCLUDE CPDSP300                                         42762000
           END-EXEC.                                                    42763000
                                                                        
      ***************************************************************** 42780000
      *       END PROGRAM COPYLIB                                       42790000
      ***************************************************************** 42800000
REARCH     EXEC SQL                                                     42811000
REARCH        INCLUDE CPD00320                                          42812000
REARCH     END-EXEC.                                                    42813000
                                                                        
NONUTL     EXEC SQL                                                     42830000
NONUTL        INCLUDE CPD00312                                          42840000
NONUTL     END-EXEC.                                                    42850000
                                                                        
