       IDENTIFICATION DIVISION.                                         
       PROGRAM-ID.    CSR02059.                                         
COB303 DATE-WRITTEN.      MARCH 21, 1995.                               
       DATE-COMPILED.                                                   
                                                                        
      ******************************************************************00060000
      *                                                                *00070000
      *                SOUTH CAROLINA ELECTRIC & GAS                   *00080000
      *                                                                *00090000
      *  THIS PROGRAM IS EXECUTED VIA A REMOTE PROCEDURE CALL (RPC).   *00100000
      *                                                                *00110000
      *  TRANID:        S059                                           *00120000
      *  PROGRAM:       S059                                           *00130000
      *  CALLING SP:    PA_S059                                        *00140000
      *                                                                *00150000
      ******************************************************************00160000
      *                 P R O G R A M  S U M M A R Y                   *00170000
      *                                                                *00180000
      *  THIS PROCEDURE UPDATES ROWS.                                  *00190000
      *                                                                *00200000
      *                                                                *00210000
      *  INPUT PARAMETERS                OUTPUT PARAMETERS             *00220000
      *  -------------------------       -----------------------       *00230000
      *  PREMISE-NO         S9(10)V      RETURN-CODE        S9(9)      *00240000
      *  PREMISE-DIRECTIONS X(255)                                     *00250000
      *  SCRATCH-PAD        X(255)                                     *00260000
      *  SPCL-INSTRUCTIONS  X(255)                                     *00270000
      *  SPCL-READ-INSTR    X(50)                                      *00280000
      *  DATE-SPCL-MSG-ENDS X(10)                                      *00290000
      *  USER-ID            X(07)                                      *00300000
      *                                                                *00310000
      *  THE FOLLOWING TABLES ARE USED :                               *00320000
      *      TABLE NAME          DCLGEN NAME    2 CHAR ID              *00330000
      *      ------------------  -----------    ---------              *00340000
      *      CSS_PREMISE         TBPREM         PR                     *00350000
      ******************************************************************00360000
      *                                                                *00370000
      *                     PROGRAM MODIFICATION LOG                   *00380000
      *                                                                *00390000
      *    DATE    INITIALS   COMMENTS                                 *00400000
      *  --------  --------   ---------------------------------------  *00410000
      *  03/31/95    GP       PROCEDURE ORIGINALLY CODED.              *00420000
      *  08/21/95    WMG      MODIFIED TO FIX TPR #6144:               *00430000
      *                       PROCEDURE MODIFIED TO AVOID WRITING A    *00430100
      *                       TRANSACTION HISTORY DETAIL RECORD WHEN   *00430200
      *                       THE MESSAGE EXPIRE DATE WAS NOT CHANGED. *00430300
      * *                                                               00430400
      *  07/31/96    SR       THE LENGTH OF SPECIAL READ INSTRUCTION   *00430500
      *                       IS CHANGED FROM 50 TO 114 DUE TO PCR#152 *00430600
T14453*  01/21/98    GC       DELETED SPECIAL READ INSTRUCTIONS WAS NOT*00430700
      *                       SHOWING IN TRANS HIST.  SHOWED AS "NEW"  *00430800
      *                       DUE TO TYPO IN IF STATEMENT.             *00430900
CBSI  *  07/24/98   CBSI      ABEND LOG MODIFIED TO INCLUDE ALL THE    *00431000
CBSI  *             MADRAS    ABEND PARAMETERS                         *00431100
REARCH*  08/15/05   CVNS      RPC TO COBOL SP CONVERSION               *        
REARCH*             CHENNAI                                            *        
T35434*  07/16/07   MR97640   REPLACED MODEL_SQL WITH SET STATEMENT    *        
T35434*                       AND ADDED WITH UR TO AVOID -911          *00431000
A03736*  10/17/11   FMB       SPACE OUT EXPIRATION DATE IF SPECIAL READ*        
A03736*                       INSTRUCTIONS ARE DELETED                 *        
      ******************************************************************00440000
      ******************************************************************00450000
      *                                                                *00460000
      *                ---- BASIC SEQUENCE STRUCTURE ----              *00470000
      *                                                                *00480000
      *  0000 - 0999  MAIN CONTROL PATH AND INITIALIZATION             *00490000
      *  1000 - 1999  INPUT PROCESSING CONTROL PATH                    *00500000
      *  2000 - 2999  OUTPUT PROCESSING CONTROL PATH                   *00510000
      *  3000 - 4999  NOT USED                                         *00520000
      *  5000 - 5999  COMMON PROGRAM MODULES                           *00530000
      *  6000 - 6999  COMMON SYSTEM MODULES                            *00540000
      *  7000 - 7999  INPUT MODULES                                    *00550000
      *  8000 - 8999  OUTPUT MODULES                                   *00560000
      *  9000 - 9999  TERMINATION,ABEND, MESSAGING MODULES             *00570000
      *                                                                *00580000
      ******************************************************************00590000
                                                                        
       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 'CSR02059'.
MSQ017     COPY MFASQLM.
                                                                        
       01  WS-START                                   PIC X(40) VALUE   
REARCH     'WORKING STORAGE FOR CSR02059 STARTS HERE'.                  
                                                                        
      ******************************************************************00680000
      *    DB2 INCLUDES                                                *00690000
      ******************************************************************00700000
                                                                        
           EXEC SQL                                                     00720000
              INCLUDE SQLCA                                             00730000
           END-EXEC.                                                    00740000
                                                                        
           EXEC SQL                                                     00800000
              INCLUDE TBMNHIST                                          00810000
           END-EXEC.                                                    00820000
                                                                        
           EXEC SQL                                                     00840000
              INCLUDE TBMNHDT                                           00850000
           END-EXEC.                                                    00860000
                                                                        
           EXEC SQL                                                     00880000
              INCLUDE TBUSRPRF                                          00890000
           END-EXEC.                                                    00900000
                                                                        
      *--------< CSS_PREMISE  >                                         00920000
                                                                        
           EXEC SQL                                                     00940000
              INCLUDE TBPREM                                            00950000
           END-EXEC.                                                    00960000
                                                                        
      ******************************************************************00980000
      *    COBOL WORKING STORAGE COPY BOOKS                            *00990000
      ******************************************************************01000000
                                                                        
           COPY CCA00001.                                               01080000
           COPY CWS00027.                                               01120000
           COPY CWS00303.                                               01140000
REARCH     EXEC SQL                                                             
REARCH         INCLUDE CWSX0010                                                 
REARCH     END-EXEC.                                                            
                                                                        
      ******************************************************************01160000
      *    WORK AREAS                                                  *01170000
      ******************************************************************01180000
                                                                        
       01  WS-MISC.                                                     
REARCH     05  PROGRAM-NAME              PIC X(08) VALUE 'CSR02059'.    
           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'.           
           05  WS-SCRTCH-CHANGED-FLAG    PIC X(03) VALUE 'NO '.         
               88 SCRTCH-CHANGED                   VALUE 'YES'.         
           05  WS-RESP-AREA-ID          PIC X(03) VALUE SPACES.         
           05  WS-TRAN-APPL-NO          PIC S9(04) COMP VALUE ZERO.     
      *                                                                 01320000
       01  WS-GENERAL-WORKING-STORAGE.                                  
           05  WS-NULLIND               PIC S9(4)   COMP.               
           05  WS-NULLIND2              PIC S9(4)   COMP.               
