       IDENTIFICATION DIVISION.                                         
       PROGRAM-ID.     PCSCA381.                                        
       DATE-WRITTEN.   04/27/95.                                        
       DATE-COMPILED.                                                   
      ****************************************************************          
      **              COPYRIGHT/CONFIDENTIAL MATERIAL               **          
      **                     PRICE WATERHOUSE                       **          
      **                1410 NORTH WESTSHORE BLVD                   **          
      **                   TAMPA, FLORIDA  33607                    **          
      **                      (813) 287-9200                        **          
      **                                                            **          
      ********            CUSTOMER SERVICE SYSTEM             ********          
      ********                      DB2                       ********          
      ****************************************************************          
      **                                                            **          
      **              PROGRAM  MODIFICATION  LOG                    **          
      **    DATE    INITIALS     REASON                             **          
      **  ________  ________     __________________________________ **          
      **  04/10/95     SR        NEW PROGRAM FOR REPORT GENERATION  **          
      **                                                            **          
T17467**  08/28/98    CBSI     PROGRAM IS RE-WRITTEN TO TAKE INPUT  **          
T17467**                       FROM DATABASE INSTEAD OF THE FLAT FILE*          
T17467**                       CREATED BY PCSCA368.                 **          
T12999**  10/24/00    GAS      REMOVE SERVICE DELIVERY TABLE AND    **          
T12999**                       CHANGED FARM TAP IND REFERENCE TO    **          
T12999**                       THE PREMISE TABLE.                   **          
C27329**   01/06/03    RR      CHANGE CSS_PREMISE TO                **          
C27329**                       CSS_PREM_DLVRY_PT FOR FARM_TAP_IND   **          
      **                                                            **          
CIGPRJ**   05/27/03   WLR      MADE CHANGE TO CHECK FOR PREVIOUS REV**          
CIGPRJ**                       MONTH SO THAT PROGRAM CAN HANDLE CIG **          
CIGPRJ**                       CUSTOMERS ON DAILY RATE.             **          
      **                                                            **          
36881 **   31 JAN 2008 RDF     CHANGE LENGTH AND FORMAT OF OUTPUT   **          
      **                       FILE.   GOT RID OF PACKED FIELDS.    **          
      **                                                            **          
A00077**    3 NOV 2008 RDF     CHANGE CURSOR TO USE TABLES          **          
      **                       CSS_GAS_SERV_LINE AND PREM_GAS_LINE  **          
      **                       INSTEAD OF CSS_PREM_DLVRY_PT         **          
      **                                                            **          
A01069**   15 APR 2009 RDF     ADD METER NUMBER AND STATUS TO       **          
      **                       REPORT 2, AND CREATE OUTPUT FILE.    **          
      **                                                            **          
A00633**    5 MAY 2009 RDF     I LEFT A HARD CODED DATE USED FOR    **          
      **                       TESTING IN THE CURSOR.  FIXING THAT. **          
      **                                                            **          
A00633**   12 MAY 2009 RDF     REARRANGING CURSOR FOR CLEARER       **          
      **                       UNDERSTANDING.  REMOVING ANOTHER     **          
      **                       DATE USED DURING TESTING.            **          
      **                       DISPLAY INITIAL ROUTINE DATES.       **          
      **                       CHANGING SOME NEGATIVE CODE TO       **          
      **                       POSITIVE.  ADDED MISSING END-IF.     **          
      **                                                            **          
A05134**   21 JAN 2015 RDF     REMOVE REPORT 2                      **          
      **                                                            **          
A05136**   13 MAR 2015 RDF     ZERO OUTPUT FILE ACCOUNT NUMBER      **          
      **                                                            **          
A05136**    7 APR 2015 RDF     ADD FCSPT331 FOR SAME REPORT AS      **          
A05136**                       FCSPT33, BUT WITH ZEROS IN           **          
A05136**                       ACCOUNT NUMBER.  CORRECT ERROR IN    **          
A05136**                       CURSOR TO PREVENT DUPLICATE ROWS.    **          
      **                                                            **          
      ****************************************************************          
           REMARKS.                                                     
                              PCSCA381 NARRATIVE                        
                  GATEWAY STATION FARM TAP ACCOUNTS MONTHLY REPORT      
              ********************************************************  
              THIS PROGRAM GETS THE INPUT FROM CSS_CNSMPTN_HIST AND     
              CSS_BILLING_DET TABLES AND PRINTS A REPORT WITH YEAR TO   
              DATE DATA AND ANOTHER REPORT WITH CURRENT MONTH DETAILS   
              AND GIVES AN OUTPUT FILE WITH CURRENT MONTH DATA TO BE    
              SENT TO PIPELINE.                                         
              ********************************************************  
                   ---- REPORT GENERATOR FOR PCSCA381 REPORTS ----      
                   -- THIS IS A NEW PROGRAM WRITTEN FOR CSS 1.3 --      
                    ---- 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.                                                    
      *                                                                         
TP3211     SELECT FARMTAPS-FILE ASSIGN UT-S-FARMTAPS                    
TP3211         FILE STATUS IS WS-FMTAPS-STATUS.                         
TP3211*                                                                         
       COPY CSSPT33.                                                            
      *                                                                         
A05136 COPY CSSPT331.                                                           
      *                                                                         
A01069 COPY CSSCA381.                                                           
      *                                                                         
       DATA DIVISION.                                                   
       FILE SECTION.                                                    
      *                                                                         
TP3211 FD  FARMTAPS-FILE                                                
TP3211     BLOCK CONTAINS 0 RECORDS                                     
TP3211     LABEL RECORDS ARE STANDARD                                   
36881      RECORD CONTAINS 27 CHARACTERS.                               
      *                                                                         
36881  01  FARMTAP-RECORD.                                              
36881      03  FT-CITY-GATE            PIC 9(7).                        
36881      03  FT-MCF                  PIC 9(7)V99.                     
36881      03  FT-BTU                  PIC 9V9999.                      
36881      03  FT-MONTH                PIC 99.                          
36881      03  FT-YEAR                 PIC 9(4).                        
      *                                                                         
       COPY CFDPT33.                                                            
      *                                                                         
A05136 COPY CFDPT331.                                                           
      *                                                                         
A01069 COPY CFDCA381.                                                           
      *                                                                         
A01069 COPY FIOCA381.                                                           
      *                                                                         
       WORKING-STORAGE SECTION.                                         

MSQ017 01 MFA-PROGRAM-ID PIC X(8) VALUE 'PCSCA381'.
MSQ017     COPY MFASQLM.
      *                                                                         
       COPY CWS09900.                                                           
       COPY CWS00038.                                                           
T15599 COPY CWS00114.                                                           
       COPY CWS00303.                                                           
       COPY FIOJC01.                                                            
      *                                                                         
       01  WS-SWITCHES.                                                 
           05  WS-MORE-DATA-SW         PIC X(01)    VALUE 'Y'.          
               88  NO-MORE-DATA                     VALUE 'N'.          
           05  WS-CURRENT-USAGE-SW     PIC X(01)    VALUE 'N'.          
      *                                                                         
       01  WS-HOLD-AREA.                                                
           05  WS-CURR-GATE-STATION-ID PIC 9(07).                       
           05  WS-PARM-REVENUE-MONTH.                                   
               10 WS-PARM-REV-YEAR     PIC 9(04).                       
               10 WS-PARM-REV-MONTH    PIC 9(02).                       
           05  WS-PARM-REV-MONTH-PACKED REDEFINES                       
                 WS-PARM-REVENUE-MONTH      PIC 9(06).                  
      *                                                                         
       01  WS-REC-STATUS.                                               
           05  WS-FMTAPS-STATUS        PIC X(02).                       
               88  FMTAPS-SUCCESSFUL                VALUE '00'.         
           05  WS-FCA331-STATUS        PIC X(02).                       
               88  FCA331-SUCCESSFUL                VALUE '00'.         
A01069     05  WS-FCA381-STATUS        PIC X(02).                       
A01069         88  FCA381-SUCCESSFUL                VALUE '00'.         
      *                                                                         
TP3211 01  WS-TOTALS.                                                   
TP3211     05  WS-GATE-STATION-CCF     PIC S9(09)V9  COMP-3 VALUE ZERO. 
T15347     05  WS-GATE-STATION-MCF     PIC S9(09)V99 COMP-3 VALUE ZERO. 
TP3211     05  WS-COMPANY-TOTL-CCF     PIC S9(09)V9  COMP-3 VALUE ZERO. 
T15347     05  WS-COMPANY-TOTL-MCF     PIC S9(09)V99 COMP-3 VALUE ZERO. 
           05  WS-ACTIVE-ACCTS         PIC S9(09)    COMP-3 VALUE ZERO. 
           05  WS-INACTIVE-ACCTS       PIC S9(09)    COMP-3 VALUE ZERO. 
           05  WS-FINALED-ACCTS        PIC S9(09)    COMP-3 VALUE ZERO. 
           05  WS-TOTAL-ACCTS          PIC S9(09)    COMP-3 VALUE ZERO. 
