       IDENTIFICATION DIVISION.                                         
       PROGRAM-ID.    CSR02042.                                         
COB303 DATE-WRITTEN.      MARCH 2, 1995.                                
       DATE-COMPILED.                                                   
                                                                        
      ***************************************************************** 00060000
      *                                                               * 00070000
      *                SOUTH CAROLINA ELECTRIC & GAS                  * 00080000
      *                                                               * 00090000
      *  THIS PROGRAM IS EXECUTED VIA A REMOTE PROCEDURE CALL (RPC).  * 00100000
      *                                                               * 00110000
      *  TRANID:        S042                                          * 00120001
      *  PROGRAM:       S042                                          * 00130001
      *  CALLING SP:    PA_S042                                       * 00140001
      *                                                               * 00150000
      ***************************************************************** 00160000
      *                P R O G R A M  S U M M A R Y                   * 00170000
      *                                                               * 00180000
      *  THIS PROGRAM RETRIEVES DATA TO POPULATE THE SERVICES         * 00190001
      *  AVAILABLE WINDOW. DATA SUCH AS ELECTRIC SERVICE, GAS SERVICE.* 00200001
      ***************************************************************** 00230001
      *                                                               * 00240000
      *                     PROGRAM MODIFICATION LOG                  * 00250000
      *                                                               * 00260000
      *    DATE    INITIALS   COMMENTS                                * 00270000
      *  --------  --------   --------------------------------------- * 00280000
      *  03/02/95    FAM      REMOTE PROCEDURE ORIGINALLY CODED.      * 00290001
      *  03/21/95    GXP      ADDED PREMISE DIRECTIONS, SCRATCH PAD,  * 00291001
      *                       SPCL INSTRUCTIONS, SPCL READ INSTRCTNS  * 00292001
      *                       AND DATE SPCL MSG ENDS.                 * 00293001
      *  07/31/96    SR       THE LENGTH OF SPECIAL READ INSTRUCTION  * 00293003
      *                       IS CHANGED FROM 50 TO 114 DUE TO PCR#152* 00293004
T19753*  04/28/99    FB       LIMIT ON SPECIAL READ INSTRUCTIONS      * 00293003
T19753*                       IF PREMISE HAS AN ELECTRIC METER WITH A * 00293004
T19753*                       CONSTANT > 1.                           * 00293004
T22243*  07/25/00    CBSI     CHANGES MADE TO IMPLEMENT MULTI-COMPANY *         
T22243*                       IN METER INVENTORY.                     *         
T23035*  11/02/00    FB       MULTI-COMPANY DOES NOT WORK FOR PREMISE * 00293003
T23035*                       ONLY.  NO CURRENT ACCOUNT FOR PENDING   * 00293003
T23035*                       ACCOUNTS.                               * 00293003
REARCH*  08/15/05    CVNS     RPC TO COBOL SP CONVERSION              *         
REARCH*              CHENNAI                                          *         
REARCH*  10/28/05    CVNS     ADDED STRIP FOR VARIABLES IN THE C1     *         
REARCH*              CHENNAI  CURSOR                                  *         
C34869*  10/19/06    AW41078  ADDING DUMMY1 TO SELECT TO PREVENT APP  *         
C34869*                       ERROR FROM OCCURRING                    *         
A03736*  10/17/11    FB       ADDED QUERYNO                           * 00293003
      ***************************************************************** 00310000
      ***************************************************************** 00320000
      *                                                               * 00330000
      *                ---- BASIC SEQUENCE STRUCTURE ----             * 00340000
      *                                                               * 00350000
      *  0000 - 0999  MAIN CONTROL PATH AND INITIALIZATION            * 00360000
      *  1000 - 1999  INPUT PROCESSING CONTROL PATH                   * 00370000
      *  2000 - 2999  OUTPUT PROCESSING CONTROL PATH                  * 00380000
      *  3000 - 4999  NOT USED                                        * 00390000
      *  5000 - 5999  COMMON PROGRAM MODULES                          * 00400000
      *  6000 - 6999  COMMON SYSTEM MODULES                           * 00410000
      *  7000 - 7999  INPUT MODULES                                   * 00420000
      *  8000 - 8999  OUTPUT MODULES                                  * 00430000
      *  9000 - 9999  TERMINATION, ABEND, MESSAGING MODULES           * 00440001
      *                                                               * 00450000
      ***************************************************************** 00460000
                                                                        
       ENVIRONMENT DIVISION.                                            
       DATA DIVISION.                                                   
       WORKING-STORAGE SECTION.                                         

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

MSQ017 01 MFA-PROGRAM-ID PIC X(8) VALUE 'CSR02042'.
MSQ017     COPY MFASQLM.
                                                                        
       01  WS-START                                   PIC X(40) VALUE   