COB305     05 WS-PREMISE-NO        PIC S9(10)V COMP-3 VALUE 0.             
           05  WS-PREMISE-DIRECTIONS.                                   
               49  WS-PREMISE-DIRECTIONS-LEN                            
                                        PIC S9(4) COMP SYNC VALUE +0.   
               49  WS-PREMISE-DIRECTIONS-TEXT                           
                                        PIC X(255) VALUE SPACES.        
           05  WS-SCRATCH-PAD.                                          
               49  WS-SCRATCH-PAD-LEN   PIC S9(4) COMP SYNC VALUE +0.   
               49  WS-SCRATCH-PAD-TEXT  PIC X(255) VALUE SPACES.        
           05  WS-SPCL-INSTRUCTIONS.                                    
               49  WS-SPCL-INSTRUCTIONS-LEN                             
                                        PIC S9(4) COMP SYNC VALUE +0.   
               49  WS-SPCL-INSTRUCTIONS-TEXT PIC X(255) VALUE SPACES.   
           05  WS-SPCL-READ-INSTR.                                      
               49  WS-SPCL-READ-INSTR-LEN                               
                                        PIC S9(4) COMP SYNC VALUE +0.   
      *        49  WS-SPCL-READ-INSTR-TEXT PIC X(50) VALUE SPACES.      01520000
PCR152         49  WS-SPCL-READ-INSTR-TEXT PIC X(114) VALUE SPACES.     
           05  WS-DATE-SPCL-MSG-ENDS    PIC X(10).                      
                                                                        
           05  WS-PREMISE-DIRECTIONS-OLD.                               
               49  WS-PREMISE-DIRECTIONS-OLD-LEN                        
                                        PIC S9(4) COMP SYNC VALUE +0.   
               49  WS-PREMISE-DIRECTIONS-OLD-TEXT                       
                                        PIC X(255) VALUE SPACES.        
           05  WS-SCRATCH-PAD-OLD.                                      
               49  WS-SCRATCH-PAD-OLD-LEN PIC S9(4) COMP SYNC VALUE +0. 
               49  WS-SCRATCH-PAD-OLD-TEXT  PIC X(255) VALUE SPACES.    
           05  WS-SPCL-INSTRUCTIONS-OLD.                                
               49  WS-SPCL-INSTRUCTIONS-OLD-LEN                         
                                        PIC S9(4) COMP SYNC VALUE +0.   
               49  WS-SPCL-INSTRUCTIONS-OLD-TEXT                        
                                        PIC X(255) VALUE SPACES.        
           05  WS-SPCL-READ-INSTR-OLD.                                  
               49  WS-SPCL-READ-INSTR-OLD-LEN                           
                                        PIC S9(4) COMP SYNC VALUE +0.   
      *        49  WS-SPCL-READ-INSTR-OLD-TEXT PIC X(50) VALUE SPACES.  01710000
PCR152         49  WS-SPCL-READ-INSTR-OLD-TEXT PIC X(114) VALUE SPACES. 
           05  WS-DATE-SPCL-MSG-ENDS-OLD PIC X(10).                     
           05  WS-USER-ID               PIC X(07).                      
PCR152     05  WS-SPLIT-INSTR-INTO-TWO.                                 
PCR152         49 WS-SPCL-READ-INSTR-SPLIT-1  PIC X(75) VALUE SPACES.   
PCR152         49 WS-SPCL-READ-INSTR-SPLIT-2  PIC X(75) VALUE SPACES.   
PCR152     05  WS-SPCL-READ-INSTR-1.                                    
PCR152         49  WS-SPCL-READ-INSTR-LEN-1                             
PCR152                                  PIC S9(4) COMP SYNC VALUE +0.   
PCR152         49  WS-SPCL-READ-INSTR-TEXT-1 PIC X(75) VALUE SPACES.    
PCR152*                                                                 01740000
PCR152     05  WS-SPCL-READ-INSTR-2.                                    
PCR152         49  WS-SPCL-READ-INSTR-LEN-2                             
PCR152                                  PIC S9(4) COMP SYNC VALUE +0.   
PCR152         49  WS-SPCL-READ-INSTR-TEXT-2 PIC X(75) VALUE SPACES.    
      *                                                                 01746000
       01  WS-LITERALS.                                                 
           05  WS-COMMON                PIC X(1) VALUE 'C'.             
           05  WS-SUMMER                PIC X(1) VALUE 'S'.             
           05  WS-TEST                  PIC X(1) VALUE 'T'.             
           05  WS-ACTIVE                PIC X(1) VALUE 'A'.             
           05  WS-INACTIVE              PIC X(1) VALUE 'I'.             
                                                                        
       01  FILLER                       PIC X(11) VALUE 'PARM FIELDS'.  
                                                                        
       01  PARM-FIELDS.                                                 
REARCH     05  PARM-PREMISE-NO-TEMP     PIC X(10) VALUE SPACES.         
REARCH     05  PARM-PREMISE-NO-RED      REDEFINES PARM-PREMISE-NO-TEMP  
                                        PIC 9(10).                      
           05  PARM-PREMISE-DIRECTIONS.                                 
               49  PARM-PREMISE-DIRECTIONS-LEN                          
                                        PIC S9(4) COMP SYNC VALUE +0.   
               49  PARM-PREMISE-DIRECTIONS-TEXT PIC X(255) VALUE SPACES.
           05  PARM-SCRATCH-PAD.                                        
               49  PARM-SCRATCH-PAD-LEN  PIC S9(4) COMP SYNC VALUE +0.  
               49  PARM-SCRATCH-PAD-TEXT PIC X(255) VALUE SPACES.       
           05  PARM-SPCL-INSTRUCTIONS.                                  
               49  PARM-SPCL-INSTRUCTIONS-LEN                           
                                        PIC S9(4) COMP SYNC VALUE +0.   
               49  PARM-SPCL-INSTRUCTIONS-TEXT PIC X(255) VALUE SPACES. 
           05  PARM-SPCL-READ-INSTR.                                    
               49  PARM-SPCL-READ-INSTR-LEN                             
                                        PIC S9(4) COMP SYNC VALUE +0.   
      *        49  PARM-SPCL-READ-INSTR-TEXT PIC X(50) VALUE SPACES.    02150000
PCR152         49  PARM-SPCL-READ-INSTR-TEXT PIC X(114) VALUE SPACES.   
                                                                        
       01  SNA-FIELDS.                                                  
           05  SNA-SUBC                PIC S9(9) COMP.                  
           05  SNA-CONNECTION-NAME     PIC X(8)  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.         
                                                                        
REARCH 01  GTT-RETURN-FIELDS.                                           
REARCH     05  S-RETURN-CODE            PIC S9(9) COMP VALUE 0.         
REARCH                                                                  
                                                                        
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 01  PARM-PREMISE-DRCTNS-LEN       PIC S9(4) COMP.                
REARCH 01  PARM-PREMISE-DRCTNS-TXT       PIC X(255).                    
REARCH 01  PARM-SCRTCH-PAD-LEN           PIC S9(4) COMP.                
REARCH 01  PARM-SCRATCH-PAD-TXT          PIC X(255).                    
REARCH 01  PARM-SPCL-INSTRCTNS-LEN       PIC S9(4) COMP.                
REARCH 01  PARM-SPCL-INSTRCTNS-TXT       PIC X(255).                    
REARCH 01  PARM-SPCL-READ-INSTR-LN       PIC S9(4) COMP.                
REARCH 01  PARM-SPCL-READ-INSTR-TXT      PIC X(255).                    
REARCH 01  PARM-DATE-SPCL-MSG-ENDS       PIC X(10).                     
REARCH 01  PARM-USERID                   PIC X(07).                     
                                                                        
