       IDENTIFICATION DIVISION.                                         
       PROGRAM-ID.     PCSCA894.                                        
       DATE-WRITTEN.   APR.2010.                                        
           DATE-COMPILED.                                               
      ****************************************************************          
      **              P R O G R A M  S U M M A R Y                  **          
      **                                                            **          
      **                                                            **          
      **         F U N C T I O N A L   D E S C R I P T I O N        **          
      **                         O F   M O D U L E                  **          
      **                                                            **          
      **  PURPOSE :                                                 **          
      **                                                            **          
      **  SENDS REPORT TO A DIRECTORY USING XCOM                    **          
      **                                                            **          
      **  LOGIC :                                                   **          
      **                                                            **          
      **  ESCHEATMENT IS USED FOR THE CIA BALANCES ON WRITE OFF AND **          
      **  FINAL BILL ACCOUNTS.  THE COMPONENT WILL RUN ONCE A YEAR  **          
      **  IN SEPTEMBER.  THE PROGRAM WILL GENERATE ONE REPORT.      **          
      ****************************************************************          
      ****************************************************************          
      **                                                            **          
      **                                                            **          
      **             PROGRAM  MODIFICATION  LOG                     **          
      **                                                            **          
      **   DATE        USERID       REASON                          **          
      **   ----        -------      ------                          **          
A02137** 04/21/2010    RC41079      INITIAL VERSION                 **          
A02137** 09/02/2010    RC41079      REMOVED WITH HOLD FOR CURSORS.  **          
A02137** 09/03/2010    RC41079      ADDED WITH HOLD TO CURSORS AND  **          
      **                            REMOVED THE OPEN STMT AFTER THE **          
      **                            COMMIT.                         **          
      **                                                            **          
A05154** 12 JAN 2015   RF10596      ADDED COPYBOOK CPD0008          **          
      **                                                            **          
A05136** 27 JUL 2015   RF10596      REMOVE CODE FOR DELEINQUENCY AND**          
      **           AND AC.AMT_UNUSED_CR >= :WS-CIA-ESCHT-AMT-FB     **          
      ****************************************************************          
      * ------------------------------------------------------------ *          
      *                                                                         
                     ---- BASIC BATCH SEQUENCE STRUCTURE ----           
                    0000 - 0000     MAIN CONTROL PATH                   
                    0100 - 0100     INITIALIZATION                      
                    1000 - 1000     MAJOR PROCESSING LOOP               
                    1100 - 4999     PERFORMED PARAGRAPHS OF MAJOR       
                                    PROCESSING LOOPS                    
                    5000 - 5999     COMMON PROGRAM MODULES              
                    6000 - 6999     COMMON SYSTEM MODULES               
                    7000 - 7999     INPUT MODULES                       
                    8000 - 8999     OUTPUT MODULES                      
                    9000 - 9799     TERMINATION MODULES                 
                    9900 - 9999     ABEND/ABORT MODULES                 
                          ---- PARAGRAPH STRUCTURE ----                 
      *                                                                         
       ENVIRONMENT DIVISION.                                            
       CONFIGURATION SECTION.                                           
       SOURCE-COMPUTER.    IBM-370.                                     
       OBJECT-COMPUTER.    IBM-370.                                     
       INPUT-OUTPUT SECTION.                                            
       FILE-CONTROL.                                                    
           SELECT FCSRP894-FILE                                         
               ASSIGN TO UT-S-FCSRP894                                  
               FILE STATUS IS WS-FRP894-STATUS.                         
                                                                        
                                                                        
      *                                                                         
       DATA DIVISION.                                                   
       FILE  SECTION.                                                   
       FD  FCSRP894-FILE                                                
           BLOCK CONTAINS  0 RECORDS                                    
           RECORDING MODE  IS F                                         
           LABEL RECORDS   ARE STANDARD.                                
                                                                        
       01 FRP894-DATA-REC.                                              
          05  FRP894-ACCOUNT-NO        PIC 9(13).                       
          05  FILLER                   PIC X(01).                       
          05  FRP894-FIRST-NAME        PIC X(15).                       
          05  FILLER                   PIC X(01).                       
          05  FRP894-MIDDLE-NAME       PIC X(15).                       
          05  FILLER                   PIC X(01).                       
          05  FRP894-LAST-NAME         PIC X(40).                       
          05  FILLER                   PIC X(01).                       
          05  FRP894-ACCT-STAT-CD      PIC X(01).                       
          05  FILLER                   PIC X(01).                       
          05  FRP894-FBWO-DATE         PIC X(10).                       
          05  FILLER                   PIC X(01).                       
          05  FRP894-FBWO-AMOUNT       PIC -(09).99.                    
          05  FILLER                   PIC X(01).                       
          05  FRP894-DATE-TRANS        PIC X(10).                       
          05  FILLER                   PIC X(01).                       
          05  FRP894-FULL-NAME         PIC X(70).                       
                                                                        
       WORKING-STORAGE SECTION.                                         

MSQ017 01 MFA-PROGRAM-ID PIC X(8) VALUE 'PCSCA894'.
MSQ017     COPY MFASQLM.
      *                                                                         
       01 WS-START                     PIC X(40)    VALUE               
             'WORKING STORAGE FOR PCSCA894 STARTS HERE'.                
      *                                                                         
       01  WS-FILE-STATUS.                                              
           05  WS-FRP894-STATUS        PIC X(02).                       
               88  FRP894-SUCCESSFUL                VALUE '00'.         
      *                                                                         
                                                                        
       01  WS-SWITCHES-AND-INDICATORS.                                  
           05  WS-END-ACCOUNT-CUR-SW   PIC X(1) VALUE 'N'.              
               88  WS-END-ACCOUNT-CUR      VALUE 'Y'.                   
               88  WS-NOT-END-ACCOUNT-CUR  VALUE 'N'.                   
      *                                                                         
       01  WS-TRANHIST-MSG1.                                            
           05  FILLER                  PIC X(39)  VALUE                 
              'SOUTH CAROLINA STATE TREASURERS OFFICE '.                
           05  FILLER                  PIC X(50)  VALUE                 
              'UNCLAIMED PROPERTY DIVISION TELEPHONE 803-737-4771'.     
      *                                                                         
       01  WS-TRANHIST-MSG2.                                            
           05  FILLER                  PIC X(41)  VALUE                 
              'DEPARTMENT OF STATE TREASURY ESCHEATMENT '.              
           05  FILLER                  PIC X(46)  VALUE                 
              'AND UNCLAIMED PROPERTY. TELEPHONE 919-508-5979'.         
      *                                                                         
       01  WS-MISCELLANEOUS.                                            
           05  WS-PYMT-PRIORITY-LVL    PIC S9(04) COMP VALUE ZERO.      
           05  WS-TIMESTAMP            PIC X(26)       VALUE SPACES.    
           05  WS-SYSIN-COMP-NO        PIC X(02)       VALUE SPACES.    