REARCH     'WORKING STORAGE FOR CSR02042 STARTS HERE'.                  
                                                                        
      ******************************************************************00550000
      *    DB2 INCLUDES                                                *00560000
      ******************************************************************00570000
                                                                        
           EXEC SQL                                                     00590000
              INCLUDE SQLCA                                             00600000
           END-EXEC.                                                    00610000
                                                                        
           EXEC SQL                                                     00670000
              INCLUDE TBPREM                                            00680001
           END-EXEC.                                                    00690000
                                                                        
           EXEC SQL                                                     00790000
              INCLUDE TBMODEL                                           00800001
           END-EXEC.                                                    00810000
                                                                        
T19753     EXEC SQL                                                     00790000
T19753        INCLUDE TBACCT                                            00800001
T19753     END-EXEC.                                                    00810000
T19753     EXEC SQL                                                     00790000
T19753        INCLUDE TBCSTPRM                                          00800001
T19753     END-EXEC.                                                    00810000
T19753     EXEC SQL                                                     00790000
T19753        INCLUDE TBMTRENV                                          00800001
T19753     END-EXEC.                                                    00810000
T19753     EXEC SQL                                                     00790000
T19753        INCLUDE TBMTRCAP                                          00800001
T19753     END-EXEC.                                                    00810000
                                                                        
      ******************************************************************00830000
      *    COBOL WORKING STORAGE COPY BOOKS                            *00840000
      ******************************************************************00850000
                                                                        
           COPY CCA00001.                                               00890001
           COPY CWS00027.                                               00910001
           COPY CWS00303.                                               00920001
T19753     EXEC SQL                                                             
T19753         INCLUDE CWS00099                                                 
T19753     END-EXEC.                                                            
                                                                        
REARCH     EXEC SQL                                                     00930000
REARCH         INCLUDE CWSX0010                                                 
REARCH     END-EXEC.                                                            
                                                                        
      ******************************************************************00940000
      *    WORK AREAS                                                  *00950000
      ******************************************************************00960000
                                                                        
REARCH 01  GTT-MISC-FIELDS.                                             
REARCH     05  GTT-NAME                PIC X(26)                        
REARCH                                      VALUE 'SESSION.CSR02042_R1'.
REARCH     05  GTT-ROW.                                                 
REARCH         49 GTT-ROW-LEN          PIC S9(04) COMP.                 
REARCH         49 GTT-ROW-CHAR         PIC X(1024).                     
REARCH     05  GTT-SQLCODE             PIC S9(9) COMP.                  
                                                                        
REARCH     05  PARM-PREMISE-NO-TEMP    PIC X(10) VALUE SPACES.          
REARCH     05  PARM-PREMISE-NO-RED     REDEFINES PARM-PREMISE-NO-TEMP   
REARCH                                 PIC 9(10).                       
                                                                        
       01  SNA-FIELDS.                                                  
           05  SNA-SUBC                PIC S9(9) COMP.                  
           05  SNA-CONNECTION-NAME     PIC X(08) VALUE SPACES.          
                                                                        
       01  COUNTER-FIELDS.                                              
           05  CTR-COLUMN              PIC S9(9) COMP VALUE 1.          
           05  CTR-ROWS                PIC S9(9) COMP VALUE 0.          
                                                                        
       01  WORK-FIELDS.                                                 
           05  MAX-LENGTH-PARM         PIC S9(9) COMP.                  
           05  WRKLEN1                 PIC S9(9) COMP.                  
           05  WRKLEN2                 PIC S9(9) COMP.                  
           05  WRK-DONE-STATUS         PIC S9(9) COMP.                  
                                                                        
       01  FILLER  PIC X(32) VALUE 'THIS IS THE ROW RETURN AREA.'.      
                                                                        
       01  TDS-RETURN-FIELDS.                                           
           05  RS-RETURN-CODE          PIC S9(9) COMP VALUE 0.          
           05  RS-ELEC-AVAILABLE-IND   PIC X(01) VALUE SPACES.          
           05  RS-GAS-AVAILABLE-IND    PIC X(01) VALUE SPACES.          
           05  RS-LITE-AVAILABLE-IND   PIC X(01) VALUE SPACES.          
           05  RS-PREMISE-DIRECTIONS.                                   
               49  RS-PREMISE-DIRECTIONS-LEN                            
                                        PIC S9(4) COMP SYNC VALUE +0.   
               49  RS-PREMISE-DIRECTIONS-TEXT PIC X(255) VALUE SPACES.  
           05  RS-SCRATCH-PAD.                                          
               49  RS-SCRATCH-PAD-LEN   PIC S9(4) COMP SYNC VALUE +0.   
               49  RS-SCRATCH-PAD-TEXT  PIC X(255) VALUE SPACES.        
           05  RS-SPCL-INSTRUCTIONS.                                    
               49  RS-SPCL-INSTRUCTIONS-LEN                             
                                        PIC S9(4) COMP SYNC VALUE +0.   
               49  RS-SPCL-INSTRUCTIONS-TEXT PIC X(255) VALUE SPACES.   
           05  RS-SPCL-READ-INSTR.                                      
               49  RS-SPCL-READ-INSTR-LEN                               
                                        PIC S9(4) COMP SYNC VALUE +0.   
      *        49  RS-SPCL-READ-INSTR-TEXT PIC X(50) VALUE SPACES.      01389606
