       IDENTIFICATION DIVISION.                                         
       PROGRAM-ID.        CSR02384.                                     
COB303 DATE-WRITTEN.      OCT 01, 2004                                  
       DATE-COMPILED.                                                   
      *                                                                         
      ******************************************************************        
      *                                                                *        
      *                SOUTH CAROLINA ELECTRIC & GAS                   *        
      *                                                                *        
      *  CALLING PROGRAM: PCSCA165                                     *        
      *                                                                *        
      ******************************************************************        
      *                 P R O G R A M  S U M M A R Y                   *        
      *                                                                *        
      *  THIS PROCEDURE UPDATES SPECEFIC ROW OF CSS_AR_CNTL            *        
      *  TABLE FOR AN ACCOUNT AND RECEIVABLE TYPE AND UPDATES THE      *        
      *  CSS_ACCOUNT TABLE AS WELL.                                    *        
      ******************************************************************        
      *                                                                *        
      *                     PROGRAM MODIFICATION LOG                   *        
      *                                                                *        
      *    DATE    INITIALS   COMMENTS                                 *        
      *  --------  --------   ---------------------------------------  *        
      *  05/20/99    KP       PROCEDURE ORIGINALLY CODED.              *        
T21218*  12/03/99    CBSI     TRANS HIST DESCRIPTION WRITTEN CORRECTLY *        
T21218*              MADRAS                                            *        
T21532*  02/09/2000  CBSI     ADDED PARM-AT-LAST-UPDATE-TS TO ADD      *        
T21532*              MADRAS   FUNCTIONALITY FOR DATE/TIMESTAMP CHECK   *        
T21450*  04/12/2000  CBSI     TO AVOID JOURNALLING EXCEPTIONS          *        
T21450*              MADRAS   101-AMT-POSTED MADE AS +VE.              *        
      *  04/09/01    CHANELLE MCR310 PSNC. CSS_GL_ACCT_NO CHANGES.     *        
      *                       RECOMPILE FOR CPD00006.                  *        
C30083*  10/04/04    SS82048  REWRITE AS DB2 STORED PROCEDURE          *        
C30083*                       TO BE CALLED BY PCSCA165                 *        
C30083*  11/08/04    GOKUL    FIX PRODUCTION ABEND WHEN PROCESSING     *        
      *                       ACCOUNTS WITH MORE THAN 1 DEPOSITS.      *        
C36956*  11/10/08    VP94820  BUDGET BILLING CHANGES.                  *        
A00956*  03/26/09    CVNS     REPLACE CPD00006 WITH CPD0006A.          *        
A00956*              CHENNAI                                           *        
P00453*  05/24/11    SP95538   PRE-PAY-PLAN CHANGES.                            
A04527*  06/06/13    MC95456  REMOVED UNUSED COPY BOOK CWS00056        *        
A05136*  09/10/115   SM93554  CONVERT USER ID TO UPPER CASE            *        
      *              ACT158                                            *        
      ******************************************************************        
      ******************************************************************        
      *                                                                *        
      *                ---- BASIC SEQUENCE STRUCTURE ----              *        
      *                                                                *        
      *  0000 - 0999  MAIN CONTROL PATH AND INITIALIZATION             *        
      *  1000 - 1999  INPUT PROCESSING CONTROL PATH                    *        
      *  2000 - 2999  OUTPUT PROCESSING CONTROL PATH                   *        
      *  3000 - 4999  NOT USED                                         *        
      *  5000 - 5999  COMMON PROGRAM MODULES                           *        
      *  6000 - 6999  COMMON SYSTEM MODULES                            *        
      *  7000 - 7999  INPUT MODULES                                    *        
      *  8000 - 8999  OUTPUT MODULES                                   *        
      *  9000 - 9999  TERMINATION,ABEND, MESSAGING MODULES             *        
      *                                                                *        
      ******************************************************************        
                                                                        
       ENVIRONMENT DIVISION.                                            
       DATA DIVISION.                                                   
       WORKING-STORAGE SECTION.                                         

MSQ002  01 MFA-CSRERLOG.
MSQ002    05 ARG-5 PIC X(255).
MSQ002    05 ARG-6 PIC X(255).
MSQ002    05 ARG-7 PIC X(447).

MSQ017 01 MFA-PROGRAM-ID PIC X(8) VALUE 'CSR02384'.
MSQ017     COPY MFASQLM.
                                                                        
       01  WS-START                                   PIC X(40) VALUE   
           'WORKING STORAGE FOR RPC S384 STARTS HERE'.                  
                                                                        
      ******************************************************************        
      *    COBOL WORKING STORAGE COPY BOOKS                            *        
      ******************************************************************        
                                                                        
ACT158*COPY SYGWCOB.                                                            
ACT158*COPY SYDBCOB.                                                            
       COPY CCA00001.                                                           
      *--------< ERROR HANDLING >                                               
C30083     EXEC SQL                                                             
C30083         INCLUDE CWSX0010                                                 
C30083     END-EXEC.                                                            
       COPY CWS00027.                                                           
       COPY CWS00303.                                                           
       COPY CJF00101.                                                           
       COPY CJF00001.                                                           
       COPY CJF00102.                                                           
       COPY CJF00103.                                                           
T21532 COPY CWS00182.                                                           
                                                                        
           EXEC SQL                                                             
A00956        INCLUDE CWS0013B                                                  
           END-EXEC.                                                            
                                                                        
      ******************************************************************        
      *    WORK AREAS                                                  *        
      ******************************************************************        
                                                                        
       01  SYBASE-DATATYPE.                                             
           05  DATATYPE                 PIC S9(9) COMP.                 
           05  ACTUAL-DATA-LENGTH       PIC S9(9) COMP.                 
           05  MAX-DATA-LENGTH          PIC S9(9) COMP.                 
           05  USER-DATATYPE            PIC S9(9) COMP.                 
       01  WS-MISC.                                                     
C30083     05  PROGRAM-NAME             PIC X(08) VALUE 'CSR02384'.     
           05  WS-ACCOUNT-NO-C          PIC X(13).                      
           05  WS-ACCOUNT-NO REDEFINES WS-ACCOUNT-NO-C                  
                                        PIC S9(13).                     
           05  WS-PYMT-PRIORITY-LVL-C   PIC X(03).                      
           05  WS-PYMT-PRIORITY-LVL-N  REDEFINES WS-PYMT-PRIORITY-LVL-C 
                                        PIC 9(03).                      
           05  WS-PYMT-PRIORITY-LVL     PIC S9(03) COMP VALUE +0.       
                                                                        
           05  WS-ITEM-ID               PIC S9(09) COMP VALUE +0.       
           05  WS-ITEM-ID-C             PIC X(09) VALUE SPACES.         
           05  WS-ITEM-ID-N             PIC 9(09) VALUE 0.              
           05  WS-AR-TYPE-SHORT-DESC    PIC X(03) VALUE SPACES.         
      *                                                                         
COB305     05 WS-TOTAL-AR-BALANCE        PIC S9(11)V99 COMP-3 VALUE 0.          
      * NEW AR CONTROL AMTS                                                     
COB305     05 WS-NEW-AMT-AR-DAY-00        PIC S9(11)V99 COMP-3 VALUE 0.         
COB305     05 WS-NEW-AMT-AR-DAY-30        PIC S9(11)V99 COMP-3 VALUE 0.         
COB305     05 WS-NEW-AMT-AR-DAY-60        PIC S9(11)V99 COMP-3 VALUE 0.         
COB305     05 WS-NEW-AMT-AR-DAY-90        PIC S9(11)V99 COMP-3 VALUE 0.         
COB305     05 WS-NEW-TOT-SUMM-UNBILLED        PIC S9(11)V99 COMP-3 
COB305       VALUE 0.           
      *                                                                         
           05  ALL-DONE-SW              PIC X(01) VALUE 'N'.            
               88 NOT-ALL-DONE                    VALUE 'N'.            
               88 ALL-DONE                        VALUE 'Y'.            
      *                                                                         
           05  SEND-DONE-SW             PIC X(01) VALUE 'Y'.            
               88 SEND-DONE-ERROR                 VALUE 'N'.            
               88 SEND-DONE-OK                    VALUE 'Y'.            
      *                                                                         
           05  WS-DATE-LAST-ACTION.                                     
               10  WS-LST-AC-CCYY       PIC X(04).                      
               10  FILLER               PIC X(01) VALUE '-'.            
               10  WS-LST-AC-MM         PIC X(02).                      
               10  FILLER               PIC X(01) VALUE '-'.            
               10  WS-LST-AC-DD         PIC X(02).                      
      *                                                                         
      *                                                                         
           05  WS-TRAN-APPL-NO          PIC S9(04) COMP VALUE +0.       
           05  WS-COMMENT-LEN           PIC S9(4) COMP-3 VALUE 0.       
           05  WS-COMP-2-CHAR-CONV      PIC -Z(10)9.99.                 
T21532     05  WS-LAST-UPDATE-TS        PIC X(26).                      
T21532     05  SCSCA182                 PIC X(08) VALUE 'SCSCA182'.     
C30083     05  MCSCA182                 PIC X(8)  VALUE 'MCSCA182'.     
                                                                        
       01  WS-LITERALS.                                                 
           05  WS-C                     PIC X(01)   VALUE 'C'.          
           05  WS-F                     PIC X(01)   VALUE 'F'.          
           05  WS-J                     PIC X(01)   VALUE 'J'.          
           05  WS-K                     PIC X(01)   VALUE 'K'.          
           05  WS-R                     PIC X(01)   VALUE 'R'.          
           05  WS-T                     PIC X(01)   VALUE 'T'.          
           05  WS-W                     PIC X(01)   VALUE 'W'.          
           05  WS-Z                     PIC X(01)   VALUE 'Z'.          
           05  WS-01                    PIC X(02)   VALUE '01'.         
           05  WS-998                   PIC X(03)   VALUE '998'.        
           05  WS-9999                  PIC X(04)   VALUE '9999'.       
                                                                        
                                                                        
       01  GW-LIB-MISC-FIELDS.                                          
           05  GWL-PROC                 POINTER.                        
           05  GWL-INIT-HANDLE          POINTER.                        
           05  GWL-RC                   PIC S9(9) COMP.                 
           05  GWL-STATUS-NR            PIC S9(9) COMP.                 
           05  GWL-STATUS-DONE          PIC S9(9) COMP.                 
           05  GWL-STATUS-COUNT         PIC S9(9) COMP.                 
           05  GWL-STATUS-COMM          PIC S9(9) COMP.                 
           05  GWL-STATUS-RETURN-CODE   PIC S9(9) COMP.                 
           05  GWL-STATUS-SUBCODE       PIC S9(9) COMP.                 
       01  FILLER                       PIC X(11) VALUE 'PARM FIELDS'.  
                                                                        
                                                                        
       01  SNA-FIELDS.                                                  
           05  SNA-SUBC                 PIC S9(9) COMP.                 
           05  SNA-CONNECTION-NAME      PIC X(8)  VALUE SPACES.         
                                                                        
       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.                 
C30083     05  WS-SQLSTATE              PIC X(5)  VALUE '     '.        
C30083     05  WS-TERMINAL-TRAN        PIC X(04) VALUE '2384'.          
                                                                        
