       IDENTIFICATION DIVISION.                                         
       PROGRAM-ID.   CSR02546.                                          
COB303 DATE-WRITTEN.      APRIL 7, 2004.                                
       DATE-COMPILED.                                                   
                                                                        
      ******************************************************************00060000
      *                                                                *00070000
      *                SOUTH CAROLINA ELECTRIC & GAS                   *00080000
      *                                                                *00090000
      *  THIS PROGRAM IS EXECUTED VIA A REMOTE PROCEDURE CALL (RPC).   *00100000
      *                                                                *00110000
      *  TRANID:        S546                                           *00120000
      *  PROGRAM:       S546                                           *00130000
      *  CALLING SP:    PA_S546                                        *00140000
      *                                                                *00150000
      ******************************************************************00160000
      *                                                                *00170000
      *                 P R O G R A M  S U M M A R Y                   *00180000
      *                                                                *00190000
      *  THIS PROGRAM UPDATES WQS FOR IVR BASED ON CUSTOMER RESPONSE.  *00200000
      *                                                                *00220000
      ******************************************************************00230000
      *                                                                *00240000
      *                     PROGRAM MODIFICATION LOG                   *00250000
      *                                                                *00260000
      *    DATE    INITIALS   COMMENTS                                 *00270000
      *  --------  --------   ---------------------------------------  *00280000
      *  04/07/04    PRA      RPC ORIGINALLY ADDED.                    *00290000
OMSCPD*  11/7/05   PA11954    ADD OPTION.                              *        
C33768*  01/23/06  PA11954    ADD OPTION.                              *        
C33411*  02/20/06  LH12766    CML 33411 ADDED CODE TO COMPLETE WQ CALL *        
C33411*                       BACK FROM THE WEB.                       *        
REARCH*  05/24/06    CVNS     RPC TO DB2 SP CONVERSION                 *        
REARCH*              CHENNAI                                           *        
C35479*  08/08/07  SC41135    ADD OPTION TO ALLOW A CUSTOMER TO RESPOND*        
C35479*                       'DON'T KNOW' WHEN ASKED IF THEIR POWER IS*        
C35479*                       RESTORED                                 *        
C35884*  11/05/07  SC41135    ADDING 2 NEW WQ COMMENTS FOR WEB         *        
A02875*  06/15/11  MSR        Add new Response 0                       *        
A04519*  04/16/13  PK98692    ADD TWO NEW RESPONSE CODES 'A' AND 'B'   *        
A04519*                       FOR IVR; add another for 'C'             *        
P00757*  12/27/13  AS7C117    update ASSGN_HIST_PRES_FL column of      *        
P00757*                       CSS_WQ_ITEMS with "Y"                    *        
P00757*                       AND REMOVED UNUSED COPY BOOKS.           *        
      ******************************************************************00570000
      *                                                                *        
      *                ---- BASIC SEQUENCE STRUCTURE ----              *        
      *                                                                *        
      *  0000 - 0999  MAIN CONTROL PATH AND INITIALIZATION             *        
      *  1000 - 1999  INPUT PROCESSING CONTROL PATH                    *        
      *  2000 - 2999  OUTPUT PROCESSING CONTROL PATH                   *        
      *  3000 - 4999  NOT USED                                         *        
      *  5000 - 5999  COMMON PROGRAM MODULES                           *        
      *  6000 - 6999  COMMON SYSTEM MODULES                            *        
      *  7000 - 7999  INPUT MODULES                                    *        
      *  8000 - 8999  OUTPUT MODULES                                   *        
      *  9000 - 9999  TERMINATION,ABEND, MESSAGING MODULES             *        
      *                                                                *        
      *****************************************************************         
                                                                        
       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 'CSR02546'.
MSQ017     COPY MFASQLM.
                                                                        
       01  WS-START                    PIC X(40) VALUE                  
