       IDENTIFICATION DIVISION.                                         
       PROGRAM-ID.     PCSRP102.                                        
       DATE-WRITTEN.                                                    
       DATE-COMPILED.                                                   
      *****************************************************************         
      **              COPYRIGHT/CONFIDENTIAL  MATERIAL               **         
      **                     PRICE WATERHOUSE                        **         
      **                1410 NORTH WESTSHORE BLVD                    **         
      **                   TAMPA, FLORIDA  33607                     **         
      **                      (813) 287-9200                         **         
      **                                                             **         
      ********            CUSTOMER SERVICE SYSTEM             *********         
      ********                      DB2                       *********         
      *****************************************************************         
      **               P R O G R A M  S U M M A R Y                  **         
      **                                                             **         
      ** PCSRP102 REPORTS THE 'METER READ ERROR' BY READER ID/ROUTE  **         
      ** USING THE EXTRACT FILE GENERATED BY PCSBW103 (INPUT TO      **         
      ** PCSBW103 IS BE00)                                           **         
      **                                                             **         
T20363** PROGRAM NEEDS CHANGES TO HANDLE MORE THAN ONE COMPANY NO.   **         
T20363**                                                             **         
      **   SORT SEQ : COMPANY/EMPLOYEE/ROUTE/METER NO                **         
      *****************************************************************         
      **                                                             **         
      **              PROGRAM  MODIFICATION  LOG                     **         
      **    DATE    INITIALS     REASON                              **         
      **  ________  _________    ___________________________________ **         
PCR672**  01/08/99     TDK       INITIAL CREATION.                   **         
      **                                                             **         
T18947**  01/22/99     TDK       SHOW MORE THAN 4 DTL. ROWS IF NESC. **         
T18994**  03/05/99     RAQ       ADD SOME COLUMNS TO REPORT          **         
T20363**  07/23/99     CBSI      SELECT ALL THE LOCAL OFFICES AND THEIR         
T20363**               MADRAS    DESC FROM CSS_LOCAL_OFFICE TABLE AND *         
T20363**                         PRINT PAGE HEADERS FOR LOCAL OFFICES *         
T20363**                         THAT ARE NOT PRESENT IN THE I/P FILE *         
T20760**  01/21/2000   CBSI      EXCLUDE LOCAL OFFICES FROM THE REPORT*         
T20760**               MADRAS    WHERE STATUS_CD IS EQUAL TO 'I' OR 'S'         
T20596**  01/21/2000   CBSI      ADDED IRRGLR MTR CODES 1 & 2, AND MTR*         
T20596**               MADRAS    READ COMMENTS TO THE REPORT          *         
T20676**  01/21/2000   CBSI      ADDED METER READ CYCLE TO THE REPORT *         
T20676**               MADRAS                                         *         
T25393**  10/18/2001   SK88120   ADD RELOAD OF LOC OFF FOR COMP CHG   *         
C35671**  09/27/2007   CVNS      NAME AND ADDRESS FORMAT CHANGES      *         
C35671**               CHENNAI                                        *         
A01738**  24/03/2010   NC94976  1. REPLACED THE EMPLOYEE NO WITH       *        
A01738**                        METER_READER_ID FROM CSS_ROUTE_REPORT  *        
A01738**                        AND USED THE EXTRACT FILE OF FIOCA103  *        
A01738**                        AND REPORT IN PCSR1021.                *        
A01738**                        2. REMOVED THE MASTER FILE OF EMPLOYEE *        
A01738**                        DATA INFORMATION (PPVS.A035).          *        
A01738**                        3. USED QUERYNO FOR SELECT STATS.      *        
      *****************************************************************         
                    ---- BASIC SEQUENCE STRUCTURE ----                  
                0000 - 0999     MAIN CONTROL PATH AND INITIALIZATION    
                1000 - 1999     INPUT PROCESSING CONTROL PATH           
                2000 - 2999     OUTPUT PROCESSING CONTROL PATH          
                3000 - 4999     BATCH PROCESSING MODULES - NOT USED     
                5000 - 5999     COMMON PROGRAM MODULES                  
                6000 - 6999     COMMON SYSTEM MODULES                   
                7000 - 7999     INPUT MODULES                           
                8000 - 8999     OUTPUT MODULES                          
                9000 - 9799     TERMINATION MODULES                     
                9800 - 9899     XCTLS TO PROGRAMS                       
                9900 - 9999     ABEND/ABORT MODULES                     
      *                                                                         
       ENVIRONMENT DIVISION.                                            
       CONFIGURATION SECTION.                                           
       SOURCE-COMPUTER.    IBM-370.                                     
       OBJECT-COMPUTER.    IBM-370.                                     
       SPECIAL-NAMES.      C01 IS TOP-OF-PAGE.                          
      *                                                                         
       INPUT-OUTPUT SECTION.                                            
       FILE-CONTROL.                                                    
       COPY CSSCA103.                                                           
      *                                                                         
       COPY CSSPT33.                                                            
      *                                                                         
       DATA DIVISION.                                                   
       FILE SECTION.                                                    
       COPY CFDCA103.                                                           
       COPY FIOCA103.                                                           
      *                                                                         
       COPY CFDPT33.                                                            
      *                                                                         
       WORKING-STORAGE SECTION.                                         

MSQ008  01 MSQ008-LOCAL-OFFICE  PIC S9(9) COMP-5.
MSQ017 01 MFA-PROGRAM-ID PIC X(8) VALUE 'PCSRP102'.
MSQ017     COPY MFASQLM.
      *                                                                         
       01  WS-START                    PIC X(40)    VALUE               
           'WORKING STORAGE FOR PCSRP102 STARTS HERE'.                  
                                                                        
      *                                                                         
       01  WS-MISC.                                                     
      *                                                                         
           05  WS-DEFAULT-RPT1-TITLE1  PIC X(50)    VALUE               
               '              METER READ ERRORS'.                       
           05  WS-DEFAULT-RPT1-DT     PIC  X(10)    VALUE SPACES.       
      *                                                                         
           05  WS-MORE-DATA-SW         PIC X(01)    VALUE 'Y'.          
               88  NO-MORE-DATA                     VALUE 'N'.          
           05  WS-CHANGE-COMP-NO       PIC X(01)    VALUE 'N'.          
               88  COMPANY-CHANGED                  VALUE 'Y'.          
           05  WS-START-REPORT         PIC X(01)    VALUE 'N'.          
               88  REPORT-STARTED                   VALUE 'Y'.          
           05  WS-SYSIN-EXIST          PIC X(01)    VALUE 'Y'.          
               88  SYSIN-EXISTS                     VALUE 'Y'.          
               88  SYSIN-DOES-NOT-EXIST             VALUE 'N'.          
           05  WS-END-OF-SYSIN-REC     PIC X(01)    VALUE 'N'.          
               88  NOT-END-OF-SYSIN                 VALUE 'N'.          
A01738     05  WS-END-REC-PROCESSED    PIC X(01)    VALUE ' '.          
               88  END-REC-WAS-PROCESSED            VALUE 'Y'.          
A01738         88  END-REC-WAS-NOT-PROCESSED        VALUE ' '.          
A01738     05  WS-BEGIN-REC-PROCESSED    PIC X(01)  VALUE ' '.          
A01738         88  BEGIN-REC-WAS-PROCESSED          VALUE 'Y'.          
A01738         88  BEGIN-REC-WAS-NOT-PROCESSED      VALUE ' '.          
A01738     05  WS-LOC-OFF-FOUND-SW     PIC X(01)    VALUE 'N'.          
A01738         88  LOC-OFF-FOUND                    VALUE 'Y'.          
A01738         88  LOC-OFF-NOT-FOUND                VALUE 'N'.          
A01738     05  WS-FCA103-REC-TYPE      PIC X(01)    VALUE ' '.          
A01738         88  FCA103-BEGIN-REC                 VALUE 'A'.          
A01738         88  FCA103-DATA-REC                  VALUE 'B'.          
A01738         88  FCA103-COMPANY-END-REC           VALUE 'C'.          
A01738         88  FCA103-FINAL-END-REC             VALUE 'D'.          
A01738         88  FCA103-UNKNOWN-REC               VALUE ' '.          
A01738*                                                                         
A01738     05  WS-TEMP-COMP-NO         PIC X(02)    VALUE SPACES.       
A01738     05  WS-SYSIN-COMP-REC-CNTR  PIC 9(07)    VALUE ZERO COMP-3.  
           05  WS-COMP-REC-CNTR        PIC 9(07)    VALUE ZERO COMP-3.  
           05  WS-CA103-REC-CNTR       PIC 9(07)    VALUE ZERO COMP-3.  
           05  WS-FCA103-STATUS           PIC X(02).                    
               88  CA103-SUCCESSFUL                 VALUE '00'.         
      *                                                                         
A01738     05  WS-PREV-LOCAL-OFFICE       PIC X(03) VALUE SPACES.       
A01738     05  WS-PREV-EMPLOYEE-NO        PIC X(05) VALUE SPACES.       
           05  WS-PREV-UTILITY-TYPE       PIC X(01) VALUE SPACES.       
           05  WS-CURRENT-COMP-NO         PIC X(02) VALUE SPACES.       
