       IDENTIFICATION DIVISION.                                         
       PROGRAM-ID.  PCSBW304.                                           
       DATE-WRITTEN.  APR. 99.                                          
       DATE-COMPILED.                                                   
       AUTHOR.         CBSIMDS                                          
      *****************************************************************         
      **              SOUTH CAROLINA ELECTRICITY  & GAS              **         
      **                                                             **         
      ********            CUSTOMER SERVICE SYSTEM             *********         
      ********                   DB2                          *********         
      *****************************************************************         
      **                                                             **         
      **              PROGRAM  MODIFICATION  LOG                     **         
      **                                                             **         
      ** DATE       INITIALS       REASON                            **         
      **                                                             **         
      ** 04/13/99   CBSI, MDS      DEVELOPMENT OF NEW REPORT PROGRAM **         
      *****************************************************************         
      *****************************************************************         
      **                                                             **         
      **              PROGRAM  MODIFICATION  LOG                     **         
      **                                                             **         
      ** DATE    INITIALS       REASON                               **         
      **________  ________   ______________                          **         
T30928**04/19/06  JC91900    CHANGES FOR TRANSFORMER DEMAND LOADING  **         
T30928**                     PROJECT.                                **         
T30928**05/01/06  JC91900    ADD "WITH UR" FOR ALL SQL STATEMENTS.   **         
      **                                                             **         
34855 ** 9 NOV 2006 RFD      CREATE AN OUTPUT FILE - SAME AS PRINTER,**         
34855 **                     EXCEPT WITH NO HEADERS, TO SEND TO      **         
34855 **                     XCOMEX                                  **         
T35434** 05/15/07 SP94986    REPLACED MODEL_SQL TO SET COMMANDS.     **         
      **                                                             **         
36831 ** 28 JAN 2008 RDF     ADD REVENUE MONTH TO RICH FILE.         **         
      **                     MADE RICH FILE INTO A COPYBOOK AND      **         
      **                     CHANGED ALL REFERENCES FROM RICH TO     **         
      **                     E-FBW304.                               **         
A02778** 10/10/10   MC95456  ADD KWH FIELDS TO THE REPORT            **         
ACT004** 08/23/11   MC95456  ADD NO OF DAYS FIELD TO THE REPORT      **         
ACT004**          A02778-ACT004                                      **         
      *****************************************************************         
      *                   PCSBW304   NARRATIVE                        *         
      *                                                               *         
      * THIS PROGRAM READS THE OUTPUT FROM PCSBW303 AND GETS THE      *         
      * LOCAL OFFICE DESCRIPTION AND DISTRICT DESCRIPTION BASED ON    *         
      * LOCAL OFFICE AND DISTRICT CODE, PRINTS A REPORT WHICH BREAKS  *         
      * IN THE ORDER OF DISTRICT, LOCAL OFFICE AND POINT-ID.          *         
      * PAGE BREAKS WHEN EVER THERE IS A BREAK FOR DISTRICT OR        *         
      * LOCAL OFFICE AND PRINTS THE POINT-ID TOTALS WHERE THERE IS    *         
      * A BREAK IN POINT-ID.                                          *         
      *                                                               *         
      *****************************************************************         
      *                                                                         
                    ---- BASIC SEQUENCE STRUCTURE ----                  
                0000 - 0999     MAIN CONTROL PATH AND INITIALIZATION    
                1000 - 1999     INPUT PROCESSING CONTROL PATH           
                7000 - 7999     DATABASE ACCESS / INPUT MODULES         
                8000 - 8999     OUTPUT MODULES                          
                9000 - 9799     TERMINATION MODULES                     
HPCCDM*EJECT                                                                    
       ENVIRONMENT DIVISION.                                            
       INPUT-OUTPUT SECTION.                                            
       FILE-CONTROL.                                                    
      *                                                                         
       COPY CSSBW302.                                                           
      *                                                                         
36831  COPY CSSBW304.                                                           
      *                                                                         
       COPY CSSPT33.                                                            
      *                                                                         
       DATA DIVISION.                                                   
       FILE SECTION.                                                    
      *                                                                         
36831  COPY CFDBW304.                                                           
      *                                                                         
36831  COPY FIOBW304.                                                           
      *                                                                         
       COPY CFDPT33.                                                            
      *                                                                         
       COPY CFDBW302.                                                           
      *                                                                         
       COPY FIOBW302.                                                           
      *                                                                         
       WORKING-STORAGE SECTION.                                         