C30083*                                                                         
C30083 01  CSRERLOG-P.                                                  
C30083     10  S-SP-NAME                 PIC X(18) VALUE SPACES.        
C30083     10  S-SQLCODE                 PIC S9(9) COMP VALUE 0.        
C30083     10  S-SQLSTATE                PIC X(5)  VALUE ' '.           
C30083     10  S-TABLE-NAME              PIC X(18) VALUE SPACES.        
C30083     10  S-HOST-VARIABLES.                                        
C30083         49  S-HOST-VARIABLES-L    PIC S9(4) USAGE COMP.          
C30083         49  S-HOST-VARIABLES-V    PIC X(255).                    
C30083     10  S-SQL-STATEMENT.                                         
C30083         49  S-SQL-STATEMENT-L     PIC S9(4) USAGE COMP.          
C30083         49  S-SQL-STATEMENT-V     PIC X(255).                    
C30083     10  S-SQL-DESCRIPTION.                                       
C30083         49  S-SQL-DESCRIPTION-L   PIC S9(4) USAGE COMP.          
C30083         49  S-SQL-DESCRIPTION-V   PIC X(255).                    
C30083*                                                                         
C30083 01  GTT-MISC-FIELDS.                                             
C30083     05  ROWICMS                 PIC X(07) VALUE 'ROWICMS'.       
C30083     05  GTT-NAME                PIC X(26)                        
C30083                                  VALUE 'SESSION.CSR02018_R1'.    
C30083     05  GTT-ROW.                                                 
C30083         49 GTT-ROW-LEN          PIC S9(04) COMP.                 
C30083         49 GTT-ROW-CHAR         PIC X(1024).                     
C30083     05  GTT-SQLCODE             PIC S9(9) COMP.                  
C30083*                                                                         
       01  FILLER  PIC X(32) VALUE 'THIS IS THE ROW RETURN AREA.'.      
C30083*                                                                         
C30083 01  GTT-RETURN-FIELDS.                                           
           05  S-RETURN-CODE            PIC S9(9) COMP VALUE 0.         
           05  S-AR-LOCKOUT-IND         PIC X(01) VALUE SPACE.          
C30083*                                                                         
       01  WS-FLAGS.                                                    
           05  WS-AR-CONTROL-CHANGED-CHECK                              
                                        PIC X(01) VALUE 'Y'.            
               88  AR-CONTROL-CHANGED-CHECK         VALUE 'Y'.          
                                                                        
                                                                        
       01  WS-DATE-VARIABLES.                                           
           05  WS-CURRENT-TIMESTAMP     PIC X(26).                      
           05  WS-CURRENT-DATE          PIC X(10).                      
       01  WS-EDITED-FIELDS.                                            
           05  WS-AT-TOT-AR-BAL-ED      PIC -Z(10).99 .                 
       01  WS-MISC-2.                                                   
           05  WS-RECV-END-AR-BAL       PIC S9(09)V99 COMP-3 VALUE 0.   
           05  WS-AR-END-BAL            PIC S9(09)V99 COMP-3 VALUE 0.   
           05  WS-DETAIL-END-AR-BAL     PIC S9(09)V99 COMP-3 VALUE 0.   
           05  WS-DETAIL-END-BAL        PIC S9(09)V99 COMP-3 VALUE 0.   
           05  WS-DATE-ORIG-PYMT-IND    PIC S9(04) COMP.                
COB305     05 WS-BILLED-BAL-CHNG-AMT        PIC S9(11)V99 COMP-3 
COB305       VALUE 0.           
           05  AC-TOT-SUMM-UNBILLED-ED  PIC 9(11).99 .                  
           05  WS-GEN-LED-UTE           PIC X(10) VALUE 'AR-UTE    '.   
           05  WS-GEN-LED-UTG           PIC X(10) VALUE 'AR-UTG    '.   
           05  WS-GEN-LED-EPP           PIC X(10) VALUE 'AR-BUD    '.   
           05  WS-GEN-LED-RCC           PIC X(10) VALUE 'AR-CCC    '.   
           05  WS-GEN-LED-CIA           PIC X(10) VALUE 'AR-CIA    '.   
           05  WS-GEN-LED-CNT           PIC X(10) VALUE 'AR-CNT    '.   
           05  WS-GEN-LED-DEP           PIC X(10) VALUE 'AR-DEP    '.   
           05  WS-GEN-LED-DFA           PIC X(10) VALUE 'AR-DFA    '.   
           05  WS-GEN-LED-LPC           PIC X(10) VALUE 'AR-LPC    '.   
           05  WS-GEN-LED-LPN           PIC X(10) VALUE 'AR-LPN    '.   
           05  WS-GEN-LED-NSA           PIC X(10) VALUE 'AR-NSA    '.   
           05  WS-GEN-LED-NSN           PIC X(10) VALUE 'AR-NSN    '.   
           05  WS-GEN-LED-NSC           PIC X(10) VALUE 'AR-NSC    '.   
           05  WS-GEN-LED-PJS           PIC X(10) VALUE 'AR-PJS    '.   
       01  WS-OLD-AR-CONTROL.                                           
COB305     05 WS-OLD-AMT-AR-DAY-00        PIC S9(11)V99 COMP-3 VALUE 0.         
COB305     05 WS-OLD-AMT-AR-DAY-30        PIC S9(11)V99 COMP-3 VALUE 0.         
COB305     05 WS-OLD-AMT-AR-DAY-60        PIC S9(11)V99 COMP-3 VALUE 0.         
COB305     05 WS-OLD-AMT-AR-DAY-90        PIC S9(11)V99 COMP-3 VALUE 0.         
COB305     05 WS-OLD-TOT-SUMM-UNBILLED        PIC S9(11)V99 COMP-3 
COB305       VALUE 0.           
COB305     05 WS-OLD-AMT-UNUSED-CR        PIC S9(11)V99 COMP-3 VALUE 0.         
COB305     05 WS-OLD-AMT-TRAN-BALANCE        PIC S9(11)V99 COMP-3 
COB305       VALUE 0.           
       01  WS-OLD-SUMM-AR-CONTROL.                                      
COB305     05 WS-OLD-SUMM-AMT-AR-DAY-00        PIC S9(11)V99 COMP-3 
COB305       VALUE 0.         
COB305     05 WS-OLD-SUMM-AMT-AR-DAY-30        PIC S9(11)V99 COMP-3 
COB305       VALUE 0.         
COB305     05 WS-OLD-SUMM-AMT-AR-DAY-60        PIC S9(11)V99 COMP-3 
COB305       VALUE 0.         
COB305     05 WS-OLD-SUMM-AMT-AR-DAY-90        PIC S9(11)V99 COMP-3 
COB305       VALUE 0.         
COB305     05 WS-OLD-SUMM-TOT-SUMM-UNBILLED        PIC S9(11)V99 COMP-3 
COB305       VALUE 0.         
       01  WS-NEW-SUMM-AR-CONTROL.                                      
COB305     05 WS-NEW-SUMM-AMT-AR-DAY-00        PIC S9(11)V99 COMP-3 
COB305       VALUE 0.         
COB305     05 WS-NEW-SUMM-AMT-AR-DAY-30        PIC S9(11)V99 COMP-3 
COB305       VALUE 0.         
COB305     05 WS-NEW-SUMM-AMT-AR-DAY-60        PIC S9(11)V99 COMP-3 
COB305       VALUE 0.         
COB305     05 WS-NEW-SUMM-AMT-AR-DAY-90        PIC S9(11)V99 COMP-3 
COB305       VALUE 0.         
COB305     05 WS-NEW-SUMM-TOT-SUMM-UNBILLED        PIC S9(11)V99 COMP-3 
COB305       VALUE 0.         
       01  WS-AT-TOTAL-AR-BALANCES.                                     
COB305     05 WS-OLD-TOTAL-AR-BALANCE        PIC S9(11)V99 COMP-3 
COB305       VALUE 0.         
COB305     05 WS-NEW-TOTAL-AR-BALANCE        PIC S9(11)V99 COMP-3 
COB305       VALUE 0.         
      ******************************************************************        
      *    DB2 INCLUDES                                                *        
      ******************************************************************        
                                                                        
           EXEC SQL                                                             
              INCLUDE SQLCA                                                     
           END-EXEC.                                                            
                                                                        
           EXEC SQL                                                             
              INCLUDE TBACCT                                                    
           END-EXEC.                                                            
                                                                        
           EXEC SQL                                                             
              INCLUDE TBARLOCK                                                  
           END-EXEC.                                                            
                                                                        
           EXEC SQL                                                             
              INCLUDE TBMNHIST                                                  
           END-EXEC.                                                            
                                                                        
           EXEC SQL                                                             
              INCLUDE TBMNHDT                                                   
           END-EXEC.                                                            
                                                                        
           EXEC SQL                                                             
              INCLUDE TBARCNTL                                                  
           END-EXEC.                                                            
                                                                        
           EXEC SQL                                                             
              INCLUDE TBMODEL                                                   
           END-EXEC.                                                            
                                                                        
           EXEC SQL                                                             
              INCLUDE TBPREM                                                    
           END-EXEC.                                                            
                                                                        
           EXEC SQL                                                             
              INCLUDE TBBTJRNL                                                  
           END-EXEC.                                                            
                                                                        
           EXEC SQL                                                             
              INCLUDE TBCDJRNL                                                  
           END-EXEC.                                                            
                                                                        
           EXEC SQL                                                             
              INCLUDE TBMSJRNL                                                  
           END-EXEC.                                                            
                                                                        
           EXEC SQL                                                             
              INCLUDE TBARHIST                                                  
           END-EXEC.                                                            
                                                                        
           EXEC SQL                                                             
              INCLUDE TBARHDT                                                   
           END-EXEC.                                                            
                                                                        
           EXEC SQL                                                             
              INCLUDE TBGLATNO                                                  
           END-EXEC.                                                            
                                                                        
           EXEC SQL                                                             
              INCLUDE TBBJCNTL                                                  
           END-EXEC.                                                            
                                                                        
           EXEC SQL                                                             
              INCLUDE TBCDCNTL                                                  
           END-EXEC.                                                            
                                                                        
           EXEC SQL                                                             
              INCLUDE TBUSRPRF                                                  
           END-EXEC.                                                            
                                                                        
T21532 LINKAGE SECTION.                                                 
       01  PARM-ACCOUNT-NO          PIC X(13).                          
       01  PARM-PYMT-PRIORITY-LVL   PIC S9(9) COMP.                     
       01  PARM-ITEM-ID             PIC S9(9) COMP.                     
       01  PARM-RECV-TYPE           PIC X(03).                          
COB305 01 PARM-AMT-AR-DAY-00        PIC S9(11)V99 COMP-3 VALUE 0.               
COB305 01 PARM-AMT-AR-DAY-30        PIC S9(11)V99 COMP-3 VALUE 0.               
COB305 01 PARM-AMT-AR-DAY-60        PIC S9(11)V99 COMP-3 VALUE 0.               
COB305 01 PARM-AMT-AR-DAY-90        PIC S9(11)V99 COMP-3 VALUE 0.               
       01  PARM-USER-ID             PIC X(07).                          
       01  PARM-RESP-AREA-ID        PIC X(03).                          
COB305 01 PARM-TOT-SUMM-UNBILLED        PIC S9(11)V99 COMP-3 VALUE 0.           
       01  PARM-RECORD-ONLY-FLAG    PIC X(01).                          
       01  PARM-COMMENT-LEN         PIC X(4).                           
       01  PARM-COMMENT-LEN-NUM REDEFINES PARM-COMMENT-LEN              
                                    PIC 9(4).                           
       01  PARM-COMMENT-TEXT        PIC X(210).                         
       01  PARM-AC-LAST-UPDATE-TS   PIC X(26).                          