PCR152         49  RS-SPCL-READ-INSTR-TEXT PIC X(114) VALUE SPACES.     
           05  RS-DATE-SPCL-MSG-ENDS   PIC X(10) VALUE SPACES.          
T19753     05  RS-CONSTANT-FLAG        PIC X     VALUE SPACES.          
                                                                        
REARCH 01  GTT-RETURN-FIELDS.                                           
REARCH     05  S-RETURN-CODE          PIC S9(9) COMP VALUE 0.           
REARCH     05  S-ELEC-AVAILABLE-IND   PIC X(01) VALUE SPACES.           
REARCH     05  S-GAS-AVAILABLE-IND    PIC X(01) VALUE SPACES.           
REARCH     05  S-LITE-AVAILABLE-IND   PIC X(01) VALUE SPACES.           
REARCH     05  S-PREMISE-DIRECTIONS.                                    
REARCH         49  S-PREMISE-DIRECTIONS-LEN                             
REARCH                                PIC S9(4) COMP SYNC VALUE +0.     
REARCH         49  S-PREMISE-DIRECTIONS-TEXT PIC X(255) VALUE SPACES.   
REARCH     05  S-SCRATCH-PAD.                                           
REARCH         49  S-SCRATCH-PAD-LEN  PIC S9(4) COMP SYNC VALUE +0.     
REARCH         49  S-SCRATCH-PAD-TEXT PIC X(255) VALUE SPACES.          
REARCH     05  S-SPCL-INSTRUCTIONS.                                     
REARCH         49  S-SPCL-INSTRUCTIONS-LEN                              
REARCH                                PIC S9(4) COMP SYNC VALUE +0.     
REARCH         49  S-SPCL-INSTRUCTIONS-TEXT PIC X(255) VALUE SPACES.    
REARCH     05  S-SPCL-READ-INSTR.                                       
REARCH         49  S-SPCL-READ-INSTR-LEN                                
REARCH                                PIC S9(4) COMP SYNC VALUE +0.     
REARCH         49  S-SPCL-READ-INSTR-TEXT PIC X(114) VALUE SPACES.      
REARCH     05  S-DATE-SPCL-MSG-ENDS   PIC X(10) VALUE SPACES.           
REARCH     05  S-CONSTANT-FLAG        PIC X     VALUE SPACES.           
                                                                        
       01  SWITCHES.                                                    
           05  ALL-DONE-SW             PIC X(01) VALUE 'N'.             
               88 NOT-ALL-DONE                   VALUE 'N'.             
               88 ALL-DONE                       VALUE 'Y'.             
           05  SEND-DONE-SW            PIC X(01) VALUE 'Y'.             
               88 SEND-DONE-ERROR                VALUE 'N'.             
               88 SEND-DONE-OK                   VALUE 'Y'.             
                                                                        
       01  WS-MISCELLANEOUS.                                            
REARCH     05  PROGRAM-NAME            PIC X(08)   VALUE 'CSR02042'.    
COB305     05 WS-PREMISE-NO-NUM        PIC S9(10)V USAGE COMP-3 VALUE 0.        
           05  WS-NULL-INDICATOR       PIC S9(4) COMP.                  
T19753     05  WS-METER-COUNT          PIC S9(4) COMP VALUE +0.         
                                                                        
REARCH 01  CSRERLOG-P.                                                  
REARCH     10  S-SP-NAME               PIC X(18)      VALUE SPACES.     
REARCH     10  S-SQLCODE               PIC S9(9) COMP VALUE 0.          
REARCH     10  S-SQLSTATE              PIC X(5)       VALUE ' '.        
REARCH     10  S-TABLE-NAME            PIC X(18)      VALUE SPACES.     
REARCH     10  S-HOST-VARIABLES.                                        
REARCH         49  S-HOST-VARIABLES-L  PIC S9(4) USAGE COMP.            
REARCH         49  S-HOST-VARIABLES-V  PIC X(255).                      
REARCH     10  S-SQL-STATEMENT.                                         
REARCH         49  S-SQL-STATEMENT-L   PIC S9(4) USAGE COMP.            
REARCH         49  S-SQL-STATEMENT-V   PIC X(255).                      
REARCH     10  S-SQL-DESCRIPTION.                                       
REARCH         49  S-SQL-DESCRIPTION-L PIC S9(4) USAGE COMP.            
REARCH         49  S-SQL-DESCRIPTION-V PIC X(255).                      
                                                                        