MSQ017 01 MFA-PROGRAM-ID PIC X(8) VALUE 'PCSBW304'.
MSQ017     COPY MFASQLM.
      *                                                                         
       01  WS-DATE.                                                     
           05  WS-DT-YR                        PIC X(04).               
           05  FILLER                          PIC X(01) VALUE '-'.     
           05  WS-DT-MM                        PIC X(02).               
           05  FILLER                          PIC X(01) VALUE '-'.     
           05  WS-DT-DD                        PIC X(02).               
      *                                                                         
       01  WS-TIME.                                                     
           05  WS-TIME-HH                      PIC X(02).               
           05  FILLER                          PIC X(01) VALUE ':'.     
           05  WS-TIME-MIN                     PIC X(02).               
           05  FILLER                          PIC X(01) VALUE ':'.     
           05  WS-TIME-SS                      PIC X(02).               
      *                                                                         
       01  WS-RPT-DATE.                                                 
           05 WS-RPT-MM                        PIC X(02).               
           05 FILLER                           PIC X(01)  VALUE '/'.    
           05 WS-RPT-DD                        PIC X(02).               
           05 FILLER                           PIC X(01)  VALUE '/'.    
           05 WS-RPT-YR                        PIC X(04).               
      *                                                                         
       01  WS-LITERALS.                                                 
           05 WS-ONE                           PIC 9(01)  VALUE 1.      
           05 WS-TWO                           PIC 9(01)  VALUE 2.      
           05 WS-THREE                         PIC 9(01)  VALUE 3.      
           05 WS-ELEVEN                        PIC 9(02)  VALUE 11.     
           05 WS-TWELVE                        PIC 9(02)  VALUE 12.     
           05 WS-THIRTEEN                      PIC 9(02)  VALUE 13.     
           05 WS-SIX                           PIC 9(01)  VALUE 6.      
           05 WS-FOUR                          PIC 9(01)  VALUE 4.      
           05 WS-FIFTY-ONE                     PIC 9(02)  VALUE 51.     
           05 WS-FIFTY-FOUR                    PIC 9(02)  VALUE 54.     
           05 WS-FIFTY-SEVEN                   PIC 9(02)  VALUE 57.     
           05 WS-34                            PIC 9(02)  VALUE 34.     
           05 WS-85                            PIC 9V99   VALUE 0.85.   
           05 WS-PF                            PIC 9V99   VALUE ZEROS.  
           05 WS-Y                             PIC X(01)  VALUE 'Y'.    
           05 WS-ASTERIX                       PIC X(01)  VALUE '*'.    
           05 WS-N                             PIC X(01)  VALUE 'N'.    
           05 WS-A                             PIC X(01)  VALUE 'A'.    
           05 WS-B                             PIC X(01)  VALUE 'B'.    
           05 WS-FINAL                         PIC X(10)                
              VALUE 'FINALLED  '.                                       
           05 WS-INACTIVE                      PIC X(10)                
              VALUE 'NOT ACTIVE'.                                       
      *                                                                         
       01  WS-VARIABLES.                                                
           05 WS-LINE-CNTR                     PIC 9(02)  VALUE 57.     
           05 WS-POINT-ID-CNTR                 PIC 9(02)  VALUE ZEROS.  
           05 WS-BLANK-LINE                    PIC X(132) VALUE SPACES. 
           05 WS-RPT-EXTRACT-MONTH             PIC X(10)  VALUE SPACES. 
           05 WS-RPT-EXTRACT-YR                PIC 9(04)  VALUE ZEROS.  
           05 WS-PAGE                          PIC 9(04)  VALUE ZEROS.  
           05 WS-RECD-COUNT                    PIC 9(04)  VALUE ZEROS.  
           05 WS-LINE-SPACE                    PIC 9(01)  VALUE ZERO.   
           05 WS-ACCT-NO-ED                    PIC 9,9999,9999,9999.    
           05 WS-NULL-IND                      PIC S9(04) COMP          
                                                          VALUE ZEROS.  
           05 WS-NULL                          PIC S9(01) VALUE -1.     
           05 WS-HEADER-DATE-FMT.                                       
              10 WS-HEADER-CC                  PIC 9(02)  VALUE ZEROS.  
              10 WS-HEADER-YR                  PIC 9(02)  VALUE ZEROS.  
              10 FILLER                        PIC X(01)  VALUE '/'.    
              10 WS-HEADER-MM                  PIC 9(02)  VALUE ZEROS.  
              10 FILLER                        PIC X(01)  VALUE '/'.    
              10 WS-HEADER-DD                  PIC 9(02)  VALUE ZEROS.  
           05 WS-CURRENT-DATE                  PIC X(10)  VALUE SPACES. 
           05 WS-CURRENT-TIME                  PIC X(08)  VALUE SPACES. 
           05 WS-RUN-REV-MONTH                 PIC 9(06)  VALUE ZEROS.  
           05 WS-REV-YR-BKUP REDEFINES WS-RUN-REV-MONTH.                
              10 WS-REV-YEAR                   PIC 9(04).               
              10 WS-REV-MONTH                  PIC 9(02).               
           05 WS-POINT-ID                      PIC X(10)  VALUE SPACES. 
           05 WS-POINT-ID-PREV                 PIC X(10)  VALUE SPACES. 
           05 WS-LOCAL-OFFICE                  PIC X(03)  VALUE SPACES. 
           05 WS-LOCAL-OFFICE-PREV             PIC X(03)  VALUE SPACES. 
           05 WS-DISTRICT-NO                   PIC X(03)  VALUE SPACES. 
           05 WS-DISTRICT-NO-PREV              PIC X(03)  VALUE SPACES. 
           05 WS-TOTAL-CUST-KVA                PIC S9(11) COMP-3        
                                                          VALUE ZEROS.  
           05 PROGRAM-NAME                     PIC X(08)  VALUE         
              'PCSBW304'.                                               
           05 RS-RETURN-CODE                   PIC S9(9) VALUE          
              +000 COMP.                                                
           05 RS-RETURN-CODE-DISP              PIC S9(9) VALUE          
              +000 COMP.                                                
           05 WS-CUST-KW                       PIC S9(10) VALUE ZEROS.  
           05 WS-CUST-KVA                      PIC S9(10) VALUE ZEROS.  
           05 WS-HOLD-RECORD                   PIC X(132) VALUE SPACES. 
           05  WS-MONTH-NAME.                                           
               10  FILLER                        PIC X(10) VALUE        
                  'JANUARY   '.                                         
               10  FILLER                        PIC X(10) VALUE        
                  'FEBRUARY  '.                                         
               10  FILLER                        PIC X(10) VALUE        
                  'MARCH     '.                                         
               10  FILLER                        PIC X(10) VALUE        
                  'APRIL     '.                                         
               10  FILLER                        PIC X(10) VALUE        
                  'MAY       '.                                         
               10  FILLER                        PIC X(10) VALUE        
                  'JUNE      '.                                         
               10  FILLER                        PIC X(10) VALUE        
                  'JULY      '.                                         
               10  FILLER                        PIC X(10) VALUE        
                  'AUGUST    '.                                         
               10  FILLER                        PIC X(10) VALUE        
                  'SEPTEMBER '.                                         
               10  FILLER                        PIC X(10) VALUE        
                  'OCTOBER   '.                                         
               10  FILLER                        PIC X(10) VALUE        
                  'NOVEMBER  '.                                         
               10  FILLER                        PIC X(10) VALUE        
                  'DECEMBER  '.                                         
           05  WS-MONTH-TABLE REDEFINES WS-MONTH-NAME.                  
               10  WS-MONTH-A                    PIC X(10) OCCURS       
                                                 12 TIMES.              
      *                                                                         
       01  WS-SWITCHES.                                                 
           05 WS-FBW302-STATUS                 PIC X(02).               
              88 INFILE-SUCCESSFUL                        VALUE '00'.   
36831      05 WS-FBW304-STATUS                 PIC X(02).               
36831         88 FBW304-SUCCESSFUL                        VALUE '00'.   
           05 WS-INFILE-EOF                    PIC X(01)  VALUE 'N'.    
              88 END-OF-FILE                              VALUE 'Y'.    
           05 WS-READ-STATUS                   PIC X(01)  VALUE 'Y'.    
              88 FIRST-READ                               VALUE 'Y'.    
              88 NOT-FIRST-READ                           VALUE 'N'.    
           05 WS-TOTAL-LINE                    PIC X(01)  VALUE SPACES. 
              88 TOTAL-LINE                               VALUE 'Y'.    
              88 NOT-TOTAL-LINE                           VALUE 'N'.    
      *                                                                         
       01  WS-HDR-ONE.                                                  
           05 FILLER                           PIC X(08)  VALUE         
              'PCSBW304'.                                               
           05 FILLER                           PIC X(43)  VALUE SPACES. 
           05 FILLER                           PIC X(39)  VALUE         
              'SOUTH CAROLINA ELECTRIC AND GAS COMPANY'.                
           05 FILLER                           PIC X(23)  VALUE SPACES. 
           05 FILLER                           PIC X(09)  VALUE         
              'RUN DATE:'.                                              
           05 WS-RUN-DATE                      PIC X(10)  VALUE SPACES. 
      *                                                                         
       01  WS-HDR-TWO.                                                  
           05 FILLER                           PIC X(06)  VALUE         
              'DATE: '.                                                 
           05 WS-HEADER-DATE.                                           
              10 WS-HDR-MM                     PIC X(02) VALUE SPACES.  
              10 FILLER                        PIC X(01) VALUE '/'.     
              10 WS-HDR-DD                     PIC X(02) VALUE SPACES.  
              10 FILLER                        PIC X(01) VALUE '/'.     
              10 WS-HDR-YY                     PIC X(02) VALUE SPACES.  
           05 FILLER                           PIC X(32) VALUE SPACES.  
           05 FILLER                           PIC X(49) VALUE          
              'PERCENT OF TRANSFORMER CAPACITY USED BY CUSTOMERS'.      
           05 FILLER                           PIC X(18) VALUE SPACES.  
           05 FILLER                           PIC X(11) VALUE          
              'RUN TIME:  '.                                            
           05 WS-RUN-TIME                      PIC X(08) VALUE SPACES.  
      *                                                                         
       01  WS-HDR-THREE.                                                
           05 FILLER                           PIC X(64)  VALUE SPACES. 
           05 WS-RPT-REV-MTH-YR                PIC X(16)  VALUE SPACES. 
           05 FILLER                           PIC X(37)  VALUE SPACES. 
           05 FILLER                           PIC X(09)  VALUE         
              'PAGE:    '.                                              
           05 WS-DET-PAGE                      PIC ZZ,ZZ9.              
      *                                                                         
       01  WS-HDR-FOUR.                                                 
           05 FILLER                           PIC X(15)  VALUE         
              'DISTRICT     - '.                                        
           05 WS-RPT-DISTRICT-NO               PIC X(03)  VALUE SPACES. 
           05 FILLER                           PIC X(02)  VALUE SPACES. 
           05 WS-RPT-DISTRICT                  PIC X(32)  VALUE SPACES. 
           05 FILLER                           PIC X(80)  VALUE SPACES. 
      *                                                                         
       01  WS-HDR-FOUR1.                                                
           05 FILLER                           PIC X(15)  VALUE         
              'LOCAL OFFICE - '.                                        
           05 WS-RPT-LOCAL-OFFICE              PIC X(03)  VALUE SPACES. 
           05 FILLER                           PIC X(02)  VALUE SPACES. 
           05 WS-RPT-LOC-OFF-DESC              PIC X(22)  VALUE SPACES. 
           05 FILLER                           PIC X(90)  VALUE SPACES. 
      *                                                                         
       01  WS-HDR-FIVE.                                                 
           05 FILLER                           PIC X(18)  VALUE SPACES. 
           05 FILLER                           PIC X(06)  VALUE         
             'TRANS-'.                                                  
           05 FILLER                           PIC X(45)  VALUE SPACES. 
           05 FILLER                           PIC X(08)  VALUE         
             '%LOAD ON'.                                                
           05 FILLER                           PIC X(70)  VALUE SPACES. 
      *                                                                         
       01  WS-HDR-SIX.                                                  
           05 FILLER                           PIC X(18)  VALUE SPACES. 
           05 FILLER                           PIC X(06)  VALUE         
             'FORMER'.                                                  
           05 FILLER                           PIC X(38)  VALUE SPACES. 
           05 FILLER                           PIC X(05)  VALUE         
             'POWER'.                                                   
           05 FILLER                           PIC X(03)  VALUE SPACES. 
           05 FILLER                           PIC X(06)  VALUE         
             'TRANS-'.                                                  
           05 FILLER                           PIC X(03)  VALUE SPACES. 
           05 FILLER                           PIC X(09)  VALUE         
             'METER NBR'.                                               
           05 FILLER                           PIC X(58)  VALUE SPACES. 
      *                                                                         
       01  WS-HDR-SEVEN.                                                
           05 FILLER                           PIC X(02)  VALUE SPACES. 
           05 FILLER                           PIC X(08)  VALUE         
              'POINT ID'.                                               
           05 FILLER                           PIC X(07)  VALUE SPACES. 
           05 FILLER                           PIC X(08)  VALUE         
              'CAPACITY'.                                               
           05 FILLER                           PIC X(06)  VALUE SPACES. 