REARCH        'WORKING STORAGE FOR CSR02546 STARTS HERE'.               
                                                                        
      ******************************************************************00650000
      *    DB2 INCLUDES                                                *00660000
      ******************************************************************00670000
                                                                        
           EXEC SQL                                                     00690000
              INCLUDE SQLCA                                             00700000
           END-EXEC.                                                    00710000
                                                                        
           EXEC SQL                                                     00970000
              INCLUDE TBWQITS                                           00980000
           END-EXEC.                                                    00990000
                                                                        
           EXEC SQL                                                     00970000
              INCLUDE TBWQHTY                                           00980000
           END-EXEC.                                                    00990000
                                                                        
           EXEC SQL                                                     00970000
              INCLUDE TBMODEL                                           00980000
           END-EXEC.                                                    00990000
                                                                        
      ******************************************************************        
      *    COBOL WORKING STORAGE COPY BOOKS                            *        
      ******************************************************************        
                                                                        
           COPY CWS00303.                                               01520000
                                                                        
REARCH     EXEC SQL                                                             
REARCH          INCLUDE CWSX0010                                                
REARCH     END-EXEC.                                                            
                                                                        
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).                     
      ******************************************************************        
      *    WORK AREAS                                                  *        
      ******************************************************************        
                                                                        
                                                                        
       01  PARM-FIELDS.                                                 
           05  PARM-ITEM-ID            PIC X(10).                       
           05  PARM-ITEM-ID-NUM REDEFINES PARM-ITEM-ID                  
                                       PIC 9(10).                       
           05  PARM-RESPONSE           PIC X(1).                        
                                                                        
       01  SNA-FIELDS.                                                  
           05  SNA-SUBC                PIC S9(9) COMP.                  
           05  SNA-CONNECTION-NAME     PIC X(08) VALUE SPACES.          
                                                                        
       01  COUNTER-FIELDS.                                              
           05  CTR-COLUMN              PIC S9(9) COMP VALUE 1.          
           05  CTR-ROWS                PIC S9(9) COMP VALUE 0.          
                                                                        
       01  WORK-FIELDS.                                                 
           05  MAX-LENGTH-PARM         PIC S9(9) COMP.                  
           05  WRKLEN1                 PIC S9(9) COMP.                  
           05  WRKLEN2                 PIC S9(9) COMP.                  
           05  WRK-DONE-STATUS         PIC S9(9) COMP.                  
                                                                        
       01  FILLER                      PIC X(32) VALUE                  
              'THIS IS THE ROW RETURN AREA.'.                           
                                                                        
       01  TDS-RETURN-FIELDS.                                           
           05  RS-RETURN-CODE          PIC S9(09) COMP VALUE +0.        
                                                                        
REARCH 01  GTT-RETURN-FIELDS.                                           
REARCH     05   S-RETURN-CODE          PIC S9(09) COMP VALUE +0.        
REARCH 01  GTT-MISC-FIELDS.                                             
REARCH      05  GTT-NAME                PIC X(26)                       
REARCH                                       VALUE                      
REARCH                                   'SESSION.CSR02546_R1'.         
REARCH      05  GTT-ROW.                                                
REARCH          49 GTT-ROW-LEN          PIC S9(04) COMP.                
REARCH          49 GTT-ROW-CHAR         PIC X(1024).                    
REARCH      05  GTT-SQLCODE             PIC S9(9) COMP.                 
                                                                        
       01  SWITCHES.                                                    
           05  ALL-DONE-SW             PIC X(01) VALUE 'N'.             
               88 NOT-ALL-DONE                   VALUE 'N'.             
               88 ALL-DONE                       VALUE 'Y'.             
           05  SEND-DONE-SW            PIC X(01) VALUE 'Y'.             
               88 SEND-DONE-ERROR                VALUE 'N'.             
               88 SEND-DONE-OK                   VALUE 'Y'.             
                                                                        
       01  WS-MISC.                                                     
REARCH     05  PROGRAM-NAME            PIC X(08)  VALUE 'CSR02546'.     
           05  WS-COMMENTS             PIC X(250) VALUE SPACES.         
           05  WS-COMMENTS-OUT         PIC X(250) VALUE SPACES.         
           05  WS-STATUS               PIC X(1)   VALUE SPACES.         
P00757     05  WS-Y                    PIC X(1)   VALUE 'Y'.            
           05  WS-CURRENT-TS           PIC X(26)  VALUE SPACES.         