TP3211*                                                                         
       01  WS-PREV-ACCT-VALUES.                                         
           05  WS-PREV-COMPANY-NO          PIC X(02).                   
           05  WS-PREV-GATE-STATION-ID     PIC 9(07).                   
           05  WS-PREV-NAME                PIC X(50).                   
           05  WS-PREV-ACCOUNT-NO          PIC 9(13).                   
A01069     05  WS-PREV-SERVICE-ADDRESS     PIC X(35).                   
A01069     05  WS-PREV-CITY-STATE-ZIP      PIC X(35).                   
           05  WS-PREV-ACCOUNT-ID          PIC X(01).                   
           05  WS-PREV-GAS-ID              PIC X(01).                   
           05  WS-PREV-RATE                PIC X(03).                   
           05  WS-PREV-CLASS               PIC X(03).                   
           05  WS-PREV-METER-NO            PIC X(09).                   
           05  WS-PREV-YTD-USE-CODES       PIC X(12).                   
COB305     05 WS-PREV-BTU-FACTOR        PIC S9V9999 COMP-3 VALUE 0.         
COB305     05 WS-PREV-REV-YYYYMM        PIC 9(06) COMP-3 VALUE 0.         
A01069     05  WS-PREV-STATUS              PIC X.                       
      *                                                                         
       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 '/'.          