A05154     05  WS-DATE-ORIG-PYMT-IND   PIC S9(4)  COMP VALUE 0.         
      *                                                                         
       01  WS-811                     PIC S9(4)     COMP VALUE -811.    
      *                                                                         
       01  WS-ERROR-MESSAGES.                                           
           05  WS-NEGATIVE-AR-BALANCE PIC  X(40) VALUE                  
                   'WARNING : AR-BALANCE IS LESS THAN ZERO'.            
      *                                                                         
       01  RS-RPC-RETURN-CODE.                                          
           05  RS-RETURN-CODE          PIC S9(04) COMP VALUE 0.         
           05  RS-RETURN-CODE-DISP     PIC +Z(04).                      
      *                                                                         
           EXEC SQL                                                             
               INCLUDE CWS00038                                                 
           END-EXEC.                                                            
      *                                                                         
           EXEC SQL                                                             
              INCLUDE CWS00013                                                  
           END-EXEC.                                                            
      *                                                                         
       COPY CWS09900.                                                           
      *                                                                         
       COPY CWS0070B.                                                           
      *                                                                         
       COPY CWS00056.                                                           
      *                                                                         
       COPY CWS00010.                                                           
      *                                                                         
       COPY CWS00303.                                                           
      *                                                                         
      ** GL NEUMONICS                                                           
       COPY CWS00061.                                                           
      *                                                                         
       COPY FIOJC01.                                                            
      *                                                                         
       COPY CJF00101.                                                           
      *                                                                         
       01  CURRENT-DATE                PIC X(10).                       
      *                                                                         
       01  WS-DATE-IN                  PIC X(10).                       
      *                                                                         
       01  WS-JOB-PARM-DATA.                                            
           05  WS-BEGIN-DATE-MSSG      PIC X(13).                       
           05  WS-BEGIN-DATE           PIC X(10).                       
           05  WS-BEGIN-DATE-R REDEFINES WS-BEGIN-DATE.                 
               10  WS-BEGIN-DATE-YR-R  PIC 9(4).                        
               10  FILLER              PIC X(1).                        
               10  WS-BEGIN-DATE-MM-R  PIC 9(2).                        
               10  FILLER              PIC X(1).                        
               10  WS-BEGIN-DATE-DD-R  PIC 9(2).                        
           05  FILLER                  PIC X(17).                       
           05  WS-END-DATE-MSSG        PIC X(11).                       
           05  WS-END-DATE             PIC X(10).                       
           05  WS-END-DATE-R REDEFINES WS-END-DATE.                     
               10  WS-END-DATE-YR-R    PIC 9(4).                        
               10  FILLER              PIC X(1).                        
               10  WS-END-DATE-MM-R    PIC 9(2).                        
               10  FILLER              PIC X(1).                        
               10  WS-END-DATE-DD-R    PIC 9(2).                        
           05  FILLER                  PIC X(19).                       
      *                                                                         
       01  WS-LITERALS.                                                 
           05  WS-N                    PIC X(01)     VALUE 'N'.         
           05  WS-Y                    PIC X(01)     VALUE 'Y'.         
           05  WS-PGRMNAME             PIC X(08)     VALUE 'PCSCA894'.  
           05  PROGRAM-NAME            PIC X(08)     VALUE 'PCSCA894'.  
           05  WS-CASH-COMPANY-NO      PIC X(02)     VALUE '01'.        
           05  WS-CASH-REPORT-NO       PIC X(03)     VALUE SPACES.      
           05  WS-CASH-LOCAL-OFFICE    PIC X(03)     VALUE SPACES.      
           05  WS-CASH-DRAWER-ID       PIC 9(04)     VALUE ZERO.        
           05  WS-SYSTEM               PIC X(07)     VALUE 'SYSTEM'.    
           05  WS-AR-REC-EXISTS        PIC X(01)     VALUE 'N'.         
      *                                                                         
       01  WS-COMPANY-NUMBER           PIC X(02).                       
           88 VALID-COMPANY                          VALUE '01' '26'.   
      *                                                                         
       01  WS-TOTALS.                                                   
           05  WS-FB-TOTAL-AMT       PIC -(11).99 VALUE ZERO.           
           05  WS-WO-TOTAL-AMT       PIC -(11).99 VALUE ZERO.           
           05  WS-AC-UNUSED-CR       PIC S9(09)V99 VALUE ZERO.          
      *                                                                         
       01  WS-RECORDS-WRITTEN-COUNTERS.                                 
           05  WS-FB-ACCOUNTS-CTR      PIC S9(07) COMP-3 VALUE ZERO.    
           05  WS-WO-ACCOUNTS-CTR      PIC S9(07) COMP-3 VALUE ZERO.    
           05  WS-FB-REC-CTR           PIC S9(07) COMP-3 VALUE ZERO.    
           05  WS-WO-REC-CTR           PIC S9(07) COMP-3 VALUE ZERO.    
      *                                                                         
       01  WS-COMMIT-REC-CNTR          PIC S9(07)     COMP-3 VALUE 0.   
       01  WS-COMMIT-COUNTER           PIC 9(9)              VALUE 0.   
       01  WS-COMMIT-UPPER-LIMIT       PIC 9(9)            VALUE 100.   
      *                                                                         
           EXEC SQL                                                             
               INCLUDE SQLCA                                                    
           END-EXEC.                                                            
      *                                                                         
      **** CSS_ACCOUNT AT ****                                                  
      *                                                                         
           EXEC SQL                                                             
               INCLUDE TBACCT                                                   
           END-EXEC.                                                            
      *                                                                         
      **** CSS_AR_CNTL AC ****                                                  
      *                                                                         
           EXEC SQL                                                             
               INCLUDE TBARCNTL                                                 
           END-EXEC.                                                            
      *                                                                         
      **** CSS_JOB_PARM G6 ****                                                 
      *                                                                         
           EXEC SQL                                                             
               INCLUDE TBJBPARM                                                 
           END-EXEC.                                                            
      *                                                                         
      **** CSS_AR_TRANS_HIST AR  ****                                           
      *                                                                         
           EXEC SQL                                                             
               INCLUDE TBARHIST                                                 
           END-EXEC.                                                            
      *                                                                         
      **** CSS_AR_TRN_HST_DET AU ****                                           
      *                                                                         
           EXEC SQL                                                             
               INCLUDE TBARHDT                                                  
           END-EXEC.                                                            
      *                                                                         
      **** CSS_GL_ACCT_NO GO ****                                               
      *                                                                         
           EXEC SQL                                                             
               INCLUDE TBGLATNO                                                 
           END-EXEC.                                                            
      *                                                                         
      **** CSS_BATCH_JRNL BJ ****                                               
      *                                                                         
           EXEC SQL                                                             
               INCLUDE TBBTJRNL                                                 
           END-EXEC.                                                            
      *                                                                         
      **** CSS_BCH_JRNL_CNTL BC ****                                            
      *                                                                         
           EXEC SQL                                                             
               INCLUDE TBBJCNTL                                                 
           END-EXEC.                                                            
      *                                                                         
      **** CSS_MISC_JRNL MJ ****                                                
      *                                                                         
           EXEC SQL                                                             
               INCLUDE TBMSJRNL                                                 
           END-EXEC.                                                            
      *                                                                         
      **** CSS_TAX_CNTL TC ****                                                 
      *                                                                         
           EXEC SQL                                                             
               INCLUDE TBTXCNTL                                                 
           END-EXEC.                                                            
      *                                                                         
      ***** CSS_PREMISE   PR ****                                               
      *                                                                         
           EXEC SQL                                                             
                INCLUDE TBPREM                                                  
           END-EXEC.                                                            
      *                                                                         
      ***** CSS_CHRG_OFF  C0 ****                                               
      *                                                                         
           EXEC SQL                                                             
                INCLUDE TBCHGOFF                                                
           END-EXEC.                                                            
      *                                                                         
      ***** CSS_CUSTOMER  CU ****                                               
      *                                                                         
           EXEC SQL                                                             
                INCLUDE TBCUST                                                  
           END-EXEC.                                                            
      *                                                                         
      ***** CSS_NAME      DQ ****                                               
      *                                                                         
           EXEC SQL                                                             
                INCLUDE TBNAME                                                  
           END-EXEC.                                                            
      *                                                                         
       01 WS-END                       PIC X(40)     VALUE              
             'WORKING STORAGE FOR PCSCA894 ENDS HERE'.                  
      *                                                                         
      ******************************************************************        
      * CURSOR DECLARATIONS                                                     
      ******************************************************************        
      *                                                                         
           EXEC SQL                                                     
               DECLARE FB_ACCOUNTS_CSR CURSOR WITH HOLD FOR             
                 SELECT DISTINCT AT.ACCOUNT_NO,                         
                        AT.COMPANY_NO,                                  
                        AT.PREMISE_NO,                                  
                        AT.CUSTOMER_NO,                                 
                        AT.CODE_ACCT_STAT,                              
                        AT.CODES_DATA_PRESENT,                          
                        REPLACE(REPLACE(CONVERT(CHAR(26), 
           AT.ACCT_FINALED_DT, 121), ' ', '-'), ':', '.') 
           ACCT_FINALED_DT,                             
                        AT.LOCAL_OFFICE,                                
                        AT.TOTAL_AR_BALANCE,                            
                        AC.AMT_UNUSED_CR,                               
                        DQ.FIRST_NAME,                                  
                        DQ.MIDDLE_NAME,                                 
                        DQ.LAST_NAME,                                   
                        DQ.FULL_NAME,                                   
                        AR.DATE_TRANS                                   
                   FROM CSS_ACCOUNT AT WITH(READUNCOMMITTED),                   
                        CSS_AR_CNTL AC WITH(READUNCOMMITTED),                   
                        CSS_CUSTOMER CU WITH(READUNCOMMITTED),                  
                        CSS_NAME     DQ WITH(READUNCOMMITTED),                  
                        CSS_AR_TRANS_HIST AR WITH(READUNCOMMITTED)              
                  WHERE AT.ACCOUNT_NO        = AC.ACCOUNT_NO            
                    AND AT.ACCOUNT_NO        = AR.ACCOUNT_NO            
                    AND AT.CUSTOMER_NO       = CU.CUSTOMER_NO           
                    AND CU.NAME_ID           = DQ.NAME_ID               
                    AND AT.CODE_ACCT_STAT    = 'B'                      
                    AND AC.PYMT_PRIORITY_LVL = 70                       
                    AND AC.ITEM_ID           = 01                       
                    AND AC.AMT_UNUSED_CR     < 0                        
                    AND AT.TOTAL_AR_BALANCE  < 0                        
                    AND CAST(AT.ACCT_FINALED_DT AS DATE) <= 
              IIF(TRY_CONVERT(DATE, :WS-END-DATE
              ) IS NULL OR (PATINDEX('%.%', :WS-END-DATE
              ) <> 0) OR (LEN(:WS-END-DATE) <> 10), CIS.CHAR2DATE(
                                                           :WS-END-DATE
              ), CONVERT(DATE, :WS-END-DATE) )        
                    AND AR.TRANS_HIST_SEQ_NO =                          
                        (SELECT MAX(A1.TRANS_HIST_SEQ_NO)               
                           FROM CSS_AR_TRANS_HIST A1
                           WITH(READUNCOMMITTED)                    
                          WHERE AT.ACCOUNT_NO = A1.ACCOUNT_NO)          
                    AND AR.DATE_TRANS <= IIF(TRY_CONVERT(DATE, 
                                                           :WS-END-DATE
              ) IS NULL OR (PATINDEX('%.%', :WS-END-DATE
              ) <> 0) OR (LEN(:WS-END-DATE) <> 10), CIS.CHAR2DATE(
                                                           :WS-END-DATE
              ), CONVERT(DATE, :WS-END-DATE) )                   
                    AND AT.COMPANY_NO = :WS-SYSIN-COMP-NO               
                  ORDER BY ACCT_FINALED_DT, AT.ACCOUNT_NO            
                  FOR READ ONLY                                        
                                                                 
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ004
MFA-TR* MSQ022
MFA-TR* MSQ029
MFA-TR* MSQ054
MFA-TR* MSQ061
MFA-TR*    EXEC SQL                                                             
MFA-TR*        DECLARE FB_ACCOUNTS_CSR CURSOR WITH HOLD FOR                     
MFA-TR*          SELECT DISTINCT AT.ACCOUNT_NO,                                 
MFA-TR*                 AT.COMPANY_NO,                                          
MFA-TR*                 AT.PREMISE_NO,                                          
MFA-TR*                 AT.CUSTOMER_NO,                                         
MFA-TR*                 AT.CODE_ACCT_STAT,                                      
MFA-TR*                 AT.CODES_DATA_PRESENT,                                  
MFA-TR*                 AT.ACCT_FINALED_DT,                                     
MFA-TR*                 AT.LOCAL_OFFICE,                                        
MFA-TR*                 AT.TOTAL_AR_BALANCE,                                    
MFA-TR*                 AC.AMT_UNUSED_CR,                                       
MFA-TR*                 DQ.FIRST_NAME,                                          
MFA-TR*                 DQ.MIDDLE_NAME,                                         
MFA-TR*                 DQ.LAST_NAME,                                           
MFA-TR*                 DQ.FULL_NAME,                                           
MFA-TR*                 AR.DATE_TRANS                                           
MFA-TR*            FROM CSS_ACCOUNT AT,                                         
MFA-TR*                 CSS_AR_CNTL AC,                                         
MFA-TR*                 CSS_CUSTOMER CU,                                        
MFA-TR*                 CSS_NAME     DQ,                                        
MFA-TR*                 CSS_AR_TRANS_HIST AR                                    
MFA-TR*           WHERE AT.ACCOUNT_NO        = AC.ACCOUNT_NO                    
MFA-TR*             AND AT.ACCOUNT_NO        = AR.ACCOUNT_NO                    
MFA-TR*             AND AT.CUSTOMER_NO       = CU.CUSTOMER_NO                   
MFA-TR*             AND CU.NAME_ID           = DQ.NAME_ID                       
MFA-TR*             AND AT.CODE_ACCT_STAT    = 'B'                              
MFA-TR*             AND AC.PYMT_PRIORITY_LVL = 70                               
MFA-TR*             AND AC.ITEM_ID           = 01                               
MFA-TR*             AND AC.AMT_UNUSED_CR     < 0                                
MFA-TR*             AND AT.TOTAL_AR_BALANCE  < 0                                
MFA-TR*             AND DATE(AT.ACCT_FINALED_DT) <= :WS-END-DATE                
MFA-TR*             AND AR.TRANS_HIST_SEQ_NO =                                  
MFA-TR*                 (SELECT MAX(A1.TRANS_HIST_SEQ_NO)                       
MFA-TR*                    FROM CSS_AR_TRANS_HIST A1                            
MFA-TR*                   WHERE AT.ACCOUNT_NO = A1.ACCOUNT_NO)                  
MFA-TR*             AND AR.DATE_TRANS <= :WS-END-DATE                           
MFA-TR*             AND AT.COMPANY_NO = :WS-SYSIN-COMP-NO                       
MFA-TR*           ORDER BY AT.ACCT_FINALED_DT, AT.ACCOUNT_NO                    
MFA-TR*           FOR FETCH ONLY                                                
MFA-TR*           WITH UR                                                       
MFA-TR*    END-EXEC.                                                            
                                                                        
           EXEC SQL                                                     
               DECLARE WO_ACCOUNTS_CSR CURSOR WITH HOLD FOR             
                 SELECT DISTINCT AT.ACCOUNT_NO,                         
                        AT.COMPANY_NO,                                  
                        AT.PREMISE_NO,                                  
                        AT.CUSTOMER_NO,                                 
                        AT.CODE_ACCT_STAT,                              
                        AT.CODES_DATA_PRESENT,                          
                        AT.LOCAL_OFFICE,                                
                        AT.TOTAL_AR_BALANCE,                            
                        AC.AMT_UNUSED_CR,                               
                        CO.DATE_OF_CHG_OFF,                             
                        DQ.FIRST_NAME,                                  
                        DQ.MIDDLE_NAME,                                 
                        DQ.LAST_NAME,                                   
                        DQ.FULL_NAME,                                   
                        AR.DATE_TRANS                                   
                   FROM CSS_ACCOUNT AT WITH(READUNCOMMITTED),                   
                        CSS_AR_CNTL AC WITH(READUNCOMMITTED),                   
                        CSS_CHRG_OFF CO WITH(READUNCOMMITTED),                  
                        CSS_CUSTOMER CU WITH(READUNCOMMITTED),                  
                        CSS_NAME    DQ WITH(READUNCOMMITTED),                   
                        CSS_AR_TRANS_HIST AR WITH(READUNCOMMITTED)              
                  WHERE AT.ACCOUNT_NO        = AC.ACCOUNT_NO            
                    AND AT.ACCOUNT_NO        = CO.ACCOUNT_NO            
                    AND AT.ACCOUNT_NO        = AR.ACCOUNT_NO            
                    AND AT.CUSTOMER_NO       = CU.CUSTOMER_NO           
                    AND CU.NAME_ID           = DQ.NAME_ID               
                    AND AC.PYMT_PRIORITY_LVL = 70                       
                    AND AT.CODE_ACCT_STAT    = 'S'                      
                    AND AC.ITEM_ID           = 01                       
                    AND AC.AMT_UNUSED_CR     < 0                        
                    AND AT.TOTAL_AR_BALANCE  < 0                        
                    AND CO.DATE_OF_CHG_OFF   <= IIF(TRY_CONVERT(DATE, 
                                                           :WS-END-DATE
              ) IS NULL OR (PATINDEX('%.%', :WS-END-DATE
              ) <> 0) OR (LEN(:WS-END-DATE) <> 10), CIS.CHAR2DATE(
                                                           :WS-END-DATE
              ), CONVERT(DATE, :WS-END-DATE) )            
                    AND AR.TRANS_HIST_SEQ_NO =                          
                        (SELECT MAX(A1.TRANS_HIST_SEQ_NO)               
                           FROM CSS_AR_TRANS_HIST A1
                           WITH(READUNCOMMITTED)                    
                          WHERE AT.ACCOUNT_NO = A1.ACCOUNT_NO)          
                    AND AR.DATE_TRANS <= IIF(TRY_CONVERT(DATE, 
                                                           :WS-END-DATE
              ) IS NULL OR (PATINDEX('%.%', :WS-END-DATE
              ) <> 0) OR (LEN(:WS-END-DATE) <> 10), CIS.CHAR2DATE(
                                                           :WS-END-DATE
              ), CONVERT(DATE, :WS-END-DATE) )                   
                    AND AT.COMPANY_NO = :WS-SYSIN-COMP-NO               
                  ORDER BY CO.DATE_OF_CHG_OFF, AT.ACCOUNT_NO            
                  FOR READ ONLY                                        
                                                                 
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ004
MFA-TR* MSQ022
MFA-TR* MSQ054
MFA-TR*    EXEC SQL                                                             
MFA-TR*        DECLARE WO_ACCOUNTS_CSR CURSOR WITH HOLD FOR                     
MFA-TR*          SELECT DISTINCT AT.ACCOUNT_NO,                                 
MFA-TR*                 AT.COMPANY_NO,                                          
MFA-TR*                 AT.PREMISE_NO,                                          
MFA-TR*                 AT.CUSTOMER_NO,                                         
MFA-TR*                 AT.CODE_ACCT_STAT,                                      
MFA-TR*                 AT.CODES_DATA_PRESENT,                                  
MFA-TR*                 AT.LOCAL_OFFICE,                                        
MFA-TR*                 AT.TOTAL_AR_BALANCE,                                    
MFA-TR*                 AC.AMT_UNUSED_CR,                                       
MFA-TR*                 CO.DATE_OF_CHG_OFF,                                     
MFA-TR*                 DQ.FIRST_NAME,                                          
MFA-TR*                 DQ.MIDDLE_NAME,                                         
MFA-TR*                 DQ.LAST_NAME,                                           
MFA-TR*                 DQ.FULL_NAME,                                           
MFA-TR*                 AR.DATE_TRANS                                           
MFA-TR*            FROM CSS_ACCOUNT AT,                                         
MFA-TR*                 CSS_AR_CNTL AC,                                         
MFA-TR*                 CSS_CHRG_OFF CO,                                        
MFA-TR*                 CSS_CUSTOMER CU,                                        
MFA-TR*                 CSS_NAME    DQ,                                         
MFA-TR*                 CSS_AR_TRANS_HIST AR                                    
MFA-TR*           WHERE AT.ACCOUNT_NO        = AC.ACCOUNT_NO                    
MFA-TR*             AND AT.ACCOUNT_NO        = CO.ACCOUNT_NO                    
MFA-TR*             AND AT.ACCOUNT_NO        = AR.ACCOUNT_NO                    
MFA-TR*             AND AT.CUSTOMER_NO       = CU.CUSTOMER_NO                   
MFA-TR*             AND CU.NAME_ID           = DQ.NAME_ID                       
MFA-TR*             AND AC.PYMT_PRIORITY_LVL = 70                               
MFA-TR*             AND AT.CODE_ACCT_STAT    = 'S'                              
MFA-TR*             AND AC.ITEM_ID           = 01                               
MFA-TR*             AND AC.AMT_UNUSED_CR     < 0                                
MFA-TR*             AND AT.TOTAL_AR_BALANCE  < 0                                
MFA-TR*             AND CO.DATE_OF_CHG_OFF   <= :WS-END-DATE                    
MFA-TR*             AND AR.TRANS_HIST_SEQ_NO =                                  
MFA-TR*                 (SELECT MAX(A1.TRANS_HIST_SEQ_NO)                       
MFA-TR*                    FROM CSS_AR_TRANS_HIST A1                            
MFA-TR*                   WHERE AT.ACCOUNT_NO = A1.ACCOUNT_NO)                  
MFA-TR*             AND AR.DATE_TRANS <= :WS-END-DATE                           
MFA-TR*             AND AT.COMPANY_NO = :WS-SYSIN-COMP-NO                       
MFA-TR*           ORDER BY CO.DATE_OF_CHG_OFF, AT.ACCOUNT_NO                    
MFA-TR*           FOR FETCH ONLY                                                
MFA-TR*           WITH UR                                                       
MFA-TR*    END-EXEC.                                                            
                                                                        
       PROCEDURE DIVISION.                                              
      *                                                                         
      ****************************************************************          
      **                                                            **          
      **  0000-MAINLINE                                             **          
      **       CONTROLS THE MAIN PROCESS OF PROGRAM                 **          
      **                                                            **          
      ****************************************************************          
      *                                                                         
       0000-MAINLINE.                                                   
      *                                                                         
                                                                        
           PERFORM 0100-INITIALIZATION           THRU 0100-EXIT.        
                                                                        
           PERFORM 1000-MAIN-PROCESS             THRU 1000-EXIT.        
                                                                        
           PERFORM 8100-UPDATE-JOB-PARM-TABLE THRU 8100-EXIT.           
                                                                        
           PERFORM 9000-TERMINATE                THRU 9000-EXIT.        
                                                                        
           STOP RUN.                                                    
      *                                                                         
       0000-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ****************************************************************          
      **  0100-INITIALIZATION                                       **          
      **       COMMON INITIALIZATION ROUTINE                        **          
      **                                                            **          
      ****************************************************************          
      *                                                                         
       0100-INITIALIZATION.                                             
      *                                                                         
           ACCEPT WS-SYSIN-COMP-NO FROM SYSIN.                          
                                                                        
           IF WS-SYSIN-COMP-NO = SPACES                                 
              DISPLAY '***********************************'             
              DISPLAY '** INVALID SYSIN COMPANY NUMBER'                 
              DISPLAY '** CHECK SYSIN DSN MEMBER IN JCL'                
              DISPLAY '** AND RERUN. NO PROCESSING DONE'                
              DISPLAY '** PROCESSING TERMINATED'                        
              DISPLAY '***********************************'             
              PERFORM 9900-ABEND THRU 9900-EXIT                         
           END-IF.                                                      
                                                                        
           MOVE  WS-SYSIN-COMP-NO TO WS-COMPANY-NUMBER.                 
                                                                        
           IF  VALID-COMPANY                                            
               NEXT SENTENCE                                            
           ELSE                                                         
               DISPLAY '***************************************'        
               DISPLAY '** AT COMPANY NO DOES NOT MATCH SYSIN '         
               DISPLAY '** CHECK SYSIN DSN MEMBER IN JCL'               
               DISPLAY '** AND RERUN. NO PROCESSING DONE'               
               DISPLAY '** PROCESSING TERMINATED'                       
               DISPLAY '***************************************'        
               PERFORM 9900-ABEND THRU 9900-EXIT                        
           END-IF.                                                      
                                                                        
           OPEN OUTPUT FCSRP894-FILE.                                   
                                                                        
           IF FRP894-SUCCESSFUL                                         
              NEXT SENTENCE                                             
           ELSE                                                         
              DISPLAY '*********************************************'   
              DISPLAY '**       PCSCA894 PROCESSING ERROR         **'   
              DISPLAY '     OPEN ERROR ON FCSRP894 OUTPUT FILE'         
              DISPLAY '     FILE STATUS = ' WS-FRP894-STATUS            
              DISPLAY '**         PROCESSING TERMINATED           **'   
              DISPLAY '*********************************************'   
              PERFORM 9900-ABEND THRU 9900-EXIT                         
           END-IF.                                                      
                                                                        
           INITIALIZE FRP894-DATA-REC.                                  
                                                                        
           PERFORM 0105-PROGRAM-JOB-PARMS THRU 0105-EXIT.               
                                                                        
           PERFORM 7000-OPEN-FBACCT-CSR THRU 7000-EXIT.                 
           PERFORM 7010-FETCH-FB-ACCTS  THRU 7010-EXIT.                 
           IF WS-END-ACCOUNT-CUR                                        
              DISPLAY ' '                                               
              DISPLAY '**  NO FB ACCOUNTS FOUND       **'               
              DISPLAY ' '                                               
           END-IF.                                                      
      *                                                                         
                                                                        
       0100-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ****************************************************************          
      **  0105-PROGRAM-JOB-PARMS                                    **          
      **       SELECTS JOB PARM INFORMATION                         **          
      **                                                            **          
      ****************************************************************          
      *                                                                         
       0105-PROGRAM-JOB-PARMS.                                          
      *                                                                         
           MOVE SPACES TO WS-SYSIPT.                                    
           MOVE WS-PGRMNAME TO WS-PROGRAM.                              
           MOVE WS-PARM     TO WS-COMMAND.                              
           MOVE ZEROS       TO WS-SEQUENCE.                             
                                                                        
           PERFORM 7600-START-FCSJC01  THRU  7600-EXIT.                 
      *                                                                         
      ****************************************************************          
      **  GET BEGIN AND END DATE FROM JOB PARM                      **          
      ****************************************************************          
      *                                                                         
           PERFORM 7610-READ-FCSJC01   THRU  7610-EXIT                  
               UNTIL (WS-INPUT-DATA-BREAKDOWN(1:6) = 'BEGIN ')          
                  OR  END-OF-SYSIPT.                                    
                                                                        
           MOVE G6-PARM-DATA       TO WS-JOB-PARM-DATA.                 
                                                                        
           EVALUATE TRUE                                                
              WHEN END-OF-SYSIPT                                        
                 DISPLAY ' '                                            
                 DISPLAY '**  PCSAC163 PROCESSING INFO   **'            
                 DISPLAY '**  BEGIN AND END DATE NOT PRESENT'           
                 PERFORM 7611-CLOSE THRU 7611-EXIT                      
                 PERFORM 9900-ABEND  THRU  9900-EXIT                    
              WHEN OTHER                                                
                 DISPLAY ' '                                            
                 DISPLAY '**  PCSAC163 PROCESSING INFO  **'             
                 DISPLAY '**  WS-JOB-PARM-DATA = ' WS-JOB-PARM-DATA     
           END-EVALUATE.                                                
      *                                                                         
       0105-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ****************************************************************          
      **  1000-MAIN-PROCESS                                         **          
      **       PROCESS THE CURSORS FOR WO AND FB ACCOUNTS           **          
      **                                                            **          
      ****************************************************************          
      *                                                                         
       1000-MAIN-PROCESS.                                               
      *                                                                         
           PERFORM 2000-PROCESS-CREDITS  THRU 2000-EXIT UNTIL           
              WS-END-ACCOUNT-CUR.                                       
           PERFORM 7020-CLOSE-FB-ACCTS-CSR THRU 7020-EXIT.              
                                                                        
           SET WS-NOT-END-ACCOUNT-CUR TO TRUE.                          
           PERFORM 7030-OPEN-WOACCT-CSR THRU 7030-EXIT.                 
           PERFORM 7040-FETCH-WO-ACCTS  THRU 7040-EXIT.                 
           IF WS-END-ACCOUNT-CUR                                        
              DISPLAY ' '                                               
              DISPLAY '**  NO WO ACCOUNTS FOUND       **'               
              DISPLAY ' '                                               
           END-IF.                                                      
           PERFORM 2000-PROCESS-CREDITS  THRU 2000-EXIT UNTIL           
              WS-END-ACCOUNT-CUR.                                       
           PERFORM 7050-CLOSE-WO-ACCTS-CSR THRU 7050-EXIT.              
                                                                        
      *                                                                         
       1000-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ****************************************************************          
      **  2000-PROCESS-CREDITS                                      **          
      ****************************************************************          
      *                                                                         
       2000-PROCESS-CREDITS.                                            
      *                                                                         
           MOVE AT-ACCOUNT-NO         TO  FRP894-ACCOUNT-NO.            
           MOVE DQ-FIRST-NAME         TO  FRP894-FIRST-NAME.            
           MOVE DQ-MIDDLE-NAME        TO  FRP894-MIDDLE-NAME.           
           MOVE DQ-LAST-NAME          TO  FRP894-LAST-NAME.             
           MOVE AT-CODE-ACCT-STAT     TO  FRP894-ACCT-STAT-CD.          
           MOVE PR-REV-DISTRICT-CD    TO  FRP894-FBWO-DATE.             
           MOVE AC-AMT-UNUSED-CR      TO  FRP894-FBWO-AMOUNT.           
           MOVE AR-DATE-TRANS         TO  FRP894-DATE-TRANS.            
           IF DQ-FIRST-NAME = SPACES AND DQ-LAST-NAME = SPACES          
              MOVE DQ-FULL-NAME          TO  FRP894-FULL-NAME           
           END-IF.                                                      
           IF AT-CODE-ACCT-STAT = 'B'                                   
               MOVE AT-ACCT-FINALED-DT(1:10)                            
                                      TO   FRP894-FBWO-DATE             
               ADD  AC-AMT-UNUSED-CR  TO WS-AC-UNUSED-CR                
               MOVE WS-AC-UNUSED-CR   TO WS-FB-TOTAL-AMT                
           ELSE                                                         
               MOVE CO-DATE-OF-CHG-OFF TO FRP894-FBWO-DATE              
               ADD AC-AMT-UNUSED-CR  TO WS-AC-UNUSED-CR                 
               MOVE WS-AC-UNUSED-CR  TO WS-WO-TOTAL-AMT                 
           END-IF.                                                      
                                                                        
           WRITE FRP894-DATA-REC.                                       
           IF AT-CODE-ACCT-STAT = 'B'                                   
               ADD 1                   TO WS-FB-REC-CTR                 
           ELSE                                                         
               ADD 1                   TO WS-WO-REC-CTR                 
           END-IF.                                                      
                                                                        
           INITIALIZE FRP894-DATA-REC.                                  
                                                                        
           MOVE AT-CODES-DATA-PRESENT TO WS-CODES-DATA-PRESENT.         
           MOVE SPACE TO WS-CODE-CIA.                                   
           MOVE WS-CODES-DATA-PRESENT TO AT-CODES-DATA-PRESENT.         
           MOVE ZERO TO AT-TOTAL-AR-BALANCE.                            
                                                                        
           PERFORM 2700-SETUP-JOURNAL-HDR      THRU 2700-EXIT.          
           PERFORM 2705-DELETE-AR-CNTL         THRU 2705-EXIT.          
                                                                        
           PERFORM 3005-CREATE-AR-TRAN-DET     THRU 3005-EXIT.          
           PERFORM 3025-CREATE-101-JRNL-ENTRY  THRU 3025-EXIT.          
                                                                        
           PERFORM 8000-UPDATE-ACCOUNT         THRU 8000-EXIT.          
                                                                        
           ADD 1                        TO WS-COMMIT-REC-CNTR.          
           IF WS-COMMIT-REC-CNTR  > WS-COMMIT-UPPER-LIMIT               
             ADD 1 TO WS-COMMIT-COUNTER                                 
             PERFORM 8898-ISSUE-CHKP  THRU  8898-EXIT                   
             DISPLAY 'COMMIT # ' WS-COMMIT-COUNTER ' TAKEN SUCESSFULLY.'
             MOVE ZEROES              TO  WS-COMMIT-REC-CNTR            
           END-IF.                                                      
                                                                        
           IF AT-CODE-ACCT-STAT = 'B'                                   
               PERFORM 7010-FETCH-FB-ACCTS THRU 7010-EXIT               
           ELSE                                                         
               PERFORM 7040-FETCH-WO-ACCTS THRU 7040-EXIT               
           END-IF.                                                      
                                                                        
      *                                                                         
       2000-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ****************************************************************          
      **  2700-SETUP-JOURNAL-HDR                                    **          
      ****************************************************************          
      *                                                                         
       2700-SETUP-JOURNAL-HDR.                                          
      *                                                                         
           MOVE 0                             TO AU-TRAN-APPL-NO.       
           PERFORM 3000-FMT-AR-TRANS-DTL      THRU 3000-EXIT.           
           PERFORM 3020-CREATE-100-JRNL       THRU 3020-EXIT.           