A02778     05 FILLER                           PIC X(08)  VALUE         
A02778       'CUST KWH'.                                                
           05 FILLER                           PIC X(04)  VALUE SPACES. 
           05 FILLER                           PIC X(04)  VALUE         
             'CUST'.                                                    
           05 FILLER                           PIC X(04)  VALUE SPACES. 
A02778     05 FILLER                           PIC X(08)  VALUE         
A02778       'CUST KW'.                                                 
           05 FILLER                           PIC X(02)  VALUE SPACES. 
           05 FILLER                           PIC X(06)  VALUE         
             'FACTOR'.                                                  
           05 FILLER                           PIC X(02)  VALUE SPACES. 
           05 FILLER                           PIC X(06)  VALUE         
             'FORMER'.                                                  
           05 FILLER                           PIC X(15)  VALUE SPACES. 
           05 FILLER                           PIC X(04)  VALUE         
             'RATE'.                                                    
           05 FILLER                           PIC X(02)  VALUE SPACES. 
           05 FILLER                           PIC X(17)  VALUE         
             'CUSTOMER LOCATION'.                                       
           05 FILLER                           PIC X(33)  VALUE SPACES. 
      *                                                                         
       01 WS-HDR-EIGHT.                                                 
          05 FILLER                            PIC X(01)  VALUE SPACES. 
          05 FILLER                            PIC X(18)  VALUE         
            'TRANSFORMER TOTALS'.                                       
          05 FILLER                            PIC X(01)  VALUE SPACES. 
          05 WS-RPT-TOTAL-CUST-KVA             PIC ZZ,ZZZ,ZZ9.          
          05 FILLER                            PIC X(20)  VALUE SPACES. 
          05 WS-RPT-TOT-PCT-LD-ON-XFRMR        PIC ZZZ,ZZ9.             
      *                                                                         
       01  WS-HDR-NINE.                                                 
           05 FILLER                           PIC X(43)  VALUE SPACES. 
           05 FILLER                           PIC X(03)  VALUE         
             'KVA'.                                                     
           05 FILLER                           PIC X(102) VALUE SPACES. 
      *                                                                         
       01  WS-HDR-TEN.                                                  
           05 FILLER                           PIC X(23)  VALUE SPACES. 
           05 FILLER                           PIC X(08)  VALUE         
             '========'.                                                
           05 FILLER                           PIC X(19)  VALUE SPACES. 
           05 FILLER                           PIC X(07)  VALUE         
             '======='.                                                 
           05 FILLER                           PIC X(77)  VALUE SPACES. 
      *                                                                         
       01  WS-HDR-ELEVEN.                                               
           05 FILLER                           PIC X(1)   VALUE SPACES. 
           05 FILLER                           PIC X(50)  VALUE         
             '* - 85% POWER FACTOR USED TO CALCULATE KVA FROM KW'.      
           05 FILLER                           PIC X(81)  VALUE SPACES. 
      *                                                                         
HPCCDM*SKIP1                                                                    
      *                                                                         
       01  WS-DET-LINE1.                                                
           05 FILLER                           PIC X(01)  VALUE SPACES. 
           05 WS-RPT-POINT-ID                  PIC X(10)  VALUE SPACES. 
           05 FILLER                           PIC X(04)  VALUE SPACES. 
           05 WS-RPT-XFORMER-CAPACITY          PIC ZZZ,ZZZ,ZZ9.         
A02778     05 FILLER                           PIC X(01)  VALUE SPACES. 
A02778     05 WS-RPT-CUST-KWH                  PIC Z,ZZZ,ZZ9.           
           05 FILLER                           PIC X(01)  VALUE SPACES. 
           05 WS-RPT-CUST-KVA.                                          
              10 WS-RPT-CUST-KVA-BK            PIC Z,ZZZ,ZZ9.           
              10 WS-FILLER                     PIC X(1)   VALUE SPACES. 
           05 FILLER                           PIC X(01)  VALUE SPACES. 
           05 WS-RPT-CUST-KW                   PIC Z,ZZZ,ZZ9.           
           05 FILLER                           PIC X(05)  VALUE SPACES. 
           05 WS-RPT-PF                        PIC 9.99.                
           05 FILLER                           PIC X(04)  VALUE SPACES. 
           05 WS-RPT-PCT-LOAD-XFORMER          PIC ZZZZ9.               
           05 FILLER                           PIC X(03)  VALUE SPACES. 
           05 WS-RPT-METER-NBR                 PIC X(09).               
           05 FILLER                           PIC X(05)  VALUE SPACES. 
           05 WS-RPT-RATE                      PIC X(03).               
           05 FILLER                           PIC X(03)  VALUE SPACES. 
C30928     05 WS-RPT-CUSTOMER                  PIC X(47).               
      *                                                                         
       01  WS-DET-LINE2.                                                
C30928     05 FILLER                           PIC X(99)  VALUE SPACES. 
           05 WS-RPT-ACCT-NO                   PIC X(16)  VALUE SPACES. 
           05 FILLER                           PIC X(01)  VALUE SPACES. 
C30928     05 WS-RPT-ADDR-STREET               PIC X(31)  VALUE SPACES. 
      *                                                                         
       01  WS-DET-LINE3.                                                