A02875     05  WS-COMMENTS-0           PIC X(44)  VALUE                 
A02875            '; IVR COMPLETE -- SYSTEM TIMED OUT'.                 
           05  WS-COMMENTS-1           PIC X(41)  VALUE                 
                  '; IVR COMPLETE -- SUCCESSFUL -- LIGHTS ON'.          
           05  WS-COMMENTS-2           PIC X(34)  VALUE                 
                  '; IVR COMPLETE -- LIGHTS STILL OFF'.                 
           05  WS-COMMENTS-3           PIC X(49)  VALUE                 
                  '; NOT COMPLETED -- INVALID RESPONSE FROM CUSTOMER'.  
           05  WS-COMMENTS-4           PIC X(31)  VALUE                 
                  '; IVR COMPLETE -- RECEIVED BUSY'.                    
           05  WS-COMMENTS-5           PIC X(32)  VALUE                 
                  '; IVR COMPLETE -- RING NO ANSWER'.                   
           05  WS-COMMENTS-6           PIC X(50)  VALUE                 
                  '; IVR COMPLETE -- ANSWERING MACHINE (LEFT MESSAGE)'. 
           05  WS-COMMENTS-7           PIC X(38)  VALUE                 
                  '; NOT COMPLETED -- INVALID RETURN CODE'.             
           05  WS-COMMENTS-8           PIC X(35)  VALUE                 
                  '; NOT COMPLETED -- INVALID RESPONSE'.                
OMSCPD     05  WS-COMMENTS-9           PIC X(24)  VALUE                 
OMSCPD            '; IVR COMPLETE -- HANGUP'.                           
A04519     05  WS-COMMENTS-A           PIC X(48)  VALUE                 
A04519            '; IVR COMPLETE -- INVALID RESPONSE FROM CUSTOMER'.   
A04519     05  WS-COMMENTS-B           PIC X(37)  VALUE                 
A04519            '; IVR COMPLETE -- INVALID RETURN CODE'.              
A04519     05  WS-COMMENTS-C           PIC X(70)  VALUE                 
A04519            '; IVR COMPLETE -- TROUBLE ORDER COMPLETED BEFORE IVR         
A04519-           ' CALLED CUSTOMER'.                                           
C33768     05  WS-COMMENTS-D           PIC X(44)  VALUE                 
C33768            '; IVR DELETE -- DUPLICATE WQ FOR STORM ORDER'.       
C33411     05  WS-COMMENTS-W           PIC X(44)  VALUE                 
C33411            '; WEB COMPLETE -- SUCCESSFUL -- LIGHTS ON'.          
C35479     05  WS-COMMENTS-U           PIC X(45)  VALUE                 
C35479            '; IVR COMPLETED -- CUSTOMER UNABLE TO CONFIRM'.      
C35884     05  WS-COMMENTS-X           PIC X(34)  VALUE                 
C35884            '; WEB COMPLETE -- LIGHTS STILL OFF'.                 
C35884     05  WS-COMMENTS-Y           PIC X(44)  VALUE                 
C35884            '; WEB COMPLETE -- CUSTOMER UNABLE TO CONFIRM'.       
                                                                        
REARCH LINKAGE SECTION.                                                 
REARCH 01 LINK-ITEM-ID            PIC X(10).                            
REARCH 01 LINK-RESPONSE           PIC X(01).                            
REARCH PROCEDURE DIVISION USING                                         
REARCH                    LINK-ITEM-ID                                  
REARCH                    LINK-RESPONSE.                                
                                                                        
      ******************************************************************04640000
      * 0000-MAINLINE                                                  *04650000
      *     CONTROLS THE MAIN PATH OF THE PROGRAM                      *04660000
      ******************************************************************04670000
                                                                        
       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.                                                        
                                                                        
      ******************************************************************04790000
      * 0100-INITIALIZE                                                *04800000
      *                                                                *04810000
      *     1. RESET DB2 ERROR HANDLERS                                *04820000
      *     2. ESTABLISH GATEWAY ENVIRONMENT (TDINIT)                  *04830000
      *     3. ACCEPT CLIENT REQUEST/ESTABLISH SNA HANDLE (TDACCEPT)   *04840000
      *     4. DETERMINE IF CLIENT HAS SENT AN RPC PARAMETER (TDRESULT)*04850000
      *                                                                *04860000
      ******************************************************************04870000
                                                                        
       0100-INITIALIZE.                                                 
                                                                        
           EXEC SQL WHENEVER SQLWARNING CONTINUE END-EXEC.              
           EXEC SQL WHENEVER SQLERROR   CONTINUE END-EXEC.              
           EXEC SQL WHENEVER NOT FOUND  CONTINUE END-EXEC.              
           EXEC SQL                                                     
                   DECLARE C1 CURSOR  FOR                    
                   SELECT                                               
                     :S-RETURN-CODE      AS RETURN_CODE                 
                   FROM                                                 
                       CIS.SYSDUMMY1                                 
           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                                 04930000