A05154     PERFORM 6510-INSERT-AR-TRANS-HIST  THRU 6510-EXIT.           
      *                                                                         
       2700-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ****************************************************************          
      ** 2705-DELETE-AR-CNTL                                        **          
      ****************************************************************          
      *                                                                         
       2705-DELETE-AR-CNTL.                                             
      *                                                                         
           MOVE AT-ACCOUNT-NO          TO AC-ACCOUNT-NO.                
           PERFORM 8300-DELETE-AR-CNTL THRU 8300-EXIT.                  
      *                                                                         
       2705-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ****************************************************************          
      **    3000-FMT-AR-TRANS-DTL.                                  **          
      **        FORMATS COMMON FIELDS FOR AR TRANS HIST             **          
      ****************************************************************          
      *                                                                         
       3000-FMT-AR-TRANS-DTL.                                           
      *                                                                         
           COMPUTE AC-AMT-UNUSED-CR = AC-AMT-UNUSED-CR * -1.            
           PERFORM 7270-SELECT-TIMESTAMP            THRU 7270-EXIT.     
           MOVE AT-ACCOUNT-NO          TO AR-ACCOUNT-NO.                
           MOVE WS-TIMESTAMP           TO AR-TRANS-HIST-SEQ-NO.         
A05154     MOVE CURRENT-DATE           TO AR-DATE-TRANS                 
A05154                                    AR-DATE-CASH-REPORT.          
           MOVE WS-PGRMNAME            TO AR-APPL-PROGRAM-ID.           
           MOVE WS-SYSTEM              TO AR-USER-ID.                   
           MOVE AT-COMPANY-NO          TO AR-COMPANY-NO.                
           MOVE SPACES                 TO AR-RECORD-ONLY-FL             
                                          AR-RESP-AREA-ID               
                                          AR-PYMT-FACILITY-CD           
                                          AR-DATE-ORIG-PYMT             
                                          AR-PYMT-REFUNDED-IND.         