T21532 01  PARM-AT-LAST-UPDATE-TS   PIC X(26).                          
C30083 01  PARM-PANEL-NO            PIC X(08).                          
T21532*                                                                         
HPCCDM*EJECT                                                                    
C30083*PROCEDURE DIVISION.                                                      
C30083                                                                  
C30083 PROCEDURE DIVISION USING PARM-ACCOUNT-NO                         
C30083                         ,PARM-PYMT-PRIORITY-LVL                  
C30083                         ,PARM-ITEM-ID                            
C30083                         ,PARM-RECV-TYPE                          
C30083                         ,PARM-AMT-AR-DAY-00                      
C30083                         ,PARM-AMT-AR-DAY-30                      
C30083                         ,PARM-AMT-AR-DAY-60                      
C30083                         ,PARM-AMT-AR-DAY-90                      
C30083                         ,PARM-USER-ID                            
C30083                         ,PARM-RESP-AREA-ID                       
C30083                         ,PARM-TOT-SUMM-UNBILLED                  
C30083                         ,PARM-RECORD-ONLY-FLAG                   
C30083                         ,PARM-COMMENT-LEN                        
C30083                         ,PARM-COMMENT-TEXT                       
C30083                         ,PARM-AC-LAST-UPDATE-TS                  
C30083                         ,PARM-AT-LAST-UPDATE-TS                  
C30083                         ,PARM-PANEL-NO.                          
                                                                        
      ******************************************************************        
      * 0000-MAINLINE                                                  *        
      *     CONTROLS THE MAIN PATH OF THE PROGRAM                      *        
      ******************************************************************        
                                                                        
       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.                                                        
                                                                        
      ******************************************************************        
      * 0100-INITIALIZE                                                *        
      *                                                                *        
      *     1. RESET DB2 ERROR HANDLERS                                *        
      *     2. ESTABLISH GATEWAY ENVIRONMENT (TDINIT)                  *        
      *     3. ACCEPT CLIENT REQUEST/ESTABLISH SNA HANDLE (TDACCEPT)   *        
      *     4. DETERMINE IF CLIENT HAS SENT AN RPC PARAMETER (TDRESULT)*        
      *                                                                *        
      ******************************************************************        
                                                                        
       0100-INITIALIZE.                                                 
                                                                        
           EXEC SQL WHENEVER SQLWARNING CONTINUE END-EXEC.              
           EXEC SQL WHENEVER SQLERROR   CONTINUE END-EXEC.              
           EXEC SQL WHENEVER NOT FOUND  CONTINUE END-EXEC.              
C30083*                                                                         
C30083     EXEC SQL                                                     
C30083         DECLARE C1 CURSOR  FOR                        
C30083         SELECT                                                   
C30083            :S-RETURN-CODE    AS RETURN_CODE                      
C30083           ,:S-AR-LOCKOUT-IND AS AR_LOCKOUT_IND                   
C30083         FROM                                                     
C30083             CIS.SYSDUMMY1                                     
C30083     END-EXEC                                                     

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ027
MFA-TR*    EXEC SQL                                                             
MFA-TR*        DECLARE C1 CURSOR WITH RETURN FOR                                
MFA-TR*        SELECT                                                           
MFA-TR*           :S-RETURN-CODE    AS RETURN_CODE                              
MFA-TR*          ,:S-AR-LOCKOUT-IND AS AR_LOCKOUT_IND                           
MFA-TR*        FROM                                                             
MFA-TR*            SYSIBM.SYSDUMMY1                                             
MFA-TR*    END-EXEC                                                             
                                                                        
           PERFORM 7300-GET-CURRENT-TIMESTAMP THRU  7300-EXIT.          
                                                                        
                                                                        
       0100-EXIT.                                                       
           EXIT.                                                        
                                                                        
      ******************************************************************        
      * 1000-PROCESS-INPUT                                             *        
      *     1. RECEIVE PARMS.                                          *        
      ******************************************************************        
                                                                        
       1000-PROCESS-INPUT.                                              
                                                                        
      *    PERFORM 1100-RECEIVE-PARMS         THRU 1100-EXIT.                   
ACT158     MOVE FUNCTION UPPER-CASE(PARM-USER-ID) TO PARM-USER-ID.      
                                                                        
       1000-EXIT.                                                       
           EXIT.                                                        
                                                                        
      ******************************************************************        
      * 2000-PROCESS-OUTPUT.                                           *        
      *                                                                *        
      *     1. DESCRIBE RESULT SET                                     *        
      *     2. UPDATE DB2 DATA                                         *        
      *     3. BUILD RESULT SET                                        *        
      *     4. SEND RESULT SET                                         *        
      *                                                                *        
      ******************************************************************        
      *                                                                         
       2000-PROCESS-OUTPUT.                                             
      *                                                                         
T21532     INITIALIZE SCSCA182-LINK-RECORD.                             
T21532     MOVE PARM-ACCOUNT-NO                  TO SCSCA182-ACCOUNT-NO.
T21532*                                                                         
           MOVE '2000'                           TO ACTIVE-PARAGRAPH.   
      *                                                                         
           MOVE PARM-COMMENT-LEN-NUM             TO WS-COMMENT-LEN.     
      *                                                                         
           PERFORM 7999-SELECT-AL                                       
           THRU 7999-SELECT-AL-EXIT.                                    
      *                                                                         
           IF AL-AR-LOCKOUT-IND = 'Y'                                   
C30083        MOVE 5000                          TO S-RETURN-CODE       
C30083        MOVE AL-AR-LOCKOUT-IND             TO S-AR-LOCKOUT-IND    
C30083*       PERFORM 8100-SEND-RESULT           THRU 8100-EXIT                 
              PERFORM 9999-END-PROGRAM           THRU 9999-EXIT         
           ELSE                                                         
              PERFORM 5000-UPDATE                THRU 5000-EXIT         
           END-IF.                                                      
           ADD +1                                TO CTR-ROWS.           
C30083*    PERFORM 8100-SEND-RESULT              THRU 8100-EXIT.                
      *                                                                         
       2000-EXIT.                                                       
           EXIT.                                                        
                                                                        
                                                                        
      ***************************************************************           
      * MAIN UPDATE PARAGRAPH.                                      *           
      ***************************************************************           
                                                                        
       5000-UPDATE.                                                     
      *                                                                         
           MOVE '5000'                          TO ACTIVE-PARAGRAPH.    
T21532*                                                                         
C30083     IF PARM-PANEL-NO EQUAL 'PCSCA165'                            
C30083        CONTINUE                                                  
C30083     ELSE                                                         
T21532        PERFORM 9200-LINK-SCSCA182           THRU 9200-EXIT       
T21532        IF  SCSCA182-RETURN-CODE NOT EQUAL ZERO                   
T21532*           MOVE ABEND-FILE-LK               TO ABEND-FILE                
T21532            MOVE PROGRAM-NAME                TO ABEND-PROGRAM     
C30083            MOVE SCSCA182-RETURN-CODE        TO                   
C30083                                            WS-ACTIVE-RETURN-CODE 
T21532                                                SQLCODE           
C30083                                                S-RETURN-CODE     
T21532            PERFORM 9000-SEND-ERROR-RESULT   THRU 9000-EXIT       
T21532            PERFORM 9900-SQL-ERROR-ROUTINE   THRU 9900-EXIT       
T21532        ELSE                                                      
T21532            MOVE SCSCA182-LAST-UPDATE-TS     TO WS-LAST-UPDATE-TS 
T21532            IF  PARM-AT-LAST-UPDATE-TS = WS-LAST-UPDATE-TS        
T21532                CONTINUE                                          
T21532            ELSE                                                  
C30083                MOVE 5272                    TO S-RETURN-CODE     
T21532*               PERFORM 8100-SEND-RESULT     THRU 8100-EXIT          10606
T21532                GO TO 2000-EXIT                                   
T21532            END-IF                                                
T21532        END-IF                                                    
C30083     END-IF.                                                      
           MOVE PARM-ACCOUNT-NO                 TO WS-ACCOUNT-NO-C.     
                                                                        
      *                                                                         
           MOVE PARM-PYMT-PRIORITY-LVL          TO                      
                                                 WS-PYMT-PRIORITY-LVL.  
      *                                                                         
           MOVE PARM-AMT-AR-DAY-00              TO WS-NEW-AMT-AR-DAY-00.
           MOVE PARM-AMT-AR-DAY-30              TO WS-NEW-AMT-AR-DAY-30.
           MOVE PARM-AMT-AR-DAY-60              TO WS-NEW-AMT-AR-DAY-60.
           MOVE PARM-AMT-AR-DAY-90              TO WS-NEW-AMT-AR-DAY-90.
      *                                                                         
           MOVE PARM-TOT-SUMM-UNBILLED          TO                      
                                                WS-NEW-TOT-SUMM-UNBILLED
      *                                                                         
           MOVE PARM-ITEM-ID                    TO WS-ITEM-ID.          
           MOVE PARM-ITEM-ID                    TO WS-ITEM-ID-N.        
           MOVE WS-ITEM-ID-N                    TO WS-ITEM-ID-C.        
      *                                                                         
           MOVE WS-ITEM-ID-N                    TO WS-ITEM-ID.          
           MOVE WS-ACCOUNT-NO                   TO AT-ACCOUNT-NO        
                                                   AC-ACCOUNT-NO.       
           PERFORM 7000-SELECT-ACCOUNT          THRU 7000-EXIT.         
           MOVE  AT-TOTAL-AR-BALANCE            TO                      
                                                WS-OLD-TOTAL-AR-BALANCE.
                                                                        
           PERFORM 5600-MOVE-GEN-LED            THRU 5600-EXIT.         
                                                                        
           PERFORM 5650-PREPARE-JOURNAL                                 
                                                THRU 5650-EXIT          
                                                                        
           PERFORM 7100-SELECT-AR-CONTROL       THRU 7100-EXIT.         
           PERFORM 5300-MOVE-OLD-AR-CONTROL     THRU 5300-EXIT.         
           PERFORM 5350-UPDATE-AR-CONTROL       THRU 5350-EXIT.         
           IF  WS-PYMT-PRIORITY-LVL  >= 50                              
               PERFORM 5400-AR-CONTROL-SUMM-PROCESS                     
                                                THRU 5400-EXIT          
           END-IF                                                       
           PERFORM 8200-UPDATE-ACCOUNT          THRU 8200-EXIT.         
      *                                                                         
           PERFORM 5100-MOVE-TRAN-HEAD          THRU 5100-EXIT.         
           PERFORM 5200-MOVE-TRAN-DET           THRU 5200-EXIT.         
           IF  WS-BILLED-BAL-CHNG-AMT NOT EQUAL ZERO                    
               PERFORM 5250-PROCESS-WASH-JOURNAL                        
                                                THRU 5250-EXIT          
           END-IF.                                                      
           PERFORM 5750-CLOSE-CSH-DRWR          THRU 5750-EXIT.         
      *                                                                         
      *                                                                         
       5000-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ***************************************************************           
      * MOVE FIELDS TO THE MAINTENANCE TRANSACTION HEADER AND       *           
      * CALL COMMON PARAGRAPH FOR WRITING A ROW.                    *           
      ***************************************************************           
      *                                                                         
       5100-MOVE-TRAN-HEAD.                                             
      *                                                                         
           MOVE 'F'                             TO MH-CODE-TRAN-TYPE.   
           MOVE PARM-RESP-AREA-ID               TO MH-RESP-AREA-ID.     
           MOVE AT-ACCOUNT-NO                   TO MH-ACCOUNT-NO.       
           MOVE AT-CUSTOMER-NO                  TO MH-CUSTOMER-NO.      
           MOVE AT-PREMISE-NO                   TO MH-PREMISE-NO.       
           MOVE PARM-USER-ID                    TO MH-USER-ID.          