MFA-TR*    END-EXEC.                                                    04940000
                                                                        
       0100-EXIT.                                                       
           EXIT.                                                        
                                                                        
      ******************************************************************        
      * 1000-PROCESS-INPUT                                             *        
      *                                                                *        
      *     1. RECEIVE PARMS.                                          *        
      *                                                                *        
      ******************************************************************        
                                                                        
       1000-PROCESS-INPUT.                                              
                                                                        
REARCH     MOVE LINK-ITEM-ID                  TO PARM-ITEM-ID .         
REARCH     MOVE LINK-RESPONSE                 TO PARM-RESPONSE .        
           MOVE PARM-ITEM-ID-NUM              TO WQ-ITEM-ID.            
                                                                        
       1000-EXIT.                                                       
           EXIT.                                                        
                                                                        
      ******************************************************************09200000
      *   2000-PROCESS-OUTPUT                                          *09210000
      *                                                                *09220000
      *       1. DESCRIBE RESULT SET                                   *09230000
      *       2. RETRIEVE DB2 DATA                                     *09240000
      *       3. BUILD RESULT SET                                      *09250000
      *       4. SEND RESULT SET                                       *09260000
      *                                                                *09270000
      ******************************************************************09280000
                                                                        
       2000-PROCESS-OUTPUT.                                             
                                                                        
                                                                        
           PERFORM 2200-BUILD-RESULT          THRU 2200-EXIT.           
                                                                        
           MOVE WS-ACTIVE-RETURN-CODE         TO RS-RETURN-CODE.        
           MOVE '2000'                        TO ACTIVE-PARAGRAPH.      
REARCH     PERFORM 2000A-MOVE-RESULT          THRU 2000A-EXIT.          
           PERFORM 8100-SEND-RESULT           THRU 8100-EXIT.           
                                                                        
       2000-EXIT.                                                       
           EXIT.                                                        
REARCH******************************************************************09420000
REARCH*   2000A-MOVE-RESULT                                            *09430000
REARCH******************************************************************09470000
REARCH 2000A-MOVE-RESULT.                                               
REARCH       MOVE RS-RETURN-CODE             TO S-RETURN-CODE.          
REARCH 2000A-EXIT.                                                      
REARCH       EXIT.                                                      
                                                                        
       2200-BUILD-RESULT.                                               
                                                                        
           PERFORM 7000-SELECT-WQ             THRU 7000-EXIT.           
           PERFORM 7100-GET-DATE              THRU 7100-EXIT.           
           PERFORM 2300-DETERMINE-VARIABLES   THRU 2300-EXIT.           
                                                                        
       2200-EXIT.                                                       
           EXIT.                                                        
                                                                        
       2300-DETERMINE-VARIABLES.                                        
           EVALUATE PARM-RESPONSE                                       