A05154     MOVE -1                     TO WS-DATE-ORIG-PYMT-IND.        
           IF AT-COMPANY-NO = '01'                                      
               MOVE WS-TRANHIST-MSG1   TO AR-TRAN-COMMENT-TEXT          
               MOVE +89                TO AR-TRAN-COMMENT-LEN           
           ELSE                                                         
               MOVE WS-TRANHIST-MSG2   TO AR-TRAN-COMMENT-TEXT          
               MOVE +87                TO AR-TRAN-COMMENT-LEN           
           END-IF.                                                      
           MOVE AT-TOTAL-AR-BALANCE    TO AR-AMT-BILLED-UNPAID.         
           MOVE AC-AMT-UNUSED-CR       TO AR-AMT-ORIG-ENTERED.          
           MOVE WS-CASH-COMPANY-NO     TO AR-CASH-COMPANY-NO.           
           MOVE AT-LOCAL-OFFICE        TO AR-CASH-LOCAL-OFFICE          
                                          WS-CASH-LOCAL-OFFICE.         
           MOVE WS-CASH-REPORT-NO      TO AR-CASH-REPORT-NO.            
           MOVE WS-CASH-DRAWER-ID      TO AR-CASH-DRAWER-ID.            
           MOVE 'S'                    TO AR-CODE-TRAN-TYPE.            
      *                                                                         
       3000-EXIT.                                                       
            EXIT.                                                       
      *                                                                         
      **************************************************************            
      **    3005-CREATE-AR-TRAN-DET                               **            
      **************************************************************            
      *                                                                         
       3005-CREATE-AR-TRAN-DET.                                         
      *                                                                         
           MOVE AT-ACCOUNT-NO            TO AU-ACCOUNT-NO.              
           MOVE WS-TIMESTAMP             TO AU-TRANS-HIST-SEQ-NO.       
                                                                        
           ADD +1                        TO AU-TRAN-APPL-NO.            
           MOVE 'P'                      TO AU-CODE-AR-AGE.             
           MOVE SPACES                   TO AU-CODE-CONTRACT-TYPE.      
                                                                        
           MOVE AC-AMT-UNUSED-CR         TO AU-AMT-POSTED.              
           MOVE WS-GL-AR-CIA-KEY         TO GO-GL-ACCT-NAME.            
           PERFORM 7430-SELECT-GL-NO THRU 7430-EXIT.                    
           MOVE GO-GL-ACCT-NO            TO AU-GL-ACCT-DEBIT.           
           IF WS-SYSIN-COMP-NO = '01'                                   
             MOVE WS-GL-DEF-ESCHEA-KEY TO GO-GL-ACCT-NAME               
           ELSE                                                         
             MOVE WS-GL-DEF-ESCHNC-KEY TO GO-GL-ACCT-NAME               
           END-IF.                                                      
           PERFORM 7430-SELECT-GL-NO THRU 7430-EXIT.                    
           MOVE GO-GL-ACCT-NO TO AU-GL-ACCT-CREDIT.                     
                                                                        
                                                                        
           MOVE 1                    TO AU-ITEM-ID.                     
           MOVE SPACES               TO AU-CURRENCY-TYPE.               
           MOVE ZERO                 TO AU-CURRENCY-AMT.                
      *                                                                         