C30083     IF  PARM-PANEL-NO = 'PCSCA165'                               
C30083         MOVE  'PCSCA165D'                TO  MH-APPL-PROGRAM-ID  
C30083     ELSE                                                         
T21218         IF WS-BILLED-BAL-CHNG-AMT > 0                            
T21218             MOVE 'PANEL098A'             TO  MH-APPL-PROGRAM-ID  
T21218         ELSE                                                     
T21218             MOVE 'PANEL098B'             TO  MH-APPL-PROGRAM-ID  
T21218         END-IF                                                   
C30083     END-IF.                                                      
      *****MOVE WS-COMMENT-LEN                  TO  MH-TRAN-COMMENT-LEN.        
           MOVE LENGTH OF MH-TRAN-COMMENT-TEXT  TO                      
                                          MH-TRAN-COMMENT-LEN.          
           STRING 'PYMT PRIORITY LVL=  '                                
                   PARM-RECV-TYPE                                       
                   ' ;  ITEM-ID ='                                      
                   WS-ITEM-ID-C                                         
                   ' ;  '                                               
                   PARM-COMMENT-TEXT                                    
                   DELIMITED BY SIZE           INTO MH-TRAN-COMMENT-TEXT
           PERFORM 7300-GET-CURRENT-TIMESTAMP   THRU  7300-EXIT.        
           MOVE WS-CURRENT-DATE                 TO MH-DATE-TRANS.       
           MOVE WS-CURRENT-TIMESTAMP            TO MH-TRANS-HIST-SEQ-NO.
      *                                                                         
       5100-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ***************************************************************           
      * CHECK WHETHER ANY OF THE COLUMN VALUES HAVE CHANGED.IF      *           
      * SO THEN WRITE A RECORD IN THE TRANSACTION DETAIL.           *           
      ***************************************************************           
      *                                                                         
       5200-MOVE-TRAN-DET.                                              
      *                                                                         
           MOVE '5200'                          TO ACTIVE-PARAGRAPH.    
      *                                                                         
           MOVE MH-TRANS-HIST-SEQ-NO            TO MI-TRANS-HIST-SEQ-NO.
           MOVE 1                               TO WS-TRAN-APPL-NO      
                                                   MI-TRAN-APPL-NO.     
      *                                                                         
           IF WS-OLD-TOTAL-AR-BALANCE NOT EQUAL AT-TOTAL-AR-BALANCE     
               MOVE +15                         TO                      
                                          MI-PRV-COLUMN-VALUE-LEN       
                                          MI-CHG-COLUMN-VALUE-LEN       
      *                                                                         
              MOVE AT-TOTAL-AR-BALANCE          TO WS-COMP-2-CHAR-CONV  
              MOVE WS-COMP-2-CHAR-CONV          TO                      
                                          MI-CHG-COLUMN-VALUE-TEXT      
              MOVE WS-OLD-TOTAL-AR-BALANCE      TO WS-COMP-2-CHAR-CONV  
      *                                                                         
              MOVE WS-COMP-2-CHAR-CONV          TO                      
                                          MI-PRV-COLUMN-VALUE-TEXT      
      *                                                                         
              MOVE 'TOTAL AR BAL   '            TO MI-COLUMN-DESC       
              PERFORM 6530-LOAD-MNT-TRANS-HIST  THRU 6530-EXIT          
              ADD 1                             TO WS-TRAN-APPL-NO      
           END-IF.                                                      
      *                                                                         
           MOVE WS-TRAN-APPL-NO                 TO MI-TRAN-APPL-NO      
      *                                                                         
           IF WS-OLD-AMT-AR-DAY-00 NOT EQUAL WS-NEW-AMT-AR-DAY-00       
              MOVE +15                          TO                      
                                           MI-PRV-COLUMN-VALUE-LEN      
                                           MI-CHG-COLUMN-VALUE-LEN      
              MOVE WS-NEW-AMT-AR-DAY-00         TO  WS-COMP-2-CHAR-CONV 
              MOVE WS-COMP-2-CHAR-CONV          TO                      
                                           MI-CHG-COLUMN-VALUE-TEXT     
      *                                                                         
              MOVE WS-OLD-AMT-AR-DAY-00         TO WS-COMP-2-CHAR-CONV  
              MOVE WS-COMP-2-CHAR-CONV          TO                      
                                           MI-PRV-COLUMN-VALUE-TEXT     
      *                                                                         
              MOVE 'AMT AR DAY 00  '            TO MI-COLUMN-DESC       
              PERFORM 6530-LOAD-MNT-TRANS-HIST  THRU 6530-EXIT          
              ADD 1                             TO WS-TRAN-APPL-NO      
            END-IF                                                      
      *                                                                         
            MOVE WS-TRAN-APPL-NO                TO MI-TRAN-APPL-NO      
      *                                                                         
            IF WS-OLD-AMT-AR-DAY-30 NOT EQUAL WS-NEW-AMT-AR-DAY-30      
               MOVE +15                         TO                      
                                           MI-PRV-COLUMN-VALUE-LEN      
                                           MI-CHG-COLUMN-VALUE-LEN      
               MOVE WS-NEW-AMT-AR-DAY-30        TO WS-COMP-2-CHAR-CONV  
               MOVE WS-COMP-2-CHAR-CONV         TO                      
                                           MI-CHG-COLUMN-VALUE-TEXT     
      *                                                                         
               MOVE WS-OLD-AMT-AR-DAY-30        TO WS-COMP-2-CHAR-CONV  
               MOVE WS-COMP-2-CHAR-CONV         TO                      
                                           MI-PRV-COLUMN-VALUE-TEXT     
      *                                                                         
               MOVE 'AMT AR DAY 30  '           TO MI-COLUMN-DESC       
               PERFORM 6530-LOAD-MNT-TRANS-HIST THRU 6530-EXIT          
               ADD 1                            TO WS-TRAN-APPL-NO      
            END-IF                                                      
            MOVE WS-TRAN-APPL-NO                TO MI-TRAN-APPL-NO      
      *                                                                         
            IF WS-OLD-AMT-AR-DAY-60 NOT EQUAL WS-NEW-AMT-AR-DAY-60      
               MOVE +15                         TO                      
                                           MI-PRV-COLUMN-VALUE-LEN      
                                           MI-CHG-COLUMN-VALUE-LEN      
               MOVE WS-NEW-AMT-AR-DAY-60        TO WS-COMP-2-CHAR-CONV  
               MOVE WS-COMP-2-CHAR-CONV         TO                      
                                           MI-CHG-COLUMN-VALUE-TEXT     
      *                                                                         
               MOVE WS-OLD-AMT-AR-DAY-60        TO WS-COMP-2-CHAR-CONV  
               MOVE WS-COMP-2-CHAR-CONV         TO                      
                                           MI-PRV-COLUMN-VALUE-TEXT     
      *                                                                         
               MOVE 'AMT AR DAY 60  '           TO MI-COLUMN-DESC       
               PERFORM 6530-LOAD-MNT-TRANS-HIST THRU 6530-EXIT          
               ADD 1                            TO WS-TRAN-APPL-NO      
            END-IF                                                      
            MOVE WS-TRAN-APPL-NO                TO MI-TRAN-APPL-NO      
      *                                                                         
            IF WS-OLD-AMT-AR-DAY-90 NOT EQUAL WS-NEW-AMT-AR-DAY-90      
               MOVE +15                         TO                      
                                           MI-PRV-COLUMN-VALUE-LEN      
                                           MI-CHG-COLUMN-VALUE-LEN      
               MOVE WS-NEW-AMT-AR-DAY-90        TO WS-COMP-2-CHAR-CONV  
               MOVE WS-COMP-2-CHAR-CONV         TO                      
                                           MI-CHG-COLUMN-VALUE-TEXT     
      *                                                                         
               MOVE WS-OLD-AMT-AR-DAY-90        TO WS-COMP-2-CHAR-CONV  
               MOVE WS-COMP-2-CHAR-CONV         TO                      
                                           MI-PRV-COLUMN-VALUE-TEXT     
      *                                                                         
               MOVE 'AMT AR DAY 90  '           TO MI-COLUMN-DESC       
               PERFORM 6530-LOAD-MNT-TRANS-HIST THRU 6530-EXIT          
               ADD 1                            TO WS-TRAN-APPL-NO      
            END-IF                                                      
      *                                                                         
            MOVE WS-TRAN-APPL-NO                TO MI-TRAN-APPL-NO      
            IF WS-OLD-TOT-SUMM-UNBILLED NOT EQUAL                       
                                           WS-NEW-TOT-SUMM-UNBILLED     
               MOVE +15                         TO                      
                                           MI-PRV-COLUMN-VALUE-LEN      
                                           MI-CHG-COLUMN-VALUE-LEN      
      *                                                                         
               MOVE WS-NEW-TOT-SUMM-UNBILLED    TO WS-COMP-2-CHAR-CONV  
               MOVE WS-COMP-2-CHAR-CONV         TO                      
                                           MI-CHG-COLUMN-VALUE-TEXT     
      *                                                                         
               MOVE WS-OLD-TOT-SUMM-UNBILLED    TO WS-COMP-2-CHAR-CONV  
               MOVE WS-COMP-2-CHAR-CONV         TO                      
                                           MI-PRV-COLUMN-VALUE-TEXT     
      *                                                                         
               MOVE 'TOTSUM UNBILLED'           TO MI-COLUMN-DESC       
               PERFORM 6530-LOAD-MNT-TRANS-HIST THRU 6530-EXIT          
               ADD 1                            TO WS-TRAN-APPL-NO      
            END-IF.                                                     
       5200-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
       5250-PROCESS-WASH-JOURNAL.                                       
           PERFORM 5550-PROCESS-AR-TRANS-HIST   THRU 5550-EXIT          
           MOVE WS-BILLED-BAL-CHNG-AMT          TO  WS-101-AMT-POSTED   
                                                    WS-RECV-END-AR-BAL  