REARCH LINKAGE SECTION.                                                 
REARCH 01  PARM-PREMISE-NO         PIC X(10).                           
                                                                        
REARCH PROCEDURE DIVISION USING PARM-PREMISE-NO.                        
                                                                        
      ******************************************************************02730000
      * 0000-MAINLINE                                                  *02740000
      *     CONTROLS THE MAIN PATH OF THE PROGRAM                      *02750000
      ******************************************************************02760000
                                                                        
       0000-MAINLINE.                                                   
                                                                        
           PERFORM 0100-INITIALIZE     THRU 0100-EXIT.                  
           PERFORM 1000-PROCESS-INPUT  THRU 1000-EXIT.                  
           PERFORM 2000-PROCESS-OUTPUT THRU 2000-EXIT.                  
           PERFORM 9999-END-PROGRAM    THRU 9999-EXIT.                  
                                                                        
       0000-EXIT.                                                       
           EXIT.                                                        
                                                                        
      ******************************************************************02880000
      * 0100-INITIALIZE                                                *02890000
      *                                                                *02900000
      *     1. RESET DB2 ERROR HANDLERS                                *02910000
      *                                                                *02950000
      ******************************************************************02960000
                                                                        
       0100-INITIALIZE.                                                 
                                                                        
           EXEC SQL WHENEVER SQLWARNING CONTINUE END-EXEC.              
           EXEC SQL WHENEVER SQLERROR   CONTINUE END-EXEC.              
           EXEC SQL WHENEVER NOT FOUND  CONTINUE END-EXEC.              
                                                                        
REARCH     EXEC SQL                                                     
REARCH         DECLARE C1 CURSOR  FOR                        
REARCH         SELECT                                                   
REARCH             :S-RETURN-CODE                 AS RETURN_CODE        
REARCH            ,LTRIM(RTRIM(:S-ELEC-AVAILABLE-IND))   AS 
           ELEC_AVAILABLE_IND 
REARCH            ,LTRIM(RTRIM(:S-GAS-AVAILABLE-IND))    AS 
           GAS_AVAILABLE_IND  
REARCH            ,LTRIM(RTRIM(:S-LITE-AVAILABLE-IND))   AS 
           LITE_AVAILABLE_IND 
REARCH            ,LTRIM(RTRIM(:S-PREMISE-DIRECTIONS))   AS 
           PREMISE_DIRECTIONS 
REARCH            ,LTRIM(RTRIM(:S-SCRATCH-PAD))          AS SCRATCH_PAD        
REARCH            ,LTRIM(RTRIM(:S-SPCL-INSTRUCTIONS))    AS 
           SPCL_INSTRUCTIONS  
REARCH            ,LTRIM(RTRIM(:S-SPCL-READ-INSTR))      AS 
           SPCL_READ_INSTR    
REARCH            ,LTRIM(RTRIM(:S-DATE-SPCL-MSG-ENDS))   AS 
           DATE_SPCL_MSG_ENDS 
REARCH            ,LTRIM(RTRIM(:S-CONSTANT-FLAG))        AS 
           CONSTANT_FLAG      
C34869            ,'1900-01-01'                   AS DUMMY1             
REARCH         FROM                                                     
REARCH             CIS.SYSDUMMY1                                     
REARCH     END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ027
MFA-TR* MSQ029
MFA-TR*    EXEC SQL                                                     03200000
MFA-TR*        DECLARE C1 CURSOR WITH RETURN FOR                                
MFA-TR*        SELECT                                                           
MFA-TR*            :S-RETURN-CODE                 AS RETURN_CODE                
MFA-TR*           ,STRIP(:S-ELEC-AVAILABLE-IND)   AS ELEC_AVAILABLE_IND         
MFA-TR*           ,STRIP(:S-GAS-AVAILABLE-IND)    AS GAS_AVAILABLE_IND          
MFA-TR*           ,STRIP(:S-LITE-AVAILABLE-IND)   AS LITE_AVAILABLE_IND         
MFA-TR*           ,STRIP(:S-PREMISE-DIRECTIONS)   AS PREMISE_DIRECTIONS         
MFA-TR*           ,STRIP(:S-SCRATCH-PAD)          AS SCRATCH_PAD                
MFA-TR*           ,STRIP(:S-SPCL-INSTRUCTIONS)    AS SPCL_INSTRUCTIONS          
MFA-TR*           ,STRIP(:S-SPCL-READ-INSTR)      AS SPCL_READ_INSTR            
MFA-TR*           ,STRIP(:S-DATE-SPCL-MSG-ENDS)   AS DATE_SPCL_MSG_ENDS         
MFA-TR*           ,STRIP(:S-CONSTANT-FLAG)        AS CONSTANT_FLAG              
MFA-TR*           ,'1900-01-01'                   AS DUMMY1                     
MFA-TR*        FROM                                                             
MFA-TR*            SYSIBM.SYSDUMMY1                                             
MFA-TR*    END-EXEC.                                                            
                                                                        
       0100-EXIT.                                                       
           EXIT.                                                        
                                                                        
      ******************************************************************03240000
      * 1000-PROCESS-INPUT                                             *03250000
      *                                                                *03260000
      *     RECEIVE PARMS FROM THE CALLING STORED PROCEDURE.           *03270000
      *                                                                *03280000
      ******************************************************************03290000
                                                                        
       1000-PROCESS-INPUT.                                              
                                                                        