A05154     PERFORM 6520-INSERT-AR-TRANS-DETL THRU 6520-EXIT.            
      *                                                                         
       3005-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ***************************************************************           
      ** 3020-CREATE-100-JRNL                                      **           
      ***************************************************************           
      *                                                                         
       3020-CREATE-100-JRNL.                                            
      *                                                                         
           MOVE WS-CASH-COMPANY-NO   TO WS-JRNL-BT-BAT-COMPANY.         
           MOVE WS-CASH-LOCAL-OFFICE TO WS-JRNL-BT-BAT-LOC-OFF.         
           MOVE WS-CASH-REPORT-NO    TO WS-JRNL-BT-BAT-REPORT-NO.       
           MOVE CURRENT-DATE         TO WS-JRNL-BT-BAT-REPORT-DT.       
           MOVE WS-CASH-DRAWER-ID    TO WS-JRNL-BT-BAT-CASH-DRWR.       
           MOVE SPACES               TO WS-JRNL-BT-ENTRY-LOC            
                                        WS-JRNL-CURRENCY-TYPE           
                                        WS-JRNL-CODE-PYMT-FACILITY.     
                                                                        
           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-COMPANY-NO           TO WS-100-COMPANY-NO.           
           MOVE AT-PREMISE-NO           TO WS-100-PREMISE-NO.           
           MOVE 'A720'                  TO WS-100-CODE-TERMINAL-TRAN.   
           MOVE AU-TRAN-APPL-NO         TO WS-100-JRNL-TRAN-APPL-NO.    
           MOVE CURRENT-DATE            TO WS-100-DATE-LAST-ACTION.     
           MOVE 'B'                     TO WS-100-CODE-ENTRY-SOURCE.    
           MOVE AT-LOCAL-OFFICE         TO WS-100-LOCAL-OFFICE-CD.      
           MOVE SPACES                  TO WS-100-TRANS-ERRORS.         
                                                                        
           MOVE WS-JRNL-SELECT-AND-OR-INS TO WS-JRNL-OPERATION-RQST.    
           PERFORM 6400-BATCH-JRNL-ROUTINE            THRU 6400-EXIT.   
                                                                        
           MOVE 'B'                     TO WS-JRNL-SOURCE-CODE.         
           MOVE WS-JRNL-CASH-UPDATE     TO WS-JRNL-BT-AUTH-TYPE.        
                                                                        
      *                                                                         
       3020-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ***************************************************************           
      ** 3025-CREATE-101-JRNL-ENTRY                                **           
      ***************************************************************           
      *                                                                         
       3025-CREATE-101-JRNL-ENTRY.                                      
      *                                                                         
           INITIALIZE CJF00101.                                         
           MOVE AU-TRAN-APPL-NO        TO WS-100-JRNL-TRAN-APPL-NO.     
           MOVE 101                    TO WS-101-JRNL-FORMAT-NO.        
           MOVE 'X'                    TO WS-101-CASH-DRAWER-USED.      
           MOVE AC-AMT-UNUSED-CR       TO WS-101-AMOUNT-ENTERED.        
           MOVE AC-AMT-UNUSED-CR       TO WS-101-AMT-POSTED.            
           MOVE WS-GL-AR-CIA-KEY       TO GO-GL-ACCT-NAME.              
           PERFORM 7430-SELECT-GL-NO THRU 7430-EXIT.                    
           MOVE GO-GL-ACCT-NO          TO WS-101-ACCT-GEN-LED-DR.       
           IF WS-SYSIN-COMP-NO = '01'                                   
             MOVE WS-GL-DEF-ESCHEA-KEY TO GO-GL-ACCT-NAME               
           ELSE                                                         
             MOVE WS-GL-DEF-ESCHNC-KEY TO GO-GL-ACCT-NAME               
           END-IF.                                                      
           PERFORM 7430-SELECT-GL-NO THRU 7430-EXIT.                    
           MOVE GO-GL-ACCT-NO TO WS-101-ACCT-GEN-LED-CR.                
                                                                        
           MOVE WS-101-AMT-POSTED      TO WS-JRNL-CASH-DEBIT-AMT        
                                          WS-JRNL-GEN-LEG-CREDIT-AMT.   
           MOVE 'P'                    TO WS-101-AR-AGE.                
           MOVE CURRENT-DATE           TO WS-101-DATE-AR-BILLED.        
           MOVE 1                      TO WS-101-ITEM-ID-NO             
           MOVE 0                      TO WS-101-DETAIL-END-BAL,        
                                          WS-101-DETAIL-END-AR-BAL.     
           MOVE AT-TOTAL-AR-BALANCE    TO WS-101-ACCT-END-AR-BAL.       
           MOVE AT-CODE-COMPANY-ACCT   TO WS-101-CODE-COMPANY-ACCT.     
           MOVE AT-CODE-ACCT-STAT      TO WS-101-CODE-ACCOUNT-STATUS.   
           MOVE WS-N                   TO WS-UPDATE-JRNL-CNTL-NOW.      
           MOVE CJF00101               TO WS-100-USER-DEFINED-AREA.     
           MOVE WS-JRNL-ONLY           TO WS-JRNL-OPERATION-RQST.       
                                                                        
           PERFORM 6400-BATCH-JRNL-ROUTINE            THRU 6400-EXIT.   
                                                                        
           IF WS-JRNL-RTRN-CODE EQUAL SPACES                            
               NEXT SENTENCE                                            
           ELSE                                                         
               PERFORM 9700-PROCESS-ABEND             THRU 9700-EXIT    
           END-IF.                                                      
                                                                        
           MOVE WS-JRNL-CNTRL-ONLY    TO WS-JRNL-OPERATION-RQST         
                                                                        
           PERFORM 6400-BATCH-JRNL-ROUTINE            THRU 6400-EXIT.   
                                                                        
           IF WS-JRNL-RTRN-CODE EQUAL SPACES                            
               NEXT SENTENCE                                            
           ELSE                                                         
               PERFORM 9700-PROCESS-ABEND             THRU 9700-EXIT    
           END-IF.                                                      
                                                                        
      *                                                                         
       3025-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ****************************************************************          
      ** 6400-BATCH-JRNL-ROUTINE                                    **          
      ****************************************************************          
      *                                                                         
           EXEC SQL                                                             
               INCLUDE CPD00007                                                 
           END-EXEC.                                                            
      *                                                                         
      ****************************************************************          
