       IDENTIFICATION DIVISION.                                         
       PROGRAM-ID.     PCSCA658.                                        
       DATE-WRITTEN.   AUG 2003.                                        
       DATE-COMPILED.                                                   
      ****************************************************************          
      **                                                            **          
      ********            CUSTOMER SERVICE SYSTEM             ********          
      ********                      DB2                       ********          
      ****************************************************************          
      **              PROGRAM  MODIFICATION  LOG                    **          
      **                                                            **          
      **    DATE    INITIALS               REASON                   **          
      **  ________  ________  _________________________________     **          
      **   08/2003   VD88125  INITIAL NEW PROGRAM DEVELOPED.        **          
      **                                                            **          
30989 **   7-16-2004 RF10596  PUT IN 6010- ROUTINE TO EDIT THE      **          
      **                      PR-SPCL-INSTRUCTIONS FIELDS FOR       **          
      **                      EXTRA SPACES.  IT WILL FIX THIS       **          
      **                      FIELD AND PREPARE IT TO BE ADDED      **          
      **                      TO PRIOR TO BEING UPDATED.            **          
      **                      ALSO, CHANGES LOW-VALUES TO SPACES    **          
      **                      ALSO, AFTER IT GOES THRU 6010-        **          
      **                      ROUTINE IT CHECKS FOR THE LENGTH      **          
      **                      OF THIS FIELD BEING > 239.  IF IT     **          
      **                      IS, IT DISPLAYS A MESSAGE AND         **          
      **                      BYPASSES THIS ACCOUNT.                **          
      **                                                            **          
30989 **  25 OCT 2004 RDF     PCSCA620 SETS CODE ON THE OUTPUT FILE **          
      **                      SIGNIFYING WHETHER TO                 **          
      **                      C = CREATE A SERVICE ORDER            **          
      **                      U = UPDATE SPCL_INSTRUCTIONS ON THE   **          
      **                          PREMISE TABLE                     **          
      **                      B = DO BOTH                           **          
      **                      THE DETERMINING FACTOR IN PCSCA620    **          
      **                      IS (JOB PARM ) UTIL TYPE PARM.        **          
      **                      PCSCA658 READS THE INPUT FILE AND     **          
      **                      DOES WHATEVER THE CODE IS ON THE      **          
      **                      FILE.                                 **          
      **                                                            **          
      **  30989 NOTE          THE COMPARES FOR THE PCSCA620 CODE    **          
      **                      INCLUDE (SPACES) AND (LOW-VALUES)     **          
      **                      BECAUSE THIS PROGRAM IS USED IN       **          
      **                      ANOTHER JOB THAT DOES NOT SET THE     **          
      **                      620 CODE.                             **          
      **                                                            **          
      **  SECOND NOTE         PCSCA620 JOB PARM IS SET UP SO THAT   **          
      **                      ALL RECORDS WILL HAVE THE SAME        **          
      **                      RUN-TYPE CODE. THEREFORE, I AM LOADING**          
      **                      WS-RUN-TYPE ONLY ON THE 1ST READ      **          
      **                                                            **          
T33182**   09/08/06  JC91900  ADDED COMMIT/RESTART LOGIC.           **          
      **                                                            **          
A03407**   05/26/11  RF10596  INCREASED INPUT FILE LENGTH.          **          
A03407**                      ADD FIELDS FOR THE SCSCA658 CALL      **          
      **                                                            **          
      ****************************************************************          
           REMARKS.                                                     
                              PCSCA658 NARRATIVE                        
                       SELECT ELECTRIC & GAS METERS FOR ITRON-AMR PILOT 
      *                                                                         
                  ---- BASIC SEQUENCE STRUCTURE ----                    
                0000 - 0999     MAIN CONTROL PATH AND INITIALIZATION    
                1000 - 1999     INPUT PROCESSING CONTROL PATH           
                2000 - 2999     OUTPUT PROCESSING CONTROL PATH          
                3000 - 4999     BATCH PROCESSING MODULES - NOT USED     
                5000 - 5999     COMMON PROGRAM MODULES                  
                6000 - 6999     COMMON SYSTEM MODULES                   
                7000 - 7999     INPUT MODULES                           
                8000 - 8999     OUTPUT MODULES                          
                9000 - 9799     TERMINATION MODULES                     
                9900 - 9999     ABEND/ABORT MODULES                     
      *                                                                         
       ENVIRONMENT DIVISION.                                            
      *                                                                         
       INPUT-OUTPUT SECTION.                                            
       FILE-CONTROL.                                                    
      *                                                                         
           SELECT METER-DETAIL-FILE      ASSIGN TO FIOCA658             
                        STATUS IS WS-METFIL-STATUS.                     
      *                                                                         
       DATA DIVISION.                                                   
       FILE SECTION.                                                    
       FD  METER-DETAIL-FILE                                            
           BLOCK CONTAINS 0 RECORDS                                     
           RECORDING MODE IS F                                          
           LABEL RECORDS ARE OMITTED.                                   
       01  METER-DETAIL-REC            PIC X(80).                       
      *                                                                         
       WORKING-STORAGE SECTION.                                         

MSQ017 01 MFA-PROGRAM-ID PIC X(8) VALUE 'PCSCA658'.
MSQ017     COPY MFASQLM.
      *                                                                         
       01  PROGRAM-NAME                PIC X(8)    VALUE 'PCSCA658'.    
      *                                                                         
       COPY CWS09900.                                                           
      *COPYBOOK HAVING NOT-FOUND                                                
       COPY CWS00303.                                                           
      *ABEND WORK AREA                                                          
       COPY CWS00010.                                                           
      *                                                                         
       COPY FIOJC01.                                                            
      *                                                                         
T33182******************************************************************        
T33182* COPY BOOK SUPPORTING RE-START                                  *        
T33182******************************************************************        
T33182     EXEC SQL                                                             
T33182        INCLUDE CWS00038                                                  
T33182     END-EXEC.                                                            
                                                                        
       01  FIOCA658.                                                    
           05 E-FCA658-COMPANY-NO      PIC XX.                          
           05 FILLER                   PIC X.                           
           05 E-FCA658-ACCT-NO         PIC 9(13).                       
           05 FILLER                   PIC X.                           
           05 E-FCA658-UTIL-TYPE       PIC X.                           
           05 FILLER                   PIC X.                           
           05 E-FCA658-METER-NO        PIC X(9).                        
           05 FILLER                   PIC X.                           
           05 E-FCA658-ORDER-TYPE      PIC X(5).                        
           05 FILLER                   PIC X.                           
           05 E-FCA658-TEST-TYPE       PIC X.                           
           05 FILLER                   PIC X.                           
           05 E-FCA658-WANTED-DATE     PIC X(10).                       
30989      05 FILLER                   PIC X.                           
30989      05 E-FCA658-RUN-TYPE        PIC X.                           
30989      05 FILLER                   PIC X.                           
30989      05 E-FCA658-PREMISE-NO      PIC 9(10).                       
A03407     05 FILLER                   PIC X.                           
A03407     05 E-FCA658-WORK-TYPE       PIC X(3).                        
A03407     05 FILLER                   PIC X.                           
A03407     05 E-FCA658-CODE-METER-STAT PIC X.                           
A03407     05 FILLER                   PIC X(14).                       
      *                                                                         
       01  WS-WORK-AREA.                                                
