       IDENTIFICATION DIVISION.                                         
       PROGRAM-ID.   CSR04773.                                          
       AUTHOR.       AMIRTHARAJ.                                        
COB303 DATE-WRITTEN. JAN 22,2014.                                       
       DATE-COMPILED.                                                   
      *----------------------------------------------------------------         
      *--                  SOUTH CAROLINA ELECTRIC & GAS             --         
      *----------------------------------------------------------------         
      *--                   STORED PROCEDURE:  CSR04773              --         
      *----------------------------------------------------------------         
      *--                         S U M M A R Y                      --         
      *--                                                            --         
      *--  CSR04773 :                                                --         
      *--                                                            --         
      *--  #  THIS PROGRAM IS USED TO INSERT DATA INTO               --         
      *--     LMS_EQUIP_INVENTRY BASED ON THE CALL TYPE.             --         
      *----------------------------------------------------------------         
      *--                                                            --         
      *--  PARAMETERS                                                --         
      *--                                                            --         
      *--      IN                                                    --         
      *--                                                            --         
      *--            CALL_TYPE                 CHAR(01)              --         
      *--            USER_ID                   CHAR(07)              --         
      *--            CRITERIA                  CHAR(250)             --         
      *--                                                            --         
      *--      OUT                                                   --         
      *--            NONE                                            --         
      *--      INOUT                                                 --         
      *--            NONE                                            --         
      *--                                                            --         
      *--  CSR04773_R1 - BUS RULE DETAILS                            --         
      *--                                                            --         
      *--            RETURN_CODE               INTEGER               --         
      *--            APPL_RETURN_CODE          INTEGER               --         
      *--            BUS_RULE_ID               CHAR(10)              --         
      *--            BUS_RULE_RESULT_CD        CHAR(10)              --         
      *--            BUS_RULE_XREF_ID          CHAR(26)              --         
      *--            EQUIP_SEQ                 DECIMAL(10,0)         --         
      *--                                                            --         
      *----------------------------------------------------------------         
      *--                        MODIFICATION LOG                    --         
      *--                                                            --         
      *--  DATE          INITIALS    COMMENTS                        --         
      *--  -----------   --------    ----------------------------------         
      *--  21/08/2014    AD7F921     INITIAL VERSION.                --         
      *----------------------------------------------------------------         
                                                                        
       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 'CSR04773'.