T18994     05  WS-PREVIOUS-OFFICE-NO      PIC X(03) VALUE SPACES.       
A01738     05  WS-PREVIOUS-EMPLOYEE-NO    PIC X(05) VALUE SPACES.       
           05  WS-EMPLOYEE-NAME           PIC X(50) VALUE SPACES.       
           05  WS-PREVIOUS-METER-NO       PIC X(09) VALUE SPACES.       
           05  WS-EMPLOYEE-ERRORS         PIC 9(05) VALUE ZERO.         
           05  WS-HEADER-COMP-NO          PIC X(02) VALUE SPACES.       
           05  WS-ERROR-ADDED-FOR-A-METER PIC X(01) VALUE 'N'.          
           05  WS-TOTAL-NAME              PIC X(50) VALUE SPACES.       
           05  WS-THIS-IS-COMP-CNTL-REC   PIC X(01) VALUE 'N'.          
           05  WS-DTL-LINES-WRITTEN       PIC 9(05) VALUE ZERO.         
           05  WS-ORIG-RD                 PIC 9(9)V999.                 
           05  WS-CORR-RD                 PIC 9(9)V999.                 
           05  WS-ORIG-TEMP               PIC 9(4).                     
           05  WS-CORR-TEMP               PIC 9(4).                     
           05  WS-ORIG-CHAR               PIC X(4).                     
           05  WS-CORR-CHAR               PIC X(4).                     
           05  WS-ORIG-NUM                PIC Z(9).                     
           05  WS-CORR-NUM                PIC Z(9).                     
           05  WS-ORIG-READ               PIC X(9).                     
           05  WS-CORR-READ               PIC X(9).                     
           05  WS-ORIGINAL-READ           PIC X(9).                     
           05  WS-CORRECTED-READ          PIC X(9).                     
           05  WS-EMP-NOT-FND-MSG         PIC X(45) VALUE               
               '** EMPLOYEE NOT FOUND ON EMPLOYEE MASTER FILE'.         
                                                                        
      *                                                                         
       COPY CWS09900.                                                           
       COPY CWS00303.                                                           
       COPY CWS00010.                                                           
       COPY CWS00011.                                                           
       COPY CWS00150.                                                           
       COPY CWS00039.                                                           
      *                                                                         
       COPY FIOJC01.                                                            
       COPY FIOCA00.                                                            
      *                                                                         
           EXEC SQL                                                             
              INCLUDE CWS00074                                                  
           END-EXEC.                                                            
      *                                                                         
           EXEC SQL                                                             
              INCLUDE CWS00037                                                  
           END-EXEC.                                                            
      *                                                                         
           EXEC SQL                                                             
              INCLUDE CWS00038                                                  
           END-EXEC.                                                            
      *                                                                         
       01  WS-RPT1-LINE-NO             PIC 9(02)    VALUE 60   COMP-3.  
       01  WS-RPT1-PAGE-NO             PIC 9(05)    VALUE ZERO COMP-3.  
      *                                                                         
       01  WS-CURRENT-TIME.                                             
           05  WS-HH                   PIC 9(02).                       
           05  WS-MM                   PIC 9(02).                       
           05  WS-SS                   PIC 9(02).                       
           05  WS-TT                   PIC 9(02).                       
      *                                                                         
       01  WS-RUN-TIME.                                                 
           05  WS-RT-HH                PIC X(02).                       
           05  FILLER                  PIC X(01)    VALUE ':'.          
           05  WS-RT-MM                PIC X(02).                       
           05  FILLER                  PIC X(01)    VALUE ':'.          
           05  WS-RT-SS                PIC X(02).                       
      *                                                                         
       01  WS-CURRENT-DATE.                                             
           05  WS-CY                   PIC 9(02).                       
           05  WS-CM                   PIC 9(02).                       
           05  WS-CD                   PIC 9(02).                       
      *                                                                         
       01  WS-RUN-DATE.                                                 
           05  WS-RD-MM                PIC X(02).                       
           05  FILLER                  PIC X(01)    VALUE '/'.          
           05  WS-RD-DD                PIC X(02).                       
           05  FILLER                  PIC X(01)    VALUE '/'.          
           05  WS-RD-YY                PIC X(02).                       
      *                                                                         
       01  WS-DATE-10.                                                  
           05  WS-D10-CC               PIC X(02).                       
           05  WS-D10-YY               PIC X(02).                       
           05  FILLER                  PIC X(01)    VALUE '-'.          
           05  WS-D10-MM               PIC X(02).                       
           05  FILLER                  PIC X(01)    VALUE '-'.          
           05  WS-D10-DD               PIC X(02).                       
      *                                                                         
       01  WS-DATE-8.                                                   
           05  WS-D8-MM                PIC X(02).                       
           05  FILLER                  PIC X(01)    VALUE '/'.          
           05  WS-D8-DD                PIC X(02).                       
           05  FILLER                  PIC X(01)    VALUE '/'.          
           05  WS-D8-YY                PIC X(02).                       
      *                                                                         
       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 'PCSRP102'.   
           05  PROGRAM-NAME            PIC X(08)    VALUE 'PCSRP102'.   
T20363     05  WS-ONE                  PIC 9(01)    VALUE 1.            
           05  WS-52                   PIC 9(02)    VALUE 52.           
           05  WS-60                   PIC 9(02)    VALUE 60.           
           05  WS-E                    PIC X(01)    VALUE 'E'.          
           05  WS-G                    PIC X(01)    VALUE 'G'.          
           05  WS-W                    PIC X(01)    VALUE 'W'.          
           05  WS-SLASH                PIC X(01)    VALUE '/'.          
T20363     05  WS-SPACES               PIC X(03)    VALUE '   '.        
       01 WS-COMMON-INFO.                                               
      *                                                                         
           05  WS-NAME-CUST            PIC X(50)     VALUE SPACES.      
A01738     05 WS-NULL-INDICATOR-1      PIC S9(4) COMP VALUE ZERO.       
C35671     05  WS-SERVICE-ADDR1        PIC X(55)     VALUE SPACES.      
           05  WS-SERVICE-ADDR2        PIC X(50)     VALUE SPACES.      
C35671     05  WS-MAIL-ADDR1           PIC X(55)     VALUE SPACES.      
           05  WS-MAIL-ADDR2           PIC X(50)     VALUE SPACES.      
           05  REASON-DESC             PIC X(50)     VALUE SPACES.      
T18994     05  WS-ACCOUNT-NO           PIC X(13)     VALUE SPACES.      
A01738     05  WS-SUB                  PIC 9(04)     VALUE 1.           
T20363     05  WS-PREV-LOC-OFF         PIC X(03)     VALUE SPACES.      
A01738     05  WS-LO-SUB               PIC 9(04)     VALUE ZERO.        
T20363     05  WS-METER-READ           PIC X(01).                       
T20363         88  NO-METER-READ                     VALUE 'Y'.         
T20363         88  METER-READ                        VALUE 'N'.         
      *                                                                         
       01  WS-ERROR-VARIABLES.                                          
           05 RS-RETURN-CODE           PIC S9(04).                      
           05  RS-RETURN-CODE-DISP     PIC +Z(04).                      
           05  WS-DISP-RETURN-CODE     PIC +Z(04).                      
      *                                                                         
T20363 01  WS-LOC-OFFICE-DESC.                                          
A01738     05  WS-LOCOFF-TABLE.                                         
A01738         10  WS-LOC-COMPANY   OCCURS 100 TIMES     PIC X(02).     
A01738         10  WS-LOC-OFF       OCCURS 100 TIMES     PIC X(03).     
A01738         10  WS-LOC-OFF-DESC  OCCURS 100 TIMES     PIC X(22).     
T20363*                                                                         
      ***************** PCSRP102 REPORT HEADERS **********************          
      *                                                                         
       01  WS-HEADING-LINES.                                            
      *                                                                         
      ****************************************************************          
      **           COMMON WORKING STORAGE FOR REPORT TITLE          **          
      ****************************************************************          
      *                                                                         
           05  WS-RPT1-TITLE.                                           
               10  FILLER              PIC X        VALUE SPACES.       
               10  P-RPT1-TITLE-PGNM   PIC X(08).                       
               10  FILLER              PIC X(45)    VALUE SPACES.       
               10  P-RPT1-COMP-NAME    PIC X(26).                       
               10  FILLER              PIC X(35)    VALUE SPACES.       
               10  FILLER              PIC X(10)    VALUE 'RUN-DATE: '. 
               10  P-RPT1-RUN-DATE     PIC X(08).                       
      *                                                                         
      ****************************************************************          
      **           COMMON WORKING STORAGE FOR REPORT HEADER1        **          
      ****************************************************************          
      *                                                                         
           05  WS-RPT1-HEADER-01.                                       
               10  FILLER              PIC X        VALUE SPACES.       
               10  FILLER              PIC X(06)    VALUE 'DATE: '.     
               10  P-RPT1-DATE         PIC X(08).                       
               10  FILLER              PIC X(27)    VALUE SPACES.       
               10  P-RPT1-HEAD1        PIC X(50).                       
               10  FILLER              PIC X(23)    VALUE SPACES.       
               10  FILLER              PIC X(10)    VALUE 'RUN-TIME: '. 
               10  P-RPT1-RUN-TIME     PIC X(08).                       
      *                                                                         
      ****************************************************************          
      **           COMMON WORKING STORAGE FOR REPORT HEADER2        **          
      ****************************************************************          
      *                                                                         
           05  WS-RPT1-HEADER-02.                                       
               10  FILLER              PIC X        VALUE SPACES.       
               10  FILLER              PIC X(118)   VALUE SPACES.       
               10  FILLER              PIC X(08)    VALUE 'PAGE:   '.   
               10  P-RPT1-PAGE-NO      PIC ZZ,ZZ9.                      
      *                                                                         
      ****************************************************************          
      *                                                                         