REARCH PROCEDURE DIVISION USING  PARM-PREMISE-NO                        
REARCH                           PARM-PREMISE-DRCTNS-LEN                
REARCH                           PARM-PREMISE-DRCTNS-TXT                
REARCH                           PARM-SCRTCH-PAD-LEN                    
REARCH                           PARM-SCRATCH-PAD-TXT                   
REARCH                           PARM-SPCL-INSTRCTNS-LEN                
REARCH                           PARM-SPCL-INSTRCTNS-TXT                
REARCH                           PARM-SPCL-READ-INSTR-LN                
REARCH                           PARM-SPCL-READ-INSTR-TXT               
REARCH                           PARM-DATE-SPCL-MSG-ENDS                
REARCH                           PARM-USERID.                           
                                                                        
      ******************************************************************02440000
      * 0000-MAINLINE                                                  *02450000
      *     CALLS 0100-INITIALIZE                                      *02460000
      *           1000-PROCESS-INPUT                                   *02470000
      *           2000-PROCESS-OUTPUT                                  *02480000
      *           9999-END-PROGRAM                                     *02490000
      *                                                                *02500000
      *     CONTROLS THE MAIN PATH OF THE PROGRAM                      *02510000
      ******************************************************************02520000
                                                                        
       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.                                                        
                                                                        
      ******************************************************************02640000
      * 0100-INITIALIZE                                                *02650000
      *     CALLS 9000-SEND-ERROR-RESULT                               *02660000
      *           9900-SQL-ERROR-ROUTINE                               *02670000
      *                                                                *02680000
      *     CALLED FROM 0000-MAINLINE                                  *02690000
      *                                                                *02700000
      *     1. RESET DB2 ERROR HANDLERS                                *02710000
      *                                                                *02750000
      ******************************************************************02760000
                                                                        
       0100-INITIALIZE.                                                 
                                                                        
           MOVE '0100'          TO ACTIVE-PARAGRAPH.                    
                                                                        
           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         FROM                                                     
REARCH             CIS.SYSDUMMY1                                     
REARCH     END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ027
MFA-TR*    EXEC SQL                                                             
MFA-TR*        DECLARE C1 CURSOR WITH RETURN FOR                                
MFA-TR*        SELECT                                                           
MFA-TR*        :S-RETURN-CODE      AS RETURN_CODE                               
MFA-TR*        FROM                                                             
MFA-TR*            SYSIBM.SYSDUMMY1                                             
MFA-TR*    END-EXEC.                                                            
                                                                        
       0100-EXIT.                                                       
           EXIT.                                                        
                                                                        
      ******************************************************************03050000
      * 1000-PROCESS-INPUT                                             *03060000
      *     CALLS 1100-RECEIVE-PARMS                                   *03070000
      *                                                                *03080000
      *     CALLED FROM 0000-MAINLINE                                  *03090000
      *                                                                *03100000
      *     1. RECEIVE PARMS.                                          *03110000
      ******************************************************************03120000
                                                                        
       1000-PROCESS-INPUT.                                              
                                                                        
REARCH     MOVE PARM-PREMISE-NO           TO PARM-PREMISE-NO-TEMP.      
REARCH     MOVE PARM-PREMISE-DRCTNS-LEN   TO                            
REARCH                                    PARM-PREMISE-DIRECTIONS-LEN.  
REARCH     MOVE PARM-PREMISE-DRCTNS-TXT   TO                            
REARCH                                    PARM-PREMISE-DIRECTIONS-TEXT. 
REARCH     MOVE PARM-SCRTCH-PAD-LEN       TO PARM-SCRATCH-PAD-LEN.      
REARCH     MOVE PARM-SCRATCH-PAD-TXT      TO PARM-SCRATCH-PAD-TEXT.     
REARCH     MOVE PARM-SPCL-INSTRCTNS-LEN   TO                            
REARCH                                    PARM-SPCL-INSTRUCTIONS-LEN.   
REARCH     MOVE PARM-SPCL-INSTRCTNS-TXT   TO                            
REARCH                                    PARM-SPCL-INSTRUCTIONS-TEXT.  
REARCH     MOVE PARM-SPCL-READ-INSTR-LN   TO PARM-SPCL-READ-INSTR-LEN.  
REARCH     MOVE PARM-SPCL-READ-INSTR-TXT  TO PARM-SPCL-READ-INSTR-TEXT. 
                                                                        
           MOVE PARM-PREMISE-NO-RED          TO PR-PREMISE-NO.          
           MOVE PARM-PREMISE-DIRECTIONS-LEN  TO                         
                WS-PREMISE-DIRECTIONS-LEN.                              
           MOVE PARM-PREMISE-DIRECTIONS-TEXT TO                         
                WS-PREMISE-DIRECTIONS-TEXT.                             
           MOVE PARM-SCRATCH-PAD-LEN         TO                         
                WS-SCRATCH-PAD-LEN.                                     
           MOVE PARM-SCRATCH-PAD-TEXT        TO                         
                WS-SCRATCH-PAD-TEXT.                                    
           MOVE PARM-SPCL-INSTRUCTIONS-LEN   TO                         
                WS-SPCL-INSTRUCTIONS-LEN.                               
           MOVE PARM-SPCL-INSTRUCTIONS-TEXT  TO                         
                WS-SPCL-INSTRUCTIONS-TEXT.                              
           MOVE PARM-SPCL-READ-INSTR-LEN     TO                         
                WS-SPCL-READ-INSTR-LEN.                                 
           MOVE PARM-SPCL-READ-INSTR-TEXT    TO                         
                WS-SPCL-READ-INSTR-TEXT                                 
PCR152          WS-SPLIT-INSTR-INTO-TWO.                                
PCR152     MOVE WS-SPCL-READ-INSTR-SPLIT-1   TO                         
PCR152          WS-SPCL-READ-INSTR-TEXT-1.                              
PCR152     MOVE LENGTH OF WS-SPCL-READ-INSTR-SPLIT-1                    
PCR152          TO WS-SPCL-READ-INSTR-LEN-1.                            
PCR152     MOVE WS-SPCL-READ-INSTR-SPLIT-2   TO                         
PCR152          WS-SPCL-READ-INSTR-TEXT-2.                              
PCR152     MOVE LENGTH OF WS-SPCL-READ-INSTR-SPLIT-2                    
PCR152          TO WS-SPCL-READ-INSTR-LEN-2.                            
           MOVE PARM-DATE-SPCL-MSG-ENDS      TO                         
                WS-DATE-SPCL-MSG-ENDS.                                  
           MOVE PARM-USERID                  TO                         
                WS-USER-ID                                              
                PF-USER-ID.                                             
                                                                        
           IF WS-PREMISE-DIRECTIONS-TEXT EQUAL SPACES                   
              MOVE 0 TO WS-PREMISE-DIRECTIONS-LEN                       
           END-IF.                                                      
           IF WS-SCRATCH-PAD-TEXT EQUAL SPACES                          
              MOVE 0 TO WS-SCRATCH-PAD-LEN                              
           END-IF.                                                      
           IF WS-SPCL-INSTRUCTIONS-TEXT EQUAL SPACES                    
              MOVE 0 TO WS-SPCL-INSTRUCTIONS-LEN                        
           END-IF.                                                      
           IF WS-SPCL-READ-INSTR-TEXT EQUAL SPACES                      
              MOVE 0 TO WS-SPCL-READ-INSTR-LEN                          