MSQ017     COPY MFASQLM.
                                                                        
      ******************************************************************        
      *    DB2 INCLUDES                                                *        
      ******************************************************************        
           EXEC SQL                                                             
              INCLUDE SQLCA                                                     
           END-EXEC.                                                            
                                                                        
      *****************************************************************         
      * LMS_EQUIP_INVENTRY, 4D                                        *         
      *****************************************************************         
            EXEC SQL                                                            
                 INCLUDE TBEQPINV                                               
            END-EXEC.                                                           
                                                                        
      *****************************************************************         
      * LMS_TRANS_HIST,     4J                                        *         
      *****************************************************************         
            EXEC SQL                                                            
                 INCLUDE TBLGTHST                                               
            END-EXEC.                                                           
                                                                        
      *****************************************************************         
      * LMS_TRANS_HIST_DET, 4S                                        *         
      *****************************************************************         
            EXEC SQL                                                            
                 INCLUDE TBLMSHST                                               
            END-EXEC.                                                           
                                                                        
      *****************************************************************         
      *   LMS_MSTR_STCK_INFO 4A                                       *         
      *****************************************************************         
           EXEC SQL                                                             
              INCLUDE TBMSTINF                                                  
           END-EXEC.                                                            
                                                                        
      ******************************************************************        
      *    SQL ERROR CHECKING COPYBOOK.                                *        
      ******************************************************************        
           COPY CWS00303.                                                       
                                                                        
      ******************************************************************        
      *    WORK AREAS TO XFER DATA.                                    *        
      ******************************************************************        
           COPY CCA00001.                                                       
                                                                        
      *    COPY CWS00010.                                                       
      ******************************************************************        
      *    ERROR HANDLING COPY BOOK.                                   *        
      ******************************************************************        
           EXEC SQL                                                             
                INCLUDE CWSX0010                                                
           END-EXEC.                                                            
                                                                        
       01  WS-WORKING-STORAGE.                                          
           05 WS-SQLSTATE             PIC X(05) VALUE SPACES.           
           05 WS-GTT-NAME             PIC X(30) VALUE SPACES.           
                                                                        
       01  WS-LITERALS.                                                 
           05 PROGRAM-NAME            PIC X(08) VALUE 'CSR04773'.       
           05 WS-YES                  PIC X(01) VALUE 'Y'.              
           05 WS-NEW                  PIC X(07) VALUE '**NEW**'.        
           05 WS-UNKNOWN              PIC X(02) VALUE 'UN'.             
           05 GTT-NAME                PIC X(26)                         
                                            VALUE 'SESSION.CSR04773_R1'.
       01  WS-ERR-FLAGS.                                                
           05 WS-ERR-INSRT-R1         PIC X(01) VALUE 'N'.              
           05 WS-FAILED               PIC X(01) VALUE 'F'.              
      *                                                                         
       01  WS-SWITCHES.                                                 
           05 WS-CALL-TYPE-SW               PIC X(01) VALUE SPACES.     
              88 FIXTURE                              VALUE 'F'.        
              88 LOCATION                             VALUE 'L'.        
              88 POLE                                 VALUE 'P'.        
              88 NODE                                 VALUE 'N'.        
              88 CONTRACT                             VALUE 'C'.        
                                                                        
       01  WS-EQ-SEQ-NO.                                                
           05 WS-EQ-SEQ-NUM           PIC 9(10).                        
           05 WS-EQ-SEQ-NO-TEXT REDEFINES                               
                    WS-EQ-SEQ-NUM     PIC X(10).                        
                                                                        
       01  WS-NULL-INDICATORS.                                          
           05  WS-NULL-MFR-DT         PIC S9(04)  COMP VALUE -1.        
           05  WS-NULL-EXP-DT         PIC S9(04)  COMP VALUE -1.        
           05  WS-NULL-DISPOSAL-DT    PIC S9(04)  COMP VALUE -1.        
      *                                                                         
       01  COUNTER-FIELDS.                                              
           05  CTR-ROWS               PIC S9(9) COMP VALUE 0.           
      *                                                                         
                                                                        
       01  WS-MISC-FIELDS.                                              
           05  WS-CALL-SECTION         PIC X(01) VALUE SPACES.          
           05  WS-USER-ID              PIC X(07) VALUE SPACES.          
           05  WS-EQUIP-TAG-NO         PIC X(12) VALUE SPACES.          
           05  WS-EQUIP-SEQ            PIC S9(10)V COMP-3 VALUE 0.      
           05  WS-COMPANY-NO           PIC X(02) VALUE SPACES.          
           05  WS-CODE-SERVICE-TYPE    PIC X(01) VALUE SPACES.          
           05  WS-STOCK-CD             PIC X(15) VALUE SPACES.          
           05  WS-EQUIP-TYPE-CD        PIC X(01) VALUE SPACES.          
           05  WS-EQUIP-MFR-CD         PIC X(02) VALUE SPACES.          
           05  WS-EQUIP-MFR-DT         PIC X(10) VALUE SPACES.          
           05  WS-WARRANTY-EXP-DT      PIC X(10) VALUE SPACES.          
           05  WS-STORAGE-FAC-CD       PIC X(03) VALUE SPACES.          
           05  WS-TRANS-COMMENTS       PIC X(60) VALUE                  
                                          'ADD NEW LIGHT TO INVENTORY'. 
      *     'ADDED FIXTURE TO THE INVENTORY USING ADD NEW LIGHT SCREEN'.        
           05  WS-STOCK-DESC           PIC X(50) VALUE SPACES.          
           05  WS-EQ-INV-EXIST         PIC X(01) VALUE SPACES.          
                                                                        
      *********************************************************                 
      *   GTT TABLE LAYOUT FOR BUS RULE AND IC NO            *                  
      *********************************************************                 
       01  GTT-RETURN-FIELDS.                                           
           05 S-RETURN-CODE                 PIC S9(9) COMP VALUE 0.     
           05 S-APPL-RETURN-CODE            PIC S9(9) COMP VALUE 0.     
           05 S-BUS-RULE-ID                 PIC X(10) VALUE SPACES.     
           05 S-BUS-RULE-RESULT-CD          PIC X(08) VALUE SPACES.     
           05 S-BUS-RULE-XREF-ID            PIC X(26) VALUE SPACES.     
           05 S-EQUIP-SEQ                   PIC S9(10)V COMP-3 VALUE 0. 
                                                                        
      *---------------------------------------------------------------          
      *--  ERROR PROCESSING VARIABLES                               --          
      *---------------------------------------------------------------          
       01  CSRERLOG-P.                                                  
            10  S-SP-NAME               PIC X(18)      VALUE SPACES.    
            10  S-SQLCODE               PIC S9(9) COMP VALUE 0.         
            10  S-SQLSTATE              PIC X(5)       VALUE ' '.       
            10  S-TABLE-NAME            PIC X(18)      VALUE SPACES.    
            10  S-HOST-VARIABLES.                                       
                49  S-HOST-VARIABLES-L  PIC S9(4) USAGE COMP.           
                49  S-HOST-VARIABLES-V  PIC X(255).                     
            10  S-SQL-STATEMENT.                                        
                49  S-SQL-STATEMENT-L   PIC S9(4) USAGE COMP.           
                49  S-SQL-STATEMENT-V   PIC X(255).                     
            10  S-SQL-DESCRIPTION.                                      
                49  S-SQL-DESCRIPTION-L PIC S9(4) USAGE COMP.           
                49  S-SQL-DESCRIPTION-V PIC X(255).                     
                                                                        
      ******************************************************************        
      *  CURSOR DECLARATIONS.                                          *        
      ******************************************************************        
                                                                        
       LINKAGE SECTION.                                                 
       01  PARM-SECTION                   PIC X(01).                    
       01  PARM-EQUIP-TAG-NO              PIC X(12).                    
       01  PARM-COMPANY-NO                PIC X(02).                    
       01  PARM-CODE-SERVICE-TYPE         PIC X(01).                    
       01  PARM-STOCK-CD                  PIC X(15).                    
       01  PARM-EQUIP-TYPE-CD             PIC X(01).                    
       01  PARM-EQUIP-MFR-CD              PIC X(02).                    
       01  PARM-EQUIP-MFR-DT              PIC X(10).                    
       01  PARM-WARRANTY-EXP-DT           PIC X(10).                    
       01  PARM-STORAGE-FAC-CD            PIC X(03).                    
       01  PARM-USER-ID                   PIC X(07).                    
       01  PARM-TRAN-COMMENTS.                                          
           05 PARM-TRAN-COMMENTS-LEN      PIC S9(04) COMP.              
           05 PARM-TRAN-COMMENTS-TEXT     PIC X(250).                   
       01  PARM-STOCK-DESC                PIC X(50).                    
                                                                        
       PROCEDURE DIVISION  USING PARM-SECTION                           
                                 PARM-EQUIP-TAG-NO                      
                                 PARM-COMPANY-NO                        
                                 PARM-CODE-SERVICE-TYPE                 
                                 PARM-STOCK-CD                          
                                 PARM-EQUIP-TYPE-CD                     
                                 PARM-EQUIP-MFR-CD                      
                                 PARM-EQUIP-MFR-DT                      
                                 PARM-WARRANTY-EXP-DT                   
                                 PARM-STORAGE-FAC-CD                    
                                 PARM-USER-ID                           
                                 PARM-TRAN-COMMENTS                     
                                 PARM-STOCK-DESC.                       
                                                                        
      ******************************************************************        
      *                                                                *        
      * 0000-MAINLINE.                                                 *        
      ******************************************************************        
       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.                                                        
                                                                        
      ******************************************************************        
      *                                                                *        
      * 0100-INITIALIZE                                                *        
      ******************************************************************        
       0100-INITIALIZE.                                                 
                                                                        
           EXEC SQL WHENEVER SQLWARNING CONTINUE END-EXEC.              
           EXEC SQL WHENEVER SQLERROR   CONTINUE END-EXEC.              
           EXEC SQL WHENEVER NOT FOUND  CONTINUE END-EXEC.              
                                                                        
           PERFORM 0100A-DECLARE-GTT                                    
              THRU 0100A-EXIT.                                          
                                                                        
           PERFORM 7100-TAG-NO-CASE-CNVRSN  THRU 7100-EXIT.             
      *                                                                         
       0100-EXIT.                                                       
           EXIT.                                                        
                                                                        
      ******************************************************************        
      *                                                                *        
      * 0100A-DECLARE-GTT                                              *        
      ******************************************************************        
       0100A-DECLARE-GTT.                                               
                                                                        
           MOVE 'SESSION.CSR04773_R1'       TO WS-GTT-NAME.             
                                                                        
           EXEC SQL
             CALL CIS.DROP_TEMP_TABLE('#CSR04773_R1')
           END-EXEC
           EXEC SQL
             CREATE TABLE #CSR04773_R1
              (                                                       
                    RETURN_CODE             INT                     
                   ,APPL_RETURN_CODE        INT                     
                   ,BUS_RULE_ID CHAR(10)  COLLATE 
                                 LATIN1_GENERAL_100_BIN2                    
                   ,BUS_RULE_RESULT_CD CHAR(10)  COLLATE 
                                 LATIN1_GENERAL_100_BIN2                    
                   ,BUS_RULE_XREF_ID CHAR(26)  COLLATE 
                                 LATIN1_GENERAL_100_BIN2                    
                   ,EQUIP_SEQ               DECIMAL(10,0)               
                )
           END-EXEC                                                     

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

                                                                        
           MOVE SQLSTATE TO WS-SQLSTATE.                                
           MOVE SQLCODE TO WS-ACTIVE-RETURN-CODE.                       
                                                                        
           IF WS-SQLSTATE = '42710'                                     
              PERFORM 8000A-DELETE-GTT-ROWS    THRU 8000A-EXIT          
           ELSE                                                         
              IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL                
                 CONTINUE                                               
              ELSE                                                      
                 MOVE PROGRAM-NAME          TO ABEND-PROGRAM            
                 MOVE '0100A'               TO ACTIVE-PARAGRAPH         
                 MOVE SQLCODE               TO ABEND-SQLCODE            
                 MOVE SQLSTATE              TO ABEND-SQLSTATE           
                 MOVE 'DECLARE GTT'         TO ABEND-FUNCTION           
                 MOVE SPACES                TO ABEND-SQL-PREDICATES     
                                               ABEND-TABLES             
                 MOVE WS-GTT-NAME           TO TABLE-1                  
                 MOVE SPACES                TO TABLE-ELEMENT-1          
                 MOVE SPACES                TO HOSTVAR-ELEMENT-1        
                 PERFORM 9700-PROCESS-ABEND    THRU 9700-EXIT           
              END-IF                                                    
           END-IF.                                                      
                                                                        
           EXEC SQL                                                     
               DECLARE C1 CURSOR                             
                                 WITH ROWSET POSITIONING FOR            
                SELECT RETURN_CODE                                      
                      ,APPL_RETURN_CODE                                 
                      ,LTRIM(RTRIM(BUS_RULE_ID))          AS BUS_RULE_ID       
                      ,LTRIM(RTRIM(BUS_RULE_RESULT_CD))   AS 
           BUS_RULE_RESULT_CD
                      ,LTRIM(RTRIM(BUS_RULE_XREF_ID))     AS 
           BUS_RULE_XREF_ID  
                      ,EQUIP_SEQ                                        
                  FROM #CSR04773_R1                              
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ029
MFA-TR* MSQ049
MFA-TR*    EXEC SQL                                                             
MFA-TR*        DECLARE C1 CURSOR WITH RETURN                                    
MFA-TR*                          WITH ROWSET POSITIONING FOR                    
MFA-TR*         SELECT RETURN_CODE                                              
MFA-TR*               ,APPL_RETURN_CODE                                         
MFA-TR*               ,STRIP(BUS_RULE_ID)          AS BUS_RULE_ID               
MFA-TR*               ,STRIP(BUS_RULE_RESULT_CD)   AS BUS_RULE_RESULT_CD        
MFA-TR*               ,STRIP(BUS_RULE_XREF_ID)     AS BUS_RULE_XREF_ID          
MFA-TR*               ,EQUIP_SEQ                                                
MFA-TR*           FROM SESSION.CSR04773_R1                                      
MFA-TR*    END-EXEC.                                                            
                                                                        
       0100A-EXIT.                                                      
            EXIT.                                                       
                                                                        
      ******************************************************************        
      *                                                                *        
      * 1000-PROCESS-INPUT                                             *        
      ******************************************************************        
       1000-PROCESS-INPUT.                                              
                                                                        
           MOVE PARM-SECTION                TO WS-CALL-SECTION.         
           MOVE PARM-USER-ID                TO WS-USER-ID.              
           MOVE PARM-EQUIP-TAG-NO           TO WS-EQUIP-TAG-NO.         
           MOVE PARM-COMPANY-NO             TO WS-COMPANY-NO.           
           MOVE PARM-CODE-SERVICE-TYPE      TO WS-CODE-SERVICE-TYPE.    
           MOVE PARM-STOCK-CD               TO WS-STOCK-CD.             
           MOVE PARM-EQUIP-TYPE-CD          TO WS-EQUIP-TYPE-CD.        
           MOVE PARM-EQUIP-MFR-CD           TO WS-EQUIP-MFR-CD.         
           MOVE PARM-EQUIP-MFR-DT           TO WS-EQUIP-MFR-DT.         
           MOVE PARM-WARRANTY-EXP-DT        TO WS-WARRANTY-EXP-DT.      
           MOVE PARM-STORAGE-FAC-CD         TO WS-STORAGE-FAC-CD.       
           INSPECT PARM-TRAN-COMMENTS-TEXT                              
              REPLACING ALL LOW-VALUES BY SPACES.                       
           INSPECT PARM-STOCK-DESC                                      
              REPLACING ALL LOW-VALUES BY SPACES.                       
           MOVE PARM-STOCK-DESC             TO WS-STOCK-DESC.           
                                                                        
       1000-EXIT.                                                       
           EXIT.                                                        
                                                                        
      ******************************************************************        
      * 2000-PROCESS-OUTPUT.                                           *        
      *                                                                *        
      ******************************************************************        
       2000-PROCESS-OUTPUT.                                             
                                                                        
           MOVE WS-CALL-SECTION             TO WS-CALL-TYPE-SW.         
                                                                        
           EVALUATE TRUE                                                
              WHEN FIXTURE                                              
                 MOVE WS-EQUIP-TAG-NO       TO 4D-EQUIP-TAG-NO          
                 PERFORM 7000-CHECK-INVTRY     THRU 7000-EXIT           
                 IF WS-ACTIVE-RETURN-CODE EQUAL NOT-FOUND               
                    PERFORM 2100-PROCESS-INSERT THRU 2100-EXIT          
                 ELSE                                                   
                    MOVE 'LMS0000009'       TO S-BUS-RULE-ID            
                    MOVE WS-FAILED          TO S-BUS-RULE-RESULT-CD     
                 END-IF                                                 
                                                                        
              WHEN OTHER                                                
                 CONTINUE                                               
           END-EVALUATE.                                                
                                                                        
           PERFORM 2000A-MOVE-RESULT           THRU 2000A-EXIT.         
      *                                                                         
       2000-EXIT.                                                       
           EXIT.                                                        
                                                                        
      ******************************************************************        
      * 2000A-MOVE-RESULT.                                             *        
      ******************************************************************        
       2000A-MOVE-RESULT.                                               
                                                                        
            MOVE 4D-EQUIP-SEQ               TO S-EQUIP-SEQ.             
            MOVE WS-ACTIVE-RETURN-CODE      TO S-RETURN-CODE.           
                                                                        
            IF S-BUS-RULE-ID > SPACES                                   
               MOVE +0                      TO S-RETURN-CODE            
               PERFORM 7550-GET-RULE-XREF-ID   THRU 7550-EXIT           
            END-IF.                                                     
                                                                        
            PERFORM 8100-SEND-RESULT           THRU 8100-EXIT.          
      *                                                                         
       2000A-EXIT.                                                      
             EXIT.                                                      
      ******************************************************************        
      * 2100-PROCESS-INSERT                                            *        
      ******************************************************************        
       2100-PROCESS-INSERT.                                             
                                                                        
            INITIALIZE DCLLMS-EQUIP-INVENTRY.                           
                                                                        
            MOVE WS-EQUIP-TAG-NO            TO 4D-EQUIP-TAG-NO.         
            MOVE WS-COMPANY-NO              TO 4D-COMPANY-NO.           
            MOVE WS-CODE-SERVICE-TYPE       TO 4D-CODE-SERVICE-TYPE.    
            MOVE WS-EQUIP-TYPE-CD           TO 4D-EQUIP-TYPE-CD.        
                                                                        
            IF WS-EQUIP-MFR-CD > SPACES                                 
               MOVE WS-EQUIP-MFR-CD         TO 4D-EQUIP-MFR-CD          
            ELSE                                                        
               MOVE WS-UNKNOWN              TO 4D-EQUIP-MFR-CD          
            END-IF.                                                     
                                                                        
            IF WS-EQUIP-MFR-DT > SPACES                                 
               MOVE WS-EQUIP-MFR-DT         TO 4D-EQUIP-MFR-DT          
               MOVE +0                      TO WS-NULL-MFR-DT           
            END-IF.                                                     
                                                                        
            IF WS-WARRANTY-EXP-DT > SPACES                              
               MOVE WS-WARRANTY-EXP-DT      TO 4D-WARRANTY-EXP-DT       
               MOVE +0                      TO WS-NULL-EXP-DT           
            END-IF.                                                     
                                                                        
            IF WS-STOCK-CD > SPACES                                     
               MOVE WS-STOCK-CD             TO 4D-STOCK-CD              
            ELSE                                                        
               IF WS-STOCK-DESC > SPACES                                
                  MOVE WS-COMPANY-NO        TO 4A-COMPANY-NO            
                  MOVE WS-CODE-SERVICE-TYPE                             
                                            TO 4A-CODE-SERVICE-TYPE     
                  MOVE WS-STOCK-DESC        TO 4A-STOCK-DESC            
                  PERFORM 7200-GET-STOCK-CD      THRU 7200-EXIT         
                  MOVE 4A-STOCK-CD          TO 4D-STOCK-CD              
               ELSE                                                     
      **NEED CODE CHANGE TO GET DFLT STCK CD FROM DB2 TABLE                     
                  MOVE 'DFLT STCK CD'       TO 4D-STOCK-CD              
               END-IF                                                   
            END-IF.                                                     
                                                                        
            MOVE WS-STORAGE-FAC-CD          TO 4D-STORAGE-FAC-CD.       
            MOVE WS-USER-ID                 TO 4D-LAST-UPDATE-USERID.   
            MOVE 'I'                        TO 4D-INVENTRY-STATUS-CD.   
                                                                        
            PERFORM 8000-INSERT-EQ-INVTRY        THRU 8000-EXIT.        
            PERFORM 7000-CHECK-INVTRY            THRU 7000-EXIT.        
            PERFORM 5000-WRITE-TRAN-HIST         THRU 5000-EXIT.        
      *                                                                         
       2100-EXIT.                                                       
            EXIT.                                                       
      ******************************************************************        
      * 5000-WRITE-TRAN-HIST                                           *        
      ******************************************************************        
       5000-WRITE-TRAN-HIST.                                            
                                                                        
            INITIALIZE DCLLMS-TRANS-HIST                                
                       DCLLMS-TRANS-HIST-DET.                           
                                                                        
            MOVE 4D-EQUIP-SEQ               TO 4J-EQUIP-SEQ             
                                               4S-EQUIP-SEQ             
                                               WS-EQ-SEQ-NUM.           
            MOVE 4D-EQUIP-TAG-NO            TO 4J-EQUIP-TAG-NO.         
            MOVE PROGRAM-NAME               TO 4J-APPL-PROGRAM-ID.      
            MOVE WS-USER-ID                 TO 4J-LAST-UPDATE-USERID    
                                               4S-LAST-UPDATE-USERID.   
            MOVE +1                         TO 4S-DETAIL-SEQ-NO.        
            IF PARM-TRAN-COMMENTS-TEXT > SPACES                         
               MOVE PARM-TRAN-COMMENTS-TEXT TO 4J-TRANS-COMMENTS-TEXT   
               MOVE LENGTH OF PARM-TRAN-COMMENTS-TEXT                   
                                            TO 4J-TRANS-COMMENTS-LEN    
            ELSE                                                        
               MOVE WS-TRANS-COMMENTS       TO 4J-TRANS-COMMENTS-TEXT   
               MOVE LENGTH OF WS-TRANS-COMMENTS                         
                                            TO 4J-TRANS-COMMENTS-LEN    
            END-IF.                                                     
      *                                                                         
            MOVE 'FXTR_TAG_NO'              TO 4S-COLUMN-DESC.          
            MOVE WS-NEW                     TO 4S-PRV-COLUMN-VALUE-TEXT.
            MOVE LENGTH OF WS-NEW           TO 4S-PRV-COLUMN-VALUE-LEN. 
            MOVE 4D-EQUIP-TAG-NO            TO 4S-CHG-COLUMN-VALUE-TEXT.
            MOVE LENGTH OF 4D-EQUIP-TAG-NO  TO 4S-CHG-COLUMN-VALUE-LEN. 
                                                                        
            PERFORM 6000-LOAD-LMS-TRN-HST-CPDLM2 THRU 6000-CPDLM2-EXIT. 
      *                                                                         
            MOVE 'FXTR_STOCK_CD'            TO 4S-COLUMN-DESC.          
            MOVE WS-NEW                     TO 4S-PRV-COLUMN-VALUE-TEXT.
            MOVE LENGTH OF WS-NEW           TO 4S-PRV-COLUMN-VALUE-LEN. 
            MOVE 4D-STOCK-CD                TO 4S-CHG-COLUMN-VALUE-TEXT.
            MOVE LENGTH OF 4D-STOCK-CD      TO 4S-CHG-COLUMN-VALUE-LEN. 
                                                                        
            PERFORM 6000-LOAD-LMS-TRN-HST-CPDLM2 THRU 6000-CPDLM2-EXIT. 
      *                                                                         
            MOVE 'FXTR_EQUIP_MFR_CD'        TO 4S-COLUMN-DESC.          
            MOVE WS-NEW                     TO 4S-PRV-COLUMN-VALUE-TEXT.
            MOVE LENGTH OF WS-NEW           TO 4S-PRV-COLUMN-VALUE-LEN. 
            MOVE 4D-EQUIP-MFR-CD            TO 4S-CHG-COLUMN-VALUE-TEXT.
            MOVE LENGTH OF 4D-EQUIP-MFR-CD  TO 4S-CHG-COLUMN-VALUE-LEN. 
                                                                        
            PERFORM 6000-LOAD-LMS-TRN-HST-CPDLM2 THRU 6000-CPDLM2-EXIT. 
      *                                                                         
            MOVE 'EQUIP_MFR_DT'             TO 4S-COLUMN-DESC.          
            MOVE WS-NEW                     TO 4S-PRV-COLUMN-VALUE-TEXT.
            MOVE LENGTH OF WS-NEW           TO 4S-PRV-COLUMN-VALUE-LEN. 
            MOVE 4D-EQUIP-MFR-DT            TO 4S-CHG-COLUMN-VALUE-TEXT.
            MOVE LENGTH OF 4D-EQUIP-MFR-DT  TO 4S-CHG-COLUMN-VALUE-LEN. 
                                                                        
            PERFORM 6000-LOAD-LMS-TRN-HST-CPDLM2 THRU 6000-CPDLM2-EXIT. 
      *                                                                         
            MOVE 'WARRANTY_EXP_DT'          TO 4S-COLUMN-DESC.          
            MOVE WS-NEW                     TO 4S-PRV-COLUMN-VALUE-TEXT.
            MOVE LENGTH OF WS-NEW           TO 4S-PRV-COLUMN-VALUE-LEN. 
            MOVE 4D-WARRANTY-EXP-DT         TO 4S-CHG-COLUMN-VALUE-TEXT.
            MOVE LENGTH OF 4D-WARRANTY-EXP-DT                           
                                            TO 4S-CHG-COLUMN-VALUE-LEN. 
            PERFORM 6000-LOAD-LMS-TRN-HST-CPDLM2 THRU 6000-CPDLM2-EXIT. 
      *                                                                         
            MOVE 'STORAGE_FAC_CD'           TO 4S-COLUMN-DESC.          
            MOVE WS-NEW                     TO 4S-PRV-COLUMN-VALUE-TEXT.
            MOVE LENGTH OF WS-NEW           TO 4S-PRV-COLUMN-VALUE-LEN. 
            MOVE 4D-STORAGE-FAC-CD          TO 4S-CHG-COLUMN-VALUE-TEXT.
            MOVE LENGTH OF 4D-STORAGE-FAC-CD                            
                                            TO 4S-CHG-COLUMN-VALUE-LEN. 
            PERFORM 6000-LOAD-LMS-TRN-HST-CPDLM2 THRU 6000-CPDLM2-EXIT. 
      *                                                                         
            MOVE 'FXTR_INVNTRY_ST_CD'       TO 4S-COLUMN-DESC.          
            MOVE WS-NEW                     TO 4S-PRV-COLUMN-VALUE-TEXT.
            MOVE LENGTH OF WS-NEW           TO 4S-PRV-COLUMN-VALUE-LEN. 
            MOVE 4D-INVENTRY-STATUS-CD      TO 4S-CHG-COLUMN-VALUE-TEXT.
            MOVE LENGTH OF 4D-INVENTRY-STATUS-CD                        
                                            TO 4S-CHG-COLUMN-VALUE-LEN. 
            PERFORM 6000-LOAD-LMS-TRN-HST-CPDLM2 THRU 6000-CPDLM2-EXIT. 
      *                                                                         
       5000-EXIT.                                                       
             EXIT.                                                      
      ******************************************************************        
      *                                                                *        
      * 6000-LOAD-LMS-TRN-HST-CPDLM2                                   *        
      ******************************************************************        
           EXEC SQL                                                             
              INCLUDE CPDLM002                                                  
           END-EXEC.                                                            
                                                                        
      ******************************************************************        
      *                                                                *        
      * 7000-CHECK-INVTRY.                                             *        
      ******************************************************************        
       7000-CHECK-INVTRY.                                               
                                                                        
           EXEC SQL                                                     
              SELECT EQUIP_SEQ                                          
                INTO :4D-EQUIP-SEQ                                      
                FROM LMS_EQUIP_INVENTRY [4D]                              
               WHERE [4D].EQUIP_TAG_NO = :4D-EQUIP-TAG-NO                 
                                                            
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ003
MFA-TR* MSQ026
MFA-TR*    EXEC SQL                                                             
MFA-TR*       SELECT EQUIP_SEQ                                                  
MFA-TR*         INTO :4D-EQUIP-SEQ                                              
MFA-TR*         FROM LMS_EQUIP_INVENTRY 4D                                      
MFA-TR*        WHERE 4D.EQUIP_TAG_NO = :4D-EQUIP-TAG-NO                         
MFA-TR*      QUERYNO 7000                                                       
MFA-TR*    END-EXEC.                                                            

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

                                                                        
           MOVE SQLCODE TO WS-ACTIVE-RETURN-CODE.                       
                                                                        
           IF WS-ACTIVE-RETURN-CODE EQUAL SUCCESSFUL-CALL               
              OR NOT-FOUND                                              
              NEXT SENTENCE                                             
           ELSE                                                         
              MOVE PROGRAM-NAME             TO ABEND-PROGRAM            
              MOVE '7000'                   TO ACTIVE-PARAGRAPH         
              MOVE 'SELECT'                 TO ABEND-FUNCTION           
              MOVE 'LMS_EQUIP_INVENTRY'     TO TABLE-1                  
              MOVE 'EQUIP_TAG_NO'           TO TABLE-ELEMENT-1          
              MOVE 4D-EQUIP-TAG-NO          TO HOSTVAR-ELEMENT-1        
              PERFORM 9700-PROCESS-ABEND         THRU 9700-EXIT         
           END-IF.                                                      
                                                                        
       7000-EXIT.                                                       
           EXIT.                                                        
                                                                        
       7100-TAG-NO-CASE-CNVRSN.                                         
                                                                        
           EXEC SQL                                                     
              SELECT
              UPPER(:PARM-EQUIP-TAG-NO)
            INTO
              :PARM-EQUIP-TAG-NO       
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ006
MFA-TR* MSQ029
MFA-TR*    EXEC SQL                                                             
MFA-TR*       SET :PARM-EQUIP-TAG-NO  = UPPER(:PARM-EQUIP-TAG-NO)               
MFA-TR*    END-EXEC.                                                            

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

                                                                        
           MOVE SQLCODE TO WS-ACTIVE-RETURN-CODE.                       
                                                                        
           IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL                   
              CONTINUE                                                  
           ELSE                                                         
              MOVE PROGRAM-NAME             TO ABEND-PROGRAM            
              MOVE SQLCODE                  TO ABEND-SQLCODE            
              MOVE '7100'                   TO ACTIVE-PARAGRAPH         
              MOVE 'SET'                    TO ABEND-FUNCTION           
              MOVE SPACES                   TO ABEND-SQL-PREDICATES     
                                               ABEND-TABLES             
                                               TABLE-1                  
              MOVE 'EQUIP-TAG-NO'           TO TABLE-ELEMENT-1          
              MOVE PARM-EQUIP-TAG-NO        TO HOSTVAR-ELEMENT-1        
              PERFORM 9700-PROCESS-ABEND       THRU 9700-EXIT           
           END-IF.                                                      
                                                                        
       7100-EXIT.                                                       
           EXIT.                                                        
                                                                        
       7200-GET-STOCK-CD.                                               
                                                                        
           EXEC SQL                                                     
              SELECT TOP(1) [4A].STOCK_CD                                       
                INTO :4A-STOCK-CD                                       
                FROM LMS_MSTR_STCK_INFO [4A] WITH(READUNCOMMITTED)              
               WHERE [4A].COMPANY_NO = :4A-COMPANY-NO                     
                 AND [4A].CODE_SERVICE_TYPE = :4A-CODE-SERVICE-TYPE       
                 AND [4A].STOCK_DESC = :4A-STOCK-DESC                     
                                                    
                                                                 
                                                            
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ003
MFA-TR* MSQ020
MFA-TR* MSQ022
MFA-TR* MSQ026
MFA-TR*    EXEC SQL                                                             
MFA-TR*       SELECT 4A.STOCK_CD                                                
MFA-TR*         INTO :4A-STOCK-CD                                               
MFA-TR*         FROM LMS_MSTR_STCK_INFO 4A                                      
MFA-TR*        WHERE 4A.COMPANY_NO = :4A-COMPANY-NO                             
MFA-TR*          AND 4A.CODE_SERVICE_TYPE = :4A-CODE-SERVICE-TYPE               
MFA-TR*          AND 4A.STOCK_DESC = :4A-STOCK-DESC                             
MFA-TR*          FETCH FIRST ROW ONLY                                           
MFA-TR*         WITH UR                                                         
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

           MOVE SQLCODE TO WS-ACTIVE-RETURN-CODE.                       
                                                                        
           IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL                   
              CONTINUE                                                  
           ELSE                                                         
              MOVE PROGRAM-NAME             TO ABEND-PROGRAM            
              MOVE SQLCODE                  TO ABEND-SQLCODE            
              MOVE SPACES                   TO ABEND-TABLES             
              MOVE SPACES                   TO ABEND-SQL-PREDICATES     
              MOVE '7200'                   TO ACTIVE-PARAGRAPH         
              MOVE 'SELECT'                 TO ABEND-FUNCTION           
              MOVE 'LMS_MSTR_STCK_INFO'     TO TABLE-1                  
              MOVE 'STOCK_DESC'             TO TABLE-ELEMENT-1          
              MOVE 4A-STOCK-DESC            TO HOSTVAR-ELEMENT-1        
              PERFORM 9700-PROCESS-ABEND         THRU 9700-EXIT         
           END-IF.                                                      
                                                                        
       7200-EXIT.                                                       
           EXIT.                                                        
                                                                        
      ******************************************************************        
      *                                                                *        
      * 7550-GET-RULE-XREF-ID                                          *        
      *                                                                *        
      ******************************************************************        
       7550-GET-RULE-XREF-ID.                                           
                                                                        
           EXEC SQL                                                     
              SELECT TOP(1) REPLACE(REPLACE(CONVERT(CHAR(26), 
           BUS_RULE_XREF_ID, 121), ' ', '-'), ':', '.') 
           BUS_RULE_XREF_ID                                   
                INTO :S-BUS-RULE-XREF-ID                                
                FROM CSS_BUS_RULE      [1R] WITH(READUNCOMMITTED)               
                    ,CSS_BUS_RULE_XREF [1T] WITH(READUNCOMMITTED)               
               WHERE [1R].BUS_RULE_ID = :S-BUS-RULE-ID                    
                 AND [1R].BUS_RULE_ID = [1T].BUS_RULE_ID                    
                                             
                                                            
           END-EXEC                                                     

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ003
MFA-TR* MSQ020
MFA-TR* MSQ022
MFA-TR* MSQ026
MFA-TR* MSQ061
MFA-TR*    EXEC SQL                                                             
MFA-TR*       SELECT BUS_RULE_XREF_ID                                           
MFA-TR*         INTO :S-BUS-RULE-XREF-ID                                        
MFA-TR*         FROM CSS_BUS_RULE      1R                                       
MFA-TR*             ,CSS_BUS_RULE_XREF 1T                                       
MFA-TR*        WHERE 1R.BUS_RULE_ID = :S-BUS-RULE-ID                            
MFA-TR*          AND 1R.BUS_RULE_ID = 1T.BUS_RULE_ID                            
MFA-TR*        FETCH FIRST ROW ONLY WITH UR                                     
MFA-TR*      QUERYNO 7550                                                       
MFA-TR*    END-EXEC                                                             

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

                                                                        
           MOVE SQLCODE TO WS-ACTIVE-RETURN-CODE                        
                                                                        
           IF WS-ACTIVE-RETURN-CODE EQUAL SUCCESSFUL-CALL               
              CONTINUE                                                  
           ELSE                                                         
               MOVE SPACES                  TO ABEND-TABLES             
               MOVE SPACES                  TO ABEND-SQL-PREDICATES     
               MOVE '7550'                  TO ACTIVE-PARAGRAPH         
               MOVE PROGRAM-NAME            TO ABEND-PROGRAM            
               MOVE 'SELECT'                TO ABEND-FUNCTION           
               MOVE 'CSS_BUS_RULE'          TO TABLE-1                  
               MOVE 'BUS_RULE_ID'           TO TABLE-ELEMENT-1          
               MOVE S-BUS-RULE-ID           TO HOSTVAR-ELEMENT-1        
               PERFORM 9700-PROCESS-ABEND        THRU 9700-EXIT         
           END-IF.                                                      
                                                                        
       7550-EXIT.                                                       
           EXIT.                                                        
                                                                        
      ******************************************************************        
      *                                                                *        
      * 8000-INSERT-EQ-INVTRY                                          *        
      ******************************************************************        
       8000-INSERT-EQ-INVTRY.                                           
                                                                        
           EXEC SQL                                                     
              INSERT INTO LMS_EQUIP_INVENTRY                            
                 (                                                      
                   EQUIP_SEQ                                            
                  ,EQUIP_TAG_NO                                         
                  ,COMPANY_NO                                           
                  ,CODE_SERVICE_TYPE                                    
                  ,STOCK_CD                                             
                  ,EQUIP_TYPE_CD                                        
                  ,EQUIP_MFR_CD                                         
                  ,EQUIP_MFR_DT                                         
                  ,WARRANTY_EXP_DT                                      
                  ,EQUIP_DISPOSAL_DT                                    
                  ,STORAGE_FAC_CD                                       
                  ,IN_TRANSIT_USERID                                    
                  ,INVENTRY_STATUS_CD                                   
                  ,WRNTY_RECEIVED_FL                                    
                  ,WRNTY_RECOUP_AMT                                     
                  ,LAST_UPDATE_USERID                                   
                 )                                                      
              VALUES                                                    
                 (                                                      
                   NEXT VALUE FOR SEQ_ID_EQUIP_SEQ                      
                  ,:4D-EQUIP-TAG-NO                                     
                  ,:4D-COMPANY-NO                                       
                  ,:4D-CODE-SERVICE-TYPE                                
                  ,:4D-STOCK-CD                                         
                  ,:4D-EQUIP-TYPE-CD                                    
                  ,:4D-EQUIP-MFR-CD                                     
                  ,IIF(TRY_CONVERT(DATE, :4D-EQUIP-MFR-DT 
                                         :WS-NULL-MFR-DT
              ) IS NULL OR (PATINDEX('%.%', :4D-EQUIP-MFR-DT 
                                                        :WS-NULL-MFR-DT
              ) <> 0) OR (LEN(:4D-EQUIP-MFR-DT :WS-NULL-MFR-DT
              ) <> 10), CIS.CHAR2DATE(:4D-EQUIP-MFR-DT :WS-NULL-MFR-DT
              ), CONVERT(DATE, :4D-EQUIP-MFR-DT :WS-NULL-MFR-DT) )             
                  ,IIF(TRY_CONVERT(DATE, :4D-WARRANTY-EXP-DT 
                                         :WS-NULL-EXP-DT
              ) IS NULL OR (PATINDEX('%.%', :4D-WARRANTY-EXP-DT 
                                                        :WS-NULL-EXP-DT
              ) <> 0) OR (LEN(:4D-WARRANTY-EXP-DT :WS-NULL-EXP-DT
              ) <> 10), CIS.CHAR2DATE(:4D-WARRANTY-EXP-DT 
                                                        :WS-NULL-EXP-DT
              ), CONVERT(DATE, :4D-WARRANTY-EXP-DT :WS-NULL-EXP-DT) )          
                  ,IIF(TRY_CONVERT(DATE, :4D-EQUIP-DISPOSAL-DT 
                                         :WS-NULL-DISPOSAL-DT
              ) IS NULL OR (PATINDEX('%.%', :4D-EQUIP-DISPOSAL-DT 
                                                   :WS-NULL-DISPOSAL-DT
              ) <> 0) OR (LEN(:4D-EQUIP-DISPOSAL-DT 
                                                   :WS-NULL-DISPOSAL-DT
              ) <> 10), CIS.CHAR2DATE(:4D-EQUIP-DISPOSAL-DT 
                                                   :WS-NULL-DISPOSAL-DT
              ), CONVERT(DATE, :4D-EQUIP-DISPOSAL-DT 
                                                   :WS-NULL-DISPOSAL-DT
              ) )            
                  ,:4D-STORAGE-FAC-CD                                   
                  ,:4D-IN-TRANSIT-USERID                                
                  ,:4D-INVENTRY-STATUS-CD                               
                  ,:4D-WRNTY-RECEIVED-FL                                
                  ,:4D-WRNTY-RECOUP-AMT                                 
                  ,:4D-LAST-UPDATE-USERID                               
                 )                                                      
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ054
MFA-TR*    EXEC SQL                                                             
MFA-TR*       INSERT INTO LMS_EQUIP_INVENTRY                                    
MFA-TR*          (                                                              
MFA-TR*            EQUIP_SEQ                                                    
MFA-TR*           ,EQUIP_TAG_NO                                                 
MFA-TR*           ,COMPANY_NO                                                   
MFA-TR*           ,CODE_SERVICE_TYPE                                            
MFA-TR*           ,STOCK_CD                                                     
MFA-TR*           ,EQUIP_TYPE_CD                                                
MFA-TR*           ,EQUIP_MFR_CD                                                 
MFA-TR*           ,EQUIP_MFR_DT                                                 
MFA-TR*           ,WARRANTY_EXP_DT                                              
MFA-TR*           ,EQUIP_DISPOSAL_DT                                            
MFA-TR*           ,STORAGE_FAC_CD                                               
MFA-TR*           ,IN_TRANSIT_USERID                                            
MFA-TR*           ,INVENTRY_STATUS_CD                                           
MFA-TR*           ,WRNTY_RECEIVED_FL                                            
MFA-TR*           ,WRNTY_RECOUP_AMT                                             
MFA-TR*           ,LAST_UPDATE_USERID                                           
MFA-TR*          )                                                              
MFA-TR*       VALUES                                                            
MFA-TR*          (                                                              
MFA-TR*            NEXT VALUE FOR SEQ_ID_EQUIP_SEQ                              
MFA-TR*           ,:4D-EQUIP-TAG-NO                                             
MFA-TR*           ,:4D-COMPANY-NO                                               
MFA-TR*           ,:4D-CODE-SERVICE-TYPE                                        
MFA-TR*           ,:4D-STOCK-CD                                                 
MFA-TR*           ,:4D-EQUIP-TYPE-CD                                            
MFA-TR*           ,:4D-EQUIP-MFR-CD                                             
MFA-TR*           ,:4D-EQUIP-MFR-DT:WS-NULL-MFR-DT                              
MFA-TR*           ,:4D-WARRANTY-EXP-DT:WS-NULL-EXP-DT                           
MFA-TR*           ,:4D-EQUIP-DISPOSAL-DT:WS-NULL-DISPOSAL-DT                    
MFA-TR*           ,:4D-STORAGE-FAC-CD                                           
MFA-TR*           ,:4D-IN-TRANSIT-USERID                                        
MFA-TR*           ,:4D-INVENTRY-STATUS-CD                                       
MFA-TR*           ,:4D-WRNTY-RECEIVED-FL                                        
MFA-TR*           ,:4D-WRNTY-RECOUP-AMT                                         
MFA-TR*           ,:4D-LAST-UPDATE-USERID                                       
MFA-TR*          )                                                              
MFA-TR*    END-EXEC.                                                            

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

                                                                        
           MOVE SQLCODE TO WS-ACTIVE-RETURN-CODE.                       
                                                                        
           IF WS-ACTIVE-RETURN-CODE EQUAL SUCCESSFUL-CALL               
              CONTINUE                                                  
           ELSE                                                         
              MOVE PROGRAM-NAME             TO ABEND-PROGRAM            
              MOVE '8000'                   TO ACTIVE-PARAGRAPH         
              MOVE 'INSERT'                 TO ABEND-FUNCTION           
              MOVE 'LMS_EQUIP_INVENTRY'     TO TABLE-1                  
              MOVE 'EQUIP_TAG_NO'           TO TABLE-ELEMENT-1          
              MOVE 4D-EQUIP-TAG-NO          TO HOSTVAR-ELEMENT-1        
              PERFORM 9700-PROCESS-ABEND         THRU 9700-EXIT         
           END-IF.                                                      
                                                                        
       8000-EXIT.                                                       
           EXIT.                                                        
                                                                        
      *****************************************************************         
      * 8000A-DELETE-GTT-ROWS.                                        *         
      *****************************************************************         
       8000A-DELETE-GTT-ROWS.                                           
      *                                                                         
            EXEC SQL                                                    
                DELETE FROM #CSR04773_R1                         
            END-EXEC.                                                   

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ049
MFA-TR*     EXEC SQL                                                            
MFA-TR*         DELETE FROM SESSION.CSR04773_R1                                 
MFA-TR*     END-EXEC.                                                           

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

      *                                                                         
            MOVE SQLCODE TO WS-ACTIVE-RETURN-CODE.                      
      *                                                                         
            IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL                  
               OR NOT-FOUND                                             
               NEXT SENTENCE                                            
            ELSE                                                        
               MOVE PROGRAM-NAME            TO ABEND-PROGRAM            
               MOVE SQLCODE                 TO ABEND-SQLCODE            
               MOVE SQLSTATE                TO ABEND-SQLSTATE           
               MOVE '8000A'                 TO ACTIVE-PARAGRAPH         
               MOVE 'DELETE'                TO ABEND-FUNCTION           
               MOVE SPACES                  TO ABEND-SQL-PREDICATES     
                                               ABEND-TABLES             
               MOVE 'CSR04773_R1'           TO TABLE-1                  
               MOVE SPACES                  TO TABLE-ELEMENT-1          
               MOVE SPACES                  TO HOSTVAR-ELEMENT-1        
               PERFORM 9700-PROCESS-ABEND        THRU 9700-EXIT         
           END-IF.                                                      
      *                                                                         
       8000A-EXIT.                                                      
           EXIT.                                                        
      *                                                                         
       8100-SEND-RESULT.                                                
                                                                        
           EXEC SQL                                                     
              INSERT INTO #CSR04773_R1                           
                 (                                                      
                   RETURN_CODE                                          
                  ,APPL_RETURN_CODE                                     
                  ,BUS_RULE_ID                                          
                  ,BUS_RULE_RESULT_CD                                   
                  ,BUS_RULE_XREF_ID                                     
                  ,EQUIP_SEQ                                            
                 )                                                      
              VALUES                                                    
                 (                                                      
                   :S-RETURN-CODE                                       
                  ,:S-APPL-RETURN-CODE                                  
                  ,:S-BUS-RULE-ID                                       
                  ,:S-BUS-RULE-RESULT-CD                                
                  ,:S-BUS-RULE-XREF-ID                                  
                  ,:S-EQUIP-SEQ                                         
                 )                                                      
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ049
MFA-TR*    EXEC SQL                                                             
MFA-TR*       INSERT INTO SESSION.CSR04773_R1                                   
MFA-TR*          (                                                              
MFA-TR*            RETURN_CODE                                                  
MFA-TR*           ,APPL_RETURN_CODE                                             
MFA-TR*           ,BUS_RULE_ID                                                  
MFA-TR*           ,BUS_RULE_RESULT_CD                                           
MFA-TR*           ,BUS_RULE_XREF_ID                                             
MFA-TR*           ,EQUIP_SEQ                                                    
MFA-TR*          )                                                              
MFA-TR*       VALUES                                                            
MFA-TR*          (                                                              
MFA-TR*            :S-RETURN-CODE                                               
MFA-TR*           ,:S-APPL-RETURN-CODE                                          
MFA-TR*           ,:S-BUS-RULE-ID                                               
MFA-TR*           ,:S-BUS-RULE-RESULT-CD                                        
MFA-TR*           ,:S-BUS-RULE-XREF-ID                                          
MFA-TR*           ,:S-EQUIP-SEQ                                                 
MFA-TR*          )                                                              
MFA-TR*    END-EXEC.                                                            

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

           MOVE SQLCODE TO WS-ACTIVE-RETURN-CODE.                       
                                                                        
           IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL                   
              ADD +1                     TO  CTR-ROWS                   
           ELSE                                                         
              MOVE PROGRAM-NAME          TO  ABEND-PROGRAM              
              MOVE '8100'                TO  ACTIVE-PARAGRAPH           
              MOVE SQLCODE               TO  ABEND-SQLCODE              
              MOVE 'INSERT'              TO  ABEND-FUNCTION             
              MOVE SPACES                TO  ABEND-SQL-PREDICATES       
                                             ABEND-TABLES               
              MOVE 'CSR04773_R1'         TO  TABLE-1                    
              MOVE SPACES                TO  TABLE-ELEMENT-1            
              MOVE SPACES                TO  HOSTVAR-ELEMENT-1          
              PERFORM 9900-SQL-ERROR-ROUTINE THRU 9900-EXIT             
           END-IF.                                                      
                                                                        
        8100-EXIT.                                                      
            EXIT.                                                       
                                                                        
       8800-CHECK-RESULTS.                                              
                                                                        
           IF CTR-ROWS <= 0                                             
              INITIALIZE GTT-RETURN-FIELDS                              
              MOVE 100                   TO S-APPL-RETURN-CODE          
              PERFORM 8100-SEND-RESULT      THRU 8100-EXIT              
           END-IF.                                                      
                                                                        
       8800-EXIT.                                                       
           EXIT.                                                        
                                                                        
       8900-SEND-DONE.                                                  
                                                                        
              EXEC SQL                                                  
                   OPEN C1                                              
              END-EXEC.