T18994     05  WS-RPT1-HEADER-30.                                       
               10  FILLER              PIC X        VALUE SPACES.       
T18994         10  FILLER              PIC X(14)    VALUE               
T18994                                'LOCAL OFFICE: '.                 
T18994         10  P-OFFICE-NO         PIC X(06).                       
T18994         10  P-OFFICE-NAME       PIC X(50)    VALUE SPACES.       
           05  WS-RPT1-HEADER-31.                                       
               10  FILLER              PIC X(01)    VALUE SPACES.       
               10  FILLER              PIC X(15)    VALUE               
                                                   'METER READER -'.    
A01738         10  P-EMPLOYEE-NO       PIC X(05).                       
A01738         10  FILLER              PIC X(53)    VALUE SPACES.       
      *                                                                         
           05  WS-RPT1-HEADER-32.                                       
               10  FILLER              PIC X(08) VALUE SPACES.          
               10  FILLER              PIC X(14) VALUE 'ACCOUNT NUMBER'.
T20676         10  FILLER              PIC X(53) VALUE SPACES.          
T20676         10  FILLER              PIC X(06) VALUE 'NEW RD'.        
T20676         10  FILLER              PIC X(02) VALUE SPACES.          
T20676         10  FILLER              PIC X(10) VALUE 'NEW SOURCE'.    
T20676         10  FILLER              PIC X(10) VALUE SPACES.          
T20676         10  FILLER              PIC X(17) VALUE                  
T20676             'ADJUSTMENT REASON'.                                 
T20676         10  FILLER              PIC X(11) VALUE SPACES.          
           05  WS-RPT1-HEADER-33.                                       
               10  FILLER              PIC X(08) VALUE SPACES.          
               10  FILLER              PIC X(37) VALUE 'CUSTOMER NAME'. 
               10  FILLER              PIC X(87) VALUE                  
T19585*    'METER    TYPE   NEW RD DT     NEW RD  NEW SOURCE          AD        
T20676     'METER    TYPE   READ DATE     OLD RD  OLD SOURCE          IT        
T20676-    'RON READ CONDITION'.                                                
           05  WS-RPT1-HEADER-34.                                       
               10  FILLER              PIC X(08) VALUE ' ROUTE'.        
               10  FILLER              PIC X(37) VALUE                  
                                                'SERVICE ADDRESS'.      
               10  FILLER              PIC X(87) VALUE                  
T19585*    'NUMBER   READ   OLD RD DT     OLD RD  OLD SOURCE  REBILL  IT        
T20676     'NUMBER   READ   READ CYCLE    IRR CD1 IRR CD2     REBILL  ME        
T20676-    'TER READ COMMENTS '.                                                
      *                                                                         
       01  WS-DETAIL-LINES.                                             
      *                                                                         
           05  WS-DETAIL-LINE-1.                                        
               10  FILLER              PIC X(01) VALUE SPACES.          
               10  P-ROUTE             PIC X(5).                        
               10  FILLER              PIC X(02) VALUE SPACES.          
               10  P-NAME-ACCT.                                         
                15 P-ACCOUNT-NO        PIC X(16).                       
                15 FILLER              PIC X(19) VALUE SPACES.          
               10  P-METER-NO          PIC X(09).                       
               10  FILLER              PIC X(02) VALUE SPACES.          
               10  P-TYPE              PIC X(03).                       
               10  P-TOU-CODE          PIC X(02) VALUE SPACES.          
               10  FILLER              PIC X(02) VALUE SPACES.          
               10  P-READ-DATE         PIC X(10).                       
               10  FILLER              PIC X(01) VALUE SPACES.          
               10  P-CORRECTED         PIC X(09).                       
               10  FILLER              PIC X(02) VALUE SPACES.          
T18994         10  P-NEW-SOURCE        PIC X(12).                       
T18994         10  FILLER              PIC X(02) VALUE SPACES.          
T18994         10  P-REBILL-IND        PIC X(01).                       
T18994         10  FILLER              PIC X(05) VALUE SPACES.          
               10  P-ADJ-REASON        PIC X(29) VALUE SPACES.          
                                                                        
           05  WS-DETAIL-LINE-2.                                        
               10  FILLER              PIC X(08) VALUE SPACES.          
               10  P-CUST-NAME         PIC X(35).                       
T20676         10  FILLER              PIC X(21) VALUE SPACES.          
T20676         10  P-READ-CYCLE        PIC X(02).                       
T20676         10  FILLER              PIC X(06) VALUE SPACES.          
               10  P-ORIGINAL          PIC X(09).                       
               10  FILLER              PIC X(02) VALUE SPACES.          
T18994         10  P-OLD-SOURCE        PIC X(12).                       
T18994         10  FILLER              PIC X(08) VALUE SPACES.          
               10  P-ADJ-REASON-2      PIC X(29) VALUE SPACES.          
                                                                        
           05  WS-DETAIL-LINE-3.                                        
               10  FILLER              PIC X(08) VALUE SPACES.          
C35671         10  P-CUST-ADDRESS1     PIC X(55).                       
T20676         10  FILLER              PIC X(35) VALUE SPACES.          
T20676         10  P-IRRGLR-CODE-1     PIC X(01).                       
T20676         10  FILLER              PIC X(07) VALUE SPACES.          
T20676         10  P-IRRGLR-CODE-2     PIC X(01).                       
T20676         10  FILLER              PIC X(16) VALUE SPACES.          
T20676         10  P-MTR-RD-COMMENTS   PIC X(30).                       
                                                                        
           05  WS-DETAIL-LINE-4.                                        
               10  FILLER              PIC X(08) VALUE SPACES.          
               10  P-CUST-ADDRESS2     PIC X(35).                       
               10  P-DETAIL-INFO-4     PIC X(89) VALUE SPACES.          
                                                                        
           05  WS-EMPLOYEE-SUMMARY-LINE.                                
               10  FILLER              PIC X(01) VALUE SPACES.          
               10  FILLER              PIC X(14) VALUE 'TOTAL ERRORS :'.
               10  P-EMPLOYEE-ERRORS   PIC ZZZ,Z9.                      
      *                                                                         
       01  WS-LINE                     PIC X(132)   VALUE ALL '-'.      
       01  WS-BLANK-LINE               PIC X(132)   VALUE SPACES.       
      *                                                                         
       01  WS-NO-DATA-LINE.                                             
           05  FILLER                  PIC X(55)    VALUE SPACES.       
           05  FILLER                  PIC X(22)    VALUE               
                     '** NO DATA THIS RUN **'.                          
           05  FILLER                  PIC X(55)    VALUE SPACES.       
      *                                                                         
T20363 01  WS-NO-METER-LINE.                                            
T20363     05  FILLER                  PIC X(45)    VALUE SPACES.       
T20363     05  FILLER                  PIC X(42)    VALUE               
T20363               '** NO METER READ ERRORS FOR THIS OFFICE **'.      
T20363     05  FILLER                  PIC X(45)    VALUE SPACES.       
      *                                                                         
       01  WS-TOU-CODES-LINE.                                           
           05  FILLER                  PIC X(52)    VALUE               
           'TOU CODES: 1 = ON-PEAK, 2 = OFF-PEAK, 3 = SHOULDER, '.      
           05  FILLER                  PIC X(39)    VALUE               
           'C = CURRENT SEASON, P = PREVIOUS SEASON'.                   
           05  FILLER                  PIC X(41)    VALUE SPACES.       
      *                                                                         
       01  WS-END-DATA-LINE.                                            
           05  FILLER                  PIC X(55)    VALUE SPACES.       
           05  FILLER                  PIC X(22)    VALUE               
                     '*** END OF REPORT ***'.                           
           05  FILLER                  PIC X(55)    VALUE SPACES.       
      *                                                                         
      *                                                                         
       01  ABEND-FUNCTION1.                                             
           05  WS-ABEND-SPACE          PIC X(02).                       
           05  FILLER REDEFINES WS-ABEND-SPACE.                         
               10  WS-ABEND-NUMERIC    PIC 9(02).                       
      *                                                                         
           EXEC SQL                                                             
               INCLUDE SQLCA                                                    
           END-EXEC.                                                            
      *                                                                         
      ****** TABLE DECLARATION FOR CSS_COMPANY *************************        
           EXEC SQL                                                             
               INCLUDE TBCOMPNY                                                 
           END-EXEC.                                                            
      *                                                                         