30989      05  WS-RUN-TYPE             PIC X       VALUE SPACES.        
30989      05  WS-PREV-PREMISE-NO      PIC 9(10)   VALUE 0.             
           05  WS-PGRMNAME             PIC X(8)    VALUE 'PCSCA658'.    
           05  WS-MIN-NUMBER           PIC 9(8)    VALUE 0.             
           05  WS-MAX-NUMBER           PIC 9(8)    VALUE 100.           
           05  WS-CALL-SCSCA658        PIC X       VALUE 'N'.           
           05  WS-DISPLAY-RC           PIC -ZZZZZZZZ9.9.                
           05  WS-FCA658-REC-CNTR      PIC 9(7)    VALUE 0.             
           05  WS-TEMP-SPCL-INSTRUC    PIC X(255)  VALUE SPACES.        
           05  WS-TEMP-READ-INSTRUC    PIC X(114)  VALUE SPACES.        
           05  WS-PREV-ACCOUNT         PIC 9(13)   VALUE 0.             
           05  WS-INSPT-CNTR           PIC 99      VALUE 0.             
           05  WS-SPCL-LEN             PIC 999     VALUE 0.             
30989      05  WS-HONK-LEN             PIC 999     VALUE 0.             
30989      05  WS-SAVE-LEN             PIC 999     VALUE 0.             
           05  WS-UPD-PREMISE          PIC X.                           
T33182     05  WS-FCSCA658-CNT         PIC 9(08) VALUE ZERO.            
T33182     05  WS-COMMIT-COUNT         PIC 9(08) VALUE ZERO.            
T33182     05  WS-COMMIT-SEQ-NO        PIC 9(05) VALUE ZERO.            
T33182     05  WS-CHKP-LUW-LIMIT       PIC 9(04)   VALUE 0.             
T33182     05  WS-CHKP-UPD-LIMIT       PIC 9(04)   VALUE 0.             
T33182     05  WS-COUNT-UNSUCCESSFUL-ROWS PIC S9(04) COMP-3 VALUE ZERO. 
T33182     05  WS-DEFAULT-CHKP-LUW-LIMIT  PIC 9(04)  VALUE 4.           
T33182     05  WS-DEFAULT-CHKP-UPD-LIMIT  PIC 9(04)  VALUE 20.          
                                                                        
           05  WS-SYS-DATE.                                             
               10  WS-SYS-DATE-YY      PIC 99.                          
               10  WS-SYS-DATE-MM      PIC 99.                          
               10  WS-SYS-DATE-DD      PIC 99.                          
           05  WS-DB2-TODAYS-DATE      PIC X(10).                       
           05  WS-SYS-TIME.                                             
               10  WS-SYS-TIME-HR      PIC 99.                          
               10  WS-SYS-TIME-MIN     PIC 99.                          
               10  WS-SYS-TIME-SEC     PIC 99.                          
               10  WS-SYS-TIME-HSEC    PIC 99.                          
           05  WS-DB2-DATE.                                             
               10  WS-DB2-YEAR .                                        
                   15  WS-DB2-CC       PIC 99.                          
                   15  WS-DB2-YY       PIC 99.                          
               10  FILLER REDEFINES WS-DB2-YEAR.                        
                   15  WS-DB2-YEARS        PIC S9(4) COMP.              
               10  FILLER              PIC X.                           
               10  WS-DB2-MM           PIC XX.                          
               10  FILLER              PIC X.                           
               10  WS-DB2-DD           PIC XX.                          
           05  WS-TEMP-CC              PIC 99.                          
           05  RS-RETURN-CODE          PIC S9(4)   COMP.                
           05  WS-CTR-K                PIC S9(7)   VALUE +0.            
           05  WS-INSPECT-CNTR         PIC 99      VALUE  0.            
           05  WS-PREMISE-NO           PIC S9(10)V COMP-3 VALUE 0.      
           05  WS-PREV-ACCT-NO         PIC 9(13)   VALUE 0.             
      *                                                                         
           05  WS-SWITCHES.                                             
               10  WS-EOF-FLAG         PIC X       VALUE 'N'.           
                   88  END-OF-FILE                 VALUE 'Y'.           
               10  WS-METFIL-STATUS    PIC XX      VALUE '00'.          
                   88  METFIL-SUCCESS              VALUE '00'.          
      *                                                                         
       01  WS-LITERALS.                                                 
           05  WS-Y                    PIC X(01)   VALUE 'Y'.           
           05  WS-N                    PIC X(01)   VALUE 'N'.           
T33182     05  WS-I                    PIC X(01)   VALUE 'I'.           
           05  WS-YES                  PIC X(03)   VALUE 'YES'.         
           05  WS-NO                   PIC X(03)   VALUE 'NO '.         
           05  WS-01                   PIC X(02)   VALUE '01'.          
           05  WS-CURRENT-CENTURY      PIC 9(02)   VALUE  19.           
           05  WS-NEXT-CENTURY         PIC 9(02)   VALUE  20.           
           05  WS-AMR-MTR              PIC X(15)                        
                                       VALUE '***AMR METER***'.         
                                                                        
T33182 01  WS-RESTART-MISC.                                             
T33182     05  WS-RESTART-DATA-LENGTH  PIC S9(04) COMP VALUE 0.         
T33182     05  WS-RESTART-REQ          PIC X(01).                       
T33182     05  WS-DEFAULT-RESTART-REQ  PIC X(01) VALUE 'N'.             
T33182     05  WS-IS-THIS-A-RESTART    PIC X(01) VALUE 'N'.             
T33182         88 WS-THIS-IS-A-RESTART           VALUE 'Y'.             
T33182     05  WS-RESTART-ACCOUNT      PIC S9(13)V9 COMP-3 VALUE 0.     
T33182     05  WS-SEQ-NO               PIC 9(04) VALUE 0.               
T33182     05  WS-RESTART-SW           PIC X(01) VALUE 'N'.             
T33182*                                                                         
T33182 01  WS-RESTART-DATA.                                             
T33182     05  WS-RESTART-PROCESS-TYPE PIC 9(01).                       
COB305     05 WS-RESTART-ACCT-NO        PIC S9(13)V COMP-3 VALUE 0.             
T33182     05  WS-RESTART-COMMON-DATE  PIC X(10).                       
T33182     05  WS-RESTART-PROG-ID      PIC X(08) VALUE 'PCSCA658'.      
T33182     05  WS-RESTART-CHKP-SEQ-NO  PIC S9(05)  COMP.                
T33182     05  WS-RESTART-FCSCA658-CNT PIC S9(05)  COMP.                
T33182                                                                  
                                                                        
                                                                        
30989 **   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *  **        
30989 **     THIS IS A CLONE OF CWS00011 WITH LARGER TABLE SIZE.      **        
30989 **     THIS COPY STATEMENT IS THE WS AREA USED TO REDUCE        **        
30989 **     EMBEDDED BLANKS. WS-EMB-INPUT MUST BE LOADED, BY THE     **        
30989 **     APPLICATION PROGRAM, WITH THE FIELD TO BE REDUCED.       **        
30989 **     THE FIELD LENGTH SHOULD ALSO BE LOADED IN WS-EMB-LENG.   **        
30989 **     WS-CMP-TABLE WILL CONTAIN THE COMPRESSED VALUE.          **        
30989 **   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *  **        
      *                                                                         