A02875         WHEN '0'                                                 
A02875             MOVE 'C'                   TO WS-STATUS              
A02875             STRING WS-COMMENTS DELIMITED BY '   '                
A02875                    WS-COMMENTS-0  DELIMITED BY SIZE              
A02875                    INTO WS-COMMENTS-OUT                          
A02875             PERFORM 8200-UPDATE-WQ1    THRU 8200-EXIT            
               WHEN '1'                                                 
                   MOVE 'C'                   TO WS-STATUS              
                   STRING WS-COMMENTS DELIMITED BY '   '                
                       WS-COMMENTS-1  DELIMITED BY SIZE                 
                       INTO WS-COMMENTS-OUT                             
                   PERFORM 8200-UPDATE-WQ1    THRU 8200-EXIT            
               WHEN '2'                                                 
                   MOVE 'C'                   TO WS-STATUS              
                   STRING WS-COMMENTS DELIMITED BY '   '                
                       WS-COMMENTS-2 DELIMITED BY SIZE                  
                       INTO WS-COMMENTS-OUT                             
                   PERFORM 8200-UPDATE-WQ1    THRU 8200-EXIT            
               WHEN '3'                                                 
                   MOVE 'A'                   TO WS-STATUS              
                   STRING WS-COMMENTS DELIMITED BY '   '                
                       WS-COMMENTS-3 DELIMITED BY SIZE                  
                       INTO WS-COMMENTS-OUT                             
                   PERFORM 8300-UPDATE-WQ2    THRU 8300-EXIT            
                   PERFORM 8400-INSERT-WQ-ASSGN-HIST                    
                                              THRU 8400-EXIT            
               WHEN '4'                                                 
                   MOVE 'C'                   TO WS-STATUS              
                   STRING WS-COMMENTS DELIMITED BY '   '                
                       WS-COMMENTS-4  DELIMITED BY SIZE                 
                       INTO WS-COMMENTS-OUT                             
                   PERFORM 8200-UPDATE-WQ1    THRU 8200-EXIT            
               WHEN '5'                                                 
                   MOVE 'C'                   TO WS-STATUS              
                   STRING WS-COMMENTS DELIMITED BY '   '                
                       WS-COMMENTS-5 DELIMITED BY SIZE                  
                       INTO WS-COMMENTS-OUT                             
                   PERFORM 8200-UPDATE-WQ1    THRU 8200-EXIT            
               WHEN '6'                                                 
                   MOVE 'C'                   TO WS-STATUS              
                   STRING WS-COMMENTS DELIMITED BY '   '                
                       WS-COMMENTS-6 DELIMITED BY SIZE                  
                       INTO WS-COMMENTS-OUT                             
                   PERFORM 8200-UPDATE-WQ1    THRU 8200-EXIT            
               WHEN '7'                                                 
                   MOVE 'A'                   TO WS-STATUS              
                   STRING WS-COMMENTS DELIMITED BY '   '                
                       WS-COMMENTS-7 DELIMITED BY SIZE                  
                       INTO WS-COMMENTS-OUT                             
                   PERFORM 8300-UPDATE-WQ2    THRU 8300-EXIT            
                   PERFORM 8400-INSERT-WQ-ASSGN-HIST                    
                                              THRU 8400-EXIT            