T18994****** TABLE DECLARATION FOR CSS_LOCAL_OFFICE ********************        
T18994     EXEC SQL                                                             
T18994         INCLUDE TBLOCOFC                                                 
T18994     END-EXEC.                                                            
T18994*                                                                         
      ****** TABLE DECLARATION FOR CSS_ACCOUNT *************************        
           EXEC SQL                                                             
               INCLUDE TBACCT                                                   
           END-EXEC.                                                            
      *                                                                         
      ****** TABLE DECLARATION FOR CSS_BILL_ADJ_REASN  *****************        
      *    EXEC SQL                                                             
      *        INCLUDE TBLADRSN                                                 
      *    END-EXEC.                                                            
      *                                                                         
      ****** TABLE DECLARATION FOR CSS_ACCT_BILL_NMES ****************          
           EXEC SQL                                                             
               INCLUDE TBATBLNM                                                 
           END-EXEC.                                                            
                                                                        
      ****** TABLE DECLARATION FOR CSS_JOB_PARM ************************        
           EXEC SQL                                                             
               INCLUDE TBJBPARM                                                 
           END-EXEC.                                                            
      ****** TABLE DECLARATION FOR CSS_NAME ****************************        
           EXEC SQL                                                             
               INCLUDE TBNAME                                                   
           END-EXEC.                                                            
      *                                                                         
      ****** TABLE DECLARATION FOR CSS_NAME_ACCT_XREF ******************        
           EXEC SQL                                                             
               INCLUDE TBNMACTX                                                 
           END-EXEC.                                                            
      *                                                                         
      ****** TABLE DECLARATION FOR CSS_ADDR_FORMATTED ******************        
           EXEC SQL                                                             
               INCLUDE TBADRFMT                                                 
           END-EXEC.                                                            
      *                                                                         
      ****** TABLE DECLARATION FOR CSS_ADDR_FREEFORM  ******************        
           EXEC SQL                                                             
               INCLUDE TBADRFRE                                                 
           END-EXEC.                                                            
      *                                                                         
      ****** TABLE DECLARATION FOR CSS_ZIP_CODE ************************        
           EXEC SQL                                                             
               INCLUDE TBZIPCD                                                  
           END-EXEC.                                                            
      *                                                                         
      ****** TABLE DECLARATION FOR CSS_CUST_ADDR_XREF ******************        
           EXEC SQL                                                             
               INCLUDE TBCSADRX                                                 
           END-EXEC.                                                            
                                                                        
      ****** TABLE DECLARATION FOR CSS_ACCT_MISC_INFO ****************          
           EXEC SQL                                                             
               INCLUDE TBATMISC                                                 
           END-EXEC.                                                            
                                                                        
T20676****** TABLE DECLARATION FOR CSS_UTIL_ENVRNMT ******************          
T20676     EXEC SQL                                                             
T20676         INCLUDE TBUTLENV                                                 
T20676     END-EXEC.                                                            
T20676                                                                  
      *                                                                         
T20363******************************************************************        
T20363* CURSOR DECLARATION TO SELECT LOCAL OFFICE AND LOCAL OFFICE              
T20363* DESCRIPTION                                                             
T20363******************************************************************        
T20363*                                                                         
T20363     EXEC SQL                                                     
T20363         DECLARE LOCAL_OFFICE CURSOR                              
A01738             WITH ROWSET POSITIONING FOR                          
A01738         SELECT COMPANY_NO                                        
A01738               ,LOCAL_OFFICE                                      
T20363               ,LOCAL_OFFICE_DESC                                 
T20363           FROM CSS_LOCAL_OFFICE WITH(READUNCOMMITTED)                    
A01738          WHERE STATUS_CD  = ' '                                  
A01738         ORDER BY COMPANY_NO                                      
A01738                 ,LOCAL_OFFICE                                    
A01738         FOR READ ONLY                                    
T20363     END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ004
MFA-TR* MSQ022
MFA-TR*    EXEC SQL                                                             
MFA-TR*        DECLARE LOCAL_OFFICE CURSOR                                      
MFA-TR*            WITH ROWSET POSITIONING FOR                                  
MFA-TR*        SELECT COMPANY_NO                                                
MFA-TR*              ,LOCAL_OFFICE                                              
MFA-TR*              ,LOCAL_OFFICE_DESC                                         
MFA-TR*          FROM CSS_LOCAL_OFFICE                                          
MFA-TR*         WHERE STATUS_CD  = ' '                                          
MFA-TR*        ORDER BY COMPANY_NO                                              
MFA-TR*                ,LOCAL_OFFICE                                            
MFA-TR*        FOR FETCH ONLY WITH UR                                           
MFA-TR*    END-EXEC.                                                            
T20363*                                                                         
       01  WS-END                      PIC X(38)    VALUE               
           'WORKING STORAGE FOR PCSRP102 ENDS HERE'.                    
      *                                                                         
      *****************************************************************         
       PROCEDURE DIVISION.                                              
      *****************************************************************         
      *===============================================================*         
       0000-MAINLINE.                                                   
      *===============================================================*         
      *                                                                         
           PERFORM 0100-INITIALIZATION           THRU 0100-EXIT.        
A01738     PERFORM 0200-PROCESS-BEGIN-REC        THRU 0200-EXIT.        
           PERFORM 7100-READ-FCSCA103            THRU 7100-EXIT.        
      *                                                                         
A01738     PERFORM 0300-GET-LOCAL-OFFICE         THRU 0300-EXIT.        
      *                                                                         
A01738     PERFORM 1000-PROCESS-FCA103           THRU 1000-EXIT         
A01738             UNTIL NO-MORE-DATA.                                  
      *                                                                         
A01738     PERFORM 1900-PROCESS-END-OF-JOB    THRU 1900-EXIT.           
      *                                                                         
           PERFORM 9000-TERMINATE                THRU 9000-EXIT.        
           STOP RUN.                                                    
      *                                                                         
       0000-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      *===============================================================*         
       0100-INITIALIZATION.                                             
      *===============================================================*         
      *                                                                         
      *--GET DATE/TIME                                                          
           ACCEPT WS-CURRENT-TIME FROM TIME.                            
           MOVE WS-HH                  TO WS-RT-HH.                     
           MOVE WS-MM                  TO WS-RT-MM.                     
           MOVE WS-SS                  TO WS-RT-SS.                     
           MOVE WS-RUN-TIME            TO P-RPT1-RUN-TIME.              
      *                                                                         
           ACCEPT WS-CURRENT-DATE FROM DATE.                            
           MOVE WS-CY                  TO WS-RD-YY.                     
           MOVE WS-CM                  TO WS-RD-MM.                     
           MOVE WS-CD                  TO WS-RD-DD.                     
           MOVE WS-RUN-DATE            TO P-RPT1-RUN-DATE.              
      *                                                                         
      *--OPEN FILES                                                             
           OPEN OUTPUT FCSPT33-FILE.                                    
      *                                                                         
           OPEN INPUT FCSCA103-FILE.                                    
           IF CA103-SUCCESSFUL                                          
              CONTINUE                                                  
           ELSE                                                         
              DISPLAY '**    FCSCA103 PROCESSING ERROR    **'           
              DISPLAY '**    OPEN ERROR OF FCSCA103 - INPUT FILE'       
              DISPLAY '**    FILE STATUS = ' WS-FCA103-STATUS           
              DISPLAY '**      PROCESSING TERMINATED      **'           
              PERFORM 9900-ABEND                 THRU 9900-EXIT         
           END-IF.                                                      
      *                                                                         
      *--GET JOB PARM DATE                                                      
           MOVE  WS-PGRMNAME TO WS-PROGRAM.                             
           MOVE  WS-DATE     TO WS-COMMAND.                             
           MOVE  SPACES      TO WS-SYSIPT.                              
                                                                        
           PERFORM 6251-GET-FJC01-DATE               THRU 6251-EXIT.    
                                                                        
           IF COMMON-DATE-NEEDED                                        
              PERFORM 6240-GET-FCA00-COMMON-DATE     THRU 6240-EXIT     
              DISPLAY 'FCA00-COMMON-DATE EQUALS ' WS-FCA00-COMMON-DATE  
              MOVE WS-FCA00-COMMON-DATE  TO WS-INPUT-DATE               
      *       MOVE WS-Y               TO WS-UPDATE-LAST-RUN-DATE                
           END-IF.                                                      
                                                                        
           MOVE WS-INPUT-DATE          TO WS-CURRENT-DATE               
                                          WS-DATE-10.                   
           MOVE WS-D10-MM              TO WS-D8-MM                      
           MOVE WS-D10-DD              TO WS-D8-DD                      
           MOVE WS-D10-YY              TO WS-D8-YY                      
           MOVE WS-DATE-8              TO P-RPT1-DATE                   
                                          WS-DEFAULT-RPT1-DT.           
      *                                                                         
       0100-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
A01738*===============================================================*         
A01738 0200-PROCESS-BEGIN-REC.                                          
A01738*===============================================================*         
A01738*** CHECKS FOR BEGINNING RECORD OF FCSCA103-FILE.                         
      *                                                                         
           PERFORM 7100-READ-FCSCA103            THRU 7100-EXIT.        
      *                                                                         
A01738     IF FCA103-BEGIN-REC                                          
              MOVE E-FCA103-CREATE-DATE-BREC TO WS-DATE-10              
              MOVE WS-D10-MM                 TO WS-D8-MM                
              MOVE WS-D10-DD                 TO WS-D8-DD                
              MOVE WS-D10-YY                 TO WS-D8-YY                
              MOVE WS-DATE-8                 TO P-RPT1-DATE             
A01738        SET BEGIN-REC-WAS-PROCESSED    TO TRUE                    
           ELSE                                                         
              DISPLAY '**       FCSCA103 PROCESSING ERROR        **'    
              DISPLAY '**  FIRST RECORD IS NOT A CONTROL RECORD  **'    
              DISPLAY '**         PROCESSING TERMINATED          **'    
              PERFORM 9900-ABEND                THRU 9900-EXIT          
           END-IF.                                                      
      *                                                                         