A05154* 6500-ONLINE-LOAD-AR-TRAN-HIST - AR - AU                      *          
A05154* 6510-INSERT-AR-TRANS-HIST                                    *          
A05154* 6520-INSERT-AR-TRANS-DETL                                    *          
      ****************************************************************          
      *                                                                         
A05154     EXEC SQL                                                             
A05154         INCLUDE CPD00008                                                 
A05154     END-EXEC.                                                            
      *                                                                         
      ****************************************************************          
      ** 7000-OPEN-FBACCT-CSR                                       **          
      ****************************************************************          
      *                                                                         
       7000-OPEN-FBACCT-CSR.                                            
      *                                                                         
           EXEC SQL                                                     
               OPEN FB_ACCOUNTS_CSR                                     
           END-EXEC.                                                    

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

                                                                        
           MOVE SQLCODE TO WS-ACTIVE-RETURN-CODE.                       
                                                                        
           IF  WS-ACTIVE-RETURN-CODE NOT = SUCCESSFUL-CALL              
               DISPLAY '*******************************************'    
               DISPLAY '* 7000-OPEN-FBACCT-CSR'                         
               DISPLAY '* OPEN FB_ACCOUNTS_CSR'                         
               DISPLAY '* RETURN CODE    = ' WS-ACTIVE-RETURN-CODE      
               DISPLAY '*******************************************'    
               PERFORM 9900-ABEND      THRU 9900-EXIT                   
           END-IF.                                                      
      *                                                                         
       7000-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ****************************************************************          
      **  7010-FETCH-FB-ACCTS                                       **          
      **      FETCH THE FB ACCOUNTS FOR PROCESSING                  **          
      ****************************************************************          
      *                                                                         
       7010-FETCH-FB-ACCTS.                                             
      *                                                                         
           EXEC SQL                                                     
               FETCH FB_ACCOUNTS_CSR                                    
                INTO :AT-ACCOUNT-NO                                     
                    ,:AT-COMPANY-NO                                     
                    ,:AT-PREMISE-NO                                     
                    ,:AT-CUSTOMER-NO                                    
                    ,:AT-CODE-ACCT-STAT                                 
                    ,:AT-CODES-DATA-PRESENT                             
                    ,:AT-ACCT-FINALED-DT                                
                    ,:AT-LOCAL-OFFICE                                   
                    ,:AT-TOTAL-AR-BALANCE                               
                    ,:AC-AMT-UNUSED-CR                                  
                    ,:DQ-FIRST-NAME                                     
                    ,:DQ-MIDDLE-NAME                                    
                    ,:DQ-LAST-NAME                                      
                    ,:DQ-FULL-NAME                                      
                    ,:AR-DATE-TRANS                                     
           END-EXEC.                                                    

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

                                                                        
           MOVE SQLCODE                TO WS-ACTIVE-RETURN-CODE.        
                                                                        
           IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL                   
              ADD +1                   TO WS-FB-ACCOUNTS-CTR            
           ELSE                                                         
              IF WS-ACTIVE-RETURN-CODE = NOT-FOUND                      
                 SET WS-END-ACCOUNT-CUR TO TRUE                         
              ELSE                                                      
                 DISPLAY '*******************************************'  
                 DISPLAY '* 7010-FETCH-FB-ACCTS'                        
                 DISPLAY '* FETCH FB_ACCOUNTS_CSR'                      
                 DISPLAY '* RETURN CODE    = ' WS-ACTIVE-RETURN-CODE    
                 DISPLAY '* ACCOUNT NO     = ' AT-ACCOUNT-NO            
                 DISPLAY '*******************************************'  
                 PERFORM 9900-ABEND      THRU 9900-EXIT                 
              END-IF                                                    
           END-IF.                                                      
      *                                                                         
       7010-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ****************************************************************          
      **  7020-CLOSE-FB-ACCTS-CSR.                                  **          
      **      CLOSE THE FB_ACCOUNTS_CSR                             **          
      ****************************************************************          
      *                                                                         
       7020-CLOSE-FB-ACCTS-CSR.                                         
      *                                                                         
           EXEC SQL                                                     
               CLOSE FB_ACCOUNTS_CSR                                    
           END-EXEC.                                                    

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

                                                                        
           MOVE SQLCODE                TO WS-ACTIVE-RETURN-CODE.        
                                                                        
           IF WS-ACTIVE-RETURN-CODE NOT = SUCCESSFUL-CALL               
              DISPLAY '*******************************************'     
              DISPLAY '* 7020-CLOSE-FB-ACCTS'                           
              DISPLAY '* CLOSE FB_ACCOUNTS_CSR'                         
              DISPLAY '* RETURN CODE    = ' WS-ACTIVE-RETURN-CODE       
              DISPLAY '*******************************************'     
              PERFORM 9900-ABEND       THRU 9900-EXIT                   
           END-IF.                                                      
      *                                                                         
       7020-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ****************************************************************          
      ** 7030-OPEN-WOACCT-CSR                                       **          
      ****************************************************************          
      *                                                                         
       7030-OPEN-WOACCT-CSR.                                            
      *                                                                         
           EXEC SQL                                                     
               OPEN WO_ACCOUNTS_CSR                                     
           END-EXEC.                                                    

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

                                                                        
           MOVE SQLCODE TO WS-ACTIVE-RETURN-CODE.                       
                                                                        
           IF  WS-ACTIVE-RETURN-CODE NOT = SUCCESSFUL-CALL              
               DISPLAY '*******************************************'    
               DISPLAY '* 7030-OPEN-WOACCT-CSR'                         
               DISPLAY '* OPEN WO_ACCOUNTS_CSR'                         
               DISPLAY '* RETURN CODE    = ' WS-ACTIVE-RETURN-CODE      
               DISPLAY '*******************************************'    
               PERFORM 9900-ABEND      THRU 9900-EXIT                   
           END-IF.                                                      
      *                                                                         
       7030-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ****************************************************************          
      **  7040-FETCH-WO-ACCTS                                       **          
      **      FETCH THE WO ACCOUNTS FOR PROCESSING                  **          
      ****************************************************************          
      *                                                                         
       7040-FETCH-WO-ACCTS.                                             
      *                                                                         
           EXEC SQL                                                     
               FETCH WO_ACCOUNTS_CSR                                    
                INTO :AT-ACCOUNT-NO                                     
                    ,:AT-COMPANY-NO                                     
                    ,:AT-PREMISE-NO                                     
                    ,:AT-CUSTOMER-NO                                    
                    ,:AT-CODE-ACCT-STAT                                 
                    ,:AT-CODES-DATA-PRESENT                             
                    ,:AT-LOCAL-OFFICE                                   
                    ,:AT-TOTAL-AR-BALANCE                               
                    ,:AC-AMT-UNUSED-CR                                  
                    ,:CO-DATE-OF-CHG-OFF                                
                    ,:DQ-FIRST-NAME                                     
                    ,:DQ-MIDDLE-NAME                                    
                    ,:DQ-LAST-NAME                                      
                    ,:DQ-FULL-NAME                                      
                    ,:AR-DATE-TRANS                                     
           END-EXEC.                                                    

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

                                                                        
           MOVE SQLCODE                TO WS-ACTIVE-RETURN-CODE.        
                                                                        
           IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL                   
              ADD +1                   TO WS-WO-ACCOUNTS-CTR            
           ELSE                                                         
              IF WS-ACTIVE-RETURN-CODE = NOT-FOUND                      
                 SET WS-END-ACCOUNT-CUR TO TRUE                         
              ELSE                                                      
                 DISPLAY '*******************************************'  
                 DISPLAY '* 7040-FETCH-W0-ACCTS'                        
                 DISPLAY '* FETCH WO_ACCOUNTS_CSR'                      
                 DISPLAY '* RETURN CODE    = ' WS-ACTIVE-RETURN-CODE    
                 DISPLAY '* ACCOUNT NO     = ' AT-ACCOUNT-NO            
                 DISPLAY '*******************************************'  
                 PERFORM 9900-ABEND      THRU 9900-EXIT                 
              END-IF                                                    
           END-IF.                                                      
      *                                                                         
       7040-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ****************************************************************          
      **  7050-CLOSE-WO-ACCTS-CSR                                   **          
      **      CLOSE THE WO_ACCOUNTS_CSR                             **          
      ****************************************************************          
      *                                                                         
       7050-CLOSE-WO-ACCTS-CSR.                                         
      *                                                                         
           EXEC SQL                                                     
               CLOSE WO_ACCOUNTS_CSR                                    
           END-EXEC.                                                    

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

                                                                        
           MOVE SQLCODE                TO WS-ACTIVE-RETURN-CODE.        
                                                                        
           IF WS-ACTIVE-RETURN-CODE NOT = SUCCESSFUL-CALL               
              DISPLAY '*******************************************'     
              DISPLAY '* 7050-CLOSE-WO-ACCTS-CSR'                       
              DISPLAY '* CLOSE WO_ACCOUNTS_CSR'                         
              DISPLAY '* RETURN CODE    = ' WS-ACTIVE-RETURN-CODE       
              DISPLAY '*******************************************'     
              PERFORM 9900-ABEND       THRU 9900-EXIT                   
           END-IF.                                                      
      *                                                                         
       7050-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ****************************************************************          
      **  7270-SELECT-TIMESTAMP.                                    **          
      ****************************************************************          
      *                                                                         
       7270-SELECT-TIMESTAMP.                                           
      *                                                                         
           EXEC SQL                                                     
                SELECT
              REPLACE(REPLACE(CONVERT(CHAR(26), CIS.CURRENT$TIMESTAMP()
           , 121), ' ', '-'), ':', '.'),
              CAST(SYSDATETIMEOFFSET() AS DATE)
            INTO
              :WS-TIMESTAMP,
              :CURRENT-DATE                        
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ006
MFA-TR* MSQ028
MFA-TR* MSQ061
MFA-TR*    EXEC SQL                                                             
MFA-TR*         SET :WS-TIMESTAMP = CURRENT TIMESTAMP                           
MFA-TR*            ,:CURRENT-DATE = CURRENT DATE                                
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                                                         
               DISPLAY '*******************************************'    
               DISPLAY '* 7270-SELECT-TIMESTAMP'                        
               DISPLAY '* RETURN CODE    = ' WS-ACTIVE-RETURN-CODE      
               DISPLAY '*******************************************'    
               PERFORM 9900-ABEND                THRU 9900-EXIT         
           END-IF.                                                      
      *                                                                         
       7270-EXIT.                                                       
            EXIT.                                                       
      *                                                                         
      ****************************************************************          
      **  7430-SELECT-GL-NO.                                        **          
      **      SELECTS GL NO FROM THE PNEUMONICS.                    **          
      ****************************************************************          
      *                                                                         
       7430-SELECT-GL-NO.                                               
      *                                                                         
           EXEC SQL                                                     
               SELECT GL_ACCT_NO                                        
                 INTO :GO-GL-ACCT-NO                                    
                 FROM CSS_GL_ACCT_NO                                    
                WHERE GL_ACCT_NAME = :GO-GL-ACCT-NAME                   
                                                            
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ003
MFA-TR*    EXEC SQL                                                             
MFA-TR*        SELECT GL_ACCT_NO                                                
MFA-TR*          INTO :GO-GL-ACCT-NO                                            
MFA-TR*          FROM CSS_GL_ACCT_NO                                            
MFA-TR*         WHERE GL_ACCT_NAME = :GO-GL-ACCT-NAME                           
MFA-TR*         QUERYNO 7430                                                    
MFA-TR*    END-EXEC.                                                            

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

                                                                        
           MOVE SQLCODE TO WS-ACTIVE-RETURN-CODE.                       
           IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL                   
              NEXT SENTENCE                                             
           ELSE                                                         
              DISPLAY '*******************************************'     
              DISPLAY '* 7430-SELECT-GL-NO'                             
              DISPLAY '* RETURN CODE    = ' WS-ACTIVE-RETURN-CODE       
              DISPLAY '* GL ACCT N0     = ' GO-GL-ACCT-NO               
              DISPLAY '* GL ACCT NAME   = ' GO-GL-ACCT-NAME             
              DISPLAY '*******************************************'     
              PERFORM 9900-ABEND THRU 9900-EXIT                         
           END-IF.                                                      
      *                                                                         
       7430-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ****************************************************************          
      ** PARAGRAPH 7600-START-FCSJC01 IS IN CPD00038.               **          
      ****************************************************************          
      *                                                                         
            EXEC SQL                                                            
                 INCLUDE CPD00038                                               
            END-EXEC.                                                           
      *                                                                         
      ****************************************************************          
      **  8000-UPDATE-ACCOUNT                                       **          
      **      ACCOUNT TABLE IS UPDATED WITH SPACES FOR MED CERT     **          
      ****************************************************************          
      *                                                                         
       8000-UPDATE-ACCOUNT.                                             
      *                                                                         
           EXEC SQL                                                     
               UPDATE CSS_ACCOUNT                                       
                 SET TOTAL_AR_BALANCE   =  :AT-TOTAL-AR-BALANCE,        
                     CODES_DATA_PRESENT =  :AT-CODES-DATA-PRESENT       
               WHERE ACCOUNT_NO         =  :AT-ACCOUNT-NO               
           END-EXEC.                                                    

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

                                                                        
           MOVE SQLCODE  TO WS-ACTIVE-RETURN-CODE.                      
                                                                        
           IF WS-ACTIVE-RETURN-CODE EQUAL SUCCESSFUL-CALL OR NOT-FOUND  
               CONTINUE                                                 
           ELSE                                                         
               DISPLAY '******************************************'     
               DISPLAY '* 8000-UPDATE-ACCOUNT'                          
               DISPLAY '* RETURN CODE    = ' WS-ACTIVE-RETURN-CODE      
               DISPLAY '* ACCOUNT NO     = ' AT-ACCOUNT-NO              
               DISPLAY '******************************************'     
               PERFORM 9900-ABEND                THRU 9900-EXIT         
           END-IF.                                                      
      *                                                                         
       8000-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ****************************************************************          
      ** 8100-UPDATE-JOB-PARM-TABLE.                                **          
      **   INCREMENTS YEAR ON JOB PARM TABLE FOR START DATE AND END **          
      **   DATE.                                                    **          
      ****************************************************************          
      *                                                                         
       8100-UPDATE-JOB-PARM-TABLE.                                      
      *                                                                         
           ADD 1 TO WS-BEGIN-DATE-YR-R.                                 
           ADD 1 TO WS-END-DATE-YR-R.                                   
           MOVE WS-JOB-PARM-DATA TO G6-PARM-DATA.                       
           MOVE 'PARM' TO G6-CMND-CODE.                                 
           MOVE 0001 TO G6-SEQ-NO.                                      
                                                                        
           EXEC SQL                                                     
             UPDATE CSS_JOB_PARM                                        
                SET PARM_DATA    = :G6-PARM-DATA                        
              WHERE COMPANY_NO   = :WS-SYSIN-COMP-NO                    
                AND PROGRAM_NAME = :PROGRAM-NAME                        
                AND CMND_CODE    = :G6-CMND-CODE                        
                AND SEQ_NO       = :G6-SEQ-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 SQLCODE = SUCCESSFUL-CALL                                 
               NEXT SENTENCE                                            
           ELSE                                                         
               DISPLAY '*************************************'          
               DISPLAY '* 8100-UPDATE-JOB-PARM-TABLE'                   
               DISPLAY '* RETURN CODE  = ' WS-ACTIVE-RETURN-CODE        
               DISPLAY '* PARM DATA    = ' G6-PARM-DATA                 
               DISPLAY '* COMPANY NO   = ' WS-SYSIN-COMP-NO             
               DISPLAY '*************************************'          
               PERFORM 9900-ABEND THRU 9900-EXIT                        
           END-IF.                                                      
                                                                        
       8100-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ****************************************************************          
      **    8300-DELETE-AR-CNTL                                     **          
      ****************************************************************          
      *                                                                         
       8300-DELETE-AR-CNTL.                                             
      *                                                                         
           EXEC SQL                                                     
               DELETE FROM CSS_AR_CNTL                                  
               WHERE                                                    
                   ACCOUNT_NO        = :AC-ACCOUNT-NO                   
               AND PYMT_PRIORITY_LVL = 70                               
           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               
               CONTINUE                                                 
           ELSE                                                         
               DISPLAY '******************************************'     
               DISPLAY '* 8300-DELETE-AR-CNTL'                          
               DISPLAY '* RETURN CODE    = ' WS-ACTIVE-RETURN-CODE      
               DISPLAY '* ACCOUNT NO     = ' AC-ACCOUNT-NO              
               DISPLAY '******************************************'     
               PERFORM 9900-ABEND                THRU 9900-EXIT         
           END-IF.                                                      
      *                                                                         
       8300-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ****************************************************************          
      **  8898-ISSUE-CHKP                                           **          
      ****************************************************************          
      *                                                                         
       8898-ISSUE-CHKP.                                                 
             EXEC SQL                                                           
                 INCLUDE CPD00047                                               
             END-EXEC                                                           
                                                    
      *                                                                         
       8898-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ****************************************************************          