C30928     05 FILLER                           PIC X(99)  VALUE SPACES. 
           05 WS-RPT-ACCT-STATUS               PIC X(10)  VALUE SPACES. 
           05 FILLER                           PIC X(07)  VALUE SPACES. 
           05 WS-RPT-CITY-ST                   PIC X(30)  VALUE SPACES. 
      *                                                                         
       01  WS-FOOT-LINE.                                                
           05 FILLER                           PIC X(55)  VALUE SPACES. 
           05 FILLER                           PIC X(22)  VALUE         
              '*** END OF  REPORT ***'.                                 
           05 FILLER                           PIC X(55)  VALUE SPACES. 
      *                                                                         
      *****************************************************************         
      **      APPLICATION  TABLE DCLGENS                             **         
      *****************************************************************         
           EXEC SQL                                                             
               INCLUDE SQLCA                                                    
           END-EXEC.                                                            
      **                                                                        
      *****************************************************************         
      *  CSS_ACCOUNT                                                            
      *****************************************************************         
           EXEC SQL                                                             
               INCLUDE TBACCT                                                   
           END-EXEC.                                                            
      *                                                                         
      *****************************************************************         
      *  CSS_NAME                                                               
      *****************************************************************         
           EXEC SQL                                                             
               INCLUDE TBNAME                                                   
           END-EXEC.                                                            
      *                                                                         
      *****************************************************************         
      *  CSS_NAME_ACCT_XREF                                                     
      *****************************************************************         
           EXEC SQL                                                             
               INCLUDE TBNMACTX                                                 
           END-EXEC.                                                            
      *                                                                         
      *****************************************************************         
      *  CSS_CUST_ADDR_XREF                                                     
      *****************************************************************         
           EXEC SQL                                                             
               INCLUDE TBCSADRX                                                 
           END-EXEC.                                                            
      *                                                                         
      *****************************************************************         
      * CSS_ADDR_FREEFORM                                                       
      *****************************************************************         
           EXEC SQL                                                             
               INCLUDE TBADRFRE                                                 
           END-EXEC.                                                            
      *                                                                         
      *****************************************************************         
      * CSS_ADDR_FORMATTED                                                      
      *****************************************************************         
           EXEC SQL                                                             
               INCLUDE TBADRFMT                                                 
           END-EXEC.                                                            
      *                                                                         
      *****************************************************************         
      * CSS_ZIP_CODE                                                            
      *****************************************************************         
           EXEC SQL                                                             
               INCLUDE TBZIPCD                                                  
           END-EXEC.                                                            
      *                                                                         
      *****************************************************************         
      * CSS_ACCT_MISC_INFO                                                      
      *****************************************************************         
           EXEC SQL                                                             
               INCLUDE TBATMISC                                                 
           END-EXEC.                                                            
      *                                                                         
      *****************************************************************         
      * OASIS_POINT                                                             
      *****************************************************************         
           EXEC SQL                                                             
               INCLUDE TBOASPT                                                  
           END-EXEC.                                                            
      *                                                                         
      *****************************************************************         
      * CSS_DISTRICT                                                            
      *****************************************************************         
           EXEC SQL                                                             
               INCLUDE TBDISTRT                                                 
           END-EXEC.                                                            
      *                                                                         
      *****************************************************************         
      * CSS_LOCAL_OFFICE                                                        
      *****************************************************************         
           EXEC SQL                                                             
               INCLUDE TBLOCOFC                                                 
           END-EXEC.                                                            
      *****************************************************************         
      *                                                                         
       COPY CWS00303.                                                           
      *-- COPY BOOK HAVING SUCCESSFUL-CALL AND NOT-FOUND                        
                                                                        
      *  ABEND SWITCH COPYBOOK                                                  
       COPY CWS09900.                                                           
      *                                                                         
      * -- USED BY CPD00074. CREATE MAIL NAME AND ADDRESS                       
       COPY CWS00074.                                                           
      * -- USED BY CPD00004                                                     
      * WORKING STORAGE AREA USED TO REDUCE EMBEDDED BLANKS                     
       COPY CWS00011.                                                           
      * -- USED BY CPD0303B                                                     
      * WS ABEND WORK AREA                                                      
       COPY CWS00010.                                                           
      *                                                                         
      ******************************************************************        
       PROCEDURE DIVISION.                                              
      *                                                                         
       0000-MAINLINE.                                                   
      *                                                                         
           PERFORM 0100-INITIALISATION         THRU 0100-EXIT.          
      *                                                                         
           PERFORM 1000-READ-INFILE            THRU 1000-EXIT           
                                            UNTIL END-OF-FILE.          
      *                                                                         
           PERFORM 9000-TERMINATE              THRU 9000-EXIT.          
      *                                                                         
           STOP RUN.                                                    
      *                                                                         
       0000-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ******************************************************************        
      *   THIS PARA OPENS THE INPUT AND OUTPUT FILES AND SETS DATE AND *        
      *   TIME FOR THE REPORT HEADERS.                                 *        
      ******************************************************************        
      *                                                                         
       0100-INITIALISATION.                                             
                                                                        
           OPEN INPUT  FCSBW302-FILE                                    
                OUTPUT FCSPT33-FILE                                     