30989  01  WS-11-TABLES.                                                
      *                                                                         
30989      05  WS-EMB-INPUT.                                            
30989          10  WS-EMB-CHAR         PIC X                            
30989                                  OCCURS 255 TIMES                 
30989                                  INDEXED BY WS-EMB-INDX.          
      *                                                                         
30989      05  WS-EMB-TBL-LENG         PIC S999   VALUE +255.           
30989      05  WS-EMB-LENG             PIC S999   VALUE ZERO.           
30989      05  WS-EMB-LAST-CHAR        PIC X.                           
      *                                                                         
30989      05  WS-CMP-TABLE.                                            
30989          10  WS-CMP-CHAR         PIC X                            
30989                                  OCCURS 255 TIMES                 
30989                                  INDEXED BY WS-CMP-INDX.          
      *                                                                         
30989 **   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *  **        
30989 **     THIS IS A CLONE OF CWS00011 WITH LARGER TABLE SIZE.      **        
30989 **     THIS COPY STATEMENT IS THE WS AREA USED TO REDUCE        **        
30989 **     EMBEDDED BLANKS. WS-EMB-INPUT MUST BE LOADED, BY THE     **        
30989 **     APPLICATION PROGRAM, WITH THE FIELD TO BE REDUCED.       **        
30989 **     THE FIELD LENGTH SHOULD ALSO BE LOADED IN WS-EMB-LENG.   **        
30989 **     WS-CMP-TABLE WILL CONTAIN THE COMPRESSED VALUE.          **        
30989 **   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *  **        
      *                                                                         
30989  01  WS-12-TABLES.                                                
      *                                                                         
30989      05  WS-HNK-INPUT.                                            
30989          10  WS-HNK1-CHAR         PIC X                           
30989                                  OCCURS 114 TIMES                 
30989                                  INDEXED BY WS-HNK1-INDX.         
      *                                                                         
30989      05  WS-HNK-TBL-LENG         PIC S999   VALUE +114.           
30989      05  WS-HNK-LENG             PIC S999   VALUE ZERO.           
30989      05  WS-HNK-LAST-CHAR        PIC X.                           
      *                                                                         
30989      05  WS-HNK-TABLE.                                            
30989          10  WS-HNK2-CHAR         PIC X                           
30989                                  OCCURS 114 TIMES                 
30989                                  INDEXED BY WS-HNK2-INDX.         
      *                                                                         
       01  WS-SCSCA658-LINKAGE.                                         
COB305     05 WS-SO-ACCT-NO        PIC S9(13) COMP-3 VALUE 0.                 
           05  WS-SO-METER-NO      PIC X(9).                            
           05  WS-SO-UTIL-TYPE     PIC X.                               
           05  WS-SO-ORDER-TYPE    PIC X(5).                            
           05  WS-SO-TEST-TYPE     PIC X.                               
           05  WS-SO-WANTED-DATE   PIC X(10).                           
           05  WS-SO-DB2-DATE      PIC X(10).                           
A03407     05  WS-SO-PREMISE       PIC X(10).                           
A03407     05  WS-SO-MTR-STATUS    PIC X.                               
A03407     05  WS-SO-WORK-TYPE     PIC X(3).                            
      ****************************************************************          
      **     INCLUDE DCLGEN TABLE AND HOST VARIABLE DEFINITIONS     **          
      ****************************************************************          
      *                                                                         
           EXEC SQL                                                             
               INCLUDE SQLCA                                                    
           END-EXEC.                                                            
      ****************************************************************          
      *    COPYBOOK FOR CSS_ACCOUNT,        PREFIX - AT              *          
      ****************************************************************          
           EXEC SQL                                                             
               INCLUDE TBACCT                                                   
           END-EXEC.                                                            
      * CSS_PREMISE (PR)                                                        
           EXEC SQL                                                             
              INCLUDE TBPREM                                                    
           END-EXEC.                                                            
                                                                        
T33182******************************************************************        
T33182* CSS_RESTART, RF                                                *        
T33182******************************************************************        
T33182     EXEC SQL                                                             
T33182        INCLUDE TBRESTRT                                                  
T33182     END-EXEC.                                                            
T33182                                                                  
T33182******************************************************************        
T33182* CSS_JOB_PARM, G6                                               *        
T33182******************************************************************        
T33182     EXEC SQL                                                             
T33182        INCLUDE TBJBPARM                                                  
T33182     END-EXEC.                                                            
      *                                                                         
       PROCEDURE DIVISION.                                              
      ****************************************************************          
      **                                                            **          
      **  0000-MAINLINE                                             **          
      **      CONTROLS MAIN PATH OF PROGRAM                         **          
      **                                                            **          
      ****************************************************************          
       0000-MAINLINE.                                                   
      *                                                                         
           PERFORM 0100-INITIALIZATION THRU 0100-EXIT.                  
                                                                        
           PERFORM 7400-READ-INPUT-FILE THRU 7400-EXIT.                 
      *                                                                         
30989      MOVE E-FCA658-RUN-TYPE TO WS-RUN-TYPE.                       
      *                                                                         
           IF END-OF-FILE                                               
              DISPLAY '************************************************'
              DISPLAY '**         PCSCA658 PROCESSING ERROR          **'
              DISPLAY '**           FCSCA658 FILE IS EMPTY           **'
              DISPLAY '**           PROCESSING TERMINATED            **'
              DISPLAY '************************************************'
              PERFORM 9900-ABEND                 THRU 9900-EXIT         
           END-IF.                                                      
                                                                        
           PERFORM 1000-PROCESS-INPUT-PARM       THRU 1000-EXIT         
                   UNTIL END-OF-FILE.                                   
                                                                        
T33182     IF WS-THIS-IS-A-RESTART                                      
T33182        PERFORM 8893-RESET-RESTART-REQ-PARM THRU 8893-EXIT        
T33182     END-IF.                                                      
T33182     MOVE WS-PGRMNAME                  TO RF-NAME-PROGRAM.        
T33182     MOVE 0                            TO RF-DUP-CNTRL-NO.        
T33182     MOVE 0                            TO RF-PARTITION-NO.        
T33182     PERFORM 8930-DELETE-RESTART-RECORD  THRU 8930-EXIT.          
                                                                        
           PERFORM 9000-TERMINATE              THRU 9000-EXIT.          
                                                                        
           STOP RUN.                                                    
      *                                                                         
       0000-EXIT.                                                       
           EXIT.                                                        
      *--------------------*                                                    
       0100-INITIALIZATION.                                             
      *--------------------*                                                    
           ACCEPT WS-SYS-DATE                    FROM DATE.             
                                                                        
           ACCEPT WS-SYS-TIME                    FROM TIME.             
                                                                        
           IF WS-SYS-DATE-YY              GREATER THAN 50               
              MOVE WS-CURRENT-CENTURY     TO WS-TEMP-CC                 
           ELSE                                                         
              MOVE WS-NEXT-CENTURY        TO WS-TEMP-CC                 
           END-IF.                                                      
                                                                        
           STRING WS-TEMP-CC,                                           
                  WS-SYS-DATE-YY,                                       
                  '-',                                                  
                  WS-SYS-DATE-MM,                                       
                  '-',                                                  
                  WS-SYS-DATE-DD                                        
                        DELIMITED BY SIZE                               
                                    INTO WS-DB2-TODAYS-DATE             
           END-STRING.                                                  
      *                                                                         
           PERFORM 0300-OPEN-INPUT-FILES         THRU 0300-EXIT.        
                                                                        