T21450     IF  WS-101-AMT-POSTED < 0                                    
T21450         COMPUTE WS-101-AMT-POSTED   = WS-101-AMT-POSTED * -1     
T21450     END-IF                                                       
                                                                        
           COMPUTE WS-DETAIL-END-AR-BAL =  WS-NEW-AMT-AR-DAY-00 +       
                                           WS-NEW-AMT-AR-DAY-30 +       
                                           WS-NEW-AMT-AR-DAY-60 +       
                                           WS-NEW-AMT-AR-DAY-90 +       
                                           WS-OLD-AMT-UNUSED-CR         
           IF  WS-PYMT-PRIORITY-LVL < 50                                
               COMPUTE WS-DETAIL-END-BAL = WS-NEW-AMT-AR-DAY-00 +       
                                           WS-NEW-AMT-AR-DAY-30 +       
                                           WS-NEW-AMT-AR-DAY-60 +       
                                           WS-NEW-AMT-AR-DAY-90 +       
                                           WS-OLD-AMT-UNUSED-CR +       
                                           WS-NEW-TOT-SUMM-UNBILLED     
           ELSE                                                         
               MOVE WS-OLD-AMT-TRAN-BALANCE     TO WS-DETAIL-END-BAL    
           END-IF                                                       
           MOVE WS-DETAIL-END-BAL               TO                      
                                             WS-101-DETAIL-END-BAL      
           MOVE WS-DETAIL-END-AR-BAL            TO                      
                                             WS-101-DETAIL-END-AR-BAL   
                                                                        
           MOVE WS-NEW-TOTAL-AR-BALANCE         TO WS-AR-END-BAL        
           MOVE WS-AR-END-BAL                   TO                      
                                             WS-101-ACCT-END-AR-BAL     
           MOVE GO-GL-ACCT-NO                   TO                      
                                            WS-101-ACCT-GEN-LED-DR      
                                            WS-101-ACCT-GEN-LED-CR.     
           PERFORM 5700-LOAD-JRNL-INFO          THRU 5700-EXIT.         
       5250-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
       5300-MOVE-OLD-AR-CONTROL.                                        
           MOVE AC-AMT-AR-DAY-00                TO  WS-OLD-AMT-AR-DAY-00
           MOVE AC-AMT-AR-DAY-30                TO  WS-OLD-AMT-AR-DAY-30
           MOVE AC-AMT-AR-DAY-60                TO  WS-OLD-AMT-AR-DAY-60
           MOVE AC-AMT-AR-DAY-90                TO  WS-OLD-AMT-AR-DAY-90
           MOVE AC-AMT-UNUSED-CR                TO  WS-OLD-AMT-UNUSED-CR
           MOVE AC-AMT-TRAN-BALANCE             TO                      
                                              WS-OLD-AMT-TRAN-BALANCE   
           MOVE AC-TOT-SUMM-UNBILLED            TO                      
                                              WS-OLD-TOT-SUMM-UNBILLED. 
       5300-EXIT.                                                       
      ******************************************************************        
      *5350-UPDATE-AR-CONTROL                                          *        
      *                                                                *        
      * UPDATE CONTROL RECORD WITH THE VALUES IN PARM                           
      ******************************************************************        
      *                                                                         
       5350-UPDATE-AR-CONTROL.                                          
      *                                                                         
           MOVE WS-ITEM-ID-N                    TO  WS-ITEM-ID.         
           MOVE WS-NEW-AMT-AR-DAY-00            TO  AC-AMT-AR-DAY-00,   
           MOVE WS-NEW-AMT-AR-DAY-30            TO  AC-AMT-AR-DAY-30,   
           MOVE WS-NEW-AMT-AR-DAY-60            TO  AC-AMT-AR-DAY-60,   
           MOVE WS-NEW-AMT-AR-DAY-90            TO  AC-AMT-AR-DAY-90,   
           MOVE WS-NEW-TOT-SUMM-UNBILLED        TO  AC-TOT-SUMM-UNBILLED
           PERFORM 8100-UPDATE-AR-CNTL          THRU 8100-UPDATE-EXIT   
      *********************                                                     
           STRING 'PYMT PRIORITY LVL = '                                
                   WS-AR-TYPE-SHORT-DESC                                
                  ' ;  ITEM-ID ='                                       
                   WS-ITEM-ID-C                                         
                  ' ;  '                                                
                   PARM-COMMENT-TEXT                                    
                   DELIMITED BY SIZE  INTO MH-TRAN-COMMENT-TEXT.        
       5350-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
       5400-AR-CONTROL-SUMM-PROCESS.                                    
           MOVE  WS-ACCOUNT-NO                  TO  AC-ACCOUNT-NO.      
           MOVE  0                              TO  WS-ITEM-ID.         
           PERFORM  7200-SELECT-AR-CONTROL-SUMM THRU 7200-EXIT.         
           PERFORM  5450-MOVE-OLD-ARCNTL-SUMM-AMTS                      
                                                THRU 5450-EXIT.         
           PERFORM  5500-COMP-NEW-ARCNTL-SUMM-AMTS                      
                                                THRU 5500-EXIT.         
           MOVE WS-NEW-SUMM-AMT-AR-DAY-00       TO  AC-AMT-AR-DAY-00    
           MOVE WS-NEW-SUMM-AMT-AR-DAY-30       TO  AC-AMT-AR-DAY-30    
           MOVE WS-NEW-SUMM-AMT-AR-DAY-60       TO  AC-AMT-AR-DAY-60    
           MOVE WS-NEW-SUMM-AMT-AR-DAY-90       TO  AC-AMT-AR-DAY-90    
           MOVE WS-NEW-SUMM-TOT-SUMM-UNBILLED   TO  AC-TOT-SUMM-UNBILLED
           MOVE  0                              TO  WS-ITEM-ID.         
           PERFORM  8100-UPDATE-AR-CNTL         THRU 8100-UPDATE-EXIT.  
       5400-EXIT.                                                       
           EXIT.                                                        
                                                                        
       5450-MOVE-OLD-ARCNTL-SUMM-AMTS.                                  
           MOVE AC-AMT-AR-DAY-00                TO                      
                                          WS-OLD-SUMM-AMT-AR-DAY-00     
           MOVE AC-AMT-AR-DAY-30                TO                      
                                          WS-OLD-SUMM-AMT-AR-DAY-30     
           MOVE AC-AMT-AR-DAY-60                TO                      
                                          WS-OLD-SUMM-AMT-AR-DAY-60     
           MOVE AC-AMT-AR-DAY-90                TO                      
                                          WS-OLD-SUMM-AMT-AR-DAY-90     
           MOVE AC-TOT-SUMM-UNBILLED            TO                      
                                          WS-OLD-SUMM-TOT-SUMM-UNBILLED.
       5450-EXIT.                                                       
           EXIT.                                                        
                                                                        
      ***************************************************************           
      * COMPUTE NEW SUMMARY VALUES FOR CONTROL ROW IN CASE DETAIL   *           
      * ROW WAS MODIFIED.                                           *           
      ***************************************************************           
                                                                        
       5500-COMP-NEW-ARCNTL-SUMM-AMTS.                                  
           MOVE '5300' TO ACTIVE-PARAGRAPH.                             
           COMPUTE WS-NEW-SUMM-AMT-AR-DAY-00 =                          
               (WS-OLD-SUMM-AMT-AR-DAY-00 - WS-OLD-AMT-AR-DAY-00        
                   + WS-NEW-AMT-AR-DAY-00)                              
           COMPUTE WS-NEW-SUMM-AMT-AR-DAY-30 =                          
               (WS-OLD-SUMM-AMT-AR-DAY-30 - WS-OLD-AMT-AR-DAY-30        
                   + WS-NEW-AMT-AR-DAY-30)                              
           COMPUTE WS-NEW-SUMM-AMT-AR-DAY-60 =                          
               (WS-OLD-SUMM-AMT-AR-DAY-60 - WS-OLD-AMT-AR-DAY-60        
                   + WS-NEW-AMT-AR-DAY-60)                              
           COMPUTE WS-NEW-SUMM-AMT-AR-DAY-90 =                          
               (WS-OLD-SUMM-AMT-AR-DAY-90 - WS-OLD-AMT-AR-DAY-90        
                   + WS-NEW-AMT-AR-DAY-90)                              
           COMPUTE WS-NEW-SUMM-TOT-SUMM-UNBILLED =                      
               (WS-OLD-SUMM-TOT-SUMM-UNBILLED - WS-OLD-TOT-SUMM-UNBILLED
                   + WS-NEW-TOT-SUMM-UNBILLED).                         
       5500-EXIT.                                                       
           EXIT.                                                        
       5550-PROCESS-AR-TRANS-HIST.                                      
           PERFORM 7300-GET-CURRENT-TIMESTAMP   THRU 7300-EXIT.         
           MOVE AT-ACCOUNT-NO                   TO  AR-ACCOUNT-NO       
                                                    AU-ACCOUNT-NO.      
           MOVE WS-CURRENT-TIMESTAMP            TO  AR-TRANS-HIST-SEQ-NO
                                                   AU-TRANS-HIST-SEQ-NO.
           MOVE WS-CURRENT-DATE                 TO  AR-DATE-TRANS       
           MOVE 'A'                             TO  AR-CODE-TRAN-TYPE   
           MOVE WS-BILLED-BAL-CHNG-AMT          TO  AR-AMT-ORIG-ENTERED 
           IF  AR-AMT-ORIG-ENTERED < 0                                  
               COMPUTE AR-AMT-ORIG-ENTERED = AR-AMT-ORIG-ENTERED * -1   
           END-IF                                                       
           MOVE WS-NEW-TOTAL-AR-BALANCE         TO  AR-AMT-BILLED-UNPAID
           MOVE PARM-RESP-AREA-ID               TO  AR-RESP-AREA-ID     
C30083     IF  PARM-PANEL-NO = 'PCSCA165'                               
C30083         MOVE  'PCSCA165D'                TO  AR-APPL-PROGRAM-ID  
C30083     ELSE                                                         
               IF WS-BILLED-BAL-CHNG-AMT > 0                            
                   MOVE 'PANEL098A'             TO  AR-APPL-PROGRAM-ID  
               ELSE                                                     
                   MOVE 'PANEL098B'             TO  AR-APPL-PROGRAM-ID  
               END-IF                                                   
C30083     END-IF.                                                      
           MOVE SPACES                          TO  AR-PYMT-FACILITY-CD 
           MOVE 1                               TO  AU-TRAN-APPL-NO     
           MOVE PARM-USER-ID                    TO  AR-USER-ID          
           MOVE AT-COMPANY-NO                   TO  AR-COMPANY-NO       
           MOVE PARM-RECORD-ONLY-FLAG           TO  AR-RECORD-ONLY-FL   
           MOVE SPACES                          TO  AR-DATE-ORIG-PYMT   
                                                   AR-PYMT-REFUNDED-IND 
                                                   AR-PYMT-RCPT-PRNTD-CD
           MOVE -1                              TO                      
                                                WS-DATE-ORIG-PYMT-IND.  
           MOVE WS-01                           TO  AR-CASH-COMPANY-NO  
           MOVE WS-998                          TO  AR-CASH-LOCAL-OFFICE
           MOVE WS-9999                         TO  AR-CASH-REPORT-NO   
           MOVE WS-CURRENT-DATE                 TO  AR-DATE-CASH-REPORT 
           MOVE ZEROES                          TO  AR-CASH-DRAWER-ID   
           MOVE LENGTH OF PARM-COMMENT-TEXT     TO  AR-TRAN-COMMENT-LEN 
           MOVE PARM-COMMENT-TEXT               TO  AR-TRAN-COMMENT-TEXT
                                                                        
      * POPULATE TRN_HIST_DET                                                   
      *                                                                         
           MOVE 'F'                             TO  AU-CODE-AR-AGE      
           MOVE AR-AMT-ORIG-ENTERED             TO  AU-AMT-POSTED       
                                                    AU-CURRENCY-AMT     
           MOVE PARM-ITEM-ID                    TO  AU-ITEM-ID          
           MOVE SPACES                          TO                      
                                                  AU-CODE-CONTRACT-TYPE 
                                                  AU-CURRENCY-TYPE      
                                                                        
           PERFORM 6500-ONLINE-LOAD-AR-TRAN-HIST                        
                                                THRU 6500-EXIT.         
       5550-EXIT.                                                       
           EXIT.                                                        
                                                                        
       5600-MOVE-GEN-LED.                                               
           MOVE '5600'                          TO ACTIVE-PARAGRAPH.    
           MOVE AT-COMPANY-NO                   TO GO-COMPANY-NO.       
           IF PARM-RECV-TYPE = 'UTE'                                    
              MOVE WS-GEN-LED-UTE               TO GO-GL-ACCT-NAME      
           ELSE                                                         
           IF PARM-RECV-TYPE = 'UTG'                                    
              MOVE WS-GEN-LED-UTG               TO GO-GL-ACCT-NAME      
           ELSE                                                         
           IF PARM-RECV-TYPE = 'NSC'                                    
              MOVE WS-GEN-LED-NSC               TO GO-GL-ACCT-NAME      
           ELSE                                                         
           IF PARM-RECV-TYPE = 'NSA'                                    
              MOVE WS-GEN-LED-NSA               TO GO-GL-ACCT-NAME      
           ELSE                                                         
           IF PARM-RECV-TYPE = 'NSN'                                    
              MOVE WS-GEN-LED-NSN               TO GO-GL-ACCT-NAME      
           ELSE                                                         
           IF PARM-RECV-TYPE = 'LPC'                                    
              MOVE WS-GEN-LED-LPC               TO GO-GL-ACCT-NAME      
           ELSE                                                         
           IF PARM-RECV-TYPE = 'LPN'                                    
              MOVE WS-GEN-LED-LPN               TO GO-GL-ACCT-NAME      
           ELSE                                                         