34855                  FCSBW304-FILE.                                   
      *                                                                         
           IF  INFILE-SUCCESSFUL                                        
               CONTINUE                                                 
           ELSE                                                         
               DISPLAY 'ERROR IN OPENING INFILE'                        
               DISPLAY 'ERROR STATUS ' WS-FBW302-STATUS                 
               PERFORM 9000-TERMINATE          THRU 9000-EXIT           
           END-IF.                                                      
      *                                                                         
           PERFORM 0110-SET-DATE-IN-HDRS       THRU 0110-EXIT.          
      *                                                                         
       0100-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ******************************************************************        
      * THIS PROCESS SETS THE DATE AND TIME FOR THE REPORT             *        
      ******************************************************************        
      *                                                                         
       0110-SET-DATE-IN-HDRS.                                           
                                                                        
           PERFORM 7000-GET-CURRENT-DATE       THRU 7000-EXIT.          
      *                                                                         
           MOVE WS-CURRENT-DATE                TO WS-DATE.              
           MOVE WS-CURRENT-TIME                TO WS-TIME.              
           MOVE WS-TIME                        TO WS-RUN-TIME.          
           MOVE WS-DT-YR                       TO WS-RPT-YR.            
           MOVE WS-DT-MM                       TO WS-RPT-MM.            
           MOVE WS-DT-DD                       TO WS-RPT-DD.            
      *                                                                         
           MOVE WS-RPT-DATE                    TO WS-RUN-DATE.          
      *                                                                         
       0110-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ******************************************************************        
      *  READS THE INPUT FILE AND AT END PRINTS THE FOOT LINE         **        
      ******************************************************************        
       1000-READ-INFILE.                                                
      *                                                                         
           READ FCSBW302-FILE                                           
               AT END                                                   
                  SET END-OF-FILE              TO TRUE                  
                  IF WS-POINT-ID-CNTR >= WS-ONE                         
                     PERFORM 2500-POINT-ID-BREAK THRU 2500-EXIT         
                  END-IF                                                
                  MOVE WS-HDR-ELEVEN           TO PRT33-DATA            
                  PERFORM 8200-WRITE-PRINT-REC THRU 8200-EXIT           
                  MOVE WS-FOOT-LINE            TO PRT33-DATA            
                  MOVE WS-TWO                  TO WS-LINE-SPACE         
                  PERFORM 8200-WRITE-PRINT-REC THRU 8200-EXIT           
                  GO TO 1000-EXIT.                                      
      *                                                                         
           IF  INFILE-SUCCESSFUL                                        
               IF E-FBW302-KEY-BREC = LOW-VALUES                        
                  MOVE E-FBW302-CREATE-DATE-BREC                        
                                               TO WS-HEADER-DATE-FMT    
                  MOVE WS-HEADER-MM            TO WS-HDR-MM             
                  MOVE WS-HEADER-DD            TO WS-HDR-DD             
                  MOVE WS-HEADER-YR            TO WS-HDR-YY             
                  MOVE E-FBW302-RUN-REV-MONTH  TO WS-RUN-REV-MONTH      
                  MOVE WS-MONTH-A (WS-REV-MONTH)                        
                                               TO WS-RPT-EXTRACT-MONTH  
                  MOVE WS-REV-YEAR             TO WS-RPT-EXTRACT-YR     
                  STRING WS-RPT-EXTRACT-MONTH  DELIMITED BY ' '         
                         ', ' DELIMITED BY SIZE                         
                         WS-RPT-EXTRACT-YR DELIMITED BY SIZE            
                  INTO WS-RPT-REV-MTH-YR                                
               ELSE                                                     
                  IF E-FBW302-KEY-EREC = HIGH-VALUES                    
                     MOVE E-FBW302-REC-COUNT-EREC TO WS-RECD-COUNT      
                     DISPLAY 'NO OF RECORDS READ' , WS-RECD-COUNT       
                  ELSE                                                  
                     PERFORM 2000-PROCESS-INPUT   THRU 2000-EXIT        
                  END-IF                                                
               END-IF                                                   
           ELSE                                                         
               DISPLAY 'ERROR IN READING INFILE'                        
               DISPLAY 'ERROR STATUS ' WS-FBW302-STATUS                 
               DISPLAY '  PROCESSING TERMINATED  '                      
               PERFORM 9000-TERMINATE          THRU 9000-EXIT           
           END-IF.                                                      
      *                                                                         
       1000-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ***************************************************************           
      * THIS PARA CHECKS FOR THE POINT-ID AND LOCAL-OFFICE BREAK    *           
      * FOR THE REPORT.                                             *           
      ***************************************************************           
      *                                                                         
       2000-PROCESS-INPUT.                                              
           MOVE E-FBW302-LOCAL-OFFICE          TO WS-LOCAL-OFFICE.      
           MOVE E-FBW302-POINT-ID              TO WS-POINT-ID.          
           MOVE E-FBW302-DISTRICT-NO           TO WS-DISTRICT-NO.       
           IF FIRST-READ                                                
              MOVE E-FBW302-LOCAL-OFFICE       TO WS-LOCAL-OFFICE-PREV  
              MOVE E-FBW302-POINT-ID           TO WS-POINT-ID-PREV      
              MOVE E-FBW302-DISTRICT-NO        TO O6-DISTRICT-NO        
                                                  WS-RPT-DISTRICT-NO    
                                                  WS-DISTRICT-NO-PREV   
              PERFORM 7100-GET-DIST-DESC       THRU 7100-EXIT           
              MOVE O6-DISTRICT-DESC            TO WS-RPT-DISTRICT       
              MOVE WS-LOCAL-OFFICE             TO WS-RPT-LOCAL-OFFICE   
                                                  B1-LOCAL-OFFICE       
              PERFORM 7105-GET-LOC-OFF-DESC    THRU 7105-EXIT           
              MOVE B1-LOCAL-OFFICE-DESC        TO WS-RPT-LOC-OFF-DESC   
           END-IF.                                                      
           IF WS-LOCAL-OFFICE = WS-LOCAL-OFFICE-PREV AND                
              WS-DISTRICT-NO  = WS-DISTRICT-NO-PREV                     
              IF WS-POINT-ID = WS-POINT-ID-PREV                         
                 IF NOT-FIRST-READ                                      
                    ADD WS-ONE                 TO WS-POINT-ID-CNTR      
                 ELSE                                                   
                    NEXT SENTENCE                                       
                 END-IF                                                 
              ELSE                                                      
                 IF WS-POINT-ID-CNTR >= WS-ONE                          
                    PERFORM 2500-POINT-ID-BREAK THRU 2500-EXIT          
                 ELSE                                                   
                    INITIALIZE WS-TOTAL-CUST-KVA                        
                 END-IF                                                 
                 MOVE E-FBW302-POINT-ID        TO WS-POINT-ID-PREV      
                 INITIALIZE WS-POINT-ID-CNTR                            
36831         END-IF                                                    
           ELSE                                                         
              IF WS-POINT-ID-CNTR >= WS-ONE                             
                 PERFORM 2500-POINT-ID-BREAK   THRU 2500-EXIT           
              ELSE                                                      
                 INITIALIZE WS-TOTAL-CUST-KVA                           
              END-IF                                                    
              INITIALIZE WS-POINT-ID-CNTR                               
              MOVE WS-FIFTY-SEVEN              TO WS-LINE-CNTR          
              MOVE E-FBW302-DISTRICT-NO        TO O6-DISTRICT-NO        
                                                  WS-RPT-DISTRICT-NO    
              PERFORM 7100-GET-DIST-DESC       THRU 7100-EXIT           
              MOVE O6-DISTRICT-DESC            TO WS-RPT-DISTRICT       
              MOVE WS-LOCAL-OFFICE             TO WS-RPT-LOCAL-OFFICE   
                                                  B1-LOCAL-OFFICE       
              PERFORM 7105-GET-LOC-OFF-DESC    THRU 7105-EXIT           
              MOVE B1-LOCAL-OFFICE-DESC        TO WS-RPT-LOC-OFF-DESC   
              PERFORM 8300-PRINT-LOC-OFF-HDR                            
                                               THRU 8300-EXIT           
              MOVE E-FBW302-LOCAL-OFFICE       TO WS-LOCAL-OFFICE-PREV  
              MOVE E-FBW302-DISTRICT-NO        TO WS-DISTRICT-NO-PREV   
              MOVE E-FBW302-POINT-ID           TO WS-POINT-ID-PREV      
           END-IF.                                                      
           PERFORM 2600-WRITE-REPORT           THRU 2600-EXIT.          
       2000-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      *****************************************************************         
      * THIS PARA PRINTS THE POINT-ID TOTALS FOR POINT-ID BREAK IN THE*         
      * REPORT.                                                       *         
      *****************************************************************         
      *                                                                         
       2500-POINT-ID-BREAK.                                             
           IF NOT-FIRST-READ                                            
              MOVE WS-TOTAL-CUST-KVA        TO WS-RPT-TOTAL-CUST-KVA    
              SET  TOTAL-LINE               TO TRUE                     
              MOVE WS-HDR-TEN               TO PRT33-DATA               
              PERFORM 8000-WRITE-PRINTER-RECORD THRU 8000-EXIT          
              SET NOT-TOTAL-LINE            TO TRUE                     
              MOVE WS-HDR-EIGHT             TO PRT33-DATA               
              PERFORM 8000-WRITE-PRINTER-RECORD THRU 8000-EXIT          
              MOVE WS-TWO                   TO WS-LINE-SPACE            
              MOVE WS-BLANK-LINE            TO PRT33-DATA               
              PERFORM 8000-WRITE-PRINTER-RECORD THRU 8000-EXIT          
              ADD WS-ONE                    TO WS-LINE-CNTR             
              INITIALIZE WS-TOTAL-CUST-KVA                              
           END-IF.                                                      
       2500-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      *************************************************************             
      *  THIS PARA GETS THE REQUIRED DETAILS FOR PRINTING IN THE  *             
      *  REPORT.                                                  *             
      *************************************************************             
      *                                                                         
       2600-WRITE-REPORT.                                               
      *                                                                         
34855      INITIALIZE FIOBW304.                                         
      *                                                                         
           IF WS-POINT-ID-CNTR <  WS-ONE                                
              MOVE WS-POINT-ID             TO WS-RPT-POINT-ID           
T30928        MOVE E-FBW302-KVA-CAPACITY   TO WS-RPT-XFORMER-CAPACITY   
              ADD E-FBW302-TOTAL-KVA       TO WS-TOTAL-CUST-KVA         