A05154**  ROUTINE ADDED BECAUSE CPD00008 NEEDS IT                   **          
      ****************************************************************          
      *                                                                         
A05154 9000-SEND-ERROR-RESULT.                                          
      *                                                                         
A05154     DISPLAY '9000-SEND-ERROR-RESULT PARAGRAPH ROUTINE - '        
A05154             ' GO TO 9900-SQL-ERROR-ROUTINE TO ABEND PROGRAM.'    
A05154     GO TO 9900-SQL-ERROR-ROUTINE.                                
      *                                                                         
      ****************************************************************          
      **  9000-TERMINATE                                            **          
      ****************************************************************          
      *                                                                         
       9000-TERMINATE.                                                  
      *                                                                         
           DISPLAY '****-------------------------------------****'.     
           DISPLAY 'TOTAL FB RECS PROCESSED      : ' WS-FB-REC-CTR.     
           DISPLAY 'TOTAL WO RECS PROCESSED      : ' WS-WO-REC-CTR.     
           DISPLAY 'TOTAL AMOUNT  FB PROCESSED   : ' WS-FB-TOTAL-AMT.   
           DISPLAY 'TOTAL AMOUNT  WO PROCESSED   : ' WS-WO-TOTAL-AMT.   
           DISPLAY '---------------------------------------------'.     
           DISPLAY '****-------------------------------------****'.     
           CLOSE FCSRP894-FILE.                                         
      *                                                                         
       9000-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ****************************************************************          
      *  9700-PROCESS-ABEND.                                         *          
      ****************************************************************          
      *                                                                         
           EXEC SQL                                                             
               INCLUDE CPD0023B                                                 
           END-EXEC.                                                            
                                                                        
HPCCDM*    EJECT                                                                
      *                                                                         
      ****************************************************************          
A05154**  ROUTINE ADDED BECAUSE CPD00008 NEEDS IT                   **          
      ****************************************************************          
      *                                                                         
A05154 9900-SQL-ERROR-ROUTINE.                                          
      *                                                                         
A05154     DISPLAY ' FAILED IN CPD00008 - PARAGRAPH - '                 
A05154          ' 9900-SQL-ERROR-ROUTINE - ABENDING USING CPD09900'.    
      *                                                                         
      **************************************************************            
A05154* DO NOT ADD ANY CODE BETWEEN 9900-SQL-ERROR-ROUTINE         *            
A05154*    AND COPYBOOK CPD09900. THE 9900-EXIT IN THE COPYBOOK    *            
A05154*    IS NEEDED.                                              *            
      **************************************************************            
      *                                                                         
      * CPD09900   THIS INCLUDES THE DB2 SQL SYSTEM ABEND MODULE   *            
      * 9900-ABEND                                                 *            
      **************************************************************            
      *                                                                         
           EXEC SQL                                                             
               INCLUDE CPD09900                                                 
           END-EXEC.                                                            
      *                                                                         