MSQ017     CALL "MFASQLCA"
MSQ017       USING SQLCA, BY VALUE MFA-PROGRAM-ID, "0", "0", "0",
MSQ017       BY REFERENCE MFSQLMESSAGETEXT
MSQ017     END-CALL

MSQ034     IF SQLCODE = 0 
MSQ034       EXEC SQL 
MSQ034           CLOSE C1 WITH RETURN TO CALLER
MSQ034       END-EXEC
MSQ017     CALL "MFASQLCA"
MSQ017       USING SQLCA, BY VALUE MFA-PROGRAM-ID, "0", "0", "0",
MSQ017       BY REFERENCE MFSQLMESSAGETEXT
MSQ017     END-CALL

MSQ034     END-IF.
                                                 
                                                                        
       8900-EXIT.                                                       
           EXIT.                                                        
                                                                        
       9000-SEND-ERROR-RESULT.                                          
                                                                        
      *    INITIALIZE GTT-RETURN-FIELDS.                                        
           MOVE WS-ACTIVE-RETURN-CODE    TO S-RETURN-CODE               
                                            ABEND-SQLCODE.              
           MOVE SQLERRMC                 TO ABEND-SQLERRMC.             
                                                                        
           EXEC SQL                                                     
               ROLLBACK                                                 
           END-EXEC.                                                    

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

                                                                        
           IF SQLCODE = 0                                               
              CONTINUE                                                  
           ELSE                                                         
              MOVE 'ROLLBACK'            TO ABEND-FUNCTION              
           END-IF.                                                      
                                                                        
           PERFORM 0100A-DECLARE-GTT        THRU 0100A-EXIT.            
           PERFORM 8100-SEND-RESULT         THRU 8100-EXIT.             
                                                                        
       9000-EXIT.                                                       
           EXIT.                                                        
                                                                        
       9700-PROCESS-ABEND.                                              
                                                                        
           PERFORM 9000-SEND-ERROR-RESULT   THRU 9000-EXIT.             
           PERFORM 9900-SQL-ERROR-ROUTINE   THRU 9900-EXIT.             
                                                                        
       9700-EXIT.                                                       
           EXIT.                                                        
                                                                        
       9900-SQL-ERROR-ROUTINE.                                          