REARCH     MOVE PARM-PREMISE-NO       TO PARM-PREMISE-NO-TEMP.          
           MOVE PARM-PREMISE-NO-RED   TO WS-PREMISE-NO-NUM.             
                                                                        
       1000-EXIT.                                                       
           EXIT.                                                        
                                                                        
      ************************************************************      03580000
      *   2000-PROCESS-OUTPUT                                    *      03590000
      *                                                          *      03600000
      *   2. RETRIEVE DB2 DATA AND BUILD RESULT SET              *      03620000
      *   3. SEND RESULT SET                                     *      03630000
      *                                                          *      03640000
      ************************************************************      03650000
                                                                        
       2000-PROCESS-OUTPUT.                                             
                                                                        
            PERFORM 2200-BUILD-RESULT    THRU 2200-EXIT.                
            MOVE '2000'          TO ACTIVE-PARAGRAPH.                   
REARCH      PERFORM 2000A-MOVE-RESULT    THRU 2000A-EXIT.               
REARCH      ADD +1                       TO   CTR-ROWS.                 
                                                                        
       2000-EXIT.                                                       
           EXIT.                                                        
                                                                        
REARCH*****************************************************************         
REARCH* 2000A-MOVE-RESULT.                                            *         
REARCH*****************************************************************         
REARCH 2000A-MOVE-RESULT.                                               
                                                                        
REARCH     MOVE  RS-RETURN-CODE           TO S-RETURN-CODE.             
REARCH     MOVE  RS-ELEC-AVAILABLE-IND    TO S-ELEC-AVAILABLE-IND.      
REARCH     MOVE  RS-GAS-AVAILABLE-IND     TO S-GAS-AVAILABLE-IND.       
REARCH     MOVE  RS-LITE-AVAILABLE-IND    TO S-LITE-AVAILABLE-IND.      
REARCH     MOVE  RS-PREMISE-DIRECTIONS    TO S-PREMISE-DIRECTIONS.      
REARCH     MOVE  RS-SCRATCH-PAD           TO S-SCRATCH-PAD.             
REARCH     MOVE  RS-SPCL-INSTRUCTIONS     TO S-SPCL-INSTRUCTIONS.       
REARCH     MOVE  RS-SPCL-READ-INSTR       TO S-SPCL-READ-INSTR.         
REARCH     MOVE  RS-DATE-SPCL-MSG-ENDS    TO S-DATE-SPCL-MSG-ENDS.      
REARCH     MOVE  RS-CONSTANT-FLAG         TO S-CONSTANT-FLAG.           
                                                                        
REARCH 2000A-EXIT.                                                      
REARCH     EXIT.                                                        
                                                                        
      ******************************************************************11460000
      *   2200-BUILD-RESULT                                            *11470000
      *                                                                *11480000
      *   1.  SELECT AND FORMAT ALL CUSTOMER DETAIL INFORMATION        *11500001
      *       TO BE RETURNED.                                          *11512001
      *                                                                *11520000
      ******************************************************************11530000
                                                                        
       2200-BUILD-RESULT.                                               
                                                                        
T19753     MOVE 'N' TO RS-CONSTANT-FLAG.                                
           PERFORM 7000-SELECT-PREMISE-UTIL THRU 7000-EXIT.             
           IF WS-NULL-INDICATOR < 0                                     
              MOVE SPACES TO  RS-DATE-SPCL-MSG-ENDS                     
           END-IF.                                                      
                                                                        
       2200-EXIT.                                                       
           EXIT.                                                        
                                                                        
T19753     EXEC SQL                                                             
T19753         INCLUDE CPD00099                                                 
T19753     END-EXEC.                                                            
                                                                        