A03736        MOVE SPACES TO PARM-DATE-SPCL-MSG-ENDS                    
A03736                       WS-DATE-SPCL-MSG-ENDS                      
           END-IF.                                                      
                                                                        
       1000-EXIT.                                                       
           EXIT.                                                        
                                                                        
      ******************************************************************05590000
      * 2000-PROCESS-OUTPUT.                                           *05600000
      *           5000-UPDATE                                          *05620000
      *           8100-SEND-RESULT                                     *05630000
      *                                                                *05640000
      *      CALLED FROM 0000-MAINLINE                                 *05650000
      *                                                                *05660000
      *     2. UPDATE DB2 DATA                                         *05680000
      *     3. SEND RESULT SET                                         *05690000
      ******************************************************************05700000
                                                                        
       2000-PROCESS-OUTPUT.                                             
                                                                        
           PERFORM 5000-UPDATE          THRU 5000-EXIT.                 
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 2000A-EXIT.                                                      
REARCH     EXIT.                                                        
                                                                        
      ******************************************************************06190000
      * 5000-UPDATE                                                    *06200000
      *     CALLS 7100-SELECT-PREMISE                                  *06210000
      *           8200-UPDATE-PREMISE                                  *06220000
      *                                                                *06230000
      *     CALLED FROM 2000-PROCESS-OUTPUT                            *06240000
      *                                                                *06250000
      *     FORMATS A ROW BASED ON THE PASSED PARAMS AND THEN          *06260000
      *     DETERMINES WHETHER THIS IS AN UPDATE OR AN INSERT. NEXT    *06270000
      *     THE APPROPRIATE PARAGRAPH IS CALLED TO DO THE INSERT /     *06280000
      *     UPDATE/FILE                                                *06290000
      ******************************************************************06300000
                                                                        
       5000-UPDATE.                                                     
                                                                        
           MOVE '5000' TO ACTIVE-PARAGRAPH.                             
                                                                        
           PERFORM 5100-JRNL-TRAN-HEAD  THRU 5100-EXIT.                 
           PERFORM 7100-SELECT-PREMISE  THRU 7100-EXIT.                 
           PERFORM 5200-JRNL-UPDATE     THRU 5200-EXIT.                 
           IF WS-DATE-SPCL-MSG-ENDS EQUAL '0000-00-00' OR               