MSQ002     EXEC SQL
MSQ002         SELECT LTRIM(RTRIM(CASE                                          
                        WHEN :TABLE-ELEMENT-1 > ' ' THEN                
                           LTRIM(RTRIM(:TABLE-ELEMENT-1)) + '=' + 
           LTRIM(RTRIM(:HOSTVAR-ELEMENT-1))                    
                        ELSE                                            
                           ''                                           
                     END + CASE                                               
                        WHEN :TABLE-ELEMENT-2 > ' ' THEN                
                           LTRIM(RTRIM(:TABLE-ELEMENT-2)) + '=' + 
           LTRIM(RTRIM(:HOSTVAR-ELEMENT-2))                    
                        ELSE                                            
                           ''                                           
                     END + CASE                                               
                        WHEN :TABLE-ELEMENT-3 > ' ' THEN                
                           LTRIM(RTRIM(:TABLE-ELEMENT-3)) + '=' + 
           LTRIM(RTRIM(:HOSTVAR-ELEMENT-3))                    
                        ELSE                                            
                           ''                                           
                     END + CASE                                               
                        WHEN :TABLE-ELEMENT-4 > ' ' THEN                
                           LTRIM(RTRIM(:TABLE-ELEMENT-4)) + '=' + 
           LTRIM(RTRIM(:HOSTVAR-ELEMENT-4))                    
                        ELSE                                            
                           ''                                           
                     END))