36831      END-IF.                                                      
      *                                                                         
36831      MOVE WS-RUN-REV-MONTH      TO E-FBW304-REV-MONTH.            
      *                                                                         
34855      MOVE E-FBW302-KVA-CAPACITY TO E-FBW304-RPT-XFORMER-CAPACITY. 
           MOVE E-FBW302-TOTAL-KW     TO E-FBW304-RPT-CUST-KW.          
A02778     MOVE E-FBW302-TOTAL-KWH    TO E-FBW304-RPT-CUST-KWH.         
34855      MOVE E-FBW302-TOTAL-KVA    TO E-FBW304-RPT-CUST-KVA-BK.      
34855      MOVE E-FBW302-ACCOUNT-NO   TO E-FBW304-RPT-ACCT-NO.          
34855      MOVE WS-POINT-ID           TO E-FBW304-RPT-POINT-ID.         
ACT004     MOVE E-FBW302-NO-OF-DAYS   TO E-FBW304-NO-OF-DAYS.           
      *                                                                         
A02778     MOVE E-FBW302-TOTAL-KWH             TO WS-RPT-CUST-KWH.      
           MOVE E-FBW302-TOTAL-KW              TO WS-RPT-CUST-KW        
                                                   WS-CUST-KW.          
           MOVE E-FBW302-TOT-PCT-LD-ON-XFMR    TO                       
                                      WS-RPT-TOT-PCT-LD-ON-XFRMR.       
           IF E-FBW302-USED-85-PF-FLAG = WS-Y                           
              MOVE WS-85                       TO WS-RPT-PF             
              MOVE E-FBW302-TOTAL-KVA          TO WS-RPT-CUST-KVA-BK    
                                                  WS-CUST-KVA           
              MOVE WS-ASTERIX                  TO WS-FILLER             
           ELSE                                                         
              MOVE E-FBW302-TOTAL-KVA          TO WS-RPT-CUST-KVA-BK    
                                                  WS-CUST-KVA           
              MOVE SPACES                      TO WS-FILLER             
              IF WS-CUST-KVA > ZEROS                                    
                 COMPUTE WS-PF ROUNDED = (WS-CUST-KW) / (WS-CUST-KVA)   
                 MOVE WS-PF                    TO WS-RPT-PF             
              ELSE                                                      
                 MOVE ZEROS                    TO WS-PF                 
              END-IF                                                    
           END-IF.                                                      
      *                                                                         
34855      MOVE WS-FILLER TO E-FBW304-FILLER.                           
34855      MOVE WS-PF     TO E-FBW304-RPT-PF.                           
      *                                                                         
           MOVE E-FBW302-ACCOUNT-NO            TO HT-ACCOUNT-NO         
                                                  AT-ACCOUNT-NO         
                                                  WS-ACCT-NO-ED.        
T30928     PERFORM 7300-GET-ACCOUNT-DET        THRU 7300-EXIT.          
           PERFORM 4000-MAIL-NAME-ADDRESS      THRU 4000-EXIT.          
           MOVE WS-CUSTOMER-NAME               TO WS-RPT-CUSTOMER.      
           MOVE WS-PR-STREET                   TO WS-RPT-ADDR-STREET.   
           MOVE WS-PR-ADDR-CITY-STATE-ZIP      TO WS-RPT-CITY-ST.       
      *                                                                         
34855      MOVE WS-CUSTOMER-NAME          TO E-FBW304-RPT-CUSTOMER.     
34855      MOVE WS-PR-STREET              TO E-FBW304-RPT-ADDR-STREET.  
34855      MOVE WS-PR-ADDR-CITY-STATE-ZIP TO E-FBW304-RPT-CITY-ST.      
      *                                                                         
           PERFORM 2800-EVALUATE-ACCT-ST       THRU 2800-EXIT.          
           INSPECT WS-ACCT-NO-ED REPLACING ALL ',' BY '-'.              
           MOVE WS-ACCT-NO-ED                  TO WS-RPT-ACCT-NO.       
      *                                                                         
           MOVE E-FBW302-PCT-LOAD-ON-XFORMER TO                         
                                             WS-RPT-PCT-LOAD-XFORMER.   
      *                                                                         
34855      MOVE E-FBW302-PCT-LOAD-ON-XFORMER                            
34855                                 TO E-FBW304-RPT-PCT-LOAD-XFORMER. 
34855      MOVE E-FBW302-METER-NO     TO E-FBW304-RPT-METER-NBR.        
34855      MOVE E-FBW302-RATE-PLAN-NO TO E-FBW304-RPT-RATE.             
34855      MOVE WS-RPT-ACCT-STATUS    TO E-FBW304-RPT-ACCT-STATUS.      
      *                                                                         
           MOVE E-FBW302-METER-NO              TO WS-RPT-METER-NBR.     
           MOVE E-FBW302-RATE-PLAN-NO          TO WS-RPT-RATE.          
           ADD WS-THREE                        TO WS-LINE-CNTR.         
           MOVE WS-DET-LINE1                   TO PRT33-RECORD.         
           PERFORM 8000-WRITE-PRINTER-RECORD   THRU 8000-EXIT.          
           IF  WS-LINE-CNTR = WS-THIRTEEN                               
               CONTINUE                                                 
           ELSE                                                         
               SUBTRACT WS-THREE               FROM WS-LINE-CNTR        
           END-IF.                                                      
           MOVE WS-DET-LINE2                   TO PRT33-RECORD.         
           PERFORM 8000-WRITE-PRINTER-RECORD   THRU 8000-EXIT.          
           MOVE WS-DET-LINE3                   TO PRT33-RECORD.         
           PERFORM 8000-WRITE-PRINTER-RECORD   THRU 8000-EXIT.          
      *                                                                         
34855      PERFORM 8888-WRITE-FCSBW304-FILE        THRU 8888-EXIT.      
      *                                                                         
       2600-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ***************************************************************           
      * THIS PARA EVALUATES THE ACCOUNT-STATUS.                     *           
      ***************************************************************           
      *                                                                         
       2800-EVALUATE-ACCT-ST.                                           
           EVALUATE AT-CODE-ACCT-STAT                                   
              WHEN WS-A                                                 
                   MOVE SPACES                 TO WS-RPT-ACCT-STATUS    
              WHEN WS-B                                                 
                   MOVE WS-FINAL               TO WS-RPT-ACCT-STATUS    
              WHEN OTHER                                                
                   MOVE WS-INACTIVE            TO WS-RPT-ACCT-STATUS    
           END-EVALUATE.                                                
      *                                                                         
       2800-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ******************************************************************        
      * 4000-MAIL-NAME-ADDRESS                                         *        
      ******************************************************************        
           EXEC SQL                                                             
              INCLUDE CPD00074                                                  
           END-EXEC.                                                            
      ******************************************************************        
           EXEC SQL                                                             
              INCLUDE CPD0303B                                                  
           END-EXEC.                                                            
      *                                                                         
      ******************************************************************        
      * 6010-REDUCE-EMBEDDED-SPACES (NEEDED BY CPD00074)               *        
      ******************************************************************        
           EXEC SQL                                                             
              INCLUDE CPD00004                                                  
           END-EXEC.                                                            
      *                                                                         
      *****************************************************************         
      *  THIS PARA GETS THE CURRENT DATE AND TIME FROM THE TABLE      *         
      *  SET COMMANDS.                                                *         
      ******************************************************************        
      *                                                                         
       7000-GET-CURRENT-DATE.                                           
      *                                                                         
           EXEC SQL                                                     