PCR566     05  WS-RD-CC                PIC X(02).                       
           05  WS-RD-YY                PIC X(02).                       
      *                                                                         
       01  WS-DATE-10.                                                  
           05  WS-D10-CC               PIC 9(02).                       
           05  WS-D10-YY               PIC 9(02).                       
           05  FILLER                  PIC X(01)    VALUE '-'.          
           05  WS-D10-MM               PIC 9(02).                       
           05  FILLER                  PIC X(01)    VALUE '-'.          
           05  WS-D10-DD               PIC 9(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 '/'.          
PCR566     05  WS-D8-CC                PIC X(02).                       
           05  WS-D8-YY                PIC X(02).                       
      *                                                                         
       01  WS-LITERALS.                                                 
A01069     05  WS-DELIM                PIC X        VALUE ';'.          
           05  WS-N                    PIC X(01)    VALUE 'N'.          
           05  WS-Y                    PIC X(01)    VALUE 'Y'.          
           05  WS-HYPHEN               PIC X(01)    VALUE '-'.          
           05  WS-SPACE                PIC X(01)    VALUE ' '.          
           05  WS-2-SPACES             PIC X(02)    VALUE '  '.         
           05  WS-PGRMNAME             PIC X(08)    VALUE 'PCSCA381'.   
           05  PROGRAM-NAME            PIC X(08)    VALUE 'PCSCA381'.   
           05  WS-48                   PIC 9(02)    VALUE 48.           
           05  WS-52                   PIC 9(02)    VALUE 52.           
           05  WS-62                   PIC 9(02)    VALUE 62.           
           05  WS-ACC-METER-YTD-CCFS   PIC S9(09).                      
T15347     05  WS-ACC-METER-YTD-MCFS   PIC S9(09)V99.                   
PCR566     05  WS-CURRENT-CENTURY      PIC X(02)    VALUE '19'.         
PCR566     05  WS-NEXT-CENTURY         PIC X(02)    VALUE '20'.         
           05  WS-DISPLAY-RC           PIC -ZZZZZZZZ9.9.                
           05  WS-NO-OF-MONTHS         PIC 9(02)    VALUE 0.            
           05  RS-RETURN-CODE          PIC S9(04)    COMP.              
           05  RS-RETURN-CODE-DISP     PIC S9(04).                      
COB305     05 WS-CURRENT-YEAR        PIC S9(04) COMP-3 VALUE 0.               
           05  WS-CURRENT-MONTH        PIC 9(02).                       
           05  WS-PREV-MONTH           PIC 9(02).                       
      *                                                                         
       01  WS-MISC.                                                     
T11623     05  WS-DEFAULT-RPT1-COMPANY PIC X(26)    VALUE               
T11623         'SOUTH CAROLINA ELEC. & GAS'.                            
      *                                                                         
           05  WS-DEFAULT-RPT1-TITLE1  PIC X(50)    VALUE               
              ' GATEWAY STATION FARM TAP ACCOUNTS MONTHLY REPORT '.     
      *                                                                         
      ***************** PCSCA381 REPORT HEADERS **********************          
      *                                                                         
       01  WS-HEADING-LINES.                                            
      ****************************************************************          
      **         COMMON WORKING STORAGE FOR REPORT TITLE            **          
      ****************************************************************          
      *                                                                         
           05  WS-RPT1-TITLE.                                           
               10  P-RPT1-TITLE-PGNM   PIC X(11)    VALUE 'PCSCA381-01'.
               10  FILLER              PIC X(42)    VALUE SPACES.       
               10  P-RPT1-COMP-NAME    PIC X(26).                       
PCR566         10  FILLER              PIC X(33)    VALUE SPACES.       
               10  FILLER              PIC X(10)    VALUE 'RUN-DATE: '. 
PCR566         10  P-RPT1-RUN-DATE     PIC X(10).                       
      *                                                                         
      ****************************************************************          
      **         COMMON WORKING STORAGE FOR REPORT HEADER1          **          
      ****************************************************************          
      *                                                                         
           05  WS-RPT1-HEADER-1.                                        
               10  FILLER              PIC X(06)    VALUE 'DATE: '.     
PCR566         10  P-RPT1-DATE         PIC X(10).                       
PCR566         10  FILLER              PIC X(25)    VALUE SPACES.       
               10  P-RPT1-HEAD1        PIC X(50).                       
               10  FILLER              PIC X(21)    VALUE SPACES.       
               10  FILLER              PIC X(10)    VALUE 'RUN-TIME: '. 
               10  FILLER              PIC X(02)    VALUE SPACES.       
               10  P-RPT1-RUN-TIME     PIC X(08).                       
      *                                                                         
      ****************************************************************          
      **         COMMON WORKING STORAGE FOR REPORT HEADER2          **          
      ****************************************************************          
      *                                                                         
           05  WS-RPT1-HEADER-2.                                        
               10  FILLER              PIC X(55)    VALUE SPACES.       
               10  FILLER              PIC X(14)    VALUE               
                                                   'CURRENT AS OF '.    
PCR566         10  P-RPT1-DATE1        PIC X(10).                       
               10  FILLER              PIC X(37)    VALUE SPACES.       
               10  FILLER              PIC X(09)    VALUE 'PAGE:   '.   
               10  P-RPT1-PAGE-NO      PIC ZZZ,ZZ9.                     
      *                                                                         
      ****************************************************************          
      **       COMMON WORKING STORAGE FOR REPORT COLUMN HEADERS     **          
      ****************************************************************          
      *                                                                         
           05  WS-RPT1-HEADER-31.                                       
               10  FILLER              PIC X(17)    VALUE               
                                                  'GATE STATION ID: '.  
               10  P-RPT1-GATE-STATION-ID                               
                                       PIC X(07).                       
               10  FILLER              PIC X(108)   VALUE SPACES.       
      *                                                                         
           05  WS-RPT1-HEADER-32.                                       
               10  FILLER              PIC X(15)    VALUE SPACES.       
               10  FILLER              PIC X(04)    VALUE 'NAME'.       
               10  FILLER              PIC X(73)    VALUE SPACES.       
               10  FILLER              PIC X(07)    VALUE SPACES.       
PCR566         10  FILLER              PIC X(33)    VALUE SPACES.       
      *                                                                         
           05  WS-RPT1-HEADER-33.                                       
               10  FILLER              PIC X(07)    VALUE 'ACCOUNT'.    
               10  FILLER              PIC X(08)    VALUE SPACES.       
               10  FILLER              PIC X(15)    VALUE               
                                                   'SERVICE ADDRESS'.   
               10  FILLER              PIC X(37)    VALUE SPACES.       
               10  FILLER              PIC X(06)    VALUE 'ACC ID'.     
               10  FILLER              PIC X(02)    VALUE SPACES.       
               10  FILLER              PIC X(04)    VALUE 'RATE'.       
               10  FILLER              PIC X(02)    VALUE SPACES.       
               10  FILLER              PIC X(05)    VALUE 'METER'.      
               10  FILLER              PIC X(06)    VALUE SPACES.       
               10  FILLER              PIC X(08)    VALUE 'MONTHS'.     
               10  FILLER              PIC X(09)    VALUE SPACES.       
               10  FILLER              PIC X(07)    VALUE 'YEAR TO'.    
               10  FILLER              PIC X(04)    VALUE SPACES.       
               10  FILLER              PIC X(12)    VALUE               
                                                   'YEAR TO DATE'.      
      *                                                                         
           05  WS-RPT1-HEADER-34.                                       
               10  FILLER              PIC X(06)    VALUE 'NUMBER'.     
               10  FILLER              PIC X(09)    VALUE SPACES.       
               10  FILLER              PIC X(14)    VALUE               
                                                   'CITY STATE ZIP'.    
               10  FILLER              PIC X(38)    VALUE SPACES.       
               10  FILLER              PIC X(06)    VALUE 'GAS ID'.     
               10  FILLER              PIC X(02)    VALUE SPACES.       
               10  FILLER              PIC X(05)    VALUE 'CLASS'.      
               10  FILLER              PIC X(01)    VALUE SPACES.       
               10  FILLER              PIC X(06)    VALUE 'NUMBER'.     
               10  FILLER              PIC X(05)    VALUE SPACES.       
               10  FILLER              PIC X(04)    VALUE ' USE'.       
               10  FILLER              PIC X(13)    VALUE SPACES.       
               10  FILLER              PIC X(08)    VALUE 'DATE CCF'.   
               10  FILLER              PIC X(12)    VALUE SPACES.       
               10  FILLER              PIC X(03)    VALUE 'MCF'.        
      *                                                                         
      ****************************************************************          
      **      COMMON WORKING STORAGE FOR REPORT DETAIL LINES        **          
      ****************************************************************          
       01  WS-DETAIL-LINES.                                             
      *                                                                         
           05  WS-DETAIL-LINE-1.                                        
               10  P-ACCOUNT-NO        PIC X(13).                       
               10  FILLER              PIC X(02)    VALUE SPACES.       
               10  P-NAME              PIC X(50).                       
               10  FILLER              PIC X(02)    VALUE SPACES.       
               10  P-ACCOUNT-ID        PIC X(01).                       
               10  FILLER              PIC X(07)    VALUE SPACES.       
               10  P-RATE              PIC X(03).                       
T16418         10  FILLER              PIC X(02)    VALUE SPACES.       
T16418         10  P-METER-NUMBER      PIC X(09).                       
               10  FILLER              PIC X(05)    VALUE SPACES.       
               10  P-YTD-USE-CODES     PIC X(02).                       
               10  FILLER              PIC X(08)    VALUE SPACES.       
               10  P-YTD-CCF           PIC ZZZ,ZZZ,ZZ9.                 
PCR566         10  FILLER              PIC X(02)    VALUE SPACES.       
T15347         10  P-YTD-MCF           PIC ZZ,ZZZ,ZZZ.99.               
      *                                                                         
           05  WS-DETAIL-LINE-2.                                        
               10  FILLER              PIC X(15)    VALUE SPACES.       
               10  P-SERVICE-ADDRESS   PIC X(45).                       
               10  FILLER              PIC X(07)    VALUE SPACES.       
               10  P-GAS-ID            PIC X(01).                       
               10  FILLER              PIC X(07)    VALUE SPACES.       
               10  P-CLASS             PIC X(03).                       
PCR566         10  FILLER              PIC X(54)    VALUE SPACES.       
      *                                                                         
           05  WS-DETAIL-LINE-3.                                        
               10  FILLER              PIC X(15)    VALUE SPACES.       
               10  P-CITY-STATE-ZIP    PIC X(40).                       
               10  FILLER              PIC X(67)    VALUE SPACES.       
      *                                                                         
TP3211****************************************************************          
TP3211**       COMMON WORKING STORAGE FOR REPORT TOTAL LINES        **          
TP3211****************************************************************          
TP3211 01  WS-TOTAL-LINES.                                              
TP3211*                                                                         
TP3211     05  WS-GATEWAY-TOTAL-LINE.                                   
TP3211         10  FILLER              PIC X(25)    VALUE SPACES.       
TP3211         10  FILLER              PIC X(10)    VALUE 'TOTALS FOR'. 
TP3211         10  FILLER              PIC X(14)    VALUE               
TP3211                                             ' GATE STATION '.    
TP3211         10  P-TOT-GATE-STATION-ID                                
TP3211                                 PIC X(07).                       
TP3211         10  FILLER              PIC X(08)    VALUE SPACES.       
TP3211         10  FILLER              PIC X(11)    VALUE 'TOTAL CCF: '.
TP3211         10  FILLER              PIC X(02)    VALUE SPACES.       
TP3211         10  P-TOT-GATEWAY-CCF   PIC Z,ZZZ,ZZZ,ZZ9.               
TP3211         10  FILLER              PIC X(08)    VALUE SPACES.       
TP3211         10  FILLER              PIC X(11)    VALUE 'TOTAL MCF: '.
T15347         10  P-TOT-GATEWAY-MCF   PIC Z,ZZZ,ZZZ,ZZZ.99.            
PCR566         10  FILLER              PIC X(05)    VALUE SPACES.       
TP3211*                                                                         
TP3211     05  WS-COMPANY-TOTAL-LINE.                                   
               10  FILLER              PIC X(25)    VALUE SPACES.       
               10  FILLER              PIC X(27)    VALUE               
                   'ALL GATE STATIONS TOTALS - '.                       
               10  FILLER              PIC X(12)    VALUE SPACES.       
TP3211         10  FILLER              PIC X(11)    VALUE 'TOTAL CCF: '.
TP3211         10  P-TOT-COMPANY-CCF   PIC ZZZ,ZZZ,ZZZ,ZZ9.             
TP3211         10  FILLER              PIC X(08)    VALUE SPACES.       
TP3211         10  FILLER              PIC X(11)    VALUE 'TOTAL MCF: '.
T15347         10  P-TOT-COMPANY-MCF   PIC Z,ZZZ,ZZZ,ZZZ.99.            
T15347         10  FILLER              PIC X(05)    VALUE SPACES.       
TP3211*                                                                         
           05  WS-ACTIVE-ACCT-LINE.                                     
               10  FILLER              PIC X(25)    VALUE SPACES.       
               10  FILLER              PIC X(17)    VALUE               
                   'ACCOUNT TOTALS : '.                                 
               10  FILLER              PIC X(05)    VALUE SPACES.       
               10  FILLER              PIC X(16)    VALUE               
                   'ACTIVE ACCTS  - '.                                  
               10  P-ACTIVE-ACCTS      PIC ZZZ,ZZZ,ZZ9.                 
               10  FILLER              PIC X(58)    VALUE SPACES.       
      *                                                                         
           05  WS-INACTIVE-ACCT-LINE.                                   
               10  FILLER              PIC X(45)    VALUE SPACES.       
               10  FILLER              PIC X(18)    VALUE               
                   'INACTIVE ACCTS  - '.                                
               10  P-INACTIVE-ACCTS    PIC ZZZ,ZZZ,ZZ9.                 
               10  FILLER              PIC X(58)    VALUE SPACES.       
      *                                                                         
           05  WS-FINALED-ACCT-LINE.                                    
               10  FILLER              PIC X(46)    VALUE SPACES.       
               10  FILLER              PIC X(17)    VALUE               
                   'FINALED ACCTS  - '.                                 
               10  P-FINALED-ACCTS     PIC ZZZ,ZZZ,ZZ9.                 
               10  FILLER              PIC X(58)    VALUE SPACES.       
      *                                                                         
           05  WS-TOTAL-ACCT-LINE.                                      
               10  FILLER              PIC X(48)    VALUE SPACES.       
               10  FILLER              PIC X(15)    VALUE               
                   'TOTAL ACCTS  - '.                                   
               10  P-TOTAL-ACCTS       PIC ZZZ,ZZZ,ZZ9.                 
               10  FILLER              PIC X(58)    VALUE SPACES.       
      *                                                                         
      *                                                                         
       01  WS-RPT1-LINE-NO             PIC 9(02)    VALUE 62   COMP-3.  
       01  WS-RPT1-PAGE-NO             PIC 9(02)    VALUE ZERO COMP-3.  
       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.       
      *                                                                         
       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.       
      *                                                                         
      *****************************************************************         
      **      APPLICATION  TABLE DCLGENS                             **         
      *****************************************************************         
           EXEC SQL                                                             
               INCLUDE SQLCA                                                    
           END-EXEC.                                                            
      **                                                                        
      *                                                                         
      *****************************************************************         
      *    CSS_MODEL_SQL                                                        
      *****************************************************************         
           EXEC SQL                                                             
              INCLUDE TBMODEL                                                   
           END-EXEC.                                                            
      *                                                                         
      *****************************************************************         
      *    CSS_COMPANY                                                          
      *****************************************************************         
           EXEC SQL                                                             
               INCLUDE TBCOMPNY                                                 
           END-EXEC.                                                            
      *                                                                         
      *****************************************************************         
      *    CSS_JOB_PARM                                                         
      *****************************************************************         
           EXEC SQL                                                             
               INCLUDE TBJBPARM                                                 
           END-EXEC.                                                            
      *                                                                         
      *****************************************************************         
      *    CSS_EQUIPMENT                                                        
      *****************************************************************         
           EXEC SQL                                                             
               INCLUDE TBEQUIP                                                  
           END-EXEC.                                                            
      **                                                                        
      *****************************************************************         
      *    CSS_CNSMPTN_HIST                                                     
      *****************************************************************         
           EXEC SQL                                                             
             INCLUDE TBCNSMP                                                    
           END-EXEC.                                                            
      *                                                                         
      *****************************************************************         
      *    CSS_BILLING_DET                                                      
      *****************************************************************         
           EXEC SQL                                                             
             INCLUDE TBBLLDET                                                   
           END-EXEC.                                                            
      *                                                                         
      *****************************************************************         
      *    CSS_BILLING_HDR                                                      
      *****************************************************************         
           EXEC SQL                                                             
             INCLUDE TBBLLHDR                                                   
           END-EXEC.                                                            
      *                                                                         
      *****************************************************************         
      *    CSS_MTRD_ENVRNMT.                                                    
      *****************************************************************         
           EXEC SQL                                                             
             INCLUDE TBMTRENV                                                   
           END-EXEC.                                                            
      *                                                                         
      *****************************************************************         
      *  CSS_PREMISE                                                            
      *****************************************************************         
           EXEC SQL                                                             
               INCLUDE TBPREM                                                   
           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.                                                            
      *                                                                         
      *****************************************************************         
      * CSS_MTR_STORGE_FAC                                                      
      *****************************************************************         
           EXEC SQL                                                             
               INCLUDE TBMTRFAC                                                 
           END-EXEC.                                                            
      *                                                                         
      ****************************************************************          
A00077* CSS_PREM_GAS_LINE - Y0                                       *          
      ****************************************************************          
A00077     EXEC SQL                                                             
A00077         INCLUDE TBPREMLN                                                 
A00077     END-EXEC.                                                            
      *                                                                         
      ****************************************************************          
A00077* CSS_GAS_SERV_LINE - XO                                       *          
      ****************************************************************          
A00077     EXEC SQL                                                             
A00077         INCLUDE TBGASSRV                                                 
A00077     END-EXEC.                                                            
      *                                                                         
       COPY CWS00010.                                                           
      *                                                                         
       COPY CWS00011.                                                           
      * -- USED BY CPD00074. CREATE MAIL NAME AND ADDRESS                       
       COPY CWS00074.                                                           
      *                                                                         
           EXEC SQL                                                     
             DECLARE FARM_TAP CURSOR FOR                                
             SELECT AT.COMPANY_NO                                       
                   ,AT.ACCOUNT_NO                                       
                   ,AT.ADDRESS_ID                                       
                   ,AT.ACCOUNT_TYPE_CODE                                
                   ,PR.CITY_GATE_ID                                     
                   ,AT.CODE_ACCT_STAT                                   
                   ,MN.CODE_METER_STATUS                                
                   ,CX.METER_NO                                         
                   ,CX.NO_UNITS                                         
                   ,CX.DATE_READ                                        
                   ,BG.RATE_PLAN_NO                                     
                   ,BG.CODE_REVENUE_CLASS                               
                   ,BG.BTU_FACTOR                                       
                   ,BG.REVENUE_MONTH                                    
               FROM CSS_PREMISE PR WITH(READUNCOMMITTED)                        
                   ,CSS_ACCOUNT AT WITH(READUNCOMMITTED)                        
                   ,CSS_CNSMPTN_HIST  CX WITH(READUNCOMMITTED)                  
                   ,CSS_BILLING_DET   BG WITH(READUNCOMMITTED)                  
                   ,CSS_BILLING_HDR   BI WITH(READUNCOMMITTED)                  
                   ,CSS_MTRD_ENVRNMT  MN WITH(READUNCOMMITTED)                  
             WHERE AT.COMPANY_NO = '01'                                 
               AND CX.CODE_UTIL_TYPE = 'G'                              
               AND BG.CODE_UTIL_TYPE = 'G'                              
               AND MN.CODE_UTIL_TYPE = 'G'                              
               AND BG.ACCOUNT_NO     = AT.ACCOUNT_NO                    
               AND BI.ACCOUNT_NO     = AT.ACCOUNT_NO                    
               AND CX.ACCOUNT_NO     = AT.ACCOUNT_NO                    
               AND MN.ACCOUNT_NO     = AT.ACCOUNT_NO                    
               AND BG.CODE_BILL_ITM_IND = 'A'                           
               AND BG.CODE_BILL_ITM_TYPE = 'C'                          
               AND YEAR(CX.DATE_READ)  = :WS-CURRENT-YEAR               
               AND CX.BILL_ITEM_TIMESTMP = BG.BILL_ITEM_TIMESTMP        
               AND CX.BILL_NO = BG.BILL_NO                              
               AND BI.BILL_NO = BG.BILL_NO                              
               AND BI.DATE_BILLED IS NOT NULL                           
               AND CX.IC_NO   = BG.IC_NO                                
               AND MN.IC_NO   = BG.IC_NO                                
               AND AT.PREMISE_NO = PR.PREMISE_NO                        
A05136         AND PR.PREMISE_NO = (SELECT DISTINCT(Y0.PREMISE_NO)      
A05136        FROM CSS_GAS_SERV_LINE XO WITH(READUNCOMMITTED)                   
A05136            ,CSS_PREM_GAS_LINE Y0 WITH(READUNCOMMITTED)                   
A05136       WHERE Y0.PREMISE_NO     = PR.PREMISE_NO                    
A05136         AND Y0.SERVICE_NO     = XO.SERVICE_NO                    
A05136         AND XO.FARM_TAP_IND   = 'Y'                              
A05136         AND XO.SERV_LINE_STAT_FL NOT IN ('I', 'R'))              
              ORDER BY PR.CITY_GATE_ID                                  
                      ,AT.ACCOUNT_NO                                    
                      ,CX.METER_NO                                      
                      ,BG.REVENUE_MONTH DESC                            
              FOR READ ONLY                                     
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ004
MFA-TR* MSQ022
MFA-TR* MSQ029
MFA-TR*    EXEC SQL                                                             
MFA-TR*      DECLARE FARM_TAP CURSOR FOR                                        
MFA-TR*      SELECT AT.COMPANY_NO                                               
MFA-TR*            ,AT.ACCOUNT_NO                                               
MFA-TR*            ,AT.ADDRESS_ID                                               
MFA-TR*            ,AT.ACCOUNT_TYPE_CODE                                        
MFA-TR*            ,PR.CITY_GATE_ID                                             
MFA-TR*            ,AT.CODE_ACCT_STAT                                           
MFA-TR*            ,MN.CODE_METER_STATUS                                        
MFA-TR*            ,CX.METER_NO                                                 
MFA-TR*            ,CX.NO_UNITS                                                 
MFA-TR*            ,CX.DATE_READ                                                
MFA-TR*            ,BG.RATE_PLAN_NO                                             
MFA-TR*            ,BG.CODE_REVENUE_CLASS                                       
MFA-TR*            ,BG.BTU_FACTOR                                               
MFA-TR*            ,BG.REVENUE_MONTH                                            
MFA-TR*        FROM CSS_PREMISE PR                                              
MFA-TR*            ,CSS_ACCOUNT AT                                              
MFA-TR*            ,CSS_CNSMPTN_HIST  CX                                        
MFA-TR*            ,CSS_BILLING_DET   BG                                        
MFA-TR*            ,CSS_BILLING_HDR   BI                                        
MFA-TR*            ,CSS_MTRD_ENVRNMT  MN                                        
MFA-TR*      WHERE AT.COMPANY_NO = '01'                                         
MFA-TR*        AND CX.CODE_UTIL_TYPE = 'G'                                      
MFA-TR*        AND BG.CODE_UTIL_TYPE = 'G'                                      
MFA-TR*        AND MN.CODE_UTIL_TYPE = 'G'                                      
MFA-TR*        AND BG.ACCOUNT_NO     = AT.ACCOUNT_NO                            
MFA-TR*        AND BI.ACCOUNT_NO     = AT.ACCOUNT_NO                            
MFA-TR*        AND CX.ACCOUNT_NO     = AT.ACCOUNT_NO                            
MFA-TR*        AND MN.ACCOUNT_NO     = AT.ACCOUNT_NO                            
MFA-TR*        AND BG.CODE_BILL_ITM_IND = 'A'                                   
MFA-TR*        AND BG.CODE_BILL_ITM_TYPE = 'C'                                  
MFA-TR*        AND YEAR(CX.DATE_READ)  = :WS-CURRENT-YEAR                       
MFA-TR*        AND CX.BILL_ITEM_TIMESTMP = BG.BILL_ITEM_TIMESTMP                
MFA-TR*        AND CX.BILL_NO = BG.BILL_NO                                      
MFA-TR*        AND BI.BILL_NO = BG.BILL_NO                                      
MFA-TR*        AND BI.DATE_BILLED IS NOT NULL                                   
MFA-TR*        AND CX.IC_NO   = BG.IC_NO                                        
MFA-TR*        AND MN.IC_NO   = BG.IC_NO                                        
MFA-TR*        AND AT.PREMISE_NO = PR.PREMISE_NO                                
MFA-TR*        AND PR.PREMISE_NO = (SELECT DISTINCT(Y0.PREMISE_NO)              
MFA-TR*       FROM CSS_GAS_SERV_LINE XO                                         
MFA-TR*           ,CSS_PREM_GAS_LINE Y0                                         
MFA-TR*      WHERE Y0.PREMISE_NO     = PR.PREMISE_NO                            
MFA-TR*        AND Y0.SERVICE_NO     = XO.SERVICE_NO                            
MFA-TR*        AND XO.FARM_TAP_IND   = 'Y'                                      
MFA-TR*        AND XO.SERV_LINE_STAT_FL NOT IN ('I', 'R'))                      
MFA-TR*       ORDER BY PR.CITY_GATE_ID                                          
MFA-TR*               ,AT.ACCOUNT_NO                                            
MFA-TR*               ,CX.METER_NO                                              
MFA-TR*               ,BG.REVENUE_MONTH DESC                                    
MFA-TR*       FOR FETCH ONLY WITH UR                                            
MFA-TR*    END-EXEC.                                                            
      *                                                                         
       PROCEDURE DIVISION.                                              
      *                                                                         
      ****************************************************************          
      **   0000-MAINLINE                                            **          
      **       CONTROLS THE MAIN PROCESSING OF THE PROGRAM          **          
      **                                                            **          
      ****************************************************************          
       0000-MAINLINE.                                                   
      *                                                                         
           PERFORM 0100-INITIALIZATION           THRU 0100-EXIT.        
      *                                                                         
           PERFORM 1200-PROCESS-DETAIL-REC THRU 1200-EXIT               
               UNTIL NO-MORE-DATA.                                      
           PERFORM 7220-CLOSE-FARM-TAP THRU 7220-EXIT.                  
           WRITE PRT33-RECORD FROM WS-END-DATA-LINE                     
                 AFTER ADVANCING 2 LINE.                                
A05136     WRITE PRT331-RECORD FROM WS-END-DATA-LINE                    
A05136           AFTER ADVANCING 2 LINE.                                
      *                                                                         
           PERFORM 9000-TERMINATE                THRU 9000-EXIT.        
           STOP RUN.                                                    
      *                                                                         
       0000-EXIT.                                                       
           EXIT.                                                        
      ****************************************************************          
      **   0100-INITIALIZATION                                      **          
      **       ACCEPTS TIME AND DATE FROM SYSTEM .. OPENS FILES     **          
      **       AND CHECKS FOR ERROR .. ACCEPTS COMP-NO FROM SYSIN   **          
      ****************************************************************          
       0100-INITIALIZATION.                                             
      *                                                                         
           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.                     
PCR566     IF WS-CY < 50                                                
PCR566         MOVE WS-NEXT-CENTURY    TO WS-RD-CC                      
PCR566     ELSE                                                         
PCR566         MOVE WS-CURRENT-CENTURY TO WS-RD-CC                      
PCR566     END-IF.                                                      
           MOVE WS-RUN-DATE            TO P-RPT1-RUN-DATE               
                                          P-RPT1-DATE1                  
                                          P-RPT1-DATE.                  
      *                                                                         
           OPEN OUTPUT FCSPT33-FILE.                                    
      *                                                                         
A05136     OPEN OUTPUT FCSPT331-FILE.                                   
A05136     IF FCA331-SUCCESSFUL                                         
A05136        CONTINUE                                                  
A05136     ELSE                                                         
A05136        DISPLAY 'WS-FCA331-STATUS = ' WS-FCA331-STATUS            
A05136     END-IF.                                                      
      *                                                                         
TP3211     OPEN OUTPUT FARMTAPS-FILE                                    
A01069                 FCSCA381-FILE.                                   
TP3211*                                                                         
TP3211     IF FMTAPS-SUCCESSFUL                                         
TP3211         CONTINUE                                                 
TP3211     ELSE                                                         
TP3211         DISPLAY '**       PCSCA381 PROCESSING ERROR        **'   
TP3211         DISPLAY '**  OPEN ERROR OF FARMTAPS - OUTPUT FILE  **'   
TP3211         DISPLAY '**        FILE STATUS = ' WS-FMTAPS-STATUS      
TP3211         DISPLAY '**        PROCESSING TERMINATED           **'   
TP3211         PERFORM 9900-ABEND                THRU 9900-EXIT         
TP3211     END-IF.                                                      
      *                                                                         
           PERFORM 0110-PROCESS-PARM-DATE        THRU 0110-EXIT.        
      *                                                                         
           MOVE WS-PARM-YR                 TO WS-CURRENT-YEAR.          
      *                                                                         
A00633     DISPLAY 'WS-CURRENT-YEAR = ' WS-CURRENT-YEAR.                
A00633     DISPLAY 'WS-PARM-REVENUE-MONTH = ' WS-PARM-REVENUE-MONTH.    
      *                                                                         
           PERFORM 7200-OPEN-FARM-TAP THRU 7200-EXIT.                   
           PERFORM 7210-FETCH-FARM-TAP THRU 7210-EXIT.                  
      *                                                                         
           IF WS-ACTIVE-RETURN-CODE EQUAL NOT-FOUND                     
              SET NO-MORE-DATA TO TRUE                                  
T11623        MOVE WS-DEFAULT-RPT1-COMPANY TO P-RPT1-COMP-NAME          
              MOVE ZERO                  TO WS-CURR-GATE-STATION-ID     
T11623        PERFORM 8100-PRINT-COMP-NAME       THRU 8100-EXIT         
T11623        PERFORM 8200-PRINT-TITLE           THRU 8200-EXIT         
T11623        PERFORM 8300-PRINT-HEADERS         THRU 8300-EXIT         
              WRITE PRT33-RECORD FROM WS-NO-DATA-LINE                   
                   AFTER ADVANCING 2 LINE                               
A05136        WRITE PRT331-RECORD FROM WS-NO-DATA-LINE                  
A05136             AFTER ADVANCING 2 LINE                               
           ELSE                                                         
              MOVE AT-COMPANY-NO   TO C7-COMPANY-NO                     
              PERFORM 7800-GET-COMPANY-DESC      THRU 7800-EXIT         
              MOVE C7-COMPANY-NAME       TO P-RPT1-COMP-NAME            
              MOVE PR-CITY-GATE-ID                                      
                                         TO WS-CURR-GATE-STATION-ID     
T11623        PERFORM 8100-PRINT-COMP-NAME       THRU 8100-EXIT         
T11623        PERFORM 8200-PRINT-TITLE           THRU 8200-EXIT         
T11623        PERFORM 8300-PRINT-HEADERS         THRU 8300-EXIT         
T11623        PERFORM 2200-SET-PREV-ACCT-VALUES  THRU 2200-EXIT         
           END-IF.                                                      
      *                                                                         
       0100-EXIT.                                                       
           EXIT.                                                        
      *****************************************************************         
      **    0110-PROCESS-PARM-DATE                                   **         
      **      PROCESSES THE REVENUE MONTH PARM.                      **         
      **                                                             **         
      *****************************************************************         
       0110-PROCESS-PARM-DATE.                                          
                                                                        
T15599     PERFORM 6200-GET-PARAMETER-DATE THRU 6200-EXIT.              
                                                                        
           IF END-OF-SYSIPT                                             
               NEXT SENTENCE                                            
           ELSE                                                         
A00633         PERFORM 7611-CLOSE THRU 7611-EXIT                        
           END-IF.                                                      
      *                                                                         
A00633     MOVE WS-PARM-YR    TO WS-PARM-REV-YEAR.                      
A00633     MOVE WS-PARM-MONTH TO WS-PARM-REV-MONTH.                     
      *                                                                         
       0110-EXIT.                                                       
           EXIT.                                                        
      ****************************************************************          
      **   1200-PROCESS-DETAIL-REC                                  **          
      ****************************************************************          
       1200-PROCESS-DETAIL-REC.                                         
      *                                                                         
           IF WS-RPT1-LINE-NO GREATER THAN WS-52                        
              PERFORM 8100-PRINT-COMP-NAME THRU 8100-EXIT               
              PERFORM 8200-PRINT-TITLE THRU 8200-EXIT                   
              PERFORM 8300-PRINT-HEADERS THRU 8300-EXIT                 
           END-IF.                                                      
      *                                                                         
A00633     IF PR-CITY-GATE-ID = WS-CURR-GATE-STATION-ID                 
A00633        IF AT-ACCOUNT-NO NOT = WS-PREV-ACCOUNT-NO OR              
A00633           CX-METER-NO   NOT = WS-PREV-METER-NO                   
A00633           PERFORM 2300-FORMAT-DETAIL-LINE THRU 2300-EXIT         
A00633           PERFORM 2200-SET-PREV-ACCT-VALUES THRU 2200-EXIT       
A00633        END-IF                                                    
A00633     ELSE                                                         
A00633        PERFORM 2300-FORMAT-DETAIL-LINE THRU 2300-EXIT            
A00633        PERFORM 2400-GATEWAY-TOTALS THRU 2400-EXIT                
A00633        MOVE WS-62 TO WS-RPT1-LINE-NO                             
A00633        MOVE PR-CITY-GATE-ID TO WS-CURR-GATE-STATION-ID           
A00633        PERFORM 8100-PRINT-COMP-NAME THRU 8100-EXIT               
A00633        PERFORM 8200-PRINT-TITLE THRU 8200-EXIT                   
A00633        PERFORM 8300-PRINT-HEADERS THRU 8300-EXIT                 
A00633        PERFORM 2200-SET-PREV-ACCT-VALUES THRU 2200-EXIT          
A00633     END-IF.                                                      
      *                                                                         
           PERFORM 8950-WRITE-FARMTAPS THRU 8950-EXIT.                  
           PERFORM 1300-SUM-YTD-CCFS THRU 1300-EXIT.                    
           PERFORM 7210-FETCH-FARM-TAP THRU 7210-EXIT.                  
           IF WS-ACTIVE-RETURN-CODE EQUAL NOT-FOUND                     
              PERFORM 2300-FORMAT-DETAIL-LINE THRU 2300-EXIT            
              PERFORM 2400-GATEWAY-TOTALS THRU 2400-EXIT                
              PERFORM 2500-COMPANY-TOTALS THRU 2500-EXIT                
              SET NO-MORE-DATA TO TRUE                                  
           END-IF.                                                      
      *                                                                         
       1200-EXIT.                                                       
           EXIT.                                                        
      ****************************************************************          
      **1300-SUM-YTD-CCFS                                           **          
      ****************************************************************          
       1300-SUM-YTD-CCFS.                                               
      *                                                                         
           ADD CX-NO-UNITS                  TO WS-ACC-METER-YTD-CCFS.   
CIGPRJ     IF BG-REVENUE-MONTH NOT = WS-PREV-REV-YYYYMM                 
               ADD 1                        TO WS-NO-OF-MONTHS          
CIGPRJ         MOVE BG-REVENUE-MONTH        TO WS-PREV-REV-YYYYMM
           END-IF.      
      *                                                                         
       1300-EXIT.                                                       
           EXIT.                                                        
      ****************************************************************          
      **2200-SET-PREV-ACCT-VALUES                                   **          
      **                                                            **          
      ****************************************************************          
       2200-SET-PREV-ACCT-VALUES.                                       
      *                                                                         
A00633     MOVE WS-N                   TO WS-CURRENT-USAGE-SW.          
A00633     MOVE 0                      TO WS-ACC-METER-YTD-CCFS.        
A00633     MOVE 0                      TO WS-NO-OF-MONTHS.              
A00633     MOVE ZEROS                  TO WS-PREV-REV-YYYYMM.           
A00633     MOVE PR-CITY-GATE-ID        TO WS-CURR-GATE-STATION-ID.      
A00633     IF AT-ACCOUNT-NO = WS-PREV-ACCOUNT-NO                        
A00633        CONTINUE                                                  
A00633     ELSE                                                         
A00633        EVALUATE AT-CODE-ACCT-STAT                                
A00633            WHEN 'A'                                              
A00633                ADD +1               TO WS-ACTIVE-ACCTS           
A00633            WHEN 'J'                                              
A00633                ADD +1               TO WS-INACTIVE-ACCTS         
A00633            WHEN 'B'                                              
A00633                ADD +1               TO WS-FINALED-ACCTS          
A00633        END-EVALUATE                                              
A00633        ADD +1                       TO WS-TOTAL-ACCTS            
A00633        MOVE AT-ACCOUNT-NO           TO WS-PREV-ACCOUNT-NO        
           END-IF.                                                      
A00633     PERFORM 4000-MAIL-NAME-ADDRESS  THRU 4000-EXIT.              
A00633     MOVE WS-CUSTOMER-NAME          TO WS-PREV-NAME.              
A00633     MOVE AT-ACCOUNT-TYPE-CODE      TO WS-PREV-ACCOUNT-ID.        
A00633     MOVE AT-CODE-ACCT-STAT         TO WS-PREV-STATUS.            
A00633     MOVE BG-RATE-PLAN-NO           TO WS-PREV-RATE.              
A00633     MOVE CX-METER-NO               TO WS-PREV-METER-NO.          
A00633     MOVE WS-PR-STREET              TO WS-PREV-SERVICE-ADDRESS.   
A00633     MOVE WS-PR-ADDR-CITY-STATE-ZIP TO WS-PREV-CITY-STATE-ZIP.    
A00633     MOVE MN-CODE-METER-STATUS      TO WS-PREV-GAS-ID.            
A00633     MOVE BG-CODE-REVENUE-CLASS     TO WS-PREV-CLASS.             
A00633     MOVE BG-BTU-FACTOR             TO WS-PREV-BTU-FACTOR.        
A00633     MOVE WS-Y                      TO WS-CURRENT-USAGE-SW.       
      *                                                                         
       2200-EXIT.                                                       
           EXIT.                                                        
      ****************************************************************          
      **   2300-FORMAT-DETAIL-LINE                                  **          
      **       FORMATS THE DETAIL LINE OF THE REPORT                **          
      **                                                            **          
      ****************************************************************          
       2300-FORMAT-DETAIL-LINE.                                         
      *                                                                         
           MOVE WS-PREV-ACCOUNT-NO          TO P-ACCOUNT-NO.            
           MOVE WS-PREV-NAME                TO P-NAME.                  
           MOVE WS-PREV-ACCOUNT-ID          TO P-ACCOUNT-ID.            
           MOVE WS-PREV-RATE                TO P-RATE.                  
           MOVE WS-PREV-METER-NO            TO P-METER-NUMBER.          
           MOVE WS-PREV-GAS-ID              TO P-GAS-ID.                
           MOVE WS-PREV-CLASS               TO P-CLASS.                 
           MOVE WS-PREV-SERVICE-ADDRESS     TO P-SERVICE-ADDRESS.       
           MOVE WS-PREV-CITY-STATE-ZIP      TO P-CITY-STATE-ZIP.        
      *                                                                         
           MOVE WS-ACC-METER-YTD-CCFS       TO P-YTD-CCF.               
TP3211     ADD  WS-ACC-METER-YTD-CCFS       TO WS-GATE-STATION-CCF,     
TP3211                                         WS-COMPANY-TOTL-CCF.     
      *                                                                         
T16418     COMPUTE WS-ACC-METER-YTD-MCFS ROUNDED                        
T16418                        = WS-ACC-METER-YTD-CCFS / 10.0            
           MOVE WS-NO-OF-MONTHS             TO P-YTD-USE-CODES          
           MOVE WS-ACC-METER-YTD-MCFS       TO P-YTD-MCF.               
TP3211     ADD  WS-ACC-METER-YTD-MCFS       TO WS-GATE-STATION-MCF,     
TP3211                                         WS-COMPANY-TOTL-MCF.     
      *                                                                         
T14014     PERFORM 8900-PRINT-DETAIL-LINE THRU 8900-EXIT.               
      *                                                                         
       2300-EXIT.                                                       
           EXIT.                                                        
TP3211****************************************************************          
TP3211**   2400-GATEWAY-TOTALS                                      **          
TP3211**       FORMATS THE TOTALS FOR GATEWAY STATION               **          
TP3211**                                                            **          
TP3211****************************************************************          
TP3211 2400-GATEWAY-TOTALS.                                             
TP3211*                                                                         
TP3211     MOVE WS-GATE-STATION-CCF    TO P-TOT-GATEWAY-CCF.            
TP3211     MOVE WS-GATE-STATION-MCF    TO P-TOT-GATEWAY-MCF.            
TP3211*                                                                         
TP3211     PERFORM 8920-PRINT-GATEWAY-TOTAL      THRU 8920-EXIT.        
TP3211*                                                                         
TP3211     MOVE ZEROES                 TO WS-GATE-STATION-CCF,          
TP3211                                    WS-GATE-STATION-MCF.          
TP3211*                                                                         
TP3211 2400-EXIT.                                                       
TP3211     EXIT.                                                        
TP3211****************************************************************          
TP3211**   2500-COMPANY-TOTALS                                      **          
TP3211**       FORMATS THE TOTALS FOR A COMPANY                     **          
TP3211**                                                            **          
TP3211****************************************************************          
TP3211 2500-COMPANY-TOTALS.                                             
TP3211*                                                                         
TP3211     MOVE WS-COMPANY-TOTL-CCF    TO P-TOT-COMPANY-CCF.            
TP3211     MOVE WS-COMPANY-TOTL-MCF    TO P-TOT-COMPANY-MCF.            
TP3211*                                                                         
TP3211     PERFORM 8930-PRINT-COMPANY-TOTAL      THRU 8930-EXIT.        
TP3211*                                                                         
           MOVE WS-ACTIVE-ACCTS        TO P-ACTIVE-ACCTS.               
           WRITE PRT33-RECORD FROM WS-ACTIVE-ACCT-LINE                  
                                   AFTER ADVANCING 3 LINE.              
A05136     WRITE PRT331-RECORD FROM WS-ACTIVE-ACCT-LINE                 
A05136                             AFTER ADVANCING 3 LINE.              
      *                                                                         
           MOVE WS-INACTIVE-ACCTS      TO P-INACTIVE-ACCTS.             
           WRITE PRT33-RECORD FROM WS-INACTIVE-ACCT-LINE                
                                   AFTER ADVANCING 1 LINE.              
A05136     WRITE PRT331-RECORD FROM WS-INACTIVE-ACCT-LINE               
A05136                             AFTER ADVANCING 1 LINE.              
      *                                                                         
           MOVE WS-FINALED-ACCTS       TO P-FINALED-ACCTS.              
           WRITE PRT33-RECORD FROM WS-FINALED-ACCT-LINE                 
                                   AFTER ADVANCING 1 LINE.              
A05136     WRITE PRT331-RECORD FROM WS-FINALED-ACCT-LINE                
A05136                             AFTER ADVANCING 1 LINE.              
      *                                                                         
           MOVE WS-TOTAL-ACCTS         TO P-TOTAL-ACCTS.                
           WRITE PRT33-RECORD FROM WS-TOTAL-ACCT-LINE                   
                                   AFTER ADVANCING 1 LINE.              
A05136     WRITE PRT331-RECORD FROM WS-TOTAL-ACCT-LINE                  
A05136                             AFTER ADVANCING 1 LINE.              
      *                                                                         
TP3211 2500-EXIT.                                                       
TP3211     EXIT.                                                        
                                                                        
      **********************************************************                
      ** 6200-GET-PARAMETER-DATE                              **                
      **********************************************************                
T15599     EXEC SQL                                                             
T15599           INCLUDE CPD00114                                               
T15599     END-EXEC.                                                            
                                                                        
      ****************************************************************          
      * THIS INCLUDES 4000-MAIL-NAME-ADDRESS                         *          
      ****************************************************************          
           EXEC SQL                                                             
                INCLUDE CPD00074                                                
           END-EXEC.                                                            
           COPY CPD00004.                                                       
       7200-OPEN-FARM-TAP.                                              
           EXEC SQL                                                     
               OPEN FARM_TAP                                            
           END-EXEC.                                                    

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

      *                                                                         
           MOVE SQLCODE                      TO WS-ACTIVE-RETURN-CODE.  
      *                                                                         
           IF  WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL                  
               CONTINUE                                                 
           ELSE                                                         
               MOVE SQLCODE            TO WS-DISPLAY-RC                 
               DISPLAY '********** PCSCA650 ABORT ************'         
               DISPLAY '* 7200-OPEN-FARM-TAP                 *'         
               DISPLAY '* SQLCODE IS ', WS-DISPLAY-RC                   
               DISPLAY '* PROGRAM ABORTING...                *'         
               DISPLAY '********** PCSCA650 ABORT ************'         
               PERFORM 9000-TERMINATE       THRU 9000-EXIT              
               PERFORM 9900-ABEND                THRU 9900-EXIT         
T15347     END-IF.                                                      
      *                                                                         
       7200-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
       7210-FETCH-FARM-TAP.                                             
      *                                                                         
           EXEC SQL                                                     
               FETCH FARM_TAP                                           
                INTO :AT-COMPANY-NO                                     
                    ,:AT-ACCOUNT-NO                                     
                    ,:AT-ADDRESS-ID                                     
                    ,:AT-ACCOUNT-TYPE-CODE                              
                    ,:PR-CITY-GATE-ID                                   
                    ,:AT-CODE-ACCT-STAT                                 
                    ,:MN-CODE-METER-STATUS                              
                    ,:CX-METER-NO                                       
                    ,:CX-NO-UNITS                                       
                    ,:CX-DATE-READ                                      
                    ,:BG-RATE-PLAN-NO                                   
                    ,:BG-CODE-REVENUE-CLASS                             
                    ,:BG-BTU-FACTOR                                     
                    ,:BG-REVENUE-MONTH                                  
           END-EXEC.                                                    

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

      *                                                                         
           MOVE SQLCODE                      TO WS-ACTIVE-RETURN-CODE.  
      *                                                                         
           IF  WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL OR NOT-FOUND     
               CONTINUE                                                 
           ELSE                                                         
               MOVE SQLCODE            TO WS-DISPLAY-RC                 
               DISPLAY '********** PCSCA650 ABORT ************'         
               DISPLAY '* 7210-FETCH-FARM-TAP                *'         
               DISPLAY '* SQLCODE IS ', WS-DISPLAY-RC                   
               DISPLAY '* PROGRAM ABORTING...                *'         
               DISPLAY '********** PCSCA650 ABORT ************'         
               PERFORM 9000-TERMINATE       THRU 9000-EXIT              
               PERFORM 9900-ABEND                THRU 9900-EXIT         
           END-IF.                                                      
      *                                                                         
       7210-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
       7220-CLOSE-FARM-TAP.                                             
           EXEC SQL                                                     
               CLOSE FARM_TAP                                           
           END-EXEC.                                                    

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

      *                                                                         
           MOVE SQLCODE                      TO WS-ACTIVE-RETURN-CODE.  
      *                                                                         
           IF  WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL                  
               CONTINUE                                                 
           ELSE                                                         
               MOVE SQLCODE            TO WS-DISPLAY-RC                 
               DISPLAY '********** PCSCA650 ABORT ************'         
               DISPLAY '* 7220-CLOSE-FARM-TAP                *'         
               DISPLAY '* SQLCODE IS ', WS-DISPLAY-RC                   
               DISPLAY '* PROGRAM ABORTING...                *'         
               DISPLAY '********** PCSCA650 ABORT ************'         
               PERFORM 9000-TERMINATE       THRU 9000-EXIT              
               PERFORM 9900-ABEND                THRU 9900-EXIT         
           END-IF.                                                      
      *                                                                         
       7220-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ****************************************************************          
      **   7800-GET-COMPANY-DESC                                    **          
      **       GETS COMPANY NAME FROM TABLE USING COMPANY-NO        **          
      **                                                            **          
      ****************************************************************          
       7800-GET-COMPANY-DESC.                                           
      *                                                                         
           EXEC SQL                                                     
               SELECT COMPANY_NAME                                      
                INTO  :C7-COMPANY-NAME                                  
               FROM   CSS_COMPANY                                       
                WHERE COMPANY_NO = :C7-COMPANY-NO                       
           END-EXEC.                                                    

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

      *                                                                         
           EVALUATE SQLCODE                                             
            WHEN SUCCESSFUL-CALL                                        
                 CONTINUE                                               
            WHEN NOT-FOUND                                              
                 MOVE SPACES         TO C7-COMPANY-NAME                 
            WHEN OTHER                                                  
                 DISPLAY '** SELECT ERROR IN 7800-GET-COMPANY-DESC **'  
                 DISPLAY '** RETURN CODE = ' SQLCODE                    
                 DISPLAY '**         PROCESSING TERMINATED         **'  
                 PERFORM 9900-ABEND            THRU 9900-EXIT           
           END-EVALUATE.                                                
      *                                                                         
       7800-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
           EXEC SQL                                                             
                INCLUDE CPD00038                                                
           END-EXEC.                                                            
      ****************************************************************          
      **  8100-PRINT-COMP-NAME                                      **          
      **       PRINTS THE COMPANY NAME FOR THE REPORT .. IF COMPANY **          
      **       CHANGES IT GETS COMPANY DESCRIPTION FROM TABLE       **          
      ****************************************************************          
       8100-PRINT-COMP-NAME.                                            
      *                                                                         
           ADD 1                       TO WS-RPT1-PAGE-NO.              
      *                                                                         
           WRITE PRT33-RECORD FROM WS-RPT1-TITLE                        
                AFTER ADVANCING TOP-OF-PAGE.                            
A05136     WRITE PRT331-RECORD FROM WS-RPT1-TITLE                       
                AFTER ADVANCING TOP-OF-PAGE.                            
      *                                                                         
       8100-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ****************************************************************          
      **   8200-PRINT-TITLE                                         **          
      **       PRINTS THE REPORT HEADING LINES                      **          
      **                                                            **          
      ****************************************************************          
       8200-PRINT-TITLE.                                                
      *                                                                         
           MOVE WS-DEFAULT-RPT1-TITLE1 TO P-RPT1-HEAD1.                 
           WRITE PRT33-RECORD FROM WS-RPT1-HEADER-1                     
                AFTER ADVANCING 1 LINE.                                 
A05136     WRITE PRT331-RECORD FROM WS-RPT1-HEADER-1                    
A05136          AFTER ADVANCING 1 LINE.                                 
      *                                                                         
           MOVE WS-RPT1-PAGE-NO        TO P-RPT1-PAGE-NO.               
           WRITE PRT33-RECORD FROM WS-RPT1-HEADER-2                     
                AFTER ADVANCING 1 LINE.                                 
A05136     WRITE PRT331-RECORD FROM WS-RPT1-HEADER-2                    
A05136          AFTER ADVANCING 1 LINE.                                 
      *                                                                         
           MOVE 3                      TO WS-RPT1-LINE-NO.              
      *                                                                         
       8200-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ****************************************************************          
      **   8300-PRINT-HEADERS                                       **          
      **       PRINTS THE COLUMN HEADERS FOR THE REPORT             **          
      **                                                            **          
      ****************************************************************          
       8300-PRINT-HEADERS.                                              
      *                                                                         
           MOVE PR-CITY-GATE-ID TO P-RPT1-GATE-STATION-ID               
                                   P-TOT-GATE-STATION-ID.               
      *                                                                         
           WRITE PRT33-RECORD FROM WS-RPT1-HEADER-31                    
                AFTER ADVANCING 3 LINES.                                
A05136     WRITE PRT331-RECORD FROM WS-RPT1-HEADER-31                   
A05136          AFTER ADVANCING 3 LINES.                                
           WRITE PRT33-RECORD FROM WS-RPT1-HEADER-32                    
                AFTER ADVANCING 3 LINES.                                
A05136     WRITE PRT331-RECORD FROM WS-RPT1-HEADER-32                   
A05136          AFTER ADVANCING 3 LINES.                                
           WRITE PRT33-RECORD FROM WS-RPT1-HEADER-33                    
                AFTER ADVANCING 1 LINE.                                 
A05136     WRITE PRT331-RECORD FROM WS-RPT1-HEADER-33                   
A05136          AFTER ADVANCING 3 LINES.                                
           WRITE PRT33-RECORD FROM WS-RPT1-HEADER-34                    
                AFTER ADVANCING 1 LINE.                                 
A05136     WRITE PRT331-RECORD FROM WS-RPT1-HEADER-34                   
A05136          AFTER ADVANCING 3 LINES.                                
           WRITE PRT33-RECORD FROM WS-LINE                              
                AFTER ADVANCING 1 LINE.                                 
A05136     WRITE PRT331-RECORD FROM WS-LINE                             
A05136          AFTER ADVANCING 1 LINE.                                 
      *                                                                         
           ADD 9                       TO WS-RPT1-LINE-NO.              
      *                                                                         
       8300-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ****************************************************************          
      **   8900-PRINT-DETAIL-LINE                                   **          
      **       PRINTS THE DETAIL LINE OF THE REPORT PCSCA381        **          
      **                                                            **          
      ****************************************************************          
       8900-PRINT-DETAIL-LINE.                                          
      *                                                                         
           WRITE PRT33-RECORD FROM WS-BLANK-LINE                        
                AFTER ADVANCING 1 LINE.                                 
A05136     WRITE PRT331-RECORD FROM WS-BLANK-LINE                       
A05136          AFTER ADVANCING 1 LINE.                                 
           WRITE PRT33-RECORD FROM WS-DETAIL-LINE-1                     
                AFTER ADVANCING 1 LINE                                  
A05136     MOVE SPACES TO P-ACCOUNT-NO.                                 
A05136     WRITE PRT331-RECORD FROM WS-DETAIL-LINE-1                    
A05136          AFTER ADVANCING 1 LINE                                  
           WRITE PRT33-RECORD FROM WS-DETAIL-LINE-2                     
                AFTER ADVANCING 1 LINE.                                 
A05136     WRITE PRT331-RECORD FROM WS-DETAIL-LINE-2                    
A05136          AFTER ADVANCING 1 LINE                                  
           WRITE PRT33-RECORD FROM WS-DETAIL-LINE-3                     
                AFTER ADVANCING 1 LINE.                                 
A05136     WRITE PRT331-RECORD FROM WS-DETAIL-LINE-3                    
A05136          AFTER ADVANCING 1 LINE                                  
      *                                                                         
           ADD 4                       TO WS-RPT1-LINE-NO.              
      *                                                                         
       8900-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
TP3211****************************************************************          
TP3211**   8920-PRINT-GATEWAY-TOTAL                                 **          
TP3211**       PRINTS THE GATEWAY TOTAL LINES FOR PCSCA381          **          
TP3211**                                                            **          
TP3211****************************************************************          
TP3211 8920-PRINT-GATEWAY-TOTAL.                                        
TP3211*                                                                         
TP3211     WRITE PRT33-RECORD FROM WS-GATEWAY-TOTAL-LINE                
TP3211          AFTER ADVANCING 3 LINES.                                
      *                                                                         
A05136     WRITE PRT331-RECORD FROM WS-GATEWAY-TOTAL-LINE               
A05136          AFTER ADVANCING 3 LINES.                                
      *                                                                         
TP3211 8920-EXIT.                                                       
TP3211     EXIT.                                                        
TP3211*                                                                         
TP3211****************************************************************          
TP3211**   8930-PRINT-COMPANY-TOTAL                                 **          
TP3211**       PRINTS THE COMPANY TOTAL LINES FOR PCSCA381          **          
TP3211**                                                            **          
TP3211****************************************************************          
TP3211 8930-PRINT-COMPANY-TOTAL.                                        
TP3211*                                                                         
TP3211     WRITE PRT33-RECORD FROM WS-COMPANY-TOTAL-LINE                
TP3211          AFTER ADVANCING 2 LINES.                                
      *                                                                         
A05136     WRITE PRT331-RECORD FROM WS-COMPANY-TOTAL-LINE               
A05136          AFTER ADVANCING 2 LINES.                                
      *                                                                         
TP3211 8930-EXIT.                                                       
TP3211     EXIT.                                                        
      *                                                                         
TP3211****************************************************************          
TP3211**      WRITES DATA TO FARMTAPS FILE                          **          
TP3211****************************************************************          
      *                                                                         
TP3211 8950-WRITE-FARMTAPS.                                             
      *                                                                         
RDF131     INITIALIZE FARMTAP-RECORD.                                   
      *                                                                         
           IF  BG-REVENUE-MONTH EQUAL WS-PARM-REV-MONTH-PACKED          
               CONTINUE                                                 
           ELSE                                                         
               GO TO 8950-EXIT                                          
           END-IF.                                                      
      *                                                                         
           MOVE WS-CURR-GATE-STATION-ID TO FT-CITY-GATE.                
      *                                                                         
           COMPUTE FT-MCF ROUNDED = CX-NO-UNITS / 10.0                  
      *                                                                         
TP3211     MOVE WS-PREV-BTU-FACTOR      TO FT-BTU.                      
           MOVE WS-PARM-REV-MONTH       TO FT-MONTH.                    
           MOVE WS-PARM-REV-YEAR        TO FT-YEAR.                     
      *                                                                         
A01069     INITIALIZE FIOCA381.                                         
A05136     MOVE ZEROS                   TO E-CA381-ACCOUNT-NO.          
A01069     MOVE FT-CITY-GATE            TO E-CA381-CITY-GATE.           
A01069     MOVE WS-PREV-STATUS          TO E-CA381-STATUS.              
A01069     MOVE WS-PREV-METER-NO        TO E-CA381-METER.               
A01069     MOVE CX-NO-UNITS             TO E-CA381-CCF.                 
A01069     MOVE FT-MCF                  TO E-CA381-MCF.                 
A01069     MOVE WS-PREV-SERVICE-ADDRESS TO E-CA381-ADDRESS.             
A01069     MOVE WS-PREV-CITY-STATE-ZIP  TO E-CA381-CITY-ST-ZIP.         
A01069     MOVE WS-DELIM                TO E-CA381-DELIM-1              
A01069                                     E-CA381-DELIM-2              
A01069                                     E-CA381-DELIM-3              
A01069                                     E-CA381-DELIM-4              
A01069                                     E-CA381-DELIM-5              
A01069                                     E-CA381-DELIM-6              
A01069                                     E-CA381-DELIM-7              
A01069                                     E-CA381-DELIM-8              
A01069                                     E-CA381-DELIM-9.             
A01069     MOVE WS-PARM-REV-MONTH       TO E-CA381-MONTH.               
A01069     MOVE WS-PARM-REV-YEAR        TO E-CA381-YEAR.                
      *                                                                         
A01069     WRITE FIOCA381.                                              
      *                                                                         
A01069     IF FCA381-SUCCESSFUL                                         
A01069         CONTINUE                                                 
A01069     ELSE                                                         
A01069         DISPLAY '**  8950-ERROR ON FIOCA381 WRITE  **'           
A01069         DISPLAY '**     FILE STATUS IS ' WS-FCA381-STATUS        
A01069         DISPLAY '**     PROCESSING TERMINATED      **'           
A01069         PERFORM 9900-ABEND THRU 9900-EXIT                        
A01069     END-IF.                                                      
      *                                                                         
TP3211     WRITE FARMTAP-RECORD.                                        
TP3211*                                                                         
TP3211     IF FMTAPS-SUCCESSFUL                                         
TP3211         CONTINUE                                                 
TP3211     ELSE                                                         
TP3211         DISPLAY '**  8950-ERROR ON FARMTAPS WRITE  **'           
TP3211         DISPLAY '**     FILE STATUS IS ' WS-FMTAPS-STATUS        
TP3211         DISPLAY '**     PROCESSING TERMINATED      **'           
TP3211         PERFORM 9900-ABEND                THRU 9900-EXIT         
TP3211     END-IF.                                                      
      *                                                                         
TP3211 8950-EXIT.                                                       
TP3211     EXIT.                                                        
      *                                                                         
      ****************************************************************          
      **   9000-TERMINATE                                           **          
      **       CLOSES ALL OPEN FILES AND TERMINATES THE PROGRAM     **          
      **                                                            **          
      ****************************************************************          
       9000-TERMINATE.                                                  
      *                                                                         
           CLOSE FCSPT33-FILE                                           
A05136           FCSPT331-FILE.                                         
TP3211     CLOSE FARMTAPS-FILE.                                         
A01069     CLOSE FCSCA381-FILE.                                         
      *                                                                         
       9000-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ****************************************************************          
      * THIS INCLUDES 9700-PROCESS-ABEND                             *          
      ****************************************************************          
           COPY CPD0023B.                                                       
      ****************************************************************          
      **    9900-   THIS INCLUDES THE DB2 SQL ABEND MODULE          **          
      ****************************************************************          
      *                                                                         
           EXEC SQL                                                             
               INCLUDE CPD09900                                                 
           END-EXEC.                                                            
      *                                                                         
      ****************************************************************          