A03736        WS-DATE-SPCL-MSG-ENDS <= SPACES                           
                MOVE SPACES TO WS-DATE-SPCL-MSG-ENDS                    
                MOVE -1 TO WS-NULLIND                                   
           ELSE                                                         
              MOVE 0 TO WS-NULLIND                                      
           END-IF.                                                      
           PERFORM 8200-UPDATE-PREMISE THRU 8200-EXIT.                  
                                                                        
           IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL                   
               CONTINUE                                                 
           ELSE                                                         
               MOVE WS-ACTIVE-RETURN-CODE TO RS-RETURN-CODE             
           END-IF.                                                      
                                                                        
       5000-EXIT.                                                       
           EXIT.                                                        
                                                                        
      ******************************************************************06550000
      *   5100-JRNL-TRAN-HEAD.                                         *06560000
      *   1.   MOVE FIELDS TO THE MAINTENANCE TRANSACTION HEADER.      *06570000
      *        THE FIRST TIME THE TRANSACTION DETAILS ROW IS WRITTEN,  *06580000
      *        THIS ROW WILL ALSO BE WRITTEN (SEE CPD00067).           *06590000
      ******************************************************************06600000
       5100-JRNL-TRAN-HEAD.                                             
                                                                        
           PERFORM 7100-SELECT-PREMISE  THRU 7100-EXIT.                 
           PERFORM 7001-SELECT-TIMESTAMP THRU 7001-EXIT.                
           PERFORM 7002-SELECT-DATE      THRU 7002-EXIT.                
           PERFORM 7050-SELECT-RESP-AREA THRU 7050-EXIT.                
                                                                        
           MOVE 1                        TO WS-TRAN-APPL-NO             
                                            MI-TRAN-APPL-NO.            
                                                                        
           MOVE 'F'                      TO MH-CODE-TRAN-TYPE.          
           MOVE WS-RESP-AREA-ID          TO MH-RESP-AREA-ID.            
           MOVE ZEROS                    TO MH-ACCOUNT-NO.              
           MOVE ZEROES                   TO MH-CUSTOMER-NO.             
           MOVE PR-PREMISE-NO            TO MH-PREMISE-NO.              
           MOVE WS-USER-ID               TO MH-USER-ID.                 
           MOVE 'PANEL028'               TO MH-APPL-PROGRAM-ID.         
           MOVE ZERO                     TO MH-TRAN-COMMENT-LEN.        
           MOVE SPACES                   TO MH-TRAN-COMMENT-TEXT.       
                                                                        
       5100-EXIT.                                                       
           EXIT.                                                        
                                                                        
      ***************************************************************   06840000
      *                                                             *   06850000
      * 5200-JRNL-UPDATE                                            *   06860000
      *                                                             *   06870000
      ***************************************************************   06880000
                                                                        
       5200-JRNL-UPDATE.                                                
                                                                        
           MOVE '5200' TO ACTIVE-PARAGRAPH.                             
                                                                        
           PERFORM 5205-JRNL-PREM-DIRECTIONS   THRU 5205-EXIT.          
           PERFORM 5210-JRNL-SCRATCH-PAD       THRU 5210-EXIT.          
           PERFORM 5220-JRNL-SPCL-INSTRUCTIONS THRU 5220-EXIT.          
           PERFORM 5230-JRNL-SPCL-READ-INSTR   THRU 5230-EXIT.          
           PERFORM 5240-JRNL-DATE-SPCL-MSG     THRU 5240-EXIT.          
                                                                        
       5200-EXIT.                                                       
           EXIT.                                                        
      ****************************************************************  07020000
      *                                                              *  07030000
      * 5205-JRNL-PREM-DIRECTIONS                                    *  07040000
      *                                                              *  07050000
      ****************************************************************  07060000
                                                                        
       5205-JRNL-PREM-DIRECTIONS.                                       
                                                                        
           MOVE MH-TRANS-HIST-SEQ-NO     TO MI-TRANS-HIST-SEQ-NO.       
                                                                        
           IF WS-PREMISE-DIRECTIONS-OLD-TEXT NOT =                      
              PARM-PREMISE-DIRECTIONS-TEXT                              
              MOVE WS-TRAN-APPL-NO    TO MI-TRAN-APPL-NO                
                                                                        
              IF PARM-PREMISE-DIRECTIONS-TEXT > SPACES                  
                 IF PARM-PREMISE-DIRECTIONS-LEN > 75                    
                    MOVE +75 TO MI-CHG-COLUMN-VALUE-LEN                 
                    MOVE PARM-PREMISE-DIRECTIONS-TEXT (1:75) TO         
                         MI-CHG-COLUMN-VALUE-TEXT                       
                 ELSE                                                   
                    MOVE PARM-PREMISE-DIRECTIONS-LEN TO                 
                         MI-CHG-COLUMN-VALUE-LEN                        
                    MOVE PARM-PREMISE-DIRECTIONS-TEXT TO                
                         MI-CHG-COLUMN-VALUE-TEXT                       
                 END-IF                                                 
              ELSE                                                      
                 MOVE +9                   TO MI-CHG-COLUMN-VALUE-LEN   
                 MOVE '*DELETED*'          TO MI-CHG-COLUMN-VALUE-TEXT  
              END-IF                                                    
                                                                        
              IF WS-SCRATCH-PAD-OLD-TEXT > SPACES                       
                 IF WS-PREMISE-DIRECTIONS-OLD-LEN > 75                  
                    MOVE +75 TO MI-CHG-COLUMN-VALUE-LEN                 
                    MOVE WS-PREMISE-DIRECTIONS-OLD-TEXT (1:75) TO       
                         MI-PRV-COLUMN-VALUE-TEXT                       
                 ELSE                                                   
                    MOVE WS-PREMISE-DIRECTIONS-OLD-LEN TO               
                         MI-PRV-COLUMN-VALUE-LEN                        
                    MOVE WS-PREMISE-DIRECTIONS-OLD-TEXT TO              
                         MI-PRV-COLUMN-VALUE-TEXT                       
                 END-IF                                                 
              ELSE                                                      
                 MOVE +5                   TO MI-PRV-COLUMN-VALUE-LEN   
                 MOVE '*NEW*'              TO MI-PRV-COLUMN-VALUE-TEXT  
              END-IF                                                    
                                                                        
              MOVE 'PREM DIRECTIONS'       TO MI-COLUMN-DESC            
              PERFORM 6530-LOAD-MNT-TRANS-HIST  THRU 6530-EXIT          
              ADD 1 TO WS-TRAN-APPL-NO                                  
           END-IF.                                                      
                                                                        
       5205-EXIT.                                                       
           EXIT.                                                        
                                                                        
      ****************************************************************  07560000
      *                                                              *  07570000
      * 5210-JRNL-SCRATCH-PAD                                        *  07580000
      *                                                              *  07590000
      ****************************************************************  07600000
                                                                        
       5210-JRNL-SCRATCH-PAD.                                           
                                                                        
           MOVE MH-TRANS-HIST-SEQ-NO     TO MI-TRANS-HIST-SEQ-NO.       
                                                                        
           IF WS-SCRATCH-PAD-OLD-TEXT NOT = PARM-SCRATCH-PAD-TEXT       
              MOVE WS-TRAN-APPL-NO    TO MI-TRAN-APPL-NO                
                                                                        
              IF PARM-SCRATCH-PAD-TEXT > SPACES                         
                 IF PARM-SCRATCH-PAD-LEN > 75                           
                    MOVE +75 TO MI-CHG-COLUMN-VALUE-LEN                 
                    MOVE PARM-SCRATCH-PAD-TEXT (1:75) TO                
                         MI-CHG-COLUMN-VALUE-TEXT                       
                 ELSE                                                   
                    MOVE PARM-SCRATCH-PAD-LEN TO                        
                         MI-CHG-COLUMN-VALUE-LEN                        
                    MOVE PARM-SCRATCH-PAD-TEXT TO                       
                         MI-CHG-COLUMN-VALUE-TEXT                       
                 END-IF                                                 
              ELSE                                                      
                 MOVE +9                   TO MI-CHG-COLUMN-VALUE-LEN   
                 MOVE '*DELETED*'          TO MI-CHG-COLUMN-VALUE-TEXT  
              END-IF                                                    
                                                                        
              IF WS-SCRATCH-PAD-OLD-TEXT > SPACES                       
                 IF WS-SCRATCH-PAD-OLD-LEN > 75                         
                    MOVE +75 TO MI-PRV-COLUMN-VALUE-LEN                 
                    MOVE WS-SCRATCH-PAD-OLD-TEXT (1:75) TO              
                         MI-PRV-COLUMN-VALUE-TEXT                       
                 ELSE                                                   
                    MOVE WS-SCRATCH-PAD-OLD-LEN TO                      
                         MI-PRV-COLUMN-VALUE-LEN                        
                    MOVE WS-SCRATCH-PAD-OLD-TEXT TO                     
                         MI-PRV-COLUMN-VALUE-TEXT                       
                 END-IF                                                 
              ELSE                                                      
                 MOVE +5                   TO MI-PRV-COLUMN-VALUE-LEN   
                 MOVE '*NEW*'              TO MI-PRV-COLUMN-VALUE-TEXT  
              END-IF                                                    
                                                                        
              MOVE 'SCRATCH PAD    '       TO MI-COLUMN-DESC            
              PERFORM 6530-LOAD-MNT-TRANS-HIST  THRU 6530-EXIT          
              ADD 1 TO WS-TRAN-APPL-NO                                  
           END-IF.                                                      
                                                                        
       5210-EXIT.                                                       
           EXIT.                                                        
                                                                        
      ****************************************************************  08090000
      *                                                              *  08100000
      * 5220-JRNL-SPCL-INSTRUCTIONS                                  *  08110000
      *                                                              *  08120000
      ****************************************************************  08130000
                                                                        
       5220-JRNL-SPCL-INSTRUCTIONS.                                     
                                                                        
           MOVE MH-TRANS-HIST-SEQ-NO     TO MI-TRANS-HIST-SEQ-NO.       
                                                                        
           IF WS-SPCL-INSTRUCTIONS-OLD-TEXT NOT =                       
                                PARM-SPCL-INSTRUCTIONS-TEXT             
              MOVE WS-TRAN-APPL-NO    TO MI-TRAN-APPL-NO                
                                                                        
              IF PARM-SPCL-INSTRUCTIONS-TEXT > SPACES                   
                 IF PARM-SPCL-INSTRUCTIONS-LEN > 75                     
                    MOVE +75 TO MI-CHG-COLUMN-VALUE-LEN                 
                    MOVE PARM-SPCL-INSTRUCTIONS-TEXT (1:75) TO          
                         MI-CHG-COLUMN-VALUE-TEXT                       
                 ELSE                                                   
                    MOVE PARM-SPCL-INSTRUCTIONS-LEN TO                  
                         MI-CHG-COLUMN-VALUE-LEN                        
                    MOVE PARM-SPCL-INSTRUCTIONS-TEXT TO                 
                         MI-CHG-COLUMN-VALUE-TEXT                       
                 END-IF                                                 
              ELSE                                                      
                 MOVE +9                   TO MI-CHG-COLUMN-VALUE-LEN   
                 MOVE '*DELETED*'          TO MI-CHG-COLUMN-VALUE-TEXT  
              END-IF                                                    
                                                                        
              IF WS-SPCL-INSTRUCTIONS-OLD-TEXT > SPACES                 
                 IF WS-SPCL-INSTRUCTIONS-OLD-LEN > 75                   
                    MOVE +75 TO MI-PRV-COLUMN-VALUE-LEN                 
                    MOVE WS-SPCL-INSTRUCTIONS-OLD-TEXT (1:75) TO        
                         MI-PRV-COLUMN-VALUE-TEXT                       
                 ELSE                                                   
                    MOVE WS-SPCL-INSTRUCTIONS-OLD-LEN TO                
                         MI-PRV-COLUMN-VALUE-LEN                        
                    MOVE WS-SPCL-INSTRUCTIONS-OLD-TEXT TO               
                         MI-PRV-COLUMN-VALUE-TEXT                       
                 END-IF                                                 
              ELSE                                                      
                 MOVE +5                   TO MI-PRV-COLUMN-VALUE-LEN   
                 MOVE '*NEW*'              TO MI-PRV-COLUMN-VALUE-TEXT  
              END-IF                                                    
                                                                        
              MOVE 'SPCL INSTR     '       TO MI-COLUMN-DESC            
              PERFORM 6530-LOAD-MNT-TRANS-HIST  THRU 6530-EXIT          
              ADD 1 TO WS-TRAN-APPL-NO                                  
           END-IF.                                                      
                                                                        
       5220-EXIT.                                                       
           EXIT.                                                        
                                                                        
      ****************************************************************  08630000
      *                                                              *  08640000
      * 5230-JRNL-SPCL-READ-INSTR.                                   *  08650000
      *                                                              *  08660000
      ****************************************************************  08670000
                                                                        
       5230-JRNL-SPCL-READ-INSTR.                                       
                                                                        
           MOVE MH-TRANS-HIST-SEQ-NO     TO MI-TRANS-HIST-SEQ-NO.       
                                                                        
           IF WS-SPCL-READ-INSTR-OLD-TEXT NOT =                         
                                PARM-SPCL-READ-INSTR-TEXT               
              MOVE WS-TRAN-APPL-NO    TO MI-TRAN-APPL-NO                
                                                                        