T35434         SELECT
              CAST(SYSDATETIMEOFFSET() AS DATE),
              REPLACE(CONVERT(CHAR(8), CIS.CURRENT$TIME(), 108), ':', 
           '.')
            INTO
              :WS-CURRENT-DATE,
              :WS-CURRENT-TIME                      
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ006
MFA-TR* MSQ028
MFA-TR* MSQ061
MFA-TR*    EXEC SQL                                                             
MFA-TR*        SET :WS-CURRENT-DATE = CURRENT DATE                              
MFA-TR*           ,:WS-CURRENT-TIME = CURRENT TIME                              
MFA-TR*    END-EXEC.                                                            

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

      *                                                                         
           MOVE SQLCODE  TO WS-ACTIVE-RETURN-CODE.                      
           IF WS-ACTIVE-RETURN-CODE EQUAL SUCCESSFUL-CALL               
               CONTINUE                                                 
           ELSE                                                         
               DISPLAY '********** PCSBW304 ABORT **********'           
               DISPLAY '* 7000-GET-CURRENT-DATE              *'         
               DISPLAY '* SQLCODE IS ', WS-ACTIVE-RETURN-CODE           
               DISPLAY '* PROGRAM ABORTING...                *'         
               DISPLAY '********** PCSBW304 ABORT ************'         
               PERFORM 9900-ABEND              THRU 9900-EXIT           
           END-IF.                                                      
      *                                                                         
       7000-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ****************************************************************          
      * THIS PARA GETS DISRICT DESCRIPTION FROM TABLE CSS_DISTRICT   *          
      ****************************************************************          
      *                                                                         
       7100-GET-DIST-DESC.                                              
           EXEC SQL                                                     
               SELECT DISTRICT_DESC                                     
               INTO :O6-DISTRICT-DESC                                   
               FROM CSS_DISTRICT WITH(READUNCOMMITTED)                          
               WHERE DISTRICT_NO = :O6-DISTRICT-NO                      
T30928                                                           
A02778                                                      
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ003
MFA-TR* MSQ022
MFA-TR*    EXEC SQL                                                             
MFA-TR*        SELECT DISTRICT_DESC                                             
MFA-TR*        INTO :O6-DISTRICT-DESC                                           
MFA-TR*        FROM CSS_DISTRICT                                                
MFA-TR*        WHERE DISTRICT_NO = :O6-DISTRICT-NO                              
MFA-TR*        WITH UR                                                          
MFA-TR*        QUERYNO 7100                                                     
MFA-TR*    END-EXEC.                                                            

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

      *                                                                         
           MOVE SQLCODE      TO WS-ACTIVE-RETURN-CODE.                  
           IF WS-ACTIVE-RETURN-CODE EQUAL SUCCESSFUL-CALL               
               CONTINUE                                                 
           ELSE                                                         
               DISPLAY '********** PCSBW304 ABORT **********'           
               DISPLAY '* 7100-GET-DIST-DESC                 *'         
               DISPLAY '* SQLCODE IS ', WS-ACTIVE-RETURN-CODE           
               DISPLAY '* PROGRAM ABORTING...                *'         
               DISPLAY '********** PCSBW304 ABORT ************'         
               PERFORM 9900-ABEND              THRU 9900-EXIT           
           END-IF.                                                      
      *                                                                         
       7100-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ****************************************************************          
      * THIS PARA GETS LOCAL OFFICE DESC FROM TABLE CSS_LOCAL_OFFICE *          
      ****************************************************************          
      *                                                                         
       7105-GET-LOC-OFF-DESC.                                           
           EXEC SQL                                                     
               SELECT LOCAL_OFFICE_DESC                                 
               INTO :B1-LOCAL-OFFICE-DESC                               
               FROM CSS_LOCAL_OFFICE WITH(READUNCOMMITTED)                      
               WHERE LOCAL_OFFICE = :B1-LOCAL-OFFICE                    
T30928                                                           
A02778                                                      
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ003
MFA-TR* MSQ022
MFA-TR*    EXEC SQL                                                             
MFA-TR*        SELECT LOCAL_OFFICE_DESC                                         
MFA-TR*        INTO :B1-LOCAL-OFFICE-DESC                                       
MFA-TR*        FROM CSS_LOCAL_OFFICE                                            
MFA-TR*        WHERE LOCAL_OFFICE = :B1-LOCAL-OFFICE                            
MFA-TR*        WITH UR                                                          
MFA-TR*        QUERYNO 7105                                                     
MFA-TR*    END-EXEC.                                                            

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

      *                                                                         
           MOVE SQLCODE     TO WS-ACTIVE-RETURN-CODE.                   
           IF WS-ACTIVE-RETURN-CODE EQUAL SUCCESSFUL-CALL               
               CONTINUE                                                 
           ELSE                                                         
               DISPLAY '********** PCSBW304 ABORT **********'           
               DISPLAY '* 7105-GET-LOC-OFF-DESC              *'         
               DISPLAY '* SQLCODE IS ', WS-ACTIVE-RETURN-CODE           
               DISPLAY '* PROGRAM ABORTING...                *'         
               DISPLAY '********** PCSBW304 ABORT ************'         
               PERFORM 9900-ABEND              THRU 9900-EXIT           
           END-IF.                                                      
      *                                                                         
       7105-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
T30928*****************************************************************         
T30928*                                                               *         
T30928*  GET THE ACCOUNT DETAILS.                                     *         
T30928*****************************************************************         
T30928 7300-GET-ACCOUNT-DET.                                            
T30928     EXEC SQL                                                     
T30928         SELECT AT.CODE_ACCT_STAT                                 
T30928               ,AT.ADDRESS_ID                                     
T30928           INTO :AT-CODE-ACCT-STAT                                
T30928               ,:AT-ADDRESS-ID                                    
T30928           FROM CSS_ACCOUNT AT WITH(READUNCOMMITTED)                      
T30928          WHERE AT.ACCOUNT_NO = :AT-ACCOUNT-NO                    
T30928                                                           
A02778                                                      
T30928     END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ003
MFA-TR* MSQ022
MFA-TR*    EXEC SQL                                                             
MFA-TR*        SELECT AT.CODE_ACCT_STAT                                         
MFA-TR*              ,AT.ADDRESS_ID                                             
MFA-TR*          INTO :AT-CODE-ACCT-STAT                                        
MFA-TR*              ,:AT-ADDRESS-ID                                            
MFA-TR*          FROM CSS_ACCOUNT AT                                            
MFA-TR*         WHERE AT.ACCOUNT_NO = :AT-ACCOUNT-NO                            
MFA-TR*        WITH UR                                                          
MFA-TR*        QUERYNO 7300                                                     
MFA-TR*    END-EXEC.                                                            

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