T33182     PERFORM 6253-GET-FJC01-CHKP-LIMIT          THRU 6253-EXIT.   
T33182     PERFORM 0200-PROCESS-RESTART          THRU 0200-EXIT.        
T33182     MOVE LENGTH OF WS-RESTART-DATA    TO WS-RESTART-DATA-LENGTH. 
                                                                        
       0100-EXIT.                                                       
           EXIT.                                                        
                                                                        
      *****************************************************************         
      *                                                               *         
      * 0200-PROCESS-RESTART.                                         *         
      *****************************************************************         
T33182 0200-PROCESS-RESTART.                                            
T33182*                                                                         
T33182     INITIALIZE WS-RESTART-REQ                                    
T33182                WS-RESTART-DATA.                                  
T33182                                                                  
T33182     PERFORM 6235-GET-FJC01-RESTART-REQ  THRU 6235-EXIT.          
T33182                                                                  
T33182     MOVE G6-SEQ-NO                    TO WS-SEQ-NO.              
T33182     MOVE PROGRAM-NAME                 TO RF-NAME-PROGRAM         
T33182     MOVE 0                            TO RF-DUP-CNTRL-NO         
T33182                                          RF-PARTITION-NO.        
T33182     PERFORM 7150-SELECT-RESTART         THRU 7150-EXIT.          
T33182                                                                  
T33182     IF WS-ACTIVE-RETURN-CODE EQUAL SUCCESSFUL-CALL               
T33182        MOVE RF-RESTART-DATA-TEXT      TO WS-RESTART-DATA         
T33182        IF WS-RESTART-PROCESS-TYPE IS NUMERIC                     
T33182           MOVE WS-Y                     TO WS-IS-THIS-A-RESTART  
T33182        DISPLAY '*******************************************'     
T33182        DISPLAY '*       THIS IS A RESTART OF PCSCA658     *'     
T33182        DISPLAY '*******************************************'     
T33182        END-IF                                                    
T33182     END-IF.                                                      
T33182                                                                  
T33182     PERFORM 0605-VALIDATE-RESTART-REQ   THRU 0605-EXIT.          
T33182                                                                  
T33182     IF WS-THIS-IS-A-RESTART                                      
T33182        MOVE WS-RESTART-CHKP-SEQ-NO   TO WS-COMMIT-SEQ-NO         
T33182        MOVE WS-RESTART-ACCT-NO       TO WS-RESTART-ACCOUNT       
T33182                                         WS-PREV-ACCT-NO          
T33182        MOVE WS-RESTART-FCSCA658-CNT  TO WS-FCSCA658-CNT          
T33182                                         WS-FCA658-REC-CNTR       
T33182        PERFORM WS-FCSCA658-CNT TIMES                             
T33182            READ METER-DETAIL-FILE INTO FIOCA658                  
T33182              AT END                                              
T33182                MOVE WS-YES            TO WS-EOF-FLAG             
T33182            END-READ                                              
T33182        END-PERFORM                                               
T33182     END-IF.                                                      
T33182                                                                  
T33182 0200-EXIT.                                                       
T33182     EXIT.                                                        
                                                                        
      *----------------------*                                                  
       0300-OPEN-INPUT-FILES.                                           
      *----------------------*                                                  
           OPEN INPUT METER-DETAIL-FILE.                                
                                                                        
           IF METFIL-SUCCESS                                            
              CONTINUE                                                  
           ELSE                                                         
               DISPLAY 'FIOCA658            FILE OPEN ERROR'            
               DISPLAY 'FIOCA658 FILE STATUS IS ==>' WS-METFIL-STATUS   
               PERFORM 9900-ABEND             THRU 9900-EXIT            
           END-IF.                                                      
      *                                                                         
       0300-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      *------------------------*                                                
       1000-PROCESS-INPUT-PARM.                                         
      *------------------------*                                                
      *                                                                         
           MOVE SPACES TO WS-UPD-PREMISE.                               
           MOVE ZERO   TO WS-PREMISE-NO.                                
      *                                                                         
30989      IF WS-RUN-TYPE = 'C' OR 'B'                                  
30989                        OR SPACES OR LOW-VALUES                    
              MOVE E-FCA658-ACCT-NO     TO WS-SO-ACCT-NO                
              MOVE E-FCA658-METER-NO    TO WS-SO-METER-NO               
              MOVE E-FCA658-UTIL-TYPE   TO WS-SO-UTIL-TYPE              
              MOVE E-FCA658-TEST-TYPE   TO WS-SO-TEST-TYPE              
              MOVE E-FCA658-ORDER-TYPE  TO WS-SO-ORDER-TYPE             
              MOVE E-FCA658-WANTED-DATE TO WS-SO-WANTED-DATE            
              MOVE WS-DB2-TODAYS-DATE   TO WS-SO-DB2-DATE               
A03407        MOVE E-FCA658-WORK-TYPE   TO WS-SO-WORK-TYPE              
A03407        MOVE E-FCA658-CODE-METER-STAT TO WS-SO-MTR-STATUS         
A03407        MOVE E-FCA658-PREMISE-NO  TO WS-SO-PREMISE                
      *                                                                         
              CALL 'SCSCA658' USING WS-SCSCA658-LINKAGE                 
                                    WS-PREMISE-NO                       
30989      END-IF.                                                      
      *                                                                         
           INITIALIZE WS-SCSCA658-LINKAGE.                              
      *                                                                         
           MOVE E-FCA658-ACCT-NO TO WS-PREV-ACCT-NO.                    
30989      MOVE E-FCA658-PREMISE-NO TO WS-PREV-PREMISE-NO.              
           PERFORM 7400-READ-INPUT-FILE THRU 7400-EXIT.                 
      *                                                                         
           IF E-FCA658-ACCT-NO NOT = WS-PREV-ACCT-NO                    
                  OR END-OF-FILE                                        