PCR152*       IF PARM-SPCL-READ-INSTR-TEXT > SPACES                     08770000
PCR152*          MOVE PARM-SPCL-READ-INSTR-LEN                          08780000
PCR152*            TO MI-CHG-COLUMN-VALUE-LEN                           08790000
PCR152*          MOVE PARM-SPCL-READ-INSTR-TEXT                         08800000
PCR152*            TO MI-CHG-COLUMN-VALUE-TEXT                          08810000
PCR152        IF WS-SPCL-READ-INSTR-SPLIT-1 > SPACES                    
PCR152           MOVE WS-SPCL-READ-INSTR-LEN-1                          
PCR152             TO MI-CHG-COLUMN-VALUE-LEN                           
PCR152           MOVE WS-SPCL-READ-INSTR-SPLIT-1                        
PCR152             TO MI-CHG-COLUMN-VALUE-TEXT                          
              ELSE                                                      
                 MOVE +9                   TO MI-CHG-COLUMN-VALUE-LEN   
                 MOVE '*DELETED*'          TO MI-CHG-COLUMN-VALUE-TEXT  
              END-IF                                                    
                                                                        
T14453*       IF WS-SPCL-INSTRUCTIONS-OLD-TEXT > SPACES                 08870000
T14453        IF WS-SPCL-READ-INSTR-OLD-TEXT   > SPACES                 
PCR152           IF WS-SPCL-READ-INSTR-OLD-LEN > 75                     
PCR152              MOVE +75 TO MI-PRV-COLUMN-VALUE-LEN                 
PCR152              MOVE WS-SPCL-READ-INSTR-OLD-TEXT(1:75)              
PCR152                   TO MI-PRV-COLUMN-VALUE-TEXT                    
PCR152           ELSE                                                   
                    MOVE WS-SPCL-READ-INSTR-OLD-LEN                     
                         TO MI-PRV-COLUMN-VALUE-LEN                     
                    MOVE WS-SPCL-READ-INSTR-OLD-TEXT                    
                         TO MI-PRV-COLUMN-VALUE-TEXT                    
PCR152           END-IF                                                 
              ELSE                                                      
                 MOVE +5                   TO MI-PRV-COLUMN-VALUE-LEN   
                 MOVE '*NEW*'              TO MI-PRV-COLUMN-VALUE-TEXT  
              END-IF                                                    
                                                                        
              MOVE 'SPCL READ INSTR'       TO MI-COLUMN-DESC            
              PERFORM 6530-LOAD-MNT-TRANS-HIST  THRU 6530-EXIT          
              ADD 1 TO WS-TRAN-APPL-NO                                  
           END-IF.                                                      
                                                                        
       5230-EXIT.                                                       
           EXIT.                                                        
                                                                        
      ****************************************************************  09050000
      *                                                              *  09060000
      * 5240-JRNL-DATE-SPCL-MSG.                                     *  09070000
      *                                                              *  09080000
      ****************************************************************  09090000
       5240-JRNL-DATE-SPCL-MSG.                                         
                                                                        
           MOVE MH-TRANS-HIST-SEQ-NO     TO MI-TRANS-HIST-SEQ-NO.       
                                                                        
           IF (((WS-DATE-SPCL-MSG-ENDS-OLD NOT =                        
                 PARM-DATE-SPCL-MSG-ENDS) AND                           
                (PARM-DATE-SPCL-MSG-ENDS NOT = '0000-00-00')) OR        
               ((WS-DATE-SPCL-MSG-ENDS-OLD > SPACES) AND                
               ((PARM-DATE-SPCL-MSG-ENDS = '0000-00-00') OR             
A03736          (PARM-DATE-SPCL-MSG-ENDS <= SPACES))))                  
              MOVE WS-TRAN-APPL-NO    TO MI-TRAN-APPL-NO                
                                                                        
              IF PARM-DATE-SPCL-MSG-ENDS > SPACES                       
                 MOVE +10                                               
                   TO MI-CHG-COLUMN-VALUE-LEN                           
                 MOVE PARM-DATE-SPCL-MSG-ENDS                           
                   TO MI-CHG-COLUMN-VALUE-TEXT                          
              ELSE                                                      
                 MOVE +9                   TO MI-CHG-COLUMN-VALUE-LEN   
                 MOVE '*DELETED*'          TO MI-CHG-COLUMN-VALUE-TEXT  
              END-IF                                                    
                                                                        
              IF WS-DATE-SPCL-MSG-ENDS-OLD > SPACES                     
                 MOVE +10                                               
                   TO MI-PRV-COLUMN-VALUE-LEN                           
                 MOVE WS-DATE-SPCL-MSG-ENDS-OLD                         
                   TO MI-PRV-COLUMN-VALUE-TEXT                          
              ELSE                                                      
                 MOVE +5                   TO MI-PRV-COLUMN-VALUE-LEN   
                 MOVE '*NEW*'              TO MI-PRV-COLUMN-VALUE-TEXT  
              END-IF                                                    
                                                                        
              MOVE 'DT SPCL MSG END'       TO MI-COLUMN-DESC            
              PERFORM 6530-LOAD-MNT-TRANS-HIST  THRU 6530-EXIT          
              ADD 1 TO WS-TRAN-APPL-NO                                  
           END-IF.                                                      
                                                                        
       5240-EXIT.                                                       
           EXIT.                                                        
                                                                        
      ******************************************************************09460000
      *  JOURNALING COPYBOOK.                                          *09470000
      ******************************************************************09480000
                                                                        
           EXEC SQL                                                     09500000
              INCLUDE CPD00067                                          09510000
           END-EXEC.                                                    09520000
                                                                        
      ****************************************************************  09540000
      *                                                              *  09550000
      * 7001-SELECT-TIMESTAMP                                        *  09560000
      *                                                              *  09570000
      ****************************************************************  09580000
                                                                        
        7001-SELECT-TIMESTAMP.                                          
                                                                        
           EXEC SQL                                                     