T19753 6995-CPD99-ERROR-ROUTINE.                                        
T19753                                                                  
T19753     MOVE PROGRAM-NAME               TO ABEND-PROGRAM.            
T19753     PERFORM 9000-SEND-ERROR-RESULT  THRU 9000-EXIT.              
T19753     PERFORM 9900-SQL-ERROR-ROUTINE  THRU 9900-EXIT.              
T19753                                                                  
T19753 6995-EXIT.                                                       
T19753     EXIT.                                                        
                                                                        
      ******************************************************************13260000
      *   7000-SELECT-PREMISE-UTIL                                     *13270001
      *                                                                *13271001
      *   1.  SELECT ELETRIC, GAS AND LITE INDICATORS FOR A GIVEN      *13272001
      *       PREMISE NUMBER.                                          *13272101
      *                                                                *13278001
      ******************************************************************13280000
                                                                        
       7000-SELECT-PREMISE-UTIL.                                        
                                                                        
           EXEC SQL                                                     
              SELECT ELEC_AVAILABLE_IND,                                
                     GAS_AVAILABLE_IND,                                 
                     LITE_AVAILABLE_IND,                                
                     PREMISE_DIRECTIONS,                                
                     SCRATCH_PAD,                                       
                     SPCL_INSTRUCTIONS,                                 
                     SPCL_READ_INSTR,                                   
                     DATE_SPCL_MSG_ENDS                                 
              INTO  :PR-ELEC-AVAILABLE-IND,                             
                    :PR-GAS-AVAILABLE-IND,                              
                    :PR-LITE-AVAILABLE-IND,                             
                    :PR-PREMISE-DIRECTIONS,                             
                    :PR-SCRATCH-PAD,                                    
                    :PR-SPCL-INSTRUCTIONS,                              
                    :PR-SPCL-READ-INSTR,                                
                    :PR-DATE-SPCL-MSG-ENDS :WS-NULL-INDICATOR            
              FROM   CSS_PREMISE                                        
              WHERE  PREMISE_NO      = :WS-PREMISE-NO-NUM               
A03736                                                      
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ003
MFA-TR*    EXEC SQL                                                     13320000
MFA-TR*       SELECT ELEC_AVAILABLE_IND,                                13330301
MFA-TR*              GAS_AVAILABLE_IND,                                 13330401
MFA-TR*              LITE_AVAILABLE_IND,                                13330601
MFA-TR*              PREMISE_DIRECTIONS,                                13330701
MFA-TR*              SCRATCH_PAD,                                       13330801
MFA-TR*              SPCL_INSTRUCTIONS,                                 13330901
MFA-TR*              SPCL_READ_INSTR,                                   13331001
MFA-TR*              DATE_SPCL_MSG_ENDS                                 13332001
MFA-TR*       INTO  :PR-ELEC-AVAILABLE-IND,                             13440401
MFA-TR*             :PR-GAS-AVAILABLE-IND,                              13440501
MFA-TR*             :PR-LITE-AVAILABLE-IND,                             13440601
MFA-TR*             :PR-PREMISE-DIRECTIONS,                             13440701
MFA-TR*             :PR-SCRATCH-PAD,                                    13440801
MFA-TR*             :PR-SPCL-INSTRUCTIONS,                              13440901
MFA-TR*             :PR-SPCL-READ-INSTR,                                13441001
MFA-TR*             :PR-DATE-SPCL-MSG-ENDS:WS-NULL-INDICATOR            13442002
MFA-TR*       FROM   CSS_PREMISE                                        13550001
MFA-TR*       WHERE  PREMISE_NO      = :WS-PREMISE-NO-NUM               13560001
MFA-TR*       QUERYNO 7000                                                      
MFA-TR*    END-EXEC.                                                    13570000

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

                                                                        
           MOVE SQLCODE TO WS-ACTIVE-RETURN-CODE.                       
                                                                        
           IF WS-ACTIVE-RETURN-CODE = NOT-FOUND OR SUCCESSFUL-CALL      
              NEXT SENTENCE                                             
           ELSE                                                         
              MOVE PROGRAM-NAME         TO ABEND-PROGRAM                
              MOVE '7000'               TO ACTIVE-PARAGRAPH             
              MOVE 'SELECT'             TO ABEND-FUNCTION               
              MOVE 'CSS_PREMISE'        TO TABLE-1                      
              MOVE 'PREMISE_NO'         TO TABLE-ELEMENT-1              
              MOVE WS-PREMISE-NO-NUM    TO HOSTVAR-ELEMENT-1            
              PERFORM 9000-SEND-ERROR-RESULT  THRU 9000-EXIT            
              PERFORM 9900-SQL-ERROR-ROUTINE  THRU 9900-EXIT            
           END-IF.                                                      
                                                                        
           IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL                   
              MOVE WS-ACTIVE-RETURN-CODE TO RS-RETURN-CODE              
              MOVE PR-ELEC-AVAILABLE-IND TO RS-ELEC-AVAILABLE-IND       
              MOVE PR-GAS-AVAILABLE-IND  TO RS-GAS-AVAILABLE-IND        
              MOVE PR-LITE-AVAILABLE-IND TO RS-LITE-AVAILABLE-IND       
              MOVE PR-PREMISE-DIRECTIONS-TEXT                           
                TO RS-PREMISE-DIRECTIONS-TEXT                           
              MOVE PR-PREMISE-DIRECTIONS-LEN                            
                TO RS-PREMISE-DIRECTIONS-LEN                            
              MOVE PR-SCRATCH-PAD-TEXT     TO RS-SCRATCH-PAD-TEXT       
              MOVE PR-SCRATCH-PAD-LEN      TO RS-SCRATCH-PAD-LEN        
              MOVE PR-SPCL-INSTRUCTIONS-TEXT                            
                TO RS-SPCL-INSTRUCTIONS-TEXT                            
              MOVE PR-SPCL-INSTRUCTIONS-LEN                             
                TO RS-SPCL-INSTRUCTIONS-LEN                             
              MOVE PR-SPCL-READ-INSTR-TEXT TO RS-SPCL-READ-INSTR-TEXT   
              MOVE PR-SPCL-READ-INSTR-LEN  TO RS-SPCL-READ-INSTR-LEN    
              MOVE PR-DATE-SPCL-MSG-ENDS   TO RS-DATE-SPCL-MSG-ENDS     