30989         IF WS-RUN-TYPE = 'U'                                      
30989            MOVE WS-PREV-PREMISE-NO TO WS-PREMISE-NO               
30989         END-IF                                                    
30989         IF WS-RUN-TYPE = 'U' OR 'B'                               
30989                          OR SPACES OR LOW-VALUES                  
                 MOVE WS-PREMISE-NO TO PR-PREMISE-NO                    
                 INITIALIZE PR-SPCL-INSTRUCTIONS                        
                            PR-SPCL-READ-INSTR                          
                            PR-PREMISE-DIRECTIONS                       
                            WS-TEMP-SPCL-INSTRUC                        
                            WS-TEMP-READ-INSTRUC                        
                 MOVE ZEROS TO PR-SPCL-INSTRUCTIONS-LEN                 
                               PR-SPCL-READ-INSTR-LEN                   
                               PR-PREMISE-DIRECTIONS-LEN                
                 PERFORM 7000-SELECT-PREMISE THRU 7000-EXIT             
                 IF SQLCODE EQUAL NOT-FOUND                             
                    DISPLAY 'RECORD NOT FOUND IN CSS_PREMISE'           
                    DISPLAY 'PREMISE NO ' PR-PREMISE-NO                 
                    DISPLAY '7200-SELECT'  WS-ACTIVE-RETURN-CODE        
                    GO TO 1000-EXIT                                     
                 END-IF                                                 
      *                                                                         
                 INITIALIZE WS-EMB-INPUT                                
                 INITIALIZE WS-CMP-TABLE                                
                 INITIALIZE WS-TEMP-SPCL-INSTRUC                        
                 INITIALIZE WS-TEMP-READ-INSTRUC                        
                 MOVE ZERO TO WS-SPCL-LEN                               
                 PERFORM 2000-BUILD-SPECL-INSTRUC THRU 2000-EXIT        
      *                                                                         
                 INITIALIZE WS-HNK-INPUT                                
                 INITIALIZE WS-HNK-TABLE                                
                 INITIALIZE WS-TEMP-SPCL-INSTRUC                        
                 INITIALIZE WS-TEMP-READ-INSTRUC                        
                 MOVE ZERO TO WS-SPCL-LEN                               
                 PERFORM 2100-BUILD-SPCL-READ-INSTR THRU 2100-EXIT      
      *                                                                         
                 INITIALIZE WS-EMB-INPUT                                
                 INITIALIZE WS-CMP-TABLE                                
                 INITIALIZE WS-TEMP-SPCL-INSTRUC                        
                 INITIALIZE WS-TEMP-READ-INSTRUC                        
                 MOVE ZERO TO WS-SPCL-LEN                               
                 PERFORM 2200-BUILD-PREMISE-DIRECTIONS THRU 2200-EXIT   
      *                                                                         
                 IF WS-UPD-PREMISE EQUAL WS-Y                           
                    PERFORM 8000-UPDATE-SPECL-INSTRUC THRU 8000-EXIT    
                 END-IF                                                 
30989         END-IF                                                    
           END-IF.                                                      
           MOVE ZERO TO WS-SPCL-LEN                                     
                        WS-INSPT-CNTR.                                  
                                                                        
T33182     ADD 1                             TO WS-FCSCA658-CNT.        
T33182     PERFORM 5900-ISSUE-COMMIT           THRU 5900-EXIT.          
                                                                        
       1000-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ****************************************************************          
      *   GET RID OF EMBEDDED SPACES IN PR-SPCL-INSTRUCTIONS         *          
      ****************************************************************          
      *                                                                         
       2000-BUILD-SPECL-INSTRUC.                                        
      *                                                                         
30989      MOVE PR-SPCL-INSTRUCTIONS-TEXT  TO WS-EMB-INPUT.             
30989      MOVE PR-SPCL-INSTRUCTIONS-LEN TO WS-EMB-LENG                 
30989                                       WS-SAVE-LEN.                
      *                                                                         
30989      PERFORM 6010-REDUCE-EMBEDDED-SPACES THRU 6010-EXIT.          
      *                                                                         
30989      IF WS-HONK-LEN = WS-SAVE-LEN                                 
30989         CONTINUE                                                  
30989      ELSE                                                         
30989         MOVE WS-CMP-TABLE TO WS-TEMP-SPCL-INSTRUC                 
30989         MOVE WS-HONK-LEN  TO WS-SPCL-LEN                          
      *                                                                         
30989         MOVE WS-TEMP-SPCL-INSTRUC TO PR-SPCL-INSTRUCTIONS-TEXT    
30989         MOVE WS-SPCL-LEN          TO PR-SPCL-INSTRUCTIONS-LEN     
30989         MOVE WS-Y                 TO WS-UPD-PREMISE               
30989      END-IF.                                                      
      *                                                                         
       2000-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ****************************************************************          
      *   GET RID OF EMBEDDED SPACES IN PR-SPCL-READ-INSTR           *          
      ****************************************************************          
      *                                                                         
       2100-BUILD-SPCL-READ-INSTR.                                      
      *                                                                         
30989      MOVE PR-SPCL-READ-INSTR-TEXT TO WS-HNK-INPUT.                
30989      MOVE PR-SPCL-READ-INSTR-LEN  TO WS-HNK-LENG                  
30989                                      WS-SAVE-LEN.                 
      *                                                                         
30989      PERFORM 6020-REDUCE-EMBEDDED-SPACES THRU 6020-EXIT.          
      *                                                                         
30989      IF WS-HONK-LEN = WS-SAVE-LEN                                 
30989         CONTINUE                                                  
30989      ELSE                                                         
30989         MOVE WS-HNK-TABLE TO WS-TEMP-READ-INSTRUC                 
30989         MOVE WS-HONK-LEN  TO WS-SPCL-LEN                          
      *                                                                         
30989         MOVE WS-TEMP-READ-INSTRUC TO PR-SPCL-READ-INSTR-TEXT      
30989         MOVE WS-SPCL-LEN          TO PR-SPCL-READ-INSTR-LEN       
30989         MOVE WS-Y                 TO WS-UPD-PREMISE               
30989      END-IF.                                                      
      *                                                                         
       2100-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ****************************************************************          
      *   GET RID OF EMBEDDED SPACES IN PR-PREMISE-DIRECTIONS        *          
      ****************************************************************          
      *                                                                         
       2200-BUILD-PREMISE-DIRECTIONS.                                   
      *                                                                         
30989      MOVE PR-PREMISE-DIRECTIONS-TEXT TO WS-EMB-INPUT.             
30989      MOVE PR-PREMISE-DIRECTIONS-LEN  TO WS-EMB-LENG               
30989                                         WS-SAVE-LEN.              
      *                                                                         
30989      PERFORM 6010-REDUCE-EMBEDDED-SPACES THRU 6010-EXIT.          
      *                                                                         
30989      IF WS-HONK-LEN = WS-SAVE-LEN                                 
30989         CONTINUE                                                  
30989      ELSE                                                         
30989         MOVE WS-CMP-TABLE TO WS-TEMP-SPCL-INSTRUC                 
30989         MOVE WS-HONK-LEN  TO WS-SPCL-LEN                          
      *                                                                         
30989         MOVE WS-TEMP-SPCL-INSTRUC TO PR-PREMISE-DIRECTIONS-TEXT   
30989         MOVE WS-SPCL-LEN          TO PR-PREMISE-DIRECTIONS-LEN    
30989         MOVE WS-Y                 TO WS-UPD-PREMISE               
30989      END-IF.                                                      
      *                                                                         
       2200-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