T35434        SELECT
              REPLACE(REPLACE(CONVERT(CHAR(26), CIS.CURRENT$TIMESTAMP()
           , 121), ' ', '-'), ':', '.')
            INTO
              :MH-TRANS-HIST-SEQ-NO             
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ006
MFA-TR* MSQ028
MFA-TR* MSQ061
MFA-TR*    EXEC SQL                                                     09620000
MFA-TR*       SET :MH-TRANS-HIST-SEQ-NO = CURRENT TIMESTAMP                     
MFA-TR*    END-EXEC.                                                    09660000

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

                                                                        
           MOVE SQLCODE                  TO WS-ACTIVE-RETURN-CODE.      
           IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL                   
              NEXT SENTENCE                                             
           ELSE                                                         
              MOVE PROGRAM-NAME          TO ABEND-PROGRAM               
CBSI          MOVE '7001'                TO ACTIVE-PARAGRAPH            
T35434        MOVE 'SET'                 TO ABEND-FUNCTION              
CBSI          MOVE SPACES                TO ABEND-SQL-PREDICATES        
CBSI                                        ABEND-TABLES                
CBSI          MOVE 'PREMISE_NO'          TO TABLE-ELEMENT-1             
CBSI          MOVE PARM-PREMISE-NO       TO HOSTVAR-ELEMENT-1           
              PERFORM 9000-SEND-ERROR-RESULT    THRU 9000-EXIT          
              PERFORM 9900-SQL-ERROR-ROUTINE    THRU 9900-EXIT          
           END-IF.                                                      
                                                                        
       7001-EXIT.                                                       
           EXIT.                                                        
                                                                        
      ***************************************************************** 09830000
      *                                                               * 09840000
      * 7002-SELECT-DATE                                              * 09850000
      *                                                               * 09860000
      ***************************************************************** 09870000
       7002-SELECT-DATE.                                                
           EXEC SQL                                                     
                                                                        
T35434        SELECT
              CAST(SYSDATETIMEOFFSET() AS DATE)
            INTO
              :MH-DATE-TRANS                         
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ006
MFA-TR* MSQ028
MFA-TR*    EXEC SQL                                                     09890000
MFA-TR*                                                                 09900000
MFA-TR*       SET :MH-DATE-TRANS = CURRENT DATE                                 
MFA-TR*    END-EXEC.                                                    09940000

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

                                                                        
           MOVE SQLCODE TO WS-ACTIVE-RETURN-CODE.                       
           IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL                   
              NEXT SENTENCE                                             
           ELSE                                                         
              MOVE PROGRAM-NAME          TO ABEND-PROGRAM               
CBSI          MOVE '7002'                TO ACTIVE-PARAGRAPH            
T35434        MOVE 'SET'                 TO ABEND-FUNCTION              
CBSI          MOVE SPACES                TO ABEND-SQL-PREDICATES        
CBSI                                        ABEND-TABLES                
CBSI          MOVE 'PREMISE_NO'          TO TABLE-ELEMENT-1             
CBSI          MOVE PARM-PREMISE-NO       TO HOSTVAR-ELEMENT-1           
              PERFORM 9000-SEND-ERROR-RESULT    THRU 9000-EXIT          
              PERFORM 9900-SQL-ERROR-ROUTINE    THRU 9900-EXIT          
           END-IF.                                                      
                                                                        
       7002-EXIT.                                                       
           EXIT.                                                        
      ***************************************************************** 10100000
      *                                                               * 10110000
      * 7050-SELECT-RESP-AREA                                         * 10120000
      *     CALLS 9000-SEND-ERROR-RESULT                              * 10130000
      *           9900-SQL-ERROR-ROUTINE                              * 10140000
      *     CALLED FROM 5000-UPDATE                                   * 10150000
      *     SELECTS CSS_PREMISE                                       * 10160000
      ***************************************************************** 10170000
       7050-SELECT-RESP-AREA.                                           
                                                                        
           MOVE '7050'               TO ACTIVE-PARAGRAPH.               
                                                                        
                                                                        
           EXEC SQL                                                     
              SELECT RESP_AREA_ID                                       
                INTO :WS-RESP-AREA-ID                                   
                FROM CSS_USER_PROFILE WITH(READUNCOMMITTED)                     
               WHERE USER_ID = :PF-USER-ID                              
T35434                                                           
                                                            
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ003
MFA-TR* MSQ022
MFA-TR*    EXEC SQL                                                     10230000
MFA-TR*       SELECT RESP_AREA_ID                                       10240000
MFA-TR*         INTO :WS-RESP-AREA-ID                                   10250000
MFA-TR*         FROM CSS_USER_PROFILE                                   10260000
MFA-TR*        WHERE USER_ID = :PF-USER-ID                              10270000
MFA-TR*         WITH UR                                                         
MFA-TR*        QUERYNO 7050                                                     
MFA-TR*    END-EXEC.                                                    10280000

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

                                                                        
           MOVE SQLCODE TO WS-ACTIVE-RETURN-CODE.                       
                                                                        
           IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL                   
              NEXT SENTENCE                                             
           ELSE                                                         
              MOVE PROGRAM-NAME          TO ABEND-PROGRAM               
              MOVE '7050'                TO ACTIVE-PARAGRAPH            
              MOVE 'SELECT'              TO ABEND-FUNCTION              
CBSI          MOVE SPACES                TO ABEND-SQL-PREDICATES        
CBSI                                        ABEND-TABLES                
              MOVE 'CSS_USER_PROFILE'    TO TABLE-1                     
              MOVE 'USER_ID'             TO TABLE-ELEMENT-1             
              MOVE PARM-USERID           TO HOSTVAR-ELEMENT-1           
              PERFORM 9000-SEND-ERROR-RESULT  THRU 9000-EXIT            
              PERFORM 9900-SQL-ERROR-ROUTINE  THRU 9900-EXIT            
           END-IF.                                                      
      *                                                                 10440000
       7050-EXIT.                                                       
           EXIT.                                                        
                                                                        
      ***************************************************************** 10480000
      *                                                               * 10490000
      * 7100-SELECT-PREMISE                                           * 10500000
      *     CALLS 9000-SEND-ERROR-RESULT                              * 10510000
      *           9900-SQL-ERROR-ROUTINE                              * 10520000
      *     CALLED FROM 5000-UPDATE                                   * 10530000
      *     SELECTS CSS_PREMISE                                       * 10540000
      ***************************************************************** 10550000
       7100-SELECT-PREMISE.                                             
                                                                        
           MOVE '7100'               TO ACTIVE-PARAGRAPH.               
                                                                        
                                                                        
           EXEC SQL                                                     
               SELECT                                                   
                    PREMISE_DIRECTIONS,                                 
                    SCRATCH_PAD,                                        
                    SPCL_INSTRUCTIONS,                                  
                    SPCL_READ_INSTR,                                    
                    DATE_SPCL_MSG_ENDS                                  
               INTO                                                     
                    :WS-PREMISE-DIRECTIONS-OLD,                         
                    :WS-SCRATCH-PAD-OLD,                                
                    :WS-SPCL-INSTRUCTIONS-OLD,                          
                    :WS-SPCL-READ-INSTR-OLD,                            
                    :WS-DATE-SPCL-MSG-ENDS-OLD :WS-NULLIND2              
               FROM CSS_PREMISE WITH(READUNCOMMITTED)                           
               WHERE PREMISE_NO = :PR-PREMISE-NO                        