OMSCPD         WHEN '9'                                                 
OMSCPD             MOVE 'C'                   TO WS-STATUS              
OMSCPD             STRING WS-COMMENTS DELIMITED BY '   '                
OMSCPD                 WS-COMMENTS-9 DELIMITED BY SIZE                  
OMSCPD                 INTO WS-COMMENTS-OUT                             
OMSCPD             PERFORM 8200-UPDATE-WQ1    THRU 8200-EXIT            
A04519         WHEN 'A'                                                 
A04519             MOVE 'C'                   TO WS-STATUS              
A04519             STRING WS-COMMENTS DELIMITED BY '   '                
A04519                 WS-COMMENTS-A DELIMITED BY SIZE                  
A04519                 INTO WS-COMMENTS-OUT                             
A04519             PERFORM 8200-UPDATE-WQ1    THRU 8200-EXIT            
A04519         WHEN 'B'                                                 
A04519             MOVE 'C'                   TO WS-STATUS              
A04519             STRING WS-COMMENTS DELIMITED BY '   '                
A04519                 WS-COMMENTS-B DELIMITED BY SIZE                  
A04519                 INTO WS-COMMENTS-OUT                             
A04519             PERFORM 8200-UPDATE-WQ1    THRU 8200-EXIT            
A04519         WHEN 'C'                                                 
A04519             MOVE 'C'                   TO WS-STATUS              
A04519             STRING WS-COMMENTS DELIMITED BY '   '                
A04519                 WS-COMMENTS-C DELIMITED BY SIZE                  
A04519                 INTO WS-COMMENTS-OUT                             
A04519             PERFORM 8200-UPDATE-WQ1    THRU 8200-EXIT            
C33768         WHEN 'D'                                                 
C33768             MOVE 'D'                   TO WS-STATUS              
C33768             STRING WS-COMMENTS DELIMITED BY '   '                
C33768                 WS-COMMENTS-D DELIMITED BY SIZE                  
C33768                 INTO WS-COMMENTS-OUT                             
C33768             PERFORM 8200-UPDATE-WQ1    THRU 8200-EXIT            
C33411         WHEN 'W'                                                 
C33411             MOVE 'C'                   TO WS-STATUS              
C33411             STRING WS-COMMENTS DELIMITED BY '   '                
C33411                 WS-COMMENTS-W DELIMITED BY SIZE                  
C33411                 INTO WS-COMMENTS-OUT                             
C33411             PERFORM 8200-UPDATE-WQ1    THRU 8200-EXIT            
C35479         WHEN 'U'                                                 
C35479             MOVE 'C'                   TO WS-STATUS              
C35479             STRING WS-COMMENTS DELIMITED BY '   '                
C35479                  WS-COMMENTS-U DELIMITED BY SIZE                 
C35479                  INTO WS-COMMENTS-OUT                            
C35479             PERFORM 8200-UPDATE-WQ1    THRU 8200-EXIT            
C35884         WHEN 'X'                                                 
C35884             MOVE 'C'                   TO WS-STATUS              
C35884             STRING WS-COMMENTS DELIMITED BY '   '                
C35884                  WS-COMMENTS-X DELIMITED BY SIZE                 
C35884                  INTO WS-COMMENTS-OUT                            
C35884             PERFORM 8200-UPDATE-WQ1    THRU 8200-EXIT            
C35884         WHEN 'Y'                                                 
C35884             MOVE 'C'                   TO WS-STATUS              
C35884             STRING WS-COMMENTS DELIMITED BY '   '                
C35884                  WS-COMMENTS-Y DELIMITED BY SIZE                 
C35884                  INTO WS-COMMENTS-OUT                            
C35884             PERFORM 8200-UPDATE-WQ1    THRU 8200-EXIT            
               WHEN OTHER                                               
                   MOVE 'A'                   TO WS-STATUS              
                   STRING WS-COMMENTS DELIMITED BY '   '                
                       WS-COMMENTS-8 DELIMITED BY SIZE                  
                       INTO WS-COMMENTS-OUT                             
                   PERFORM 8300-UPDATE-WQ2    THRU 8300-EXIT            
                   PERFORM 8400-INSERT-WQ-ASSGN-HIST                    
                                              THRU 8400-EXIT            
            END-EVALUATE.                                               
                                                                        
       2300-EXIT.                                                       
            EXIT.                                                       
                                                                        
       7000-SELECT-WQ.                                                  
                                                                        
           EXEC SQL                                                     
              SELECT COMMENTS,                                          
                     COMPANY_NO                                         
                INTO :WS-COMMENTS,                                      
                     :WQ-COMPANY-NO                                     
                FROM CSS_WQ_ITEMS                                       
               WHERE ITEM_ID = :WQ-ITEM-ID                              
           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  
                                                        RS-RETURN-CODE. 
                                                                        
           IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL                   
              NEXT SENTENCE                                             
           ELSE                                                         
              MOVE PROGRAM-NAME               TO ABEND-PROGRAM          
              MOVE '7000'                     TO ACTIVE-PARAGRAPH       
              MOVE 'SELECT'                   TO ABEND-FUNCTION         
              MOVE 'CSS_WQ_ITEMS'             TO TABLE-1                
              MOVE 'ITEM-ID'                  TO TABLE-ELEMENT-1        
              MOVE WQ-ITEM-ID                 TO HOSTVAR-ELEMENT-1      
              PERFORM 9000-SEND-ERROR-RESULT  THRU 9000-EXIT            
              PERFORM 9900-SQL-ERROR-ROUTINE  THRU 9900-EXIT            
           END-IF.                                                      
                                                                        
       7000-EXIT.                                                       
           EXIT.                                                        
                                                                        
       7100-GET-DATE.                                                   
                                                                        
           MOVE '7100'                        TO ACTIVE-PARAGRAPH.      
           EXEC SQL                                                     
              SELECT
              REPLACE(REPLACE(CONVERT(CHAR(26), CIS.CURRENT$TIMESTAMP()
           , 121), ' ', '-'), ':', '.')
            INTO
              :WS-CURRENT-TS                    
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ006
MFA-TR* MSQ028
MFA-TR* MSQ061
MFA-TR*    EXEC SQL                                                             
MFA-TR*       SET :WS-CURRENT-TS = CURRENT TIMESTAMP                            
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  
                                                        RS-RETURN-CODE. 
           IF WS-ACTIVE-RETURN-CODE EQUAL SUCCESSFUL-CALL               
              NEXT SENTENCE                                             
           ELSE                                                         
              MOVE SPACES                     TO ABEND-TABLES           
              MOVE SPACES                     TO ABEND-SQL-PREDICATES   
              MOVE PROGRAM-NAME               TO ABEND-PROGRAM          
              MOVE '7100'                     TO ACTIVE-PARAGRAPH       
              MOVE 'SET'                      TO ABEND-FUNCTION         
      *       MOVE 'SELECT'                   TO ABEND-FUNCTION                 
      *       MOVE 'CSS_MODEL_SQL'            TO TABLE-1                        
              PERFORM 9000-SEND-ERROR-RESULT  THRU 9000-EXIT            
              PERFORM 9900-SQL-ERROR-ROUTINE  THRU 9900-EXIT            
           END-IF.                                                      
                                                                        
       7100-EXIT.                                                       
            EXIT.                                                       
                                                                        