30989***     *     *     *     *     *     *     *     *     *       ***        
30989***    THIS PARAGRAPH IS A CLONE - SORT OF - OF CPD0004 AND     ***        
30989***    CWS00011. IT CHECKS ONE CHARACTER AT A TIME UNTIL THE    ***        
30989***    LIMIT IS REACHED. I AM NOT USING THE COPY BOOKS BECAUSE  ***        
30989***    THEY HAVE A LENGTH THAT IS NOT LARGE ENOUGH FOR THIS     ***        
30989***    FIELD.                                                   ***        
30989***     *     *     *     *     *     *     *     *     *       ***        
      *                                                                         
T33182*****************************************************************         
T33182*                                                               *         
T33182* 5900-ISSUE-COMMIT.                                            *         
T33182*****************************************************************         
T33182 5900-ISSUE-COMMIT.                                               
T33182                                                                  
T33182     ADD +1                            TO WS-COMMIT-COUNT.        
C26208                                                                  
T33182     IF WS-COMMIT-COUNT = WS-CHKP-LUW-LIMIT                       
C26208                 OR WS-COMMIT-COUNT = WS-CHKP-UPD-LIMIT           
T33182        ADD +1                         TO WS-COMMIT-SEQ-NO        
T33182        MOVE WS-COMMIT-SEQ-NO          TO WS-RESTART-CHKP-SEQ-NO  
T33182        MOVE WS-PREV-ACCT-NO           TO WS-RESTART-ACCT-NO      
T33182        MOVE WS-FCSCA658-CNT           TO WS-RESTART-FCSCA658-CNT 
T33182        MOVE WS-INPUT-DATE             TO WS-RESTART-COMMON-DATE  
T33182        MOVE 1                         TO WS-RESTART-PROCESS-TYPE 
T33182        MOVE WS-RESTART-DATA           TO RF-RESTART-DATA-TEXT    
T33182        MOVE WS-RESTART-DATA-LENGTH    TO RF-RESTART-DATA-LEN     
T33182                                                                  
T33182        PERFORM 8910-WRITE-RESTART       THRU 8910-EXIT           
T33182        IF WS-ACTIVE-RETURN-CODE EQUAL NOT-FOUND                  
T33182            PERFORM 8920-INSERT-RESTART  THRU 8920-EXIT           
T33182        END-IF                                                    
T33182        PERFORM 8950-COMMIT-CHANGES      THRU 8950-EXIT           
T33182        MOVE +0                        TO WS-COMMIT-COUNT         
T33182     END-IF.                                                      
T33182                                                                  
T33182 5900-EXIT.                                                       
T33182     EXIT.                                                        
T33182                                                                  
      ****************************************************************          
      *  USED FOR PR-SPCL-INSTRUCTIONS                               *          
      *       AND PR-PREMISE-DIRECTIONS                              *          
      *  USED FOR PR-SPCL-READ-INSTR                                 *          
      ****************************************************************          
      *                                                                         
30989  6010-REDUCE-EMBEDDED-SPACES.                                     
30989      SET WS-EMB-INDX TO 1.                                        
30989      SET WS-CMP-INDX TO 1.                                        
30989      MOVE 0 TO WS-HONK-LEN.                                       
30989      MOVE SPACE TO WS-EMB-LAST-CHAR.                              
30989      IF WS-EMB-LENG NUMERIC AND                                   
30989        WS-EMB-LENG GREATER THAN ZERO AND LESS                     
30989            THAN WS-EMB-TBL-LENG                                   
30989              NEXT SENTENCE                                        
30989      ELSE                                                         
30989          MOVE WS-EMB-TBL-LENG TO WS-EMB-LENG
           END-IF.                     
30989      PERFORM 6011-COMPRESSION-ROUTINE THRU 6011-EXIT              
30989          VARYING WS-EMB-INDX FROM WS-EMB-INDX BY 1                
30989          UNTIL WS-EMB-INDX GREATER THAN WS-EMB-LENG.              
30989      MOVE ZERO TO WS-EMB-LENG.                                    
      *                                                                         
30989  6010-EXIT.                                                       
30989      EXIT.                                                        
      *                                                                         
30989***     *     *     *     *     *     *     *     *     *       ***        
30989***    THIS PARAGRAPH LOADS OUTPUT TABLE WITH ALL VALUES EXCEPT ***        
30989***    EXTRA SPACES.                                            ***        
30989***     *     *     *     *     *     *     *     *     *       ***        
      *                                                                         
30989  6011-COMPRESSION-ROUTINE.                                        
      *                                                                         
30989      IF WS-EMB-CHAR (WS-EMB-INDX) = LOW-VALUES                    
30989         MOVE SPACES TO WS-EMB-CHAR (WS-EMB-INDX)                  
30989      END-IF.                                                      
      *                                                                         
30989      IF WS-EMB-CHAR (WS-EMB-INDX) = SPACE AND                     
30989          WS-EMB-LAST-CHAR                                         
30989           NEXT SENTENCE                                           
30989      ELSE                                                         
30989       MOVE WS-EMB-CHAR (WS-EMB-INDX) TO WS-CMP-CHAR (WS-CMP-INDX) 
30989                                         WS-EMB-LAST-CHAR          
30989       ADD 1 TO WS-HONK-LEN                                        
30989       SET WS-CMP-INDX UP BY 1                                     
30989      END-IF.                                                      
      *                                                                         
30989  6011-EXIT.                                                       
30989      EXIT.                                                        
      *                                                                         
      ****************************************************************          
      *  USED FOR PR-SPCL-READ-INSTR                                 *          
      ****************************************************************          
      *                                                                         
30989  6020-REDUCE-EMBEDDED-SPACES.                                     
30989      SET WS-HNK1-INDX TO 1.                                       
30989      SET WS-HNK2-INDX TO 1.                                       
30989      MOVE 0 TO WS-HONK-LEN.                                       
30989      MOVE SPACE TO WS-HNK-LAST-CHAR.                              
30989      IF WS-HNK-LENG NUMERIC AND                                   
30989        WS-HNK-LENG GREATER THAN ZERO AND LESS                     
30989            THAN WS-HNK-TBL-LENG                                   
30989              NEXT SENTENCE                                        
30989      ELSE                                                         
30989          MOVE WS-HNK-TBL-LENG TO WS-HNK-LENG
           END-IF.                     
30989      PERFORM 6021-COMPRESSION-ROUTINE THRU 6021-EXIT              
30989          VARYING WS-HNK1-INDX FROM WS-HNK1-INDX BY 1              
30989          UNTIL WS-HNK1-INDX GREATER THAN WS-HNK-LENG.             
30989      MOVE ZERO TO WS-HNK-LENG.                                    
      *                                                                         
30989  6020-EXIT.                                                       
30989      EXIT.                                                        
      *                                                                         
30989***     *     *     *     *     *     *     *     *     *       ***        
30989***    THIS PARAGRAPH LOADS OUTPUT TABLE WITH ALL VALUES EXCEPT ***        
30989***    EXTRA SPACES.                                            ***        
30989***     *     *     *     *     *     *     *     *     *       ***        
      *                                                                         
30989  6021-COMPRESSION-ROUTINE.                                        
      *                                                                         