P00453     IF PARM-RECV-TYPE = 'BBP' OR 'PRP'                           
              MOVE WS-GEN-LED-EPP               TO GO-GL-ACCT-NAME      
           ELSE                                                         
           IF PARM-RECV-TYPE = 'CNT'                                    
              MOVE WS-GEN-LED-CNT               TO GO-GL-ACCT-NAME      
           ELSE                                                         
           IF PARM-RECV-TYPE = 'DFA' OR PARM-RECV-TYPE = 'DPP'          
              MOVE WS-GEN-LED-DFA               TO GO-GL-ACCT-NAME      
           ELSE                                                         
           IF PARM-RECV-TYPE = 'DEP'                                    
              MOVE WS-GEN-LED-DEP               TO GO-GL-ACCT-NAME      
           ELSE                                                         
           IF PARM-RECV-TYPE = 'RCC'                                    
              MOVE WS-GEN-LED-RCC               TO GO-GL-ACCT-NAME      
           ELSE                                                         
           IF PARM-RECV-TYPE = 'CIA'                                    
              MOVE WS-GEN-LED-CIA               TO GO-GL-ACCT-NAME      
           ELSE                                                         
              MOVE WS-GEN-LED-PJS               TO GO-GL-ACCT-NAME
           END-IF
           END-IF
           END-IF
           END-IF
           END-IF
           END-IF
           END-IF
           END-IF
           END-IF
           END-IF
           END-IF
           END-IF
           END-IF.     
                                                                        
           PERFORM 7500-SELECT-GL-NAME          THRU 7500-EXIT.         
           MOVE GO-GL-ACCT-NO                   TO AU-GL-ACCT-CREDIT    
                                                   AU-GL-ACCT-DEBIT.    
       5600-EXIT.                                                       
           EXIT.                                                        
                                                                        
      ******************************************************************        
      * 5650-PREPARE-JOURNAL.                                          *        
      *                                                                *        
      *     -- LOAD STATIC JOURNALLING FIELDS.                         *        
      *                                                                *        
      ******************************************************************        
      *                                                                         
       5650-PREPARE-JOURNAL.                                            
      *                                                                         
           MOVE '5650'                          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 'C'                             TO WS-TRAN-JRNL-TYPE.   
           MOVE '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.  
      *                                                                         
           PERFORM 6400-ONLINE-JRNL-ROUTINE     THRU 6400-EXIT.         
      *                                                                         
           MOVE WS-JRNL-OL-OPR-LOC              TO  WS-TERM-LOC.        
           MOVE '01'                            TO  WS-JRNL-OL-COMPANY. 
           MOVE '998'                           TO  WS-JRNL-OL-LOC-OFF. 
           MOVE '998'                           TO                      
                                               WS-JRNL-OL-REPORT-NO.    
           MOVE WS-CURRENT-DATE                 TO                      
                                               WS-JRNL-OL-REPORT-DT.    
           MOVE +9999                           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 '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.                                                      
                                                                        
           PERFORM 6400-ONLINE-JRNL-ROUTINE     THRU 6400-EXIT.         
                                                                        
           MOVE '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.   
C30083*    MOVE EIBTRNID                        TO                              
C30083     MOVE WS-TERMINAL-TRAN                TO                      
                                              WS-100-CODE-TERMINAL-TRAN.
           MOVE WS-CURRENT-DATE                 TO                      
                                              WS-100-DATE-LAST-ACTION   
                                              AT-DATE-LAST-ACTION.      
           MOVE 'C'                             TO                      
                                              WS-100-CODE-ENTRY-SOURCE. 
           MOVE AT-LOCAL-OFFICE                 TO                      
                                              WS-100-LOCAL-OFFICE-CD.   
      *                                                                         
       5650-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ******************************************************************        
      * 5700-LOAD-JRNL-INFO.                                           *        
      *                                                                *        
      *     -- LOAD STATIC JOURNALLING FIELDS.                         *        
      *        HEADER FOR JOURNAL                                               
      *                                                                *        
      ******************************************************************        
       5700-LOAD-JRNL-INFO.                                             
                                                                        
           MOVE 101                             TO                      
                                                WS-101-JRNL-FORMAT-NO.  
           MOVE WS-CURRENT-DATE                 TO                      
                                                WS-101-DATE-AR-BILLED.  
           MOVE ZEROES                          TO WS-101-REVENUE-MONTH.
           MOVE PR-REV-DISTRICT-CD              TO                      
                                           WS-101-CODE-REVENUE-DISTRICT.
           MOVE AT-CODE-COMPANY-ACCT            TO                      
                                           WS-101-CODE-COMPANY-ACCT.    
           MOVE AT-CODE-ACCT-STAT               TO                      
                                           WS-101-CODE-ACCOUNT-STATUS.  
           MOVE PR-CODE-PREMISE-STAT            TO                      
                                           WS-101-CODE-PREMISE-STATUS.  
           MOVE WS-BILLED-BAL-CHNG-AMT          TO                      
                                           WS-101-AMOUNT-ENTERED.       
T21450     IF  WS-101-AMOUNT-ENTERED < 0                                
T21450         COMPUTE WS-101-AMOUNT-ENTERED   =                        
T21450                           WS-101-AMOUNT-ENTERED * -1             
T21450     END-IF                                                       
           MOVE PARM-ITEM-ID                    TO WS-101-ITEM-ID-NO.   
                                                                        
           MOVE CJF00101                        TO                      
                                               WS-100-USER-DEFINED-AREA.
                                                                        
           MOVE WS-JRNL-ONLY                    TO                      
                                               WS-JRNL-OPERATION-RQST.  
      *                                                                         
           PERFORM 6400-ONLINE-JRNL-ROUTINE     THRU 6400-EXIT.         
      *                                                                         
       5700-EXIT.                                                       
           EXIT.                                                        
      *****************************************************************         
       5750-CLOSE-CSH-DRWR.                                             
           MOVE WS-JRNL-CNTRL-ONLY              TO                      
                                               WS-JRNL-OPERATION-RQST.  
           PERFORM 6400-ONLINE-JRNL-ROUTINE     THRU 6400-EXIT.         
           IF NOT (WS-JRNL-RTRN-CODE = SPACES)                          
              MOVE PROGRAM-NAME                 TO ABEND-PROGRAM        
              MOVE '6602'                       TO ACTIVE-PARAGRAPH     
              MOVE 'USER FORCED ABEND'          TO ABEND-FUNCTION       
              MOVE 'Y'                          TO WS-USER-FORCE-ABEND  
              MOVE 'JRNL ABEND'                 TO DSNTIAR-MESSAGE-1    
              PERFORM 9700-PROCESS-ABEND        THRU 9700-EXIT          
           END-IF.                                                      
       5750-EXIT.                                                       
           EXIT.                                                        
      ******************************************************************        
      * 6400 - FINANCIAL JOURNALING ROUTINE                            *        
      ******************************************************************        
           EXEC SQL                                                             
A00956        INCLUDE CPD0006A                                                  
           END-EXEC.                                                            
      ******************************************************************        
           EXEC SQL                                                             
              INCLUDE CPD00008                                                  
           END-EXEC.                                                            
      ******************************************************************        
      * 6530-  MAINTENANCE      JOURNALING ROUTINE                     *        
      ******************************************************************        
           EXEC SQL                                                             
              INCLUDE CPD00067                                                  
           END-EXEC.                                                            
      *                                                                         