A01738 0200-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
A01738*================================================================*        
A01738 0300-GET-LOCAL-OFFICE.                                           
A01738*================================================================*        
A01738*                                                                         
A01738*-- FETCH LOCAL OFFICE AND LOCAL OFFICE DESC FROM CSS_LOCAL_OFFICE        
A01738*-- AND POPULATE IN A WORKING STORAGE TABLE.                              
A01738*                                                                         
A01738     PERFORM 7000-OPEN-LOCAL-OFFICE      THRU 7000-EXIT.          
A01738     PERFORM 7010-FETCH-LOCAL-OFFICE     THRU 7010-EXIT.          
A01738*                                                                         
A01738     IF WS-LO-SUB = (0 OR 100)                                    
A01738        DISPLAY '** LOCAL_OFFICE CURSOR FETCHES EITHER **'        
A01738        DISPLAY '** ZERO OR 100 ROWS                   **'        
A01738        DISPLAY '** TOTAL LOC OFFICE ROWS: ' WS-LO-SUB            
              DISPLAY '**       PROCESSING TERMINATED        **'        
              PERFORM 9900-ABEND            THRU 9900-EXIT              
           END-IF                                                       
A01738                                                                  
A01738     PERFORM 7020-CLOSE-LOCAL-OFFICE     THRU 7020-EXIT.          
A01738*                                                                         
A01738 0300-EXIT.                                                       
A01738     EXIT.                                                        
A01738*                                                                         
A01738*===============================================================*         
A01738 1000-PROCESS-FCA103.                                             
A01738*===============================================================*         
A01738*                                                                         
A01738     IF FCA103-DATA-REC                                           
A01738        PERFORM 1100-PROCESS-DATA-REC THRU 1100-EXIT              
A01738             UNTIL NO-MORE-DATA                                   
A01738             OR FCA103-FINAL-END-REC                              
A01738             OR FCA103-COMPANY-END-REC                            
A01738     END-IF.                                                      
A01738*                                                                         
A01738     IF FCA103-COMPANY-END-REC                                    
A01738        PERFORM 1700-PROCESS-COMP-END-REC THRU 1700-EXIT          
A01738        PERFORM 7100-READ-FCSCA103        THRU 7100-EXIT          
A01738     END-IF.                                                      
A01738*                                                                         
A01738     IF FCA103-FINAL-END-REC                                      
A01738        PERFORM 1800-PROCESS-END-REC      THRU 1800-EXIT          
A01738        PERFORM 7100-READ-FCSCA103        THRU 7100-EXIT          
A01738        IF NOT NO-MORE-DATA                                       
A01738           DISPLAY '**     FCSCA103 PROCESSING ERROR      **'     
A01738           DISPLAY '** RECORDS FOUND AFTER END RECORD     **'     
A01738           DISPLAY '**       PROCESSING TERMINATED        **'     
A01738           PERFORM 9900-ABEND            THRU 9900-EXIT           
A01738        END-IF                                                    
A01738     END-IF.                                                      
A01738*                                                                         
A01738     IF  FCA103-BEGIN-REC AND BEGIN-REC-WAS-PROCESSED             
               DISPLAY '**     FCSCA103 PROCESSING ERROR      **'       
               DISPLAY '**   MULTIPLE BEGIN CONTROL RECORDS   **'       
               DISPLAY '**       PROCESSING TERMINATED        **'       
               PERFORM 9900-ABEND            THRU 9900-EXIT             
           END-IF.                                                      
      *                                                                         
       1000-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
A01738*===============================================================*         
A01738 1100-PROCESS-DATA-REC.                                           
A01738*===============================================================*         
A01738*                                                                         
A01738     MOVE E-FCA103-LOCAL-OFFICE TO WS-PREV-LOCAL-OFFICE           
A01738     SET LOC-OFF-NOT-FOUND    TO TRUE                             
A01738     PERFORM UNTIL LOC-OFF-FOUND                                  
A01738              OR (WS-SUB > WS-LO-SUB)                             
A01738       MOVE WS-LOC-OFF(WS-SUB)      TO P-OFFICE-NO                
A01738       MOVE WS-LOC-OFF-DESC(WS-SUB) TO P-OFFICE-NAME              
A01738       MOVE WS-LOC-COMPANY(WS-SUB)  TO WS-TEMP-COMP-NO            
A01738*                                                                         
A01738       IF WS-TEMP-COMP-NO = C7-COMPANY-NO                         
A01738          CONTINUE                                                
             ELSE                                                       
A01738          MOVE WS-TEMP-COMP-NO TO C7-COMPANY-NO                   
A01738          PERFORM 7800-GET-COMPANY-DESC     THRU 7800-EXIT        
             END-IF                                                     
      *                                                                         
A01738       PERFORM 8100-PRINT-MAIN-HEADERS   THRU 8100-EXIT           
A01738       IF WS-LOC-OFF(WS-SUB) = E-FCA103-LOCAL-OFFICE              
A01738          SET LOC-OFF-FOUND    TO TRUE                            
A01738       ELSE                                                       
A01738          MOVE SPACES                  TO P-EMPLOYEE-NO           
A01738          PERFORM 8200-PRINT-SUB-HEADERS    THRU 8200-EXIT        
A01738          WRITE PRT33-RECORD FROM WS-NO-METER-LINE AFTER 3        
A01738          ADD 3                       TO WS-RPT1-LINE-NO          
A01738       END-IF                                                     
A01738       COMPUTE WS-SUB = WS-SUB + 1                                
A01738     END-PERFORM.                                                 
      **                                                                        
A01738     PERFORM 1200-PROCESS-LOC-OFFICE THRU 1200-EXIT               
A01738       UNTIL NO-MORE-DATA                                         
A01738          OR FCA103-FINAL-END-REC                                 
A01738          OR FCA103-COMPANY-END-REC                               
                OR E-FCA103-LOCAL-OFFICE NOT = WS-PREV-LOCAL-OFFICE.    
      *                                                                         
A01738 1100-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
A01738*===============================================================*         
A01738 1200-PROCESS-LOC-OFFICE.                                         
A01738*===============================================================*         
A01738*                                                                         
A01738     MOVE ZEROS                TO WS-EMPLOYEE-ERRORS              
A01738     MOVE E-FCA103-EMPLOYEE-NO TO WS-PREV-EMPLOYEE-NO             
A01738                                  P-EMPLOYEE-NO                   
A01738*                                                                         
A01738     IF WS-RPT1-LINE-NO > 48                                      
A01738       PERFORM 8100-PRINT-MAIN-HEADERS   THRU 8100-EXIT           
A01738     END-IF                                                       
A01738     PERFORM 8200-PRINT-SUB-HEADERS    THRU 8200-EXIT             
A01738*                                                                         
A01738     PERFORM 1400-PROCESS-EMPLOYEE   THRU 1400-EXIT               
A01738       UNTIL NO-MORE-DATA                                         
A01738          OR FCA103-FINAL-END-REC                                 
A01738          OR FCA103-COMPANY-END-REC                               
A01738          OR E-FCA103-LOCAL-OFFICE NOT = WS-PREV-LOCAL-OFFICE     
A01738          OR E-FCA103-EMPLOYEE-NO  NOT = WS-PREV-EMPLOYEE-NO.     
A01738*                                                                         
A01738     MOVE WS-EMPLOYEE-ERRORS    TO  P-EMPLOYEE-ERRORS             
A01738     WRITE PRT33-RECORD FROM WS-EMPLOYEE-SUMMARY-LINE AFTER 2     
A01738     ADD 2                      TO WS-RPT1-LINE-NO.               
A01738*                                                                         
A01738 1200-EXIT.                                                       
A01738     EXIT.                                                        
A01738*                                                                         
A01738*===============================================================*         
A01738 1400-PROCESS-EMPLOYEE.                                           
A01738*===============================================================*         
A01738*                                                                         
A01738     IF WS-RPT1-LINE-NO > 54                                      
A01738       PERFORM 8100-PRINT-MAIN-HEADERS   THRU 8100-EXIT           
A01738       PERFORM 8200-PRINT-SUB-HEADERS    THRU 8200-EXIT           
A01738     END-IF                                                       
A01738     PERFORM 1450-FORMAT-DETAIL-LINE        THRU 1450-EXIT.       
A01738     PERFORM 7100-READ-FCSCA103             THRU 7100-EXIT.       
A01738*                                                                         
A01738 1400-EXIT.                                                       
A01738     EXIT.                                                        
A01738*                                                                         
A01738*================================================================*        
A01738 1450-FORMAT-DETAIL-LINE.                                         
A01738*================================================================*        
A01738*                                                                         
A01738     ADD 1 TO WS-EMPLOYEE-ERRORS                                  
           MOVE SPACES                    TO WS-DETAIL-LINE-1           