T19753        PERFORM 7100-DETERMINE-CONSTANT  THRU 7100-EXIT           
           ELSE                                                         
              MOVE WS-ACTIVE-RETURN-CODE   TO RS-RETURN-CODE            
              MOVE SPACES                  TO RS-ELEC-AVAILABLE-IND     
              MOVE SPACES                  TO RS-GAS-AVAILABLE-IND      
              MOVE SPACES                  TO RS-LITE-AVAILABLE-IND     
              MOVE SPACES                  TO RS-PREMISE-DIRECTIONS-TEXT
              MOVE ZEROES                  TO RS-PREMISE-DIRECTIONS-LEN 
              MOVE SPACES                  TO RS-SCRATCH-PAD-TEXT       
              MOVE ZEROES                  TO RS-SCRATCH-PAD-LEN        
              MOVE SPACES                  TO RS-SPCL-INSTRUCTIONS-TEXT 
              MOVE ZEROES                  TO RS-SPCL-INSTRUCTIONS-LEN  
              MOVE SPACES                  TO RS-SPCL-READ-INSTR-TEXT   
              MOVE ZEROES                  TO RS-SPCL-READ-INSTR-LEN    
              MOVE SPACES                  TO RS-DATE-SPCL-MSG-ENDS     
           END-IF.                                                      
                                                                        
       7000-EXIT.                                                       
           EXIT.                                                        
                                                                        
T19753 7100-DETERMINE-CONSTANT.                                         
T19753                                                                  
T19753     MOVE WS-PREMISE-NO-NUM TO WS-CPD99-PREMISE-NO.               
T19753     PERFORM 6990-FETCH-CUR-ACCOUNT THRU 6990-EXIT.               
T19753     MOVE WS-CPD99-ACCOUNT-NO TO MN-ACCOUNT-NO,                   
T22243                                 AT-ACCOUNT-NO.                   
T22243     PERFORM 7200-SELECT-COMPANY-NO THRU 7200-EXIT.               
T19753                                                                  
T19753     EXEC SQL                                                     
T19753         SELECT COUNT(*)                                          
T19753           INTO :WS-METER-COUNT                                   
T19753           FROM CSS_MTRD_ENVRNMT MN,                              
T19753                CSS_MTR_CAP MC                                    
T19753          WHERE MN.ACCOUNT_NO = :MN-ACCOUNT-NO                    
T22243            AND MC.COMPANY_NO = :MC-COMPANY-NO                    
T19753            AND MN.CODE_UTIL_TYPE = 'E'                           
T19753            AND MC.CODE_UTIL_TYPE = 'E'                           
T19753            AND MN.METER_NO = MC.METER_NO                         
T19753            AND MC.CONSTANT > 1                                   
A03736                                                      
T19753     END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ003
MFA-TR*    EXEC SQL                                                             
MFA-TR*        SELECT COUNT(*)                                                  
MFA-TR*          INTO :WS-METER-COUNT                                           
MFA-TR*          FROM CSS_MTRD_ENVRNMT MN,                                      
MFA-TR*               CSS_MTR_CAP MC                                            
MFA-TR*         WHERE MN.ACCOUNT_NO = :MN-ACCOUNT-NO                            
MFA-TR*           AND MC.COMPANY_NO = :MC-COMPANY-NO                            
MFA-TR*           AND MN.CODE_UTIL_TYPE = 'E'                                   
MFA-TR*           AND MC.CODE_UTIL_TYPE = 'E'                                   
MFA-TR*           AND MN.METER_NO = MC.METER_NO                                 
MFA-TR*           AND MC.CONSTANT > 1                                           
MFA-TR*           QUERYNO 7100                                                  
MFA-TR*    END-EXEC.                                                            

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