30989      IF WS-HNK1-CHAR (WS-HNK1-INDX) = LOW-VALUES                  
30989         MOVE SPACES TO WS-HNK1-CHAR (WS-HNK1-INDX)                
30989      END-IF.                                                      
      *                                                                         
30989      IF WS-HNK1-CHAR (WS-HNK1-INDX) = SPACE AND                   
30989         WS-HNK-LAST-CHAR                                          
30989          NEXT SENTENCE                                            
30989      ELSE                                                         
30989         MOVE WS-HNK1-CHAR (WS-HNK1-INDX) TO                       
30989                  WS-HNK2-CHAR (WS-HNK2-INDX)                      
30989                  WS-HNK-LAST-CHAR                                 
30989         ADD 1 TO WS-HONK-LEN                                      
30989         SET WS-HNK2-INDX UP BY 1                                  
30989      END-IF.                                                      
      *                                                                         
30989  6021-EXIT.                                                       
30989      EXIT.                                                        
      *                                                                         
      *--------------------*                                                    
       7000-SELECT-PREMISE.                                             
      *--------------------*                                                    
      *                                                                         
           EXEC SQL                                                     
                SELECT  SPCL_INSTRUCTIONS                               
                       ,SPCL_READ_INSTR                                 
                       ,PREMISE_DIRECTIONS                              
                  INTO :PR-SPCL-INSTRUCTIONS                            
                      ,:PR-SPCL-READ-INSTR                              
                      ,:PR-PREMISE-DIRECTIONS                           
                  FROM  CSS_PREMISE                                     
                 WHERE  PREMISE_NO = :PR-PREMISE-NO                     
           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 TO SUCCESSFUL-CALL OR        
               NOT-FOUND                                                
               NEXT SENTENCE                                            
           ELSE                                                         
               DISPLAY '7000-SELECT ' WS-ACTIVE-RETURN-CODE             
               DISPLAY 'PREMISE NO ' PR-PREMISE-NO                      
               PERFORM 9900-ABEND THRU 9900-EXIT
           END-IF.                       
      *                                                                         
       7000-EXIT.                                                       
           EXIT.                                                        
                                                                        
T33182*****************************************************************         
T33182*                                                               *         
T33182* 7150-SELECT-RESTART.                                          *         
T33182*****************************************************************         
T33182 7150-SELECT-RESTART.                                             
T33182                                                                  
T33182     EXEC SQL                                                     
T33182         SELECT RF.RESTART_DATA                                   
T33182           INTO :RF-RESTART-DATA                                  
T33182           FROM CSS_RESTART RF                                    
T33182          WHERE RF.NAME_PROGRAM = :RF-NAME-PROGRAM                
T33182            AND RF.DUP_CNTRL_NO = :RF-DUP-CNTRL-NO                
T33182            AND RF.PARTITION_NO = :RF-PARTITION-NO                
T33182     END-EXEC.                                                    

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

T33182                                                                  
T33182     MOVE SQLCODE                  TO WS-ACTIVE-RETURN-CODE.      
T33182                                                                  
T33182     IF WS-ACTIVE-RETURN-CODE EQUAL SUCCESSFUL-CALL OR NOT-FOUND  
T33182        NEXT SENTENCE                                             
T33182     ELSE                                                         
T33182        DISPLAY '********** PCSCA658 ABORT **************'        
T33182        DISPLAY '*        7150-SELECT-RESTART           *'        
T33182        DISPLAY '* SQLCODE        : ' WS-ACTIVE-RETURN-CODE       
T33182        DISPLAY '* PROGRAM ABORTING...                  *'        
T33182        DISPLAY '********** PCSCA658 ABORT **************'        
T33182        PERFORM 9900-ABEND               THRU 9900-EXIT           
T33182     END-IF.                                                      
T33182                                                                  
T33182 7150-EXIT.                                                       
T33182     EXIT.                                                        
                                                                        
      *---------------------*                                                   
       7400-READ-INPUT-FILE.                                            
      *---------------------*                                                   
      *    MOVE '7400'                 TO ACTIVE-PARAGRAPH.                     
           READ METER-DETAIL-FILE                                       
                INTO FIOCA658                                           
                     AT END MOVE WS-YES TO WS-EOF-FLAG.                 
                                                                        
           IF NOT END-OF-FILE                                           
              ADD 1                    TO WS-FCA658-REC-CNTR            
           END-IF.                                                      
      *                                                                         
       7400-EXIT.                                                       
           EXIT.                                                        
      *--------------------------*                                              
       8000-UPDATE-SPECL-INSTRUC.                                       
      *--------------------------*                                              
      *                                                                         
           EXEC SQL                                                     
               UPDATE CSS_PREMISE                                       
               SET SPCL_INSTRUCTIONS  = :PR-SPCL-INSTRUCTIONS           
                  ,SPCL_READ_INSTR    = :PR-SPCL-READ-INSTR             
                  ,PREMISE_DIRECTIONS = :PR-PREMISE-DIRECTIONS          
               WHERE PREMISE_NO = :PR-PREMISE-NO                        
           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 TO SUCCESSFUL-CALL           
               NEXT SENTENCE                                            
           ELSE                                                         
                 DISPLAY '8000-ABEND ' WS-ACTIVE-RETURN-CODE            
                 PERFORM 9900-ABEND THRU 9900-EXIT
           END-IF.                     
      *                                                                         
       8000-EXIT.                                                       
           EXIT.                                                        
T33182*****************************************************************         
T33182*                                                               *         
T33182* 8910-WRITE-RESTART.                                           *         
T33182*****************************************************************         
T33182  8910-WRITE-RESTART.                                             
T33182*                                                                         
T33182      EXEC SQL                                                    
T33182         UPDATE CSS_RESTART                                       
T33182            SET RESTART_DATA = :RF-RESTART-DATA                   
T33182          WHERE NAME_PROGRAM = :RF-NAME-PROGRAM                   
T33182            AND PARTITION_NO = :RF-PARTITION-NO                   
T33182            AND DUP_CNTRL_NO = :RF-DUP-CNTRL-NO                   
T33182      END-EXEC.                                                   

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

T33182                                                                  
T33182     MOVE SQLCODE                  TO WS-ACTIVE-RETURN-CODE.      
T33182                                                                  
T33182     IF WS-ACTIVE-RETURN-CODE EQUAL SUCCESSFUL-CALL OR NOT-FOUND  
T33182        NEXT SENTENCE                                             
T33182     ELSE                                                         
T33182        DISPLAY '********** PCSCA658 ABORT **************'        
T33182        DISPLAY '*        8910-WRITE-RESTART            *'        
T33182        DISPLAY '* PROGRAM NAME   : ' RF-NAME-PROGRAM             
T33182        DISPLAY '* PARTITION NO   : ' RF-PARTITION-NO             
T33182        DISPLAY '* SQLCODE        : ' WS-ACTIVE-RETURN-CODE       
T33182        DISPLAY '* PROGRAM ABORTING...                  *'        
T33182        DISPLAY '********** PCSCA658 ABORT **************'        
T33182        PERFORM 9900-ABEND               THRU 9900-EXIT           
T33182     END-IF.                                                      
T33182                                                                  
T33182 8910-EXIT.                                                       
T33182     EXIT.                                                        
T33182                                                                  
T33182*****************************************************************         
T33182*                                                               *         
T33182* 8920-INSERT-RESTART.                                          *         
T33182*****************************************************************         
T33182 8920-INSERT-RESTART.                                             
T33182                                                                  
T33182     EXEC SQL                                                     
T33182        INSERT INTO CSS_RESTART                                   
T33182             (NAME_PROGRAM                                        
T33182             ,PARTITION_NO                                        
T33182             ,DUP_CNTRL_NO                                        
T33182             ,RESTART_DATA)                                       
T33182        VALUES                                                    
T33182             (:RF-NAME-PROGRAM                                    
T33182             ,:RF-PARTITION-NO                                    
T33182             ,:RF-DUP-CNTRL-NO                                    
T33182             ,:RF-RESTART-DATA)                                   
T33182     END-EXEC.                                                    

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