A01738                                       WS-DETAIL-LINE-2           
A01738                                       WS-DETAIL-LINE-3           
A01738                                       WS-DETAIL-LINE-4.          
           WRITE PRT33-RECORD FROM WS-BLANK-LINE AFTER 1                
           ADD 1                      TO WS-RPT1-LINE-NO                
           MOVE E-FCA103-ORIGINAL-READ       TO WS-ORIG-RD              
           MOVE E-FCA103-CORRECTED-READ      TO WS-CORR-RD              
           IF E-FCA103-READ-TYPE NOT = 'KWH' AND 'GAS'                  
              COMPUTE WS-ORIG-TEMP = WS-ORIG-RD * 1000                  
              COMPUTE WS-CORR-TEMP = WS-CORR-RD * 1000                  
              MOVE WS-ORIG-TEMP              TO WS-ORIG-CHAR            
              MOVE WS-CORR-TEMP              TO WS-CORR-CHAR            
              STRING WS-ORIG-CHAR(1:1), '.',                            
                     WS-ORIG-CHAR(2:3)  DELIMITED BY SIZE               
                INTO WS-ORIG-READ                                       
              STRING WS-CORR-CHAR(1:1), '.',                            
                     WS-CORR-CHAR(2:3)  DELIMITED BY SIZE               
                INTO WS-CORR-READ                                       
              MOVE WS-ORIG-READ              TO WS-ORIGINAL-READ(5:5)   
              MOVE WS-CORR-READ              TO WS-CORRECTED-READ(5:5)  
           ELSE                                                         
              MOVE WS-ORIG-RD                TO WS-ORIG-NUM             
              MOVE WS-CORR-RD                TO WS-CORR-NUM             
              MOVE WS-ORIG-NUM               TO WS-ORIGINAL-READ        
              MOVE WS-CORR-NUM               TO WS-CORRECTED-READ       
A01738     END-IF.                                                      
      *                                                                         
           PERFORM 2800-GET-NAME-ADDRESS THRU 2800-EXIT                 
           MOVE E-FCA103-ROUTE-NO         TO P-ROUTE                    
           MOVE E-FCA103-ACCOUNT-NO       TO WS-ACCOUNT-NO              
           STRING WS-ACCOUNT-NO(1:1), '-',                              
                  WS-ACCOUNT-NO(2:4), '-',                              
                  WS-ACCOUNT-NO(6:4), '-',                              
                  WS-ACCOUNT-NO(10:4), DELIMITED BY SIZE                
             INTO P-ACCOUNT-NO                                          
           MOVE WS-CUSTOMER-NAME          TO P-CUST-NAME                
           MOVE WS-SERVICE-ADDR1          TO P-CUST-ADDRESS1            
           MOVE WS-SERVICE-ADDR2          TO P-CUST-ADDRESS2            
           MOVE E-FCA103-METER-NO         TO P-METER-NO                 
      *                                                                         
           STRING E-FCA103-READ-DATE(6:2), '/',                         
                  E-FCA103-READ-DATE(9:2), '/',                         
                  E-FCA103-READ-DATE(1:4), DELIMITED BY SIZE            
             INTO P-READ-DATE                                           
           MOVE E-FCA103-READ-TYPE            TO P-TYPE                 
           MOVE E-FCA103-TOU-CODE             TO P-TOU-CODE             
           MOVE WS-ORIGINAL-READ              TO P-ORIGINAL             
           MOVE WS-CORRECTED-READ             TO P-CORRECTED            
           MOVE E-FCA103-CODE-SOURCE-ID-DESC  TO P-NEW-SOURCE           
           MOVE E-FCA103-ORIG-SOURCE-ID-DESC  TO P-OLD-SOURCE           
           MOVE E-FCA103-CODE-BILL-ITM-IND    TO P-REBILL-IND           
           MOVE E-FCA103-ADJ-REASON-DESC      TO P-ADJ-REASON           
           MOVE E-FCA103-READING-COND-CD-DESC TO P-ADJ-REASON-2         
T20676     MOVE E-FCA103-IRRGLR-MTR-CD1       TO P-IRRGLR-CODE-1        
T20676     MOVE E-FCA103-IRRGLR-MTR-CD2       TO P-IRRGLR-CODE-2        
T20676     MOVE E-FCA103-MTR-RD-COMMENTS      TO P-MTR-RD-COMMENTS      
T20676     MOVE E-FCA103-ACCOUNT-NO           TO UT-ACCOUNT-NO          
T20676     MOVE E-FCA103-UTILITY-TYPE         TO UT-CODE-UTIL-TYPE      
T20676     PERFORM 7400-SELECT-READ-CYCLE     THRU 7400-EXIT            
T20676     IF  WS-ACTIVE-RETURN-CODE EQUAL SUCCESSFUL-CALL              
T20676         MOVE UT-READ-CYCLE             TO P-READ-CYCLE           
T20676     ELSE                                                         
T20676         MOVE SPACES                    TO P-READ-CYCLE           
T20676     END-IF                                                       
           WRITE PRT33-RECORD FROM WS-DETAIL-LINE-1 AFTER 1             
           WRITE PRT33-RECORD FROM WS-DETAIL-LINE-2 AFTER 1             
A01738     WRITE PRT33-RECORD FROM WS-DETAIL-LINE-3 AFTER 1             
           WRITE PRT33-RECORD FROM WS-DETAIL-LINE-4 AFTER 1             
A01738     ADD 4                      TO WS-RPT1-LINE-NO.               
      *                                                                         
A01738 1450-EXIT.                                                       
           EXIT.                                                        
A01738*                                                                         
A01738*===============================================================*         
A01738 1700-PROCESS-COMP-END-REC.                                       
A01738*===============================================================*         
A01738*** IT VALIDATE CONTROL REC COUNTS AT COMPANY LEVEL            **         
A01738*                                                                         
A01738     IF WS-COMP-REC-CNTR = E-FCA103-CO-REC-COUNT-EREC             
A01738        CONTINUE                                                  
           ELSE                                                         
              DISPLAY '**      FCSCA103 PROCESSING ERROR       **'      
              DISPLAY '**  COMPANY NO = ' E-FCA103-COMPANY-NO           
              DISPLAY '** ACTUAL REC COUNT OF THE CO. DOES NOT **'      
              DISPLAY '**            MATCH CNTL REC            **'      
              DISPLAY '** CONTROL REC COUNT = '                         
                                 E-FCA103-CO-REC-COUNT-EREC             
              DISPLAY '** ACTUAL  REC COUNT = ' WS-COMP-REC-CNTR        
              DISPLAY '**        PROCESSING TERMINATED         **'      
              PERFORM 9900-ABEND            THRU 9900-EXIT              
           END-IF.                                                      
A01738     MOVE ZEROS           TO WS-COMP-REC-CNTR.                    
A01738*                                                                         
A01738 1700-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
A01738*===============================================================*         
A01738 1800-PROCESS-END-REC.                                            
A01738*===============================================================*         
A01738*** IT VALIDATE CONTROL REC COUNTS FOR ALL COMPANIES.          **         
A01738*                                                                         
A01738     IF WS-CA103-REC-CNTR EQUAL E-FCA103-RECORD-COUNT-EREC        
A01738        CONTINUE                                                  
A01738     ELSE                                                         
A01738        DISPLAY '**         FCSCA103 PROCESSING ERROR        **'  
A01738        DISPLAY '** ACTUAL REC COUNT DOES NOT MATCH CNTL REC **'  
A01738        DISPLAY '**     CONTROL REC COUNT = '                     
A01738                              E-FCA103-RECORD-COUNT-EREC          
A01738        DISPLAY '**     ACTUAL  REC COUNT = ' WS-CA103-REC-CNTR   
A01738        DISPLAY '**           PROCESSING TERMINATED          **'  
A01738        PERFORM 9900-ABEND                THRU 9900-EXIT          
A01738     END-IF.                                                      
A01738*                                                                         
A01738     SET END-REC-WAS-PROCESSED TO TRUE.                           
A01738*                                                                         
A01738 1800-EXIT.                                                       
           EXIT.                                                        