T19753                                                                  
T19C53     MOVE SQLCODE TO WS-ACTIVE-RETURN-CODE.                       
T19753                                                                  
T19753     EVALUATE WS-ACTIVE-RETURN-CODE                               
T19753         WHEN SUCCESSFUL-CALL                                     
T19753             IF WS-METER-COUNT > 0                                
T19753                 MOVE 'Y' TO RS-CONSTANT-FLAG                     
T19753             ELSE                                                 
T19753                 MOVE 'N' TO RS-CONSTANT-FLAG                     
T19753             END-IF                                               
T19753         WHEN NOT-FOUND                                           
T19753             MOVE 'N' TO RS-CONSTANT-FLAG                         
T19753         WHEN OTHER                                               
T19753             MOVE PROGRAM-NAME        TO ABEND-PROGRAM            
T19753             MOVE '7100'              TO ACTIVE-PARAGRAPH         
T19753             MOVE 'SELECT'            TO ABEND-FUNCTION           
T19753             MOVE 'CSS_MTRD_ENVRNMT'  TO TABLE-1                  
T19753             MOVE 'CSS_MTR_CAP'       TO TABLE-2                  
T19753             MOVE 'ACCOUNT_NO'        TO TABLE-ELEMENT-1          
T22243             MOVE 'COMPANY_NO'        TO TABLE-ELEMENT-2          
T19753             MOVE MN-ACCOUNT-NO       TO HOSTVAR-ELEMENT-1        
T22243             MOVE MC-COMPANY-NO       TO HOSTVAR-ELEMENT-2        
T19753             PERFORM 9000-SEND-ERROR-RESULT THRU 9000-EXIT        
T19753             PERFORM 9900-SQL-ERROR-ROUTINE THRU 9900-EXIT        
T19753     END-EVALUATE.                                                
T19753                                                                  
T19753 7100-EXIT.                                                       
T19753     EXIT.                                                        
                                                                        
T22243 7200-SELECT-COMPANY-NO.                                          
                                                                        
T22243     EXEC SQL                                                     
T22243           SELECT COMPANY_NO                                      
T22243             INTO :AT-COMPANY-NO                                  
T22243             FROM CSS_ACCOUNT AT                                  
T22243            WHERE AT.ACCOUNT_NO = :AT-ACCOUNT-NO                  
A03736                                                      
T22243     END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ003
MFA-TR*    EXEC SQL                                                             
MFA-TR*          SELECT COMPANY_NO                                              
MFA-TR*            INTO :AT-COMPANY-NO                                          
MFA-TR*            FROM CSS_ACCOUNT AT                                          
MFA-TR*           WHERE AT.ACCOUNT_NO = :AT-ACCOUNT-NO                          
MFA-TR*           QUERYNO 7200                                                  
MFA-TR*    END-EXEC.                                                            

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

T22243     MOVE SQLCODE                     TO WS-ACTIVE-RETURN-CODE.   
T22243     EVALUATE WS-ACTIVE-RETURN-CODE                               
T22243         WHEN SUCCESSFUL-CALL                                     
T22243              MOVE AT-COMPANY-NO      TO MC-COMPANY-NO            
T23035         WHEN NOT-FOUND                                           
T23035              MOVE '01'               TO MC-COMPANY-NO            
T22243         WHEN OTHER                                               
T22243             MOVE PROGRAM-NAME        TO ABEND-PROGRAM            
T22243             MOVE '7200'              TO ACTIVE-PARAGRAPH         
T22243             MOVE 'SELECT'            TO ABEND-FUNCTION           
T22243             MOVE 'CSS_ACCOUNT'       TO TABLE-1                  
T22243             MOVE 'ACCOUNT_NO'        TO TABLE-ELEMENT-1          
T22243             MOVE AT-ACCOUNT-NO       TO HOSTVAR-ELEMENT-1        
T22243             PERFORM 9000-SEND-ERROR-RESULT THRU 9000-EXIT        
T22243             PERFORM 9900-SQL-ERROR-ROUTINE THRU 9900-EXIT        
T22243     END-EVALUATE.                                                
T22243                                                                  
T22243 7200-EXIT.                                                       
T22243     EXIT.                                                        
      ******************************************************************15251101
      * 9900- JOURNALING / ERROR HANDLING INCLUDE *                     15251201
      ******************************************************************15252001
REARCH     EXEC SQL                                                             
REARCH        INCLUDE CPDSP300                                                  
REARCH     END-EXEC.                                                            
      ******************************************************************15300001
      *       END PROGRAM COPYLIB                                      *15310001
      ******************************************************************15320001
REARCH     EXEC SQL                                                             
REARCH        INCLUDE CPD00321                                                  
REARCH     END-EXEC.                                                            
                                                                        