T30928                                                                  
T30928     MOVE SQLCODE     TO WS-ACTIVE-RETURN-CODE.                   
T30928                                                                  
T30928     IF WS-ACTIVE-RETURN-CODE EQUAL SUCCESSFUL-CALL               
T30928         CONTINUE                                                 
T30928     ELSE                                                         
T30928         DISPLAY '********** PCSBW304 ABORT **********'           
T30928         DISPLAY '*      7300-GET-ACCOUNT-DET        *'           
T30928         DISPLAY '* SQLCODE IS : ' WS-ACTIVE-RETURN-CODE          
T30928         DISPLAY '* ACCOUNT NO : ' AT-ACCOUNT-NO                  
T30928         DISPLAY '* PROGRAM ABORTING...                *'         
T30928         DISPLAY '********** PCSBW304 ABORT ************'         
T30928         PERFORM 9900-ABEND              THRU 9900-EXIT           
T30928     END-IF.                                                      
T30928                                                                  
T30928 7300-EXIT.                                                       
T30928     EXIT.                                                        
      *                                                                         
      *****************************************************************         
      * IF LINE COUNTER IS > 56 PRINTS THE PAGE HEADINGS, MOVES INPUT**         
      * VARIABLES TO THE REPORT VARIABLES AND  PRINTS THE REPORT.    **         
      *****************************************************************         
      *                                                                         
       8000-WRITE-PRINTER-RECORD.                                       
           IF  (WS-LINE-CNTR > WS-FIFTY-FOUR) OR                        
               (WS-LINE-CNTR > WS-FIFTY-ONE AND TOTAL-LINE)             
               MOVE PRT33-RECORD               TO WS-HOLD-RECORD        
               IF FIRST-READ                                            
                  SET NOT-FIRST-READ           TO TRUE                  
               ELSE                                                     
                  MOVE WS-HDR-ELEVEN           TO PRT33-DATA            
                  PERFORM 8200-WRITE-PRINT-REC THRU 8200-EXIT           
               END-IF                                                   
               PERFORM 8100-PRT-HEADINGS       THRU 8100-EXIT           
               MOVE WS-HOLD-RECORD             TO PRT33-RECORD          
               MOVE WS-ONE                     TO WS-LINE-SPACE         
           END-IF.                                                      
           PERFORM 8200-WRITE-PRINT-REC        THRU 8200-EXIT.          
           MOVE WS-ONE                         TO WS-LINE-SPACE.        
           ADD WS-ONE                          TO WS-LINE-CNTR.         
      *                                                                         
       8000-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ****************************************************************          
      *  PRINTS THE PAGE HEADINGS  AT THE TOP OF EACH PAGE          **          
      ****************************************************************          
      *                                                                         
       8100-PRT-HEADINGS.                                               
           MOVE 0                              TO WS-LINE-CNTR.         
           ADD WS-ONE                          TO WS-PAGE.              
           MOVE WS-PAGE                        TO WS-DET-PAGE.          
           MOVE WS-HDR-ONE                     TO PRT33-DATA.           
           WRITE PRT33-RECORD AFTER ADVANCING PAGE.                     
           MOVE WS-HDR-TWO                     TO PRT33-DATA.           
           MOVE WS-ONE                         TO WS-LINE-SPACE.        
           PERFORM 8200-WRITE-PRINT-REC        THRU 8200-EXIT.          
           MOVE WS-HDR-THREE                   TO PRT33-DATA.           
           PERFORM 8200-WRITE-PRINT-REC        THRU 8200-EXIT.          
           MOVE WS-BLANK-LINE                  TO PRT33-DATA.           
           PERFORM 8200-WRITE-PRINT-REC        THRU 8200-EXIT.          
           MOVE WS-HDR-FOUR                    TO PRT33-DATA.           
           PERFORM 8200-WRITE-PRINT-REC        THRU 8200-EXIT.          
           MOVE WS-HDR-FOUR1                   TO PRT33-DATA.           
           PERFORM 8200-WRITE-PRINT-REC        THRU 8200-EXIT.          
           MOVE WS-BLANK-LINE                  TO PRT33-DATA.           
           PERFORM 8200-WRITE-PRINT-REC        THRU 8200-EXIT.          
           MOVE WS-HDR-FIVE                    TO PRT33-DATA.           
           PERFORM 8200-WRITE-PRINT-REC        THRU 8200-EXIT.          
           MOVE WS-HDR-SIX                     TO PRT33-DATA.           
           PERFORM 8200-WRITE-PRINT-REC        THRU 8200-EXIT.          
           MOVE WS-HDR-SEVEN                   TO PRT33-DATA.           
           PERFORM 8200-WRITE-PRINT-REC        THRU 8200-EXIT.          
           MOVE WS-HDR-NINE                    TO PRT33-DATA.           
           PERFORM 8200-WRITE-PRINT-REC        THRU 8200-EXIT.          
           MOVE WS-BLANK-LINE                  TO PRT33-DATA.           
           PERFORM 8200-WRITE-PRINT-REC        THRU 8200-EXIT.          
           ADD WS-TWELVE                       TO WS-LINE-CNTR.         
      *                                                                         
       8100-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
       8200-WRITE-PRINT-REC.                                            
           WRITE PRT33-RECORD AFTER ADVANCING WS-LINE-SPACE.            
      *                                                                         
       8200-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ***************************************************************           
      * THIS PARA PRINTS LOCAL-OFFICE HEADER FOR LOCAL-OFFICE BREAK *           
      ***************************************************************           
      *                                                                         
       8300-PRINT-LOC-OFF-HDR.                                          
           ADD WS-ELEVEN                          TO WS-LINE-CNTR.      
           IF  WS-LINE-CNTR > WS-FIFTY-FOUR                             
               MOVE WS-BLANK-LINE                 TO PRT33-DATA         
               PERFORM 8000-WRITE-PRINTER-RECORD  THRU 8000-EXIT        
           ELSE                                                         
              MOVE WS-HDR-FOUR                    TO PRT33-DATA         
              PERFORM 8000-WRITE-PRINTER-RECORD   THRU 8000-EXIT        
              SUBTRACT WS-ELEVEN                  FROM WS-LINE-CNTR     
              MOVE WS-HDR-FOUR1                   TO PRT33-DATA         
              PERFORM 8000-WRITE-PRINTER-RECORD   THRU 8000-EXIT        
              MOVE WS-BLANK-LINE                  TO PRT33-DATA         
              PERFORM 8000-WRITE-PRINTER-RECORD   THRU 8000-EXIT        
              MOVE WS-HDR-FIVE                    TO PRT33-DATA         
              PERFORM 8000-WRITE-PRINTER-RECORD   THRU 8000-EXIT        
              MOVE WS-HDR-SIX                     TO PRT33-DATA         
              PERFORM 8000-WRITE-PRINTER-RECORD   THRU 8000-EXIT        
              MOVE WS-HDR-SEVEN                   TO PRT33-DATA         
              PERFORM 8000-WRITE-PRINTER-RECORD   THRU 8000-EXIT        
              MOVE WS-HDR-NINE                    TO PRT33-DATA         
              PERFORM 8000-WRITE-PRINTER-RECORD   THRU 8000-EXIT        
              MOVE WS-BLANK-LINE                  TO PRT33-DATA         
              PERFORM 8000-WRITE-PRINTER-RECORD   THRU 8000-EXIT        
           END-IF.                                                      
       8300-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
34855 ***************************************************************           
34855 * WRITE FCSBW304-FILE                                             *       
34855 ***************************************************************           
      *                                                                         
34855  8888-WRITE-FCSBW304-FILE.                                        
34855      WRITE FIOBW304.                                              
      *                                                                         
34855  8888-EXIT.                                                       
34855      EXIT.                                                        
      *                                                                         
      ****************************************************************          
      *  CLOSES   INPUT FILE AND OUTPUT FILE                         *          
      ****************************************************************          
      *                                                                         
       9000-TERMINATE.                                                  
           CLOSE   FCSBW302-FILE                                        
                   FCSPT33-FILE                                         
34855              FCSBW304-FILE.                                       
      *                                                                         
           IF  INFILE-SUCCESSFUL                                        
               CONTINUE                                                 
           ELSE                                                         
               DISPLAY 'ERROR IN CLOSING INFILE'                        
               DISPLAY 'ERROR STATUS ' WS-FBW302-STATUS                 
           END-IF.                                                      
      *                                                                         
       9000-EXIT.                                                       
           EXIT.                                                        
      ****************************************************************          
      *  COPY BOOK CONTAINING 9900-ABEND AND 9900-EXIT           ****           
      ****************************************************************          
           EXEC SQL                                                             
               INCLUDE CPD09900                                                 
           END-EXEC.                                                            
      ******************************************************************        
      * 9700-PROCESS-ABEND  (REQUIED BY CPD00074)                      *        
      ******************************************************************        
       COPY CPD0023B.                                                           