A01738*                                                                         
A01738*===============================================================*         
A01738 1900-PROCESS-END-OF-JOB.                                         
A01738*===============================================================*         
A01738*** IT VALIDATE END CONTROL RECORD.                            **         
A01738*** WRITE ANY MISSING LOC OFFICES THAT NOT HAVE ERRORS         **         
A01738*                                                                         
A01738     IF END-REC-WAS-PROCESSED                                     
A01738        CONTINUE                                                  
A01738     ELSE                                                         
A01738        DISPLAY '**       PCSRP102 PROCESSING ERROR       **'     
A01738        DISPLAY '** DID NOT HAVE AN ENDING CONTROL RECORD **'     
A01738        DISPLAY '**         PROCESSING TERMINATED         **'     
A01738        PERFORM 9900-ABEND                THRU 9900-EXIT          
A01738     END-IF.                                                      
A01738*                                                                         
A01738     PERFORM UNTIL WS-SUB > WS-LO-SUB                             
A01738       MOVE WS-LOC-OFF(WS-SUB)      TO P-OFFICE-NO                
A01738       MOVE WS-LOC-OFF-DESC(WS-SUB) TO P-OFFICE-NAME              
A01738       MOVE WS-LOC-COMPANY(WS-SUB)  TO WS-TEMP-COMP-NO            
A01738*                                                                         
A01738       IF WS-TEMP-COMP-NO = C7-COMPANY-NO                         
A01738          CONTINUE                                                
A01738       ELSE                                                       
A01738          MOVE WS-TEMP-COMP-NO TO C7-COMPANY-NO                   
A01738          PERFORM 7800-GET-COMPANY-DESC     THRU 7800-EXIT        
A01738       END-IF                                                     
A01738*                                                                         
A01738       PERFORM 8100-PRINT-MAIN-HEADERS  THRU 8100-EXIT            
A01738       MOVE SPACES                  TO P-EMPLOYEE-NO              
A01738       PERFORM 8200-PRINT-SUB-HEADERS   THRU 8200-EXIT            
A01738       WRITE PRT33-RECORD FROM WS-NO-METER-LINE AFTER 3           
A01738       ADD 3                       TO WS-RPT1-LINE-NO             
A01738       COMPUTE WS-SUB = WS-SUB + 1                                
A01738     END-PERFORM.                                                 
A01738*                                                                         
A01738 1900-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ****************************************************************          
      **                                                            **          
      **   2800-GET-NAME-ADDRESS.                                   **          
      **                                                            **          
      ****************************************************************          
      *                                                                         
       2800-GET-NAME-ADDRESS.                                           
      *                                                                         
           MOVE ZEROES TO AT-ADDRESS-ID,                                
                          AT-ACCOUNT-NO,                                
                          HT-NAME-ID,                                   
                          HT-ADDRESS-ID                                 
           MOVE E-FCA103-ACCOUNT-NO   TO AT-ACCOUNT-NO.                 
           PERFORM 4000-MAIL-NAME-ADDRESS              THRU 4000-EXIT.  
      *                                                                         
           MOVE WS-CUSTOMER-NAME      TO WS-NAME-CUST.                  
      *                                                                         
           MOVE WS-PR-STREET          TO WS-SERVICE-ADDR1.              
           MOVE WS-PR-ADDR-CITY-STATE-ZIP                               
                                      TO WS-SERVICE-ADDR2.              
      *                                                                         
           MOVE WS-MAIL-ADDR-STREET   TO WS-MAIL-ADDR1.                 
           MOVE WS-MAIL-ADDR-CITY-STATE-ZIP                             
                                      TO WS-MAIL-ADDR2.                 
       2800-EXIT.                                                       
           EXIT.                                                        
                                                                        
      ********  ALL CPD-COPYBOOKS *********                                     
      ****************************************************************          
      **                                                            **          
      **   3900-CENTERING-ROUTINE                                   **          
      **                                                            **          
      ****************************************************************          
      *                                                                         
       COPY CPD00150.                                                           
      *                                                                         
      ****************************************************************          
      **                                                            **          
      **   4000-MAIL-NAME-ADDRESS                                   **          
      **                                                            **          
      ****************************************************************          
      *                                                                         
           EXEC SQL                                                             
                INCLUDE CPD00074                                                
           END-EXEC.                                                            
      *                                                                         
      ****************************************************************          
      **                                                            **          
      **   6010-REDUCE-EMBEDDED-SPACES                              **          
      **                                                            **          
      ****************************************************************          
      *                                                                         
       COPY CPD00004.                                                           
      *                                                                         
      ****************************************************************          
      **                                                            **          
      ** 6240-GET-FCA00-COMMON-DATE                                 **          
      **                                                            **          
      ****************************************************************          
      *                                                                         
           EXEC SQL                                                             
                INCLUDE CPD00040                                                
           END-EXEC.                                                            
      *                                                                         
      ****************************************************************          
      **                                                            **          
      **   6251-GET-FJC01-DATE                                      **          
      **                                                            **          
      ****************************************************************          
      *                                                                         
           EXEC SQL                                                             
                INCLUDE CPD00037                                                
           END-EXEC.                                                            
      ****************************************************************          
      **                                                            **          
      ** 7600-START-FCSJC01                                         **          
      **                                                            **          
      ****************************************************************          
      *                                                                         
           EXEC SQL                                                             
                INCLUDE CPD00038                                                
           END-EXEC.                                                            
      *                                                                         
      ****************************************************************          
      **                                                            **          
      ** 7620-START-FCSCA00                                         **          
      **                                                            **          
      ****************************************************************          
      *                                                                         
           EXEC SQL                                                             
                INCLUDE CPD00039                                                
           END-EXEC.                                                            
      *                                                                         
      ****************************************************************          
T20363**  7000-OPEN-LOCAL-OFFICE                                    **          
T20363**   OPENS READ_REASON CURSOR                                 **          
T20363****************************************************************          
T20363*                                                                         
T20363 7000-OPEN-LOCAL-OFFICE.                                          
T20363*                                                                         
T20363     MOVE '7000'                     TO WS-ACTIVE-PARAGRAPH.      
T20363*                                                                         
T20363     EXEC SQL                                                     
T20363          OPEN LOCAL_OFFICE                                       
T20363     END-EXEC.                                                    

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

T20363*                                                                         
T20363     IF  SQLCODE NOT EQUAL SUCCESSFUL-CALL                        
T20363         DISPLAY '*****  ERROR IN  7000-OPEN-LOCAL-OFFICE   *****'
T20363         DISPLAY '*****  RETURN CODE = ' SQLCODE                  
T20363         DISPLAY '*****  PROCESSING TERMINATED              *****'
T20363         PERFORM 9900-ABEND          THRU 9900-EXIT               
T20363     END-IF.                                                      
T20363*                                                                         
T20363 7000-EXIT.                                                       
T20363     EXIT.                                                        
T20363                                                                  
T20363****************************************************************          
T20363**  7010-FETCH-LOCAL-OFFICE                                   **          
T20363**   FETCHES LOCAL OFFICE CODE AND LOCAL OFFICE  DESCRIPTION  **          
T20363****************************************************************          
T20363*                                                                         
T20363 7010-FETCH-LOCAL-OFFICE.                                         
T20363*                                                                         
T20363     MOVE '7010'                     TO WS-ACTIVE-PARAGRAPH.      

MSQ008     MOVE 100 TO MSQ008-LOCAL-OFFICE
T20363*                                                                         
A01738     EXEC SQL                                                     
A01738          FOR :MSQ008-LOCAL-OFFICE
              FETCH 
              FROM LOCAL_OFFICE         
A01738           INTO :WS-LOC-COMPANY                                   
A01738               ,:WS-LOC-OFF                                       
A01738               ,:WS-LOC-OFF-DESC                                  
T20363     END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ008
MFA-TR*    EXEC SQL                                                             
MFA-TR*         FETCH NEXT ROWSET FROM LOCAL_OFFICE FOR 100 ROWS                
MFA-TR*          INTO :WS-LOC-COMPANY                                           
MFA-TR*              ,:WS-LOC-OFF                                               
MFA-TR*              ,:WS-LOC-OFF-DESC                                          
MFA-TR*    END-EXEC.                                                            

MSQ008      IF SQLCODE EQUAL ZERO AND
MSQ008        SQLERRD(3) < MSQ008-LOCAL-OFFICE
MSQ008         MOVE 100        TO SQLCODE
MSQ008         MOVE 2000       TO SQLSTATE
MSQ008      END-IF.
MSQ017     CALL "MFASQLCA"
MSQ017       USING SQLCA, BY VALUE MFA-PROGRAM-ID, "0", "0", "0",
MSQ017       BY REFERENCE MFSQLMESSAGETEXT
MSQ017     END-CALL

T20363*                                                                         
T20363     MOVE SQLCODE                    TO WS-ACTIVE-RETURN-CODE.    
T20363*                                                                         
T20363     IF  WS-ACTIVE-RETURN-CODE EQUAL SUCCESSFUL-CALL OR NOT-FOUND 
A01738         MOVE SQLERRD(3)              TO WS-LO-SUB                
T20363     ELSE                                                         
T20363         DISPLAY '****  ERROR IN 7010-FETCH-LOCAL OFFICE   ***'   
T20363         DISPLAY '****  RETURN CODE = ' SQLCODE                   
T20363         DISPLAY '****  PROCESSING TERMINATED              ***'   
T20363         PERFORM 9900-ABEND       THRU 9900-EXIT                  
T20363     END-IF.                                                      
T20363*                                                                         
T20363 7010-EXIT.                                                       
T20363     EXIT.                                                        
T20363*                                                                         
T20363****************************************************************          
T20363**   7020-CLOSE-READ-REASON                                   **          
T20363**    CLOSES LOCAL_OFFICE CURSOR                              **          
T20363****************************************************************          
T20363 7020-CLOSE-LOCAL-OFFICE.                                         
T20363*                                                                         
T20363     MOVE '7020'                     TO WS-ACTIVE-PARAGRAPH.      
T20363*                                                                         
T20363     EXEC SQL                                                     
T20363          CLOSE LOCAL_OFFICE                                      
T20363     END-EXEC.                                                    

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

T20363*                                                                         
T20363     IF  SQLCODE NOT EQUAL SUCCESSFUL-CALL                        
T20363         DISPLAY '****  ERROR IN 7020-CLOSE-LOCAL-OFFICE   ***'   
T20363         DISPLAY '****  RETURN CODE = ' SQLCODE                   
T20363         DISPLAY '****  PROCESSING TERMINATED              ***'   
T20363         PERFORM 9900-ABEND          THRU 9900-EXIT               
T20363     END-IF.                                                      
T20363*                                                                         
T20363 7020-EXIT.                                                       
T20363     EXIT.                                                        
      *                                                                         
      ****************************************************************          
      **                                                            **          
      **   7100-READ-FCSCA103                                       **          
      **       READS THE INPUT FILE FCSCA103-FILE                   **          
      **                                                            **          
      ****************************************************************          
      *                                                                         
       7100-READ-FCSCA103.                                              
      *                                                                         
           READ FCSCA103-FILE                                           
               AT END                                                   
                   MOVE WS-N           TO WS-MORE-DATA-SW               
                   GO                  TO 7100-EXIT.                    
      *                                                                         
           IF CA103-SUCCESSFUL                                          