REARCH 8100-SEND-RESULT.                                                
REARCH       ADD 1                            TO CTR-ROWS.              
REARCH 8100-EXIT.                                                       
REARCH      EXIT.                                                       
                                                                        
       8200-UPDATE-WQ1.                                                 
                                                                        
           EXEC SQL                                                     
              UPDATE CSS_WQ_ITEMS                                       
                 SET STATUS        = :WS-STATUS,                        
                     COMMENTS      = :WS-COMMENTS-OUT,                  
                     COMPLETE_DATE = CIS.CHAR2TIMESTAMP(:WS-CURRENT-TS)         
               WHERE ITEM_ID       = :WQ-ITEM-ID                        
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ054
MFA-TR*    EXEC SQL                                                             
MFA-TR*       UPDATE CSS_WQ_ITEMS                                               
MFA-TR*          SET STATUS        = :WS-STATUS,                                
MFA-TR*              COMMENTS      = :WS-COMMENTS-OUT,                          
MFA-TR*              COMPLETE_DATE = :WS-CURRENT-TS                             
MFA-TR*        WHERE ITEM_ID       = :WQ-ITEM-ID                                
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  
                                                        RS-RETURN-CODE. 
                                                                        
           IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL                   
              NEXT SENTENCE                                             
           ELSE                                                         
              MOVE PROGRAM-NAME               TO ABEND-PROGRAM          
              MOVE '8200'                     TO ACTIVE-PARAGRAPH       
              MOVE 'UPDATE'                   TO ABEND-FUNCTION         
              MOVE 'CSS_WQ_ITEMS'             TO TABLE-1                
              MOVE 'ITEM_ID'                  TO TABLE-ELEMENT-1        
              MOVE WQ-ITEM-ID                 TO HOSTVAR-ELEMENT-1      
              PERFORM 9000-SEND-ERROR-RESULT  THRU 9000-EXIT            
              PERFORM 9900-SQL-ERROR-ROUTINE  THRU 9900-EXIT            
           END-IF.                                                      
                                                                        
       8200-EXIT.                                                       
           EXIT.                                                        
                                                                        
       8300-UPDATE-WQ2.                                                 
                                                                        
           EXEC SQL                                                     
              UPDATE CSS_WQ_ITEMS                                       