T33182                                                                  
T33182     MOVE SQLCODE                  TO WS-ACTIVE-RETURN-CODE.      
T33182                                                                  
T33182     IF WS-ACTIVE-RETURN-CODE EQUAL SUCCESSFUL-CALL               
T33182        NEXT SENTENCE                                             
T33182     ELSE                                                         
T33182        DISPLAY '********** PCSCA658 ABORT **************'        
T33182        DISPLAY '*        8920-INSERT-RESTART           *'        
T33182        DISPLAY '* PROGRAM NAME   : ' RF-NAME-PROGRAM             
T33182        DISPLAY '* PARTITION NO   : ' RF-PARTITION-NO             
T33182        DISPLAY '* SQLCODE        : ' WS-ACTIVE-RETURN-CODE       
T33182        DISPLAY '* PROGRAM ABORTING...                  *'        
T33182        DISPLAY '********** PCSCA658 ABORT **************'        
T33182        PERFORM 9900-ABEND               THRU 9900-EXIT           
T33182     END-IF.                                                      
T33182                                                                  
T33182 8920-EXIT.                                                       
T33182     EXIT.                                                        
T33182                                                                  
T33182*****************************************************************         
T33182*                                                               *         
T33182* 8930-DELETE-RESTART-RECORD.                                   *         
T33182*****************************************************************         
T33182 8930-DELETE-RESTART-RECORD.                                      
T33182     EXEC SQL                                                     
T33182       DELETE FROM CSS_RESTART                                    
T33182        WHERE NAME_PROGRAM = :RF-NAME-PROGRAM                     
T33182          AND DUP_CNTRL_NO = :RF-DUP-CNTRL-NO                     
T33182          AND PARTITION_NO = :RF-PARTITION-NO                     
T33182     END-EXEC.                                                    

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

T33182                                                                  
T33182     MOVE SQLCODE                  TO WS-ACTIVE-RETURN-CODE.      
T33182                                                                  
T33182     IF WS-ACTIVE-RETURN-CODE EQUAL SUCCESSFUL-CALL OR NOT-FOUND  
T33182        NEXT SENTENCE                                             
T33182     ELSE                                                         
T33182        DISPLAY '********** PCSCA658 ABORT **************'        
T33182        DISPLAY '*    8930-DELETE-RESTART-RECORD        *'        
T33182        DISPLAY '* PROGRAM NAME   : ' RF-NAME-PROGRAM             
T33182        DISPLAY '* PARTITION NO   : ' RF-PARTITION-NO             
T33182        DISPLAY '* SQLCODE        : ' WS-ACTIVE-RETURN-CODE       
T33182        DISPLAY '* PROGRAM ABORTING...                  *'        
T33182        DISPLAY '********** PCSCA658 ABORT **************'        
T33182        PERFORM 9900-ABEND               THRU 9900-EXIT           
T33182     END-IF.                                                      
T33182                                                                  
T33182 8930-EXIT.                                                       
T33182     EXIT.                                                        
T33182                                                                  
T33182******************************************************************        
T33182*                                                                *        
T33182* 8950-COMMIT-CHANGES                                            *        
T33182******************************************************************        
T33182 8950-COMMIT-CHANGES.                                             
T33182                                                                  
T33182     EXEC SQL                                                     
T33182         COMMIT                                                   
T33182     END-EXEC.                                                    

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

T33182                                                                  
T33182     DISPLAY '*** COMMIT POINT # ' WS-COMMIT-SEQ-NO' TAKEN.'      
T33182             '  ACCOUNT LAST REC PROCESSED = ' WS-PREV-ACCT-NO    
T33182              ' ***'.                                             
T33182                                                                  
T33182 8950-EXIT.                                                       
T33182     EXIT.                                                        
                                                                        
       9000-TERMINATE.                                                  
      *                                                                         
           DISPLAY '*** TOTAL RECORDS PROCESSED = ' WS-FCA658-REC-CNTR  
           CLOSE METER-DETAIL-FILE.                                     
      *                                                                         
       9000-EXIT.                                                       
           EXIT.                                                        
      ******************************************************************        
      *     9900-ABEND                                                 *        
      *                                                                *        
      *     PERFORMED IF VSAM OR DB2 PROBLEM OCCURS.                   *        
      ******************************************************************        
      *                                                                         
       9900-ABEND.                                                      
      *                                                                         
           DISPLAY 'PERFORMING 9900-ABEND'.                             
      *                                                                         
SCA003     EXEC SQL
SCA003         ROLLBACK
SCA003     END-EXEC.                                                      

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

                                                                        
           MOVE 12  TO  RETURN-CODE.                                    
           MOVE 'YES' TO WS-ABEND-SWITCH.                               
                                                                        
           IF WS-ABEND-YES                                              
               STOP RUN                                                 
           END-IF.                                                      
      *                                                                         
       9900-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
T33182******************************************************************        
T33182* CPD00029 - RESET THE RESTART-REQ FLAG IN JOB PARM              *        
T33182******************************************************************        
T33182     EXEC SQL                                                             
T33182         INCLUDE CPD00029                                                 
T33182     END-EXEC.                                                            
T33182                                                                  
T33182******************************************************************        
T33182* CPD00030 - VALIDATES RESTART REQUEST                           *        
T33182******************************************************************        
T33182 COPY CPD00030.                                                           
T33182                                                                  
T33182******************************************************************        
T33182* 6253-GET-FJC01-CHKP-LIMIT.                                     *        
T33182******************************************************************        
T33182     EXEC SQL                                                             
T33182         INCLUDE CPD00034                                                 
T33182     END-EXEC.                                                            
T33182                                                                  
T33182******************************************************************        
T33182* 6235-GET-FJC01-RESTART-REQ.                                    *        
T33182******************************************************************        
T33182     EXEC SQL                                                             
T33182         INCLUDE CPD00035                                                 
T33182     END-EXEC.                                                            
T33182                                                                  
T33182******************************************************************        
T33182* 7600-START-FCSJC01                                             *        
T33182******************************************************************        
T33182     EXEC SQL                                                             
T33182        INCLUDE CPD00038                                                  
T33182     END-EXEC.                                                            
                                                                        