A01738        EVALUATE TRUE                                             
A01738           WHEN E-FCA103-KEY-BREC = LOW-VALUES                    
A01738             SET FCA103-BEGIN-REC TO TRUE                         
A01738           WHEN E-FCA103-KEY-EREC = HIGH-VALUES                   
A01738             SET FCA103-FINAL-END-REC TO TRUE                     
A01738           WHEN E-FCA103-CO-KEY-EREC = HIGH-VALUES                
A01738             AND (E-FCA103-CO-NO-KEY-EREC = '01'                  
A01738                 OR E-FCA103-CO-NO-KEY-EREC = '26')               
A01738             SET FCA103-COMPANY-END-REC TO TRUE                   
A01738           WHEN E-FCA103-CO-NO-KEY-EREC = '01'                    
A01738             OR E-FCA103-CO-NO-KEY-EREC = '26'                    
A01738             SET FCA103-DATA-REC TO TRUE                          
A01738             COMPUTE WS-CA103-REC-CNTR = WS-CA103-REC-CNTR + 1    
A01738             COMPUTE WS-COMP-REC-CNTR  = WS-COMP-REC-CNTR + 1     
A01738        END-EVALUATE                                              
           ELSE                                                         
               DISPLAY '7100-ERROR ON FCSCA103 READ.  STATUS IS '       
                        WS-FCA103-STATUS                                
               PERFORM 9900-ABEND                THRU 9900-EXIT         
           END-IF.                                                      
      *                                                                         
       7100-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
T20676 7400-SELECT-READ-CYCLE.                                          
T20676*                                                                         
T20676     MOVE '7400' TO WS-ACTIVE-PARAGRAPH.                          
T20676*                                                                         
T20676     EXEC SQL                                                     
T20676         SELECT  MAX(READ_CYCLE)                                  
T20676           INTO :UT-READ-CYCLE                                    
T20676           FROM  CSS_UTIL_ENVRNMT WITH(READUNCOMMITTED)                   
T20676          WHERE  ACCOUNT_NO     = :UT-ACCOUNT-NO                  
T20676            AND  CODE_UTIL_TYPE = :UT-CODE-UTIL-TYPE              
A01738                                                           
A01738                                                      
T20676     END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ003
MFA-TR* MSQ022
MFA-TR*    EXEC SQL                                                             
MFA-TR*        SELECT  MAX(READ_CYCLE)                                          
MFA-TR*          INTO :UT-READ-CYCLE                                            
MFA-TR*          FROM  CSS_UTIL_ENVRNMT                                         
MFA-TR*         WHERE  ACCOUNT_NO     = :UT-ACCOUNT-NO                          
MFA-TR*           AND  CODE_UTIL_TYPE = :UT-CODE-UTIL-TYPE                      
MFA-TR*         WITH UR                                                         
MFA-TR*         QUERYNO 7400                                                    
MFA-TR*    END-EXEC.                                                            

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

T20676*                                                                         
T20676     MOVE SQLCODE            TO WS-ACTIVE-RETURN-CODE             
T20676     IF  WS-ACTIVE-RETURN-CODE  EQUAL SUCCESSFUL-CALL OR NOT-FOUND
T20676         NEXT SENTENCE                                            
T20676     ELSE                                                         
T20676         DISPLAY '* ERROR IN 7400-SELECT-READ-CYCLE *'            
T20676         DISPLAY '* RETURN CODE = ' WS-ACTIVE-RETURN-CODE         
T20676         DISPLAY '* ACCOUNT_NO  = ' UT-ACCOUNT-NO                 
A01738         DISPLAY '* UTIL TYPE   = ' UT-CODE-UTIL-TYPE             
T20676         DISPLAY '* PROCESSING TERMINATED           *'            
T20676         PERFORM 9900-ABEND  THRU 9900-EXIT                       
T20676     END-IF.                                                      
T20676*                                                                         
T20676 7400-EXIT.                                                       
T20676     EXIT.                                                        
T20676*                                                                         
      ****************************************************************          
      **                                                            **          
      **   7800-GET-COMPANY-DESC                                    **          
      **      READS THE COMPANY NAME WITH THE GIVEN CODE            **          
      **                                                            **          
      ****************************************************************          
      *                                                                         
       7800-GET-COMPANY-DESC.                                           
      *                                                                         
           MOVE '7800' TO WS-ACTIVE-PARAGRAPH.                          
      *                                                                         
           EXEC SQL                                                     
               SELECT    COMPANY_NAME                                   
               INTO  :C7-COMPANY-NAME                                   
               FROM  CSS_COMPANY WITH(READUNCOMMITTED)                          
               WHERE     COMPANY_NO   = :C7-COMPANY-NO                  
A01738                                                           
A01738                                                      
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ003
MFA-TR* MSQ022
MFA-TR*    EXEC SQL                                                             
MFA-TR*        SELECT    COMPANY_NAME                                           
MFA-TR*        INTO  :C7-COMPANY-NAME                                           
MFA-TR*        FROM  CSS_COMPANY                                                
MFA-TR*        WHERE     COMPANY_NO   = :C7-COMPANY-NO                          
MFA-TR*        WITH UR                                                          
MFA-TR*        QUERYNO 7800                                                     
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

      *                                                                         
           IF SQLCODE EQUAL SUCCESSFUL-CALL                             
               MOVE C7-COMPANY-NAME    TO P-RPT1-COMP-NAME              
           ELSE                                                         
               IF SQLCODE EQUAL NOT-FOUND                               
                   MOVE SPACES         TO P-RPT1-COMP-NAME              
               ELSE                                                     
                   DISPLAY '* SELECT ERROR IN 7800-GET-COMPANY-DESC *'  
                   DISPLAY '* RETURN CODE = ' WS-DISP-RETURN-CODE       
A01738             DISPLAY '* COMPANY NO  = ' C7-COMPANY-NO             
                   DISPLAY '*         PROCESSING TERMINATED         *'  
                   PERFORM 9900-ABEND            THRU 9900-EXIT         
               END-IF                                                   
           END-IF.                                                      
      *                                                                         
       7800-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      *===============================================================*         
       8100-PRINT-MAIN-HEADERS.                                         
      *===============================================================*         
      ***  PRINTS THE COMPANY NAME FOR THE REPORT                    **         
      *                                                                         
           ADD 1                       TO WS-RPT1-PAGE-NO.              
           MOVE WS-PGRMNAME            TO P-RPT1-TITLE-PGNM.            
      *                                                                         
           WRITE PRT33-RECORD FROM WS-RPT1-TITLE AFTER TOP-OF-PAGE.     
      *                                                                         
           MOVE WS-DEFAULT-RPT1-TITLE1 TO P-RPT1-HEAD1.                 
           WRITE PRT33-RECORD FROM WS-RPT1-HEADER-01 AFTER 1            
      *                                                                         
           MOVE WS-RPT1-PAGE-NO        TO P-RPT1-PAGE-NO.               
           WRITE PRT33-RECORD FROM WS-RPT1-HEADER-02 AFTER 1            
      *                                                                         
T18994     WRITE PRT33-RECORD FROM WS-RPT1-HEADER-30 AFTER 2            
A01738     MOVE 5                      TO WS-RPT1-LINE-NO.              
      *                                                                         
       8100-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
A01738*===============================================================*         
A01738 8200-PRINT-SUB-HEADERS.                                          
A01738*===============================================================*         
      *                                                                         
           WRITE PRT33-RECORD FROM WS-RPT1-HEADER-31 AFTER 2            
           WRITE PRT33-RECORD FROM WS-LINE           AFTER 1            
A01738     WRITE PRT33-RECORD FROM WS-RPT1-HEADER-32 AFTER 1            
A01738     WRITE PRT33-RECORD FROM WS-RPT1-HEADER-33 AFTER 1            
A01738     WRITE PRT33-RECORD FROM WS-RPT1-HEADER-34 AFTER 1            
A01738     ADD 6                       TO WS-RPT1-LINE-NO.              
A01738*                                                                         
A01738 8200-EXIT.                                                       
           EXIT.                                                        
      ****************************************************************          
      **   9000-TERMINATE                                           **          
      **       CLOSES ALL OPEN FILES AND TERMINATES THE PROGRAM     **          
      ****************************************************************          
      *                                                                         
       9000-TERMINATE.                                                  
      *                                                                         
           CLOSE FCSCA103-FILE.                                         
           IF CA103-SUCCESSFUL                                          
              CONTINUE                                                  
           ELSE                                                         
              DISPLAY '**  PCSRP102 PROCESSING ERROR  **'               
              DISPLAY '**  CLOSE ERROR FOR FCSCA103 - INPUT FILE'       
              DISPLAY '**  FILE STATUS = ' WS-FCA103-STATUS             
           END-IF.                                                      
      *                                                                         
           CLOSE FCSPT33-FILE.                                          
      *                                                                         
       9000-EXIT.                                                       
           EXIT.                                                        
      ****************************************************************          
      **  9700-PROCESS-ABEND                                        **          
      ****************************************************************          
           EXEC SQL                                                             
               INCLUDE CPD0023B                                                 
           END-EXEC.                                                            
      ****************************************************************          
      **  9900-ABEND                                                **          
      ****************************************************************          
           EXEC SQL                                                             
               INCLUDE CPD09900                                                 
           END-EXEC.                                                            
      ****************************************************************          