MSQ002              , :ABEND-FUNCTION
MSQ002              , 'PARAGRAPH-' + LTRIM(RTRIM(:ACTIVE-PARAGRAPH)) + 
           ',' + 'TABLES-' + LTRIM(RTRIM(:TABLE-2)) + ',' + 
           LTRIM(RTRIM(:TABLE-3)) + ',' + LTRIM(RTRIM(:TABLE-4)) + 
           ',' + 'ERRMSG-' + LTRIM(RTRIM(:ABEND-SQLERRMC))
MSQ002           INTO :MFA-CSRERLOG.ARG-5
MSQ002              , :MFA-CSRERLOG.ARG-6
MSQ002              , :MFA-CSRERLOG.ARG-7
MSQ002     END-EXEC
                                                                        
           EXEC SQL                                                     
               CALL CSRERLOG ( :ABEND-PROGRAM
                  , :ABEND-SQLCODE
                  , :ABEND-SQLSTATE
                  , :TABLE-1
                  , :MFA-CSRERLOG.ARG-5
                  , :MFA-CSRERLOG.ARG-6
                  , :MFA-CSRERLOG.ARG-7
                  )                                                   
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ002
MFA-TR*    EXEC SQL                                                             
MFA-TR*        CALL CSRERLOG (                                                  
MFA-TR*             :ABEND-PROGRAM,                                             
MFA-TR*             :ABEND-SQLCODE,                                             
MFA-TR*             :ABEND-SQLSTATE,                                            
MFA-TR*             :TABLE-1,                                                   
MFA-TR*              VARCHAR(STRIP(                                             
MFA-TR*              CASE                                                       
MFA-TR*                 WHEN :TABLE-ELEMENT-1 > ' ' THEN                        
MFA-TR*                    STRIP(:TABLE-ELEMENT-1) CONCAT '=' CONCAT            
MFA-TR*                    STRIP(:HOSTVAR-ELEMENT-1)                            
MFA-TR*                 ELSE                                                    
MFA-TR*                    ''                                                   
MFA-TR*              END CONCAT                                                 
MFA-TR*              CASE                                                       
MFA-TR*                 WHEN :TABLE-ELEMENT-2 > ' ' THEN                        
MFA-TR*                    STRIP(:TABLE-ELEMENT-2) CONCAT '=' CONCAT            
MFA-TR*                    STRIP(:HOSTVAR-ELEMENT-2)                            
MFA-TR*                 ELSE                                                    
MFA-TR*                    ''                                                   
MFA-TR*              END CONCAT                                                 
MFA-TR*              CASE                                                       
MFA-TR*                 WHEN :TABLE-ELEMENT-3 > ' ' THEN                        
MFA-TR*                    STRIP(:TABLE-ELEMENT-3) CONCAT '=' CONCAT            
MFA-TR*                    STRIP(:HOSTVAR-ELEMENT-3)                            
MFA-TR*                 ELSE                                                    
MFA-TR*                    ''                                                   
MFA-TR*              END CONCAT                                                 
MFA-TR*              CASE                                                       
MFA-TR*                 WHEN :TABLE-ELEMENT-4 > ' ' THEN                        
MFA-TR*                    STRIP(:TABLE-ELEMENT-4) CONCAT '=' CONCAT            
MFA-TR*                    STRIP(:HOSTVAR-ELEMENT-4)                            
MFA-TR*                 ELSE                                                    
MFA-TR*                    ''                                                   
MFA-TR*              END                                                        
MFA-TR*              )),                                                        
MFA-TR*              VARCHAR(:ABEND-FUNCTION),                                  
MFA-TR*              VARCHAR(                                                   
MFA-TR*              'PARAGRAPH-' CONCAT STRIP(:ACTIVE-PARAGRAPH) CONCAT        
MFA-TR*              ',' CONCAT 'TABLES-' CONCAT STRIP(:TABLE-2) CONCAT         
MFA-TR*              ',' CONCAT STRIP(:TABLE-3) CONCAT                          
MFA-TR*              ',' CONCAT STRIP(:TABLE-4) CONCAT                          
MFA-TR*              ',' CONCAT 'ERRMSG-' CONCAT STRIP(:ABEND-SQLERRMC)         
MFA-TR*              )                                                          
MFA-TR*             )                                                           
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

                                                                        
           PERFORM 8900-SEND-DONE            THRU 8900-EXIT.            
           
MSQ016        GOBACK.                                                    
                                                                        
       9900-EXIT.                                                       
           EXIT.                                                        
                                                                        
      *===============================================================*         
       9999-END-PROGRAM.                                                
      *===============================================================*         
                                                                        
           PERFORM 8800-CHECK-RESULTS        THRU 8800-EXIT.            
           PERFORM 8900-SEND-DONE            THRU 8900-EXIT.            
                                                                        
           
MSQ016        GOBACK.                                                    
                                                                        
       9999-EXIT.                                                       
           EXIT.                                                        
                                                                        
      ******************************************************************        
      *                       END OF PROGRAM                           *        
      ******************************************************************        