HPCCDM*EJECT                                                                    
      *                                                                         
      ***************************************************************           
      * 7000-SELECT-ACCOUNT                                         *           
      *                                                             *           
      * FETCH DETAILS FROM THE ACCOUNT TABLE                        *           
      ***************************************************************           
      *                                                                         
       7000-SELECT-ACCOUNT.                                             
      *                                                                         
           MOVE '7000'                          TO ACTIVE-PARAGRAPH.    
      *                                                                         
           EXEC SQL                                                     
             SELECT                                                     
                 AT.PREMISE_NO,                                         
                 AT.CUSTOMER_NO,                                        
                 AT.COMPANY_NO,                                         
                 AT.LOCAL_OFFICE,                                       
                 AT.CODE_ACCT_STAT,                                     
                 AT.CODE_COMPANY_ACCT,                                  
                 AT.TOTAL_AR_BALANCE,                                   
                 PR.REV_DISTRICT_CD,                                    
                 PR.CODE_PREMISE_STAT                                   
             INTO                                                       
                 :AT-PREMISE-NO,                                        
                 :AT-CUSTOMER-NO,                                       
                 :AT-COMPANY-NO,                                        
                 :AT-LOCAL-OFFICE,                                      
                 :AT-CODE-ACCT-STAT,                                    
                 :AT-CODE-COMPANY-ACCT,                                 
                 :AT-TOTAL-AR-BALANCE,                                  
                 :PR-REV-DISTRICT-CD,                                   
                 :PR-CODE-PREMISE-STAT                                  
             FROM CSS_ACCOUNT AT, CSS_PREMISE PR                        
             WHERE AT.ACCOUNT_NO     = :AT-ACCOUNT-NO                   
               AND AT.PREMISE_NO     =  PR.PREMISE_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               
              NEXT SENTENCE                                             
           ELSE                                                         
               MOVE SPACES                     TO ABEND-TABLES          
               MOVE SPACES                     TO ABEND-SQL-PREDICATES  
               MOVE 'S384'                     TO ABEND-PROGRAM         
               MOVE '7000'                     TO ACTIVE-PARAGRAPH      
               MOVE 'SELECT'                   TO ABEND-FUNCTION        
               MOVE 'CSS_ACCOUNT'              TO TABLE-1               
               MOVE 'ACCOUNT_NO'               TO TABLE-ELEMENT-1       
               MOVE AT-ACCOUNT-NO              TO HOSTVAR-ELEMENT-1     
               PERFORM 9000-SEND-ERROR-RESULT  THRU 9000-EXIT           
               PERFORM 9900-SQL-ERROR-ROUTINE  THRU 9900-EXIT           
           END-IF.                                                      
      *                                                                         
       7000-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ***************************************************************           
      * FETCH CONTROL RECORD FROM THE AR CONTROL TABLE.             *           
      ***************************************************************           
      *                                                                         
       7100-SELECT-AR-CONTROL.                                          
      *                                                                         
           MOVE '7100'                         TO ACTIVE-PARAGRAPH.     
      *                                                                         
           EXEC SQL                                                     
             SELECT                                                     
                 AMT_AR_DAY_00,                                         
                 AMT_AR_DAY_30,                                         
                 AMT_AR_DAY_60,                                         
                 AMT_AR_DAY_90,                                         
                 AMT_TRAN_BALANCE,                                      
                 TOT_SUMM_UNBILLED,                                     
                 AMT_UNUSED_CR,                                         
                 REPLACE(REPLACE(CONVERT(CHAR(26), LAST_UPDATE_TS
           , 121), ' ', '-'), ':', '.') LAST_UPDATE_TS                         
             INTO                                                       
                 :AC-AMT-AR-DAY-00,                                     
                 :AC-AMT-AR-DAY-30,                                     
                 :AC-AMT-AR-DAY-60,                                     
                 :AC-AMT-AR-DAY-90,                                     
                 :AC-AMT-TRAN-BALANCE,                                  
                 :AC-TOT-SUMM-UNBILLED,                                 
                 :AC-AMT-UNUSED-CR,                                     
                 :AC-LAST-UPDATE-TS                                     
             FROM                                                       
                 CSS_AR_CNTL                                            
             WHERE                                                      
                 ACCOUNT_NO        = :AT-ACCOUNT-NO                     
             AND PYMT_PRIORITY_LVL = :WS-PYMT-PRIORITY-LVL              
             AND ITEM_ID           = :WS-ITEM-ID                        
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ061
MFA-TR*    EXEC SQL                                                             
MFA-TR*      SELECT                                                             
MFA-TR*          AMT_AR_DAY_00,                                                 
MFA-TR*          AMT_AR_DAY_30,                                                 
MFA-TR*          AMT_AR_DAY_60,                                                 
MFA-TR*          AMT_AR_DAY_90,                                                 
MFA-TR*          AMT_TRAN_BALANCE,                                              
MFA-TR*          TOT_SUMM_UNBILLED,                                             
MFA-TR*          AMT_UNUSED_CR,                                                 
MFA-TR*          LAST_UPDATE_TS                                                 
MFA-TR*      INTO                                                               
MFA-TR*          :AC-AMT-AR-DAY-00,                                             
MFA-TR*          :AC-AMT-AR-DAY-30,                                             
MFA-TR*          :AC-AMT-AR-DAY-60,                                             
MFA-TR*          :AC-AMT-AR-DAY-90,                                             
MFA-TR*          :AC-AMT-TRAN-BALANCE,                                          
MFA-TR*          :AC-TOT-SUMM-UNBILLED,                                         
MFA-TR*          :AC-AMT-UNUSED-CR,                                             
MFA-TR*          :AC-LAST-UPDATE-TS                                             
MFA-TR*      FROM                                                               
MFA-TR*          CSS_AR_CNTL                                                    
MFA-TR*      WHERE                                                              
MFA-TR*          ACCOUNT_NO        = :AT-ACCOUNT-NO                             
MFA-TR*      AND PYMT_PRIORITY_LVL = :WS-PYMT-PRIORITY-LVL                      
MFA-TR*      AND ITEM_ID           = :WS-ITEM-ID                                
MFA-TR*    END-EXEC.                                                            

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

                                                                        
           MOVE SQLCODE TO WS-ACTIVE-RETURN-CODE.                       
      *                                                                         
           IF  WS-ACTIVE-RETURN-CODE EQUAL SUCCESSFUL-CALL              
               IF  AR-CONTROL-CHANGED-CHECK                             
                   IF  AC-LAST-UPDATE-TS NOT = PARM-AC-LAST-UPDATE-TS   
                       MOVE -2                 TO SQLCODE               
                                                  WS-ACTIVE-RETURN-CODE 
                       MOVE SPACES             TO ABEND-TABLES          
                       MOVE SPACES             TO ABEND-SQL-PREDICATES  
                       MOVE 'S384'             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 'PYMT_PRIORITY_LVL'                         
                                               TO TABLE-ELEMENT-2       
                       MOVE 'ITEM_ID'          TO TABLE-ELEMENT-3       
                       MOVE AT-ACCOUNT-NO      TO HOSTVAR-ELEMENT-1     
                       MOVE WS-PYMT-PRIORITY-LVL                        
                                               TO HOSTVAR-ELEMENT-2     
                       MOVE WS-ITEM-ID         TO HOSTVAR-ELEMENT-3     
                       PERFORM 9000-SEND-ERROR-RESULT                   
                                               THRU 9000-EXIT           
                                                                        
                       PERFORM 9900-SQL-ERROR-ROUTINE                   
                                               THRU 9900-EXIT           
                   END-IF                                               
               END-IF                                                   
           ELSE                                                         
               MOVE SPACES                     TO ABEND-TABLES          
               MOVE SPACES                     TO ABEND-SQL-PREDICATES  
               MOVE 'S384'                     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 'PYMT_PRIORITY_LVL'        TO TABLE-ELEMENT-2       
               MOVE 'ITEM_ID'                  TO TABLE-ELEMENT-3       
               MOVE AT-ACCOUNT-NO              TO HOSTVAR-ELEMENT-1     
               MOVE WS-PYMT-PRIORITY-LVL       TO HOSTVAR-ELEMENT-2     
               MOVE WS-ITEM-ID                 TO HOSTVAR-ELEMENT-3     
               PERFORM 9000-SEND-ERROR-RESULT  THRU 9000-EXIT           
               PERFORM 9900-SQL-ERROR-ROUTINE  THRU 9900-EXIT
           END-IF.          
      *                                                                         
       7100-EXIT.                                                       
           EXIT.                                                        
      ***************************************************************           
      * FETCH SUMMARY RECORD FROM THE AR CONTROL TABLE.             *           
      ***************************************************************           
      *                                                                         
       7200-SELECT-AR-CONTROL-SUMM.                                     
      *                                                                         
           MOVE '7200'                         TO ACTIVE-PARAGRAPH.     
      *                                                                         
           EXEC SQL                                                     
             SELECT                                                     
                 AMT_AR_DAY_00,                                         
                 AMT_AR_DAY_30,                                         
                 AMT_AR_DAY_60,                                         
                 AMT_AR_DAY_90,                                         
                 AMT_TRAN_BALANCE,                                      
                 TOT_SUMM_UNBILLED,                                     
                 AMT_UNUSED_CR                                          
             INTO                                                       
                 :AC-AMT-AR-DAY-00,                                     
                 :AC-AMT-AR-DAY-30,                                     
                 :AC-AMT-AR-DAY-60,                                     
                 :AC-AMT-AR-DAY-90,                                     
                 :AC-AMT-TRAN-BALANCE,                                  
                 :AC-TOT-SUMM-UNBILLED,                                 
                 :AC-AMT-UNUSED-CR                                      
             FROM                                                       
                 CSS_AR_CNTL                                            
             WHERE                                                      
                 ACCOUNT_NO        = :AT-ACCOUNT-NO                     
             AND PYMT_PRIORITY_LVL = :WS-PYMT-PRIORITY-LVL              
             AND ITEM_ID           =  0                                 
           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                                                         
               IF  WS-ACTIVE-RETURN-CODE EQUAL NOT-FOUND                
                   MOVE 2000                   TO  WS-ACTIVE-RETURN-CODE
               END-IF                                                   
               MOVE SPACES                     TO ABEND-TABLES          
               MOVE SPACES                     TO ABEND-SQL-PREDICATES  
               MOVE 'S384'                     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 'PYMT_PRIORITY_LVL'        TO TABLE-ELEMENT-2       
               MOVE 'ITEM_ID'                  TO TABLE-ELEMENT-3       
               MOVE AT-ACCOUNT-NO              TO HOSTVAR-ELEMENT-1     
               MOVE WS-PYMT-PRIORITY-LVL       TO HOSTVAR-ELEMENT-2     
               MOVE WS-ITEM-ID                 TO HOSTVAR-ELEMENT-3     
               PERFORM 9000-SEND-ERROR-RESULT  THRU 9000-EXIT           
               PERFORM 9900-SQL-ERROR-ROUTINE  THRU 9900-EXIT           
           END-IF.                                                      
      *                                                                         
       7200-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
       7300-GET-CURRENT-TIMESTAMP.                                      
           EXEC SQL                                                     
              SELECT                                                    
                 REPLACE(REPLACE(CONVERT(CHAR(26), 
           CIS.CURRENT$TIMESTAMP(), 121), ' ', '-'), ':', '.'), 
           CAST(SYSDATETIMEOFFSET() AS DATE)                        
              INTO                                                      
                 :WS-CURRENT-TIMESTAMP, :WS-CURRENT-DATE                
              FROM                                                      
                 CSS_MODEL_SQL                                          
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ028
MFA-TR* MSQ061
MFA-TR*    EXEC SQL                                                             
MFA-TR*       SELECT                                                            
MFA-TR*          CURRENT TIMESTAMP, CURRENT DATE                                
MFA-TR*       INTO                                                              
MFA-TR*          :WS-CURRENT-TIMESTAMP, :WS-CURRENT-DATE                        
MFA-TR*       FROM                                                              
MFA-TR*          CSS_MODEL_SQL                                                  
MFA-TR*    END-EXEC.                                                            

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

                                                                        
           MOVE SQLCODE                        TO WS-ACTIVE-RETURN-CODE.
           IF WS-ACTIVE-RETURN-CODE EQUAL SUCCESSFUL-CALL               
               NEXT SENTENCE                                            
           ELSE                                                         
               MOVE SPACES                     TO ABEND-TABLES          
               MOVE SPACES                     TO ABEND-SQL-PREDICATES  
               MOVE '7300'                     TO ACTIVE-PARAGRAPH      
               MOVE 'S384'                     TO ABEND-PROGRAM         
               MOVE 'SELECT'                   TO ABEND-FUNCTION        
               MOVE 'CSS_MODEL_SQL'            TO TABLE-1               
               MOVE 'ACCOUNT_NO'               TO TABLE-ELEMENT-1       
               MOVE AT-ACCOUNT-NO              TO HOSTVAR-ELEMENT-1     
      *                                                                         
               PERFORM 9000-SEND-ERROR-RESULT  THRU 9000-EXIT           
               PERFORM 9900-SQL-ERROR-ROUTINE  THRU 9900-EXIT           
           END-IF.                                                      
       7300-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
       7500-SELECT-GL-NAME.                                             
           MOVE '7500'                         TO ACTIVE-PARAGRAPH.     
                                                                        
           EXEC SQL                                                     
               SELECT GL_ACCT_NO                                        
               INTO :GO-GL-ACCT-NO                                      
               FROM CSS_GL_ACCT_NO                                      
MCR310*        WHERE  COMPANY_NO        = :GO-COMPANY-NO                        
MCR310         WHERE  COMPANY_NO        = '01'                          
               AND    GL_ACCT_NAME      = :GO-GL-ACCT-NAME              
           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                                                         