P00757           SET STATUS             = :WS-STATUS,                   
P00757               RESP_AREA_ID       = '400',                        
P00757               USER_ID_ASGN       = 'ZZ00491',                    
P00757               COMMENTS           = :WS-COMMENTS-OUT,             
P00757               ASSGN_HIST_PRES_FL = :WS-Y                         
P00757         WHERE ITEM_ID            = :WQ-ITEM-ID                   
           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  
                                                        RS-RETURN-CODE. 
                                                                        
           IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL                   
              NEXT SENTENCE                                             
           ELSE                                                         
              MOVE PROGRAM-NAME               TO ABEND-PROGRAM          
              MOVE '8300'                     TO ACTIVE-PARAGRAPH       
              MOVE 'UPDATE'                   TO ABEND-FUNCTION         
              MOVE 'CSS_WQ_ITEMS'             TO TABLE-1                
              MOVE 'ITEM_ID'                  TO TABLE-ELEMENT-1        
              MOVE WQ-ITEM-ID                 TO HOSTVAR-ELEMENT-1      
              PERFORM 9000-SEND-ERROR-RESULT  THRU 9000-EXIT            
              PERFORM 9900-SQL-ERROR-ROUTINE  THRU 9900-EXIT            
           END-IF.                                                      
                                                                        
       8300-EXIT.                                                       
           EXIT.                                                        
                                                                        
       8400-INSERT-WQ-ASSGN-HIST.                                       
                                                                        
           EXEC SQL                                                     
              INSERT INTO CSS_WQ_ASSGN_HSTY                             
                    ( COMPANY_NO                                        
                     ,ITEM_ID                                           
                     ,RESP_AREA_ID                                      
                     ,REASSIGN_DATE                                     
                     ,USER_ID)                                          
               VALUES                                                   
                     (:WQ-COMPANY-NO                                    
                     ,:WQ-ITEM-ID                                       
                     ,'400'                                             
                     ,CIS.CHAR2TIMESTAMP(:WS-CURRENT-TS)                        
                     ,'ZZ00490')                                        
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ054
MFA-TR*    EXEC SQL                                                             
MFA-TR*       INSERT INTO CSS_WQ_ASSGN_HSTY                                     
MFA-TR*             ( COMPANY_NO                                                
MFA-TR*              ,ITEM_ID                                                   
MFA-TR*              ,RESP_AREA_ID                                              
MFA-TR*              ,REASSIGN_DATE                                             
MFA-TR*              ,USER_ID)                                                  
MFA-TR*        VALUES                                                           
MFA-TR*              (:WQ-COMPANY-NO                                            
MFA-TR*              ,:WQ-ITEM-ID                                               
MFA-TR*              ,'400'                                                     
MFA-TR*              ,:WS-CURRENT-TS                                            
MFA-TR*              ,'ZZ00490')                                                
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  
                                                        RS-RETURN-CODE. 
                                                                        
           IF WS-ACTIVE-RETURN-CODE EQUAL SUCCESSFUL-CALL               
               NEXT SENTENCE                                            
           ELSE                                                         
               MOVE PROGRAM-NAME              TO ABEND-PROGRAM          
               MOVE '8400'                    TO ACTIVE-PARAGRAPH       
               MOVE 'INSERT'                  TO ABEND-FUNCTION         
               MOVE 'CSS_WQ_ASSGN_HSTY'       TO TABLE-1                
               MOVE 'COMPANY_NO'              TO TABLE-ELEMENT-1        
               MOVE 'ITEM_ID'                 TO TABLE-ELEMENT-2        
               MOVE 'REASSIGN DATE'           TO TABLE-ELEMENT-3        
               MOVE WQ-COMPANY-NO             TO HOSTVAR-ELEMENT-1      
               MOVE WQ-ITEM-ID                TO HOSTVAR-ELEMENT-2      
               MOVE WS-CURRENT-TS             TO HOSTVAR-ELEMENT-3      
               PERFORM 9000-SEND-ERROR-RESULT THRU 9000-EXIT            
               PERFORM 9900-SQL-ERROR-ROUTINE THRU 9900-EXIT            
            END-IF.                                                     
                                                                        
       8400-EXIT.                                                       
           EXIT.                                                        
                                                                        
      ******************************************************************        
      * 9900- JOURNALING / ERROR HANDLING INCLUDE *                    *        
      ******************************************************************        
                                                                        
REARCH     EXEC SQL                                                     46890000
REARCH        INCLUDE CPDSP300                                          46900000
REARCH     END-EXEC.                                                    46910000
      ******************************************************************        
      *       END PROGRAM COPYLIB                                      *        
      ******************************************************************        
REARCH     EXEC SQL                                                             
REARCH          INCLUDE CPD00321                                                
REARCH     END-EXEC.                                                            