T35434                                                           
                                                            
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ003
MFA-TR* MSQ022
MFA-TR*    EXEC SQL                                                     10610000
MFA-TR*        SELECT                                                   10620000
MFA-TR*             PREMISE_DIRECTIONS,                                 10630000
MFA-TR*             SCRATCH_PAD,                                        10640000
MFA-TR*             SPCL_INSTRUCTIONS,                                  10650000
MFA-TR*             SPCL_READ_INSTR,                                    10660000
MFA-TR*             DATE_SPCL_MSG_ENDS                                  10670000
MFA-TR*        INTO                                                     10680000
MFA-TR*             :WS-PREMISE-DIRECTIONS-OLD,                         10690000
MFA-TR*             :WS-SCRATCH-PAD-OLD,                                10700000
MFA-TR*             :WS-SPCL-INSTRUCTIONS-OLD,                          10710000
MFA-TR*             :WS-SPCL-READ-INSTR-OLD,                            10720000
MFA-TR*             :WS-DATE-SPCL-MSG-ENDS-OLD:WS-NULLIND2              10730000
MFA-TR*        FROM CSS_PREMISE                                         10740000
MFA-TR*        WHERE PREMISE_NO = :PR-PREMISE-NO                        10750000
MFA-TR*        WITH UR                                                          
MFA-TR*        QUERYNO 7100                                                     
MFA-TR*    END-EXEC.                                                    10760000

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                   
A03736        IF WS-NULLIND2 < 0                                        
A03736            MOVE SPACES TO WS-DATE-SPCL-MSG-ENDS-OLD              
A03736        END-IF                                                    
           ELSE                                                         
              MOVE PROGRAM-NAME               TO ABEND-PROGRAM          
CBSI          MOVE 'SELECT'                   TO ABEND-FUNCTION         
CBSI          MOVE SPACES                     TO ABEND-SQL-PREDICATES   
CBSI                                             ABEND-TABLES           
              MOVE 'CSS_PREMISE'              TO TABLE-1                
              MOVE 'PREMISE_NO'               TO TABLE-ELEMENT-1        
              MOVE PR-PREMISE-NO              TO HOSTVAR-ELEMENT-1      
                                                                        
              PERFORM 9000-SEND-ERROR-RESULT  THRU 9000-EXIT            
              PERFORM 9900-SQL-ERROR-ROUTINE  THRU 9900-EXIT            
           END-IF.                                                      
      *                                                                 10930000
       7100-EXIT.                                                       
           EXIT.                                                        
                                                                        
      ***************************************************************** 10970000
      * 8200-UPDATE-PREMISE                                           * 10980000
      *     CALLS 9000-SEND-ERROR-RESULT                              * 10990000
      *           9900-SQL-ERROR-ROUTINE                              * 11000000
      *                                                               * 11010000
      *     CALLED FROM 5000-UPDATE                                   * 11020000
      *                                                               * 11030000
      *     UPDATES CSS_PREMISE.                                      * 11040000
      ***************************************************************** 11050000
                                                                        
       8200-UPDATE-PREMISE.                                             
                                                                        
           MOVE '8200'               TO ACTIVE-PARAGRAPH.               
                                                                        
           EXEC SQL                                                     
              UPDATE CSS_PREMISE                                        
              SET PREMISE_DIRECTIONS = :WS-PREMISE-DIRECTIONS,          
                  SCRATCH_PAD        = :WS-SCRATCH-PAD,                 
                  SPCL_INSTRUCTIONS  = :WS-SPCL-INSTRUCTIONS,           
                  SPCL_READ_INSTR    = :WS-SPCL-READ-INSTR,             
                  DATE_SPCL_MSG_ENDS = IIF(TRY_CONVERT(DATE, 
                                                :WS-DATE-SPCL-MSG-ENDS 
                                                             :WS-NULLIND
              ) IS NULL OR (PATINDEX('%.%', :WS-DATE-SPCL-MSG-ENDS 
                                                            :WS-NULLIND
              ) <> 0) OR (LEN(:WS-DATE-SPCL-MSG-ENDS :WS-NULLIND
              ) <> 10), CIS.CHAR2DATE(:WS-DATE-SPCL-MSG-ENDS 
                                                            :WS-NULLIND
              ), CONVERT(DATE, :WS-DATE-SPCL-MSG-ENDS :WS-NULLIND) )
              WHERE  PREMISE_NO      = :PR-PREMISE-NO                   
                                                            
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ003
MFA-TR* MSQ054
MFA-TR*    EXEC SQL                                                     11110000
MFA-TR*       UPDATE CSS_PREMISE                                        11120000
MFA-TR*       SET PREMISE_DIRECTIONS = :WS-PREMISE-DIRECTIONS,          11130000
MFA-TR*           SCRATCH_PAD        = :WS-SCRATCH-PAD,                 11140000
MFA-TR*           SPCL_INSTRUCTIONS  = :WS-SPCL-INSTRUCTIONS,           11150000
MFA-TR*           SPCL_READ_INSTR    = :WS-SPCL-READ-INSTR,             11160000
MFA-TR*           DATE_SPCL_MSG_ENDS = :WS-DATE-SPCL-MSG-ENDS:WS-NULLIND11170000
MFA-TR*       WHERE  PREMISE_NO      = :PR-PREMISE-NO                   11180000
MFA-TR*        QUERYNO 8200                                                     
MFA-TR*    END-EXEC.                                                    11190000

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

                                                                        
           MOVE SQLCODE TO WS-ACTIVE-RETURN-CODE.                       
                                                                        
           IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL                   
              NEXT SENTENCE                                             
           ELSE                                                         
              MOVE PROGRAM-NAME               TO ABEND-PROGRAM          
CBSI          MOVE 'UPDATE'                   TO ABEND-FUNCTION         
CBSI          MOVE SPACES                     TO ABEND-SQL-PREDICATES   
CBSI                                             ABEND-TABLES           
              MOVE 'CSS_PREMISE'              TO TABLE-1                
              MOVE 'PREMISE_NO'               TO TABLE-ELEMENT-1        
CBSI          MOVE 'PREMISE_DIRECTIONS'       TO TABLE-ELEMENT-2        
CBSI          MOVE 'SCRATCH_PAD'              TO TABLE-ELEMENT-3        
CBSI          MOVE 'SPCL_INSTRUCTIONS'        TO TABLE-ELEMENT-4        
CBSI          MOVE PR-PREMISE-NO              TO HOSTVAR-ELEMENT-1      
CBSI          MOVE WS-PREMISE-DIRECTIONS      TO HOSTVAR-ELEMENT-2      
CBSI          MOVE WS-SCRATCH-PAD             TO HOSTVAR-ELEMENT-3      
CBSI          MOVE WS-SPCL-INSTRUCTIONS       TO HOSTVAR-ELEMENT-4      
                                                                        
              PERFORM 9000-SEND-ERROR-RESULT  THRU 9000-EXIT            
              PERFORM 9900-SQL-ERROR-ROUTINE  THRU 9900-EXIT            
           END-IF.                                                      
                                                                        
       8200-EXIT.                                                       
           EXIT.                                                        
                                                                        
      ******************************************************************11400000
      * 9900- JOURNALING / ERROR HANDLING INCLUDE *                     11410000
      ******************************************************************11420000
REARCH     EXEC SQL                                                             
REARCH        INCLUDE CPDSP300                                                  
REARCH     END-EXEC.                                                            
                                                                        
      ******************************************************************11470000
      *       END PROGRAM COPYLIB                                      *11480000
      ******************************************************************11490000
REARCH     EXEC SQL                                                             
REARCH        INCLUDE CPD00321                                                  
REARCH     END-EXEC.                                                            
                                                                        
                                                                        