C30083        MOVE WS-ACTIVE-RETURN-CODE       TO S-RETURN-CODE         
              MOVE SPACES                      TO ABEND-TABLES          
              MOVE SPACES                      TO ABEND-SQL-PREDICATES  
              MOVE 'S384'                      TO ABEND-PROGRAM         
              MOVE 'SELECT'                    TO ABEND-FUNCTION        
              MOVE 'CSS_GL_ACCT_NO'            TO TABLE-1               
              MOVE 'COMPANY_NO'                TO TABLE-ELEMENT-1       
              MOVE 'GL_ACCT_NAME'              TO TABLE-ELEMENT-2       
              MOVE 'ACCOUNT_NO'                TO TABLE-ELEMENT-3       
              MOVE '01'                        TO HOSTVAR-ELEMENT-1     
              MOVE GO-GL-ACCT-NAME             TO HOSTVAR-ELEMENT-2     
              MOVE PARM-ACCOUNT-NO             TO HOSTVAR-ELEMENT-3     
              PERFORM 9000-SEND-ERROR-RESULT   THRU 9000-EXIT           
              PERFORM 9900-SQL-ERROR-ROUTINE   THRU 9900-EXIT
           END-IF.          
       7500-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ****************************************************************          
      * 7999-SELECT-AL AR LOCKOUT AND TRANSFER ROUTINE               *          
      ****************************************************************          
      *                                                                         
              EXEC SQL                                                          
                 INCLUDE CPD00075                                               
              END-EXEC.                                                         
      *                                                                         
              EXEC SQL                                                          
                 INCLUDE CPD00307                                               
              END-EXEC.                                                         
      *                                                                         
      ***************************************************************           
      * UPDATE CONTROL RECORD IN THE AR CONTROL TABLE.              *           
      ***************************************************************           
      *                                                                         
       8100-UPDATE-AR-CNTL.                                             
      *                                                                         
           MOVE '8100'                         TO ACTIVE-PARAGRAPH.     
      *                                                                         
           EXEC SQL                                                     
      *                                                                         
               UPDATE                                                   
                   CSS_AR_CNTL                                          
               SET                                                      
                   AMT_AR_DAY_00     = :AC-AMT-AR-DAY-00 ,              
                   AMT_AR_DAY_30     = :AC-AMT-AR-DAY-30 ,              
                   AMT_AR_DAY_60     = :AC-AMT-AR-DAY-60 ,              
                   AMT_AR_DAY_90     = :AC-AMT-AR-DAY-90 ,              
                   TOT_SUMM_UNBILLED = :AC-TOT-SUMM-UNBILLED,           
                   LAST_UPDATE_TS    = CIS.CURRENT$TIMESTAMP()                
               WHERE                                                    
                   ACCOUNT_NO        = :AT-ACCOUNT-NO                   
               AND PYMT_PRIORITY_LVL = :WS-PYMT-PRIORITY-LVL            
               AND ITEM_ID           = :WS-ITEM-ID                      
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ028
MFA-TR*    EXEC SQL                                                             
MFA-TR*                                                                         
MFA-TR*        UPDATE                                                           
MFA-TR*            CSS_AR_CNTL                                                  
MFA-TR*        SET                                                              
MFA-TR*            AMT_AR_DAY_00     = :AC-AMT-AR-DAY-00 ,                      
MFA-TR*            AMT_AR_DAY_30     = :AC-AMT-AR-DAY-30 ,                      
MFA-TR*            AMT_AR_DAY_60     = :AC-AMT-AR-DAY-60 ,                      
MFA-TR*            AMT_AR_DAY_90     = :AC-AMT-AR-DAY-90 ,                      
MFA-TR*            TOT_SUMM_UNBILLED = :AC-TOT-SUMM-UNBILLED,                   
MFA-TR*            LAST_UPDATE_TS    = CURRENT TIMESTAMP                        
MFA-TR*        WHERE                                                            
MFA-TR*            ACCOUNT_NO        = :AT-ACCOUNT-NO                           
MFA-TR*        AND PYMT_PRIORITY_LVL = :WS-PYMT-PRIORITY-LVL                    
MFA-TR*        AND ITEM_ID           = :WS-ITEM-ID                              
MFA-TR*    END-EXEC.                                                            

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

                                                                        
           MOVE SQLCODE                        TO WS-ACTIVE-RETURN-CODE.
           IF WS-ACTIVE-RETURN-CODE EQUAL SUCCESSFUL-CALL               
               NEXT SENTENCE                                            
           ELSE                                                         
               MOVE SPACES                     TO ABEND-TABLES          
               MOVE SPACES                     TO ABEND-SQL-PREDICATES  
               MOVE 'S384'                     TO ABEND-PROGRAM         
               MOVE 'UPDATE'                   TO ABEND-FUNCTION        
               MOVE 'CSS_AR_CNTL'              TO TABLE-1               
               MOVE 'ACCOUNT_NO'               TO TABLE-ELEMENT-1       
               MOVE 'PYMT_PRIORITY_LVL'        TO TABLE-ELEMENT-2       
               MOVE 'ITEM_ID'                  TO TABLE-ELEMENT-3       
               MOVE 'AMT_TRAN_BALANCE'         TO TABLE-ELEMENT-4       
               MOVE AT-ACCOUNT-NO              TO HOSTVAR-ELEMENT-1     
               MOVE WS-PYMT-PRIORITY-LVL       TO HOSTVAR-ELEMENT-2     
               MOVE WS-ITEM-ID                 TO HOSTVAR-ELEMENT-3     
               MOVE AC-TOT-SUMM-UNBILLED       TO                       
                                               AC-TOT-SUMM-UNBILLED-ED  
               MOVE AC-TOT-SUMM-UNBILLED-ED                             
                                               TO HOSTVAR-ELEMENT-4     
               PERFORM 9000-SEND-ERROR-RESULT  THRU 9000-EXIT           
               PERFORM 9900-SQL-ERROR-ROUTINE  THRU 9900-EXIT           
           END-IF.                                                      
      *                                                                         
       8100-UPDATE-EXIT.                                                
           EXIT.                                                        
      *                                                                         
      ***************************************************************           
      * UPDATE ACCOUNT TABLE                                        *           
      ***************************************************************           
      *                                                                         
       8200-UPDATE-ACCOUNT.                                             
      *                                                                         
           MOVE '8200'                         TO ACTIVE-PARAGRAPH.     
      *                                                                         
      *                                                                         
           COMPUTE WS-NEW-TOTAL-AR-BALANCE =                            
                   WS-OLD-TOTAL-AR-BALANCE -                            
                   (WS-OLD-AMT-AR-DAY-00  +                             
                    WS-OLD-AMT-AR-DAY-30  +                             
                    WS-OLD-AMT-AR-DAY-60  +                             
                    WS-OLD-AMT-AR-DAY-90)     +                         
                   (WS-NEW-AMT-AR-DAY-00 +                              
                    WS-NEW-AMT-AR-DAY-30 +                              
                    WS-NEW-AMT-AR-DAY-60 +                              
                    WS-NEW-AMT-AR-DAY-90)                               
           COMPUTE WS-BILLED-BAL-CHNG-AMT  =  WS-OLD-TOTAL-AR-BALANCE - 
                                              WS-NEW-TOTAL-AR-BALANCE   
           MOVE  WS-NEW-TOTAL-AR-BALANCE       TO  AT-TOTAL-AR-BALANCE. 
      *                                                                         
           EXEC SQL                                                     
               UPDATE                                                   
                   CSS_ACCOUNT                                          
               SET                                                      
                   TOTAL_AR_BALANCE   = :AT-TOTAL-AR-BALANCE,           
                   LAST_UPDATE_TS     =  CIS.CURRENT$TIMESTAMP()              
              WHERE                                                     
                   ACCOUNT_NO = :AT-ACCOUNT-NO                          
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ028
MFA-TR*    EXEC SQL                                                             
MFA-TR*        UPDATE                                                           
MFA-TR*            CSS_ACCOUNT                                                  
MFA-TR*        SET                                                              
MFA-TR*            TOTAL_AR_BALANCE   = :AT-TOTAL-AR-BALANCE,                   
MFA-TR*            LAST_UPDATE_TS     =  CURRENT TIMESTAMP                      
MFA-TR*       WHERE                                                             
MFA-TR*            ACCOUNT_NO = :AT-ACCOUNT-NO                                  
MFA-TR*    END-EXEC.                                                            

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

                                                                        
           MOVE SQLCODE                        TO WS-ACTIVE-RETURN-CODE.
           IF WS-ACTIVE-RETURN-CODE EQUAL SUCCESSFUL-CALL               
               NEXT SENTENCE                                            
           ELSE                                                         
               MOVE SPACES                     TO ABEND-TABLES          
               MOVE SPACES                     TO ABEND-SQL-PREDICATES  
               MOVE 'S384'                     TO ABEND-PROGRAM         
               MOVE 'UPDATE'                   TO ABEND-FUNCTION        
               MOVE 'CSS_ACCOUNT'              TO TABLE-1               
               MOVE 'ACCOUNT_NO'               TO TABLE-ELEMENT-1       
               MOVE 'TOTAL_AR_BALANCE'         TO TABLE-ELEMENT-2       
               MOVE AT-ACCOUNT-NO              TO HOSTVAR-ELEMENT-1     
               MOVE AT-TOTAL-AR-BALANCE        TO WS-AT-TOT-AR-BAL-ED   
               MOVE WS-AT-TOT-AR-BAL-ED        TO HOSTVAR-ELEMENT-2     
               PERFORM 9000-SEND-ERROR-RESULT  THRU 9000-EXIT           
               PERFORM 9900-SQL-ERROR-ROUTINE  THRU 9900-EXIT           
           END-IF.                                                      
                                                                        
       8200-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ***************************************************************           
      * DELETE CSS_AR_CNTL IF ALL VALUES ARE ZEROS.                 *           
      ***************************************************************           
      *                                                                         
       8300-DELETE-AR-CNTL.                                             
      *                                                                         
           MOVE '8300'                         TO ACTIVE-PARAGRAPH.     
      *                                                                         
           EXEC SQL                                                     
               DELETE FROM                                              
                   CSS_AR_CNTL                                          
               WHERE                                                    
                  ACCOUNT_NO        = :AT-ACCOUNT-NO                    
              AND ITEM_ID           = :WS-ITEM-ID                       
              AND PYMT_PRIORITY_LVL = :WS-PYMT-PRIORITY-LVL             
           END-EXEC.                                                    

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

                                                                        
           MOVE SQLCODE                        TO WS-ACTIVE-RETURN-CODE.
           IF WS-ACTIVE-RETURN-CODE EQUAL SUCCESSFUL-CALL               
                 NEXT SENTENCE                                          
           ELSE                                                         
               MOVE SPACES                     TO ABEND-TABLES          
               MOVE SPACES                     TO ABEND-SQL-PREDICATES  
               MOVE 'S384'                     TO ABEND-PROGRAM         
               MOVE 'DELETE'                   TO ABEND-FUNCTION        
               MOVE 'CSS_AR_CNTL'              TO TABLE-1               
               MOVE 'ACCOUNT_NO'               TO TABLE-ELEMENT-1       
               MOVE 'PYMT_PRIORITY_LVL'        TO TABLE-ELEMENT-2       
               MOVE 'ITEM_ID'                  TO TABLE-ELEMENT-3       
               MOVE AT-ACCOUNT-NO              TO HOSTVAR-ELEMENT-1     
               MOVE WS-PYMT-PRIORITY-LVL       TO HOSTVAR-ELEMENT-2     
               MOVE WS-ITEM-ID                 TO HOSTVAR-ELEMENT-3     
               PERFORM 9000-SEND-ERROR-RESULT  THRU 9000-EXIT           
               PERFORM 9900-SQL-ERROR-ROUTINE  THRU 9900-EXIT           
           END-IF.                                                      
                                                                        
       8300-EXIT.                                                       
           EXIT.                                                        
T21532*****************************************************************         
T21532*  CALLS THE SUBPROGRAM SCSCA182                                          
T21532*****************************************************************         
T21532*                                                                         
T21532 9200-LINK-SCSCA182.                                              
T21532*                                                                         
T21532*    MOVE '9200'                         TO ACTIVE-PARAGRAPH.     23970000
T21532*                                                                 23980000
T21532*    EXEC CICS                                                    23990000
T21532*        HANDLE ABEND CANCEL                                      24000000
T21532*    END-EXEC.                                                    24010000
T21532*                                                                 24020000
T21532*    EXEC CICS LINK                                                       
T21532*              PROGRAM ('SCSCA182')                                       
T21532*              COMMAREA (SCSCA182-LINK-RECORD)                            
T21532*              LENGTH (LENGTH OF SCSCA182-LINK-RECORD)                    
T21532*    END-EXEC.                                                            
T21532*                                                                 24080000
T21532*    EXEC CICS                                                    24090000
T21532*        HANDLE ABEND LABEL(9250-CALL-ABEND)                      24100000
T21532*    END-EXEC.                                                    24110000
C30083        CALL MCSCA182  USING  SCSCA182-ACCOUNT-NO                 
C30083                              SCSCA182-RETURN-CODE                
C30083                              SCSCA182-LAST-UPDATE-TS             
C30083                              ABEND-FILE.                         
T21532                                                                  
T21532 9200-EXIT.                                                       
T21532     EXIT.                                                        
T21532*                                                                         
T21532******************************************************************        
T21532*  PERFORMS THE ABEND  WHEN THE CICS STATMENT FAILS                       
T21532******************************************************************        
T21532*                                                                         
T21532 9250-CALL-ABEND.                                                 
T21532*                                                                         
T21532     MOVE PROGRAM-NAME                   TO ABEND-PROGRAM.        
T21532     MOVE 'LINKFAIL'                     TO ABEND-FUNCTION.       
T21532     MOVE 100                            TO WS-ACTIVE-RETURN-CODE 
T21532                                            SQLCODE.              
T21532     PERFORM 9700-PROCESS-ABEND          THRU 9700-EXIT.          
T21532                                                                  
T21532 9250-EXIT.                                                       
T21532     EXIT.                                                        
      *                                                                         
HPCCDM*    EJECT                                                                
      *                                                                         
              EXEC SQL                                                          
                 INCLUDE CPD0023C                                               
              END-EXEC.                                                         
      *                                                                         
      ****************************************************************          
      * 9900- JOURNALING / ERROR HANDLING INCLUDE *                             
      ****************************************************************          
              EXEC SQL                                                          
C30083           INCLUDE CPDSP300                                               
              END-EXEC.                                                         
                                                                        
      ****************************************************************          
      *       END PROGRAM COPYLIB                                               
      ****************************************************************          
C30083     EXEC SQL                                                             
C30083        INCLUDE CPD00321                                                  
C30083     END-EXEC.                                                            
                                                                        
