       IDENTIFICATION DIVISION.                                         
       PROGRAM-ID.     PCSCA272.                                        
       INSTALLATION.                                                    
       DATE-WRITTEN.   MAY 2012.                                        
           DATE-COMPILED.                                               
      *****************************************************************         
      **             SOUTH CAROLINA ELECTRIC & GAS                   **         
      **                                                             **         
      ********            CUSTOMER SERVICE SYSTEM             *********         
      ********                 COBOL/DB2                      *********         
      *****************************************************************         
      *****************************************************************         
      **                                                             **         
      **              PROGRAM  MODIFICATION  LOG                     **         
      **                                                             **         
      ** DATE       INITIALS      REASON                             **         
      ** =====      ========      ======                             **         
      ** 09/10/12   SS95855       P#00585 DEVELOPMENT OF NEW PROGRAM **         
      ** 12/12/12   SS95855       P#00585 FORMAT COMM RECORD DATE.   **         
      ** 02/18/13   SS95855       P00730  PROMOTIONAL EMAIL CHANGES  **         
      **                                                             **         
A04867** 01/06/14   SS7F226       CHANGES TO STOP BCC AND IMAGING FOR**         
A04867**                          SPECIFIC EMAIL EVENTS AND REMOVED  **         
A04867**                          UNUSED COPYBOOKS                   **         
A04867** 02/20/14   SS7F226       REMOVED 'R' EVENTS AND SET THE     **         
A04867**                          COMM-CMNT-INSERTED FLAG TO AVIOD   **         
A04867**                          LOOPING                            **         
ACT020** 01/25/16   BD09555       Do not reference fd area after     **         
ACT020**A05460-ACT020             end of file                        **         
      *****************************************************************         
           REMARKS.                                                     
                              PCSCA272 NARRATIVE                        
                              ==================                        
      *                                                                         
           THIS PROGRAM CREATES A COMMUNICATION RECORD FOR THE BATCH    
           EMAIL EXTRACT FILE PROCESSED BY VENDOR AND UPDATES TABLE     
           CSS_BATCH_EMAIL STATUS TO DELIVERED 'D' AND PROCESSED DATE   
           TO CURRENT DATE.                                             
      *                                                                         
       ENVIRONMENT DIVISION.                                            
                                                                        
       CONFIGURATION SECTION.                                           
       INPUT-OUTPUT SECTION.                                            
                                                                        
       FILE-CONTROL.                                                    
       COPY CSSCA271.                                                           
                                                                        
       DATA DIVISION.                                                   
       FILE SECTION.                                                    
       COPY CFDCA271.                                                           
       01  FIOCA271-REC                PIC X(700).                      
                                                                        
      **************************                                                
       WORKING-STORAGE SECTION.                                         

MSQ008  01 MSQ008-EMAIL-EVENT  PIC S9(9) COMP-5.
MSQ017 01 MFA-PROGRAM-ID PIC X(8) VALUE 'PCSCA272'.
MSQ017     COPY MFASQLM.
      **************************                                                
      *                                                                         
       01  WS-START                    PIC X(40)                        
           VALUE 'WORKING STORAGE FOR PCSCA272 STARTS HERE'.            
                                                                        
      *** FIOCA271 FILE LAYOUT                                                  
       01 FIOCA271                     PIC X(700).                      
       01 FIOCA271-LEN                 PIC 9(04).                       
                                                                        
      *** ABEND SWITCH                                                          
       COPY CWS09900.                                                           
                                                                        
      *** WS ABEND WORK AREA                                                    
       COPY CWS00010.                                                           
                                                                        
      *** DB2 ERROR PROCESSING                                                  
       COPY CWS00303.                                                           
                                                                        
      *** NAME & ADDRESS                                                        
       COPY CWS00004.                                                           
       COPY CWS00074.                                                           
       COPY CWS00011.                                                           
                                                                        
      ******************************************************************        
      ***                         DCLGEN'S                           ***        
      ******************************************************************        
                                                                        
      ******************************************************************        
      *    COMMUNICATION AREA                                          *        
      ******************************************************************        
           EXEC SQL                                                             
               INCLUDE SQLCA                                                    
           END-EXEC.                                                            
      *                                                                         
      ******************************************************************        
      *    DCLGEN FOR CSS_BATCH_EMAIL  (AE)                            *        
      ******************************************************************        
           EXEC SQL                                                             
               INCLUDE TBBEMAIL                                                 
           END-EXEC.                                                            
      *                                                                         
      ******************************************************************        
      *    DCLGEN FOR CSS_EMAIL_EVENT  (2T)                            *        
      ******************************************************************        
           EXEC SQL                                                             
               INCLUDE TBEMEVNT                                                 
           END-EXEC.                                                            
      *                                                                         
A04867******************************************************************        
A04867*    DCLGEN FOR CSS_COMM_COMMENT (KN)                            *        
A04867******************************************************************        
A04867     EXEC SQL                                                             
A04867         INCLUDE TBCOMCMT                                                 
A04867     END-EXEC.                                                            
A04867*                                                                         
      ******************************************************************        
      *    DCLGEN FOR CSS_NAME_ACCT_XREF (NE)                          *        
      ******************************************************************        
           EXEC SQL                                                             
               INCLUDE TBNMACTX                                                 
           END-EXEC.                                                            
      *                                                                         
      ******************************************************************        
      *    DCLGEN FOR CSS_JOB_PARM     (G6)                            *        
      ******************************************************************        
           EXEC SQL                                                             
               INCLUDE TBJBPARM                                                 
           END-EXEC.                                                            
      *                                                                         
           EXEC SQL                                                             
               INCLUDE TBACCT                                                   
           END-EXEC.                                                            
      *                                                                         
           EXEC SQL                                                             
               INCLUDE TBCOMDAT                                                 
           END-EXEC.                                                            
      *                                                                         
           EXEC SQL                                                             
               INCLUDE TBADRFMT                                                 
           END-EXEC.                                                            
      *                                                                         
           EXEC SQL                                                             
               INCLUDE TBADRFRE                                                 
           END-EXEC.                                                            
      *                                                                         
           EXEC SQL                                                             
               INCLUDE TBNAME                                                   
           END-EXEC.                                                            
      *                                                                         
           EXEC SQL                                                             
               INCLUDE TBCSADRX                                                 
           END-EXEC.                                                            
      *                                                                         
           EXEC SQL                                                             
               INCLUDE TBZIPCD                                                  
           END-EXEC.                                                            
      *                                                                         
           EXEC SQL                                                             
              INCLUDE TBRESTRT                                                  
           END-EXEC.                                                            
      *                                                                         
           EXEC SQL                                                             
               INCLUDE TBATMISC                                                 
           END-EXEC.                                                            
      *                                                                         
      * FCA00 MISC INPUT     *                                                  
           EXEC SQL                                                             
              INCLUDE CWS00039                                                  
           END-EXEC.                                                            
      *                                                                         
      * WOKING STORAGE FOR CPDCA099                                             
           EXEC SQL                                                             
              INCLUDE CWS00099                                                  
           END-EXEC.                                                            
      *                                                                         
      * FCA00-KEY                                                               
           EXEC SQL                                                             
              INCLUDE FIOCA00                                                   
           END-EXEC.                                                            
      *                                                                         
      * IO AREA FOR PARM INPUT FILE 'A'                                         
           EXEC SQL                                                             
              INCLUDE FIOJC01                                                   
           END-EXEC.                                                            
      *                                                                         
       01 WS-LITERALS.                                                  
          05 WS-Y                      PIC X(01)  VALUE 'Y'.            
          05 WS-YES                    PIC X(01)  VALUE 'Y'.            
          05 WS-N                      PIC X(01)  VALUE 'N'.            
          05 WS-E                      PIC X(01)  VALUE 'E'.            
          05 WS-O                      PIC X(01)  VALUE 'O'.            
A04867    05 WS-SEMI-COLON             PIC X(02)  VALUE '; '.           
          05 WS-PGRMNAME               PIC X(08)  VALUE 'PCSCA272'.     
          05 PROGRAM-NAME              PIC X(08)  VALUE 'PCSCA272'.     
          05 WS-DELIVERED              PIC X(01)  VALUE 'D'.            
          05 WS-HEADER-RECORD          PIC X(11)  VALUE 'CustomerNo;'.  
          05 WS-USER-ID-ORIG           PIC X(07)  VALUE 'SYSTEM '.      
          05 WS-ONE                    PIC X(01)  VALUE '1'.            
          05 WS-I                      PIC X(01)  VALUE 'I'.            
          05 WS-PARTITION-NO           PIC 9(01)  VALUE 0.              
                                                                        
          05 WS-803-CTR                PIC 9(01) VALUE 0.               
          05 WS-803                    PIC S9(9) VALUE -803 COMP.       
          05 WS-COMM-DATA-INSERTED     PIC X(01) VALUE ' '.             
             88 COMM-DATA-INSERTED               VALUE 'Y'.             
             88 COMM-DATA-NOT-INSERTED           VALUE 'N'.             
A04867    05 WS-COMM-CMNT-INSERTED     PIC X(01) VALUE ' '.             
A04867       88 COMM-CMNT-INSERTED               VALUE 'Y'.             
A04867       88 COMM-CMNT-NOT-INSERTED           VALUE 'N'.             
          05 WS-FCS271-STATUS          PIC X(02).                       
             88 FCS271-SUCCESSFUL                 VALUE '00'.           
             88 FCS271-READ-EOF                   VALUE '10'.           
          05 WS-FCS271-EOF             PIC X(01)  VALUE 'N'.            
             88 FCS271-EOF-REACHED                VALUE 'Y'.            
          05 WS-ARR-MATCH              PIC X(01)  VALUE 'N'.            
             88 ARR-MATCH-FOUND                   VALUE 'Y'.            
             88 ARR-MATCH-NOT-FOUND               VALUE 'N'.            
          05 WS-RUN-FOR-COMPANY        PIC X(02)  VALUE '  '.           
             88 SCEG-RUN                          VALUE '01'.           
             88 PSNC-RUN                          VALUE '26'.           
             88 SEB-RUN                           VALUE '03'.           
             88 SEBR-RUN                          VALUE '04'.           
P00585    05 WS-FORMAT-DATE.                                            
P00585       10 WS-FMT-MM              PIC X(02).                       
P00585       10 FILLER                 PIC X(01)  VALUE '/'.            
P00585       10 WS-FMT-DD              PIC X(02).                       
P00585       10 FILLER                 PIC X(01)  VALUE '/'.            
P00585       10 WS-FMT-YYYY            PIC X(04).                       
A04867    05 WS-COMMON-TXT             PIC X(30).                       
A04867    05 WS-COMMON-TXT-REVERSED    PIC X(30)  VALUE SPACES.         
A04867    05 WS-COMMON-TXT-CHARS       PIC 9(3)   VALUE 0.              
A04867    05 WS-COMMON-TXT-POINTER     PIC 9(3)   VALUE 0.              
A04867    05 WS-BILLD-DT-POINTER       PIC 9(3)   VALUE 0.              
A04867    05 WS-DRAFT-DT-POINTER       PIC 9(3)   VALUE 0.              
A04867    05 WS-SCHED-DT-POINTER       PIC 9(3)   VALUE 0.              
A04867    05 WS-CHRGE-DT-POINTER       PIC 9(3)   VALUE 0.              
A04867    05 WS-BANK-ACCT-POINTER      PIC 9(3)   VALUE 0.              
A04867    05 WS-BILLD-AMT-POINTER      PIC 9(3)   VALUE 0.              
A04867    05 WS-DRAFT-AMT-POINTER      PIC 9(3)   VALUE 0.              
A04867    05 WS-DEP-AMT-POINTER        PIC 9(3)   VALUE 0.              
A04867    05 WS-CHRGE-AMT-POINTER      PIC 9(3)   VALUE 0.              
      *                                                                         
       01 WS-EMAIL-EVENT-TABLE.                                         
          05 WS-EVENT-COUNT                PIC 9(05) VALUE ZERO.        
          05 WS-EVENT-SUB                  PIC 9(03) VALUE ZERO.        
          05 WS-EVENT-TABLE.                                            
             10 TAB-COMPANY-NO         OCCURS 100 TIMES  PIC X(02).     
             10 TAB-EMAIL-EVENT-CD     OCCURS 100 TIMES  PIC X(05).     
             10 TAB-EVENT-CHANNEL-CD   OCCURS 100 TIMES  PIC X(01).     
             10 TAB-REG-GROUP-CD       OCCURS 100 TIMES  PIC X(03).     
             10 TAB-EVENT-STATUS-CD    OCCURS 100 TIMES  PIC X(01).     
             10 TAB-EVENT-PROCESS-CD   OCCURS 100 TIMES  PIC X(01).     
             10 TAB-EVENT-VENDOR-NM    OCCURS 100 TIMES  PIC X(40).     
             10 TAB-EVENT-IMAGE-REQ-FL OCCURS 100 TIMES  PIC X(01).     
             10 TAB-COMM-RECORD-FL     OCCURS 100 TIMES  PIC X(01).     
             10 TAB-EVENT-PRIORITY-CD  OCCURS 100 TIMES  PIC X(01).     
             10 TAB-EVENT-COMPONENT-NM OCCURS 100 TIMES  PIC X(40).     
             10 TAB-EMAIL-EVENT-DESC   OCCURS 100 TIMES  PIC X(100).    
             10 TAB-COMM-TYPE-CODE     OCCURS 100 TIMES  PIC X(02).     
             10 TAB-COMM-SUBTYPE-CODE  OCCURS 100 TIMES  PIC X(02).     
      *                                                                         
       01 WS-WORK-AREA.                                                 
          05 RS-RETURN-CODE            PIC S9(09) VALUE +0 COMP.        
          05 RS-RETURN-CODE-DISP       PIC S9(09) VALUE +0 COMP.        
          05 WS-DISPLAY-SQLCODE        PIC ---9.                        
          05 WS-TALLY                  PIC   99.                        
          05 WS-FCSCA271-REC-CNTR      PIC 9(08)  VALUE ZERO.           
          05 WS-EVENT-RECORDS          PIC 9(08)  VALUE ZERO.           
          05 WS-TOTAL-RECORDS-STR      PIC Z,ZZ,ZZ,ZZ9.                 
          05 WS-PREV-EVENT-CD          PIC X(05)  VALUE SPACES.         
          05 WS-SUB                    PIC 9(02)  VALUE ZERO.           
          05 WS-RED-FL-NULL-IND        PIC S9(04) COMP VALUE +0.        
          05 WS-CALL-END-NULL-IND      PIC S9(04) COMP VALUE +0.        
          05 WS-INITIAL-COMMENT-TEXT   PIC X(250) VALUE SPACES.         
          05 WS-CURR-TIMESTMP          PIC X(26)  VALUE SPACES.         
          05 WS-HOLD-FIRST-100-BYTES   PIC X(100) VALUE SPACES.         
          05 WS-EMAIL-EVENT-DESC       PIC X(100) VALUE SPACES.         
          05 WS-COMM-TYPE-CODE         PIC X(02)  VALUE SPACES.         
          05 WS-COMM-SUBTYPE-CODE      PIC X(02)  VALUE SPACES.         
          05 WS-EVENT-VENDOR-NM        PIC X(40)  VALUE SPACES.         
A04867    05 WS-EVENT-IMAGE-REQ-FL     PIC X(01)  VALUE ' '.            
A04867       88 IMAGE-REQ-FL-SET                  VALUE 'Y'.            
A04867       88 IMAGE-REQ-FL-NOT-SET              VALUE 'N'.            
      *                                                                         
       01 WS-UNSTRING-CA271-REC.                                        
          05 WS-CUSTOMER-NO            PIC 9(10).                       
          05 WS-ACCOUNT-NO             PIC 9(13).                       
          05 WS-FIRST-NAM              PIC X(15).                       
          05 WS-LAST-NAM               PIC X(70).                       
          05 WS-CUST-EMAIL-ID          PIC X(75).                       
          05 WS-BATCH-EMAIL-ID         PIC 9(18).                       
          05 WS-EMAIL-EVENT-CD         PIC X(05).                       
          05 WS-EMAIL-EVENT-DT         PIC X(10).                       
          05 WS-COMPANY-NO             PIC X(02).                       
          05 WS-EMAIL-DISP-CD          PIC X(01).                       
          05 WS-ACCNO-MASK             PIC X(13).                       
          05 WS-EVENT-CHANNL-CD        PIC X(01).                       
          05 WS-REG-GROUP-CD           PIC X(03).                       
          05 WS-PROCESS-CD             PIC X(01).                       
          05 WS-PREM-ADDR              PIC X(75).                       
A04867    05 WS-BANK-ACCT              PIC X(30).                       
A04867    05 WS-DRAFT-DT               PIC X(30).                       
A04867    05 WS-DRAFT-AMT              PIC X(30).                       
A04867    05 WS-BILLD-DT               PIC X(30).                       
A04867    05 WS-BILLD-AMT              PIC X(30).                       
A04867    05 WS-CHRGE-DT               PIC X(30).                       
A04867    05 WS-CHRGE-AMT              PIC X(30).                       
A04867    05 WS-SCHED-DT               PIC X(30).                       
          05 WS-UTIL-TYPE              PIC X(20).                       
          05 WS-REQ-TYPE               PIC X(25).                       
          05 WS-CONTACT-INFO           PIC X(50).                       
          05 WS-APPT-ARRG              PIC X(70).                       
A04867    05 WS-DEP-AMT                PIC X(30).                       
          05 WS-CUST-NAME              PIC X(30).                       
P#0730    05 WS-GUID-LINK              PIC X(35).                       
      *                                                                         
      * MISC INPUT           *                                                  
           EXEC SQL                                                             
              INCLUDE CWS00038                                                  
           END-EXEC.                                                            
      *                                                                         
       01 WS-RESTART-DATA.                                              
          05 WS-RESTART-PROCESS-TYPE       PIC 9(01).                   
          05 WS-RESTART-JOB-COMPLETE       REDEFINES                    
             WS-RESTART-PROCESS-TYPE       PIC X(01).                   
          05 WS-RESTART-JOB-STATUS         PIC X(01).                   
             88 WS-RUN-COMPLETED-NO-PROBLEMS         VALUE 'A'.         
             88 WS-RERUN-COMPLETED                   VALUE 'B'.         
             88 WS-RERUN-PENDING                     VALUE 'C'.         
          05 WS-RESTART-INPUT-DATE         PIC X(10) VALUE SPACES.      
          05 WS-RESTART-CHKP-SEQ-NO        PIC 9(07) VALUE ZERO.        
          05 WS-RESTART-REC-100-BYTES      PIC X(100) VALUE SPACES.     
          05 WS-RESTART-RECORD-NO          PIC 9(09) VALUE ZERO.        
      *                                                                         
       01 WS-RESTART-MISC.                                              
          05 WS-COMMIT-REQ-SW              PIC 9(1) VALUE 0.            
             88 COMMITS-REQUIRE                     VALUE 0.            
             88 COMMITS-NOT-REQUIRE                 VALUE 1.            
          05 WS-RESTART-DATA-LENGTH        PIC S9(04) COMP VALUE +128.  
          05 WS-IS-THIS-A-RESTART          PIC X(01) VALUE 'N'.         
             88 WS-THIS-IS-A-RESTART                 VALUE 'Y'.         
          05 WS-RESTART-REQ                PIC X(01).                   
          05 WS-DEFAULT-RESTART-REQ        PIC X(01) VALUE 'N'.         
          05 WS-CHKP-SEQ-NO                PIC 9(05) VALUE ZERO.        
          05 WS-COMMIT-COUNTER             PIC 9(07) VALUE ZERO.        
          05 WS-FLAG-TO-TURN-OFF-COMMITS   PIC 9(04) VALUE 9999.        
          05 WS-DEFAULT-CHKP-LUW-LIMIT     PIC 9(04) VALUE 4.           
          05 WS-DEFAULT-CHKP-UPD-LIMIT     PIC 9(04) VALUE 20.          
          05 WS-CHKP-LUW-LIMIT             PIC 9(04).                   
          05 WS-CHKP-UPD-LIMIT             PIC 9(04).                   
          05 WS-COUNT-UNSUCCESSFUL-ROWS    PIC S9(04) COMP-3 VALUE 0.   
      *                                                                         
       01 WS-END                            PIC X(40)                   
           VALUE 'WORKING STORAGE FOR PCSCA272 ENDS HERE  '.            
      *                                                                         
      ******************************************************************        
      * DECLARE CURSOR FOR EMAIL EVENT                                 *        
      ******************************************************************        
           EXEC SQL                                                     
              DECLARE EMAIL_EVENT CURSOR WITH ROWSET POSITIONING FOR    
              SELECT COMPANY_NO                                         
                    ,EMAIL_EVENT_CD                                     
                    ,EVENT_CHANNEL_CD                                   
                    ,REG_GROUP_CD                                       
                    ,EVENT_STATUS_CD                                    
                    ,EVENT_PROCESS_CD                                   
                    ,EVENT_VENDOR_NM                                    
                    ,EVENT_IMAGE_REQ_FL                                 
                    ,COMM_RECORD_FL                                     
                    ,EVENT_PRIORITY_CD                                  
                    ,EVENT_COMPONENT_NM                                 
                    ,LTRIM(RTRIM(EMAIL_EVENT_DESC)) AS EMAIL_EVENT_DESC        
                    ,COMM_TYPE_CODE                                     
                    ,COMM_SUBTYPE_CODE                                  
              FROM CSS_EMAIL_EVENT WITH(READUNCOMMITTED)                        
              WHERE EVENT_STATUS_CD = 'A'                               
              ORDER BY COMPANY_NO                                       
                     ,EMAIL_EVENT_CD                                    
                     ,EVENT_CHANNEL_CD                                  
                     ,REG_GROUP_CD                                      
              FOR READ ONLY                                     
                                                            
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ003
MFA-TR* MSQ004
MFA-TR* MSQ022
MFA-TR* MSQ029
MFA-TR*    EXEC SQL                                                             
MFA-TR*       DECLARE EMAIL_EVENT CURSOR WITH ROWSET POSITIONING FOR            
MFA-TR*       SELECT COMPANY_NO                                                 
MFA-TR*             ,EMAIL_EVENT_CD                                             
MFA-TR*             ,EVENT_CHANNEL_CD                                           
MFA-TR*             ,REG_GROUP_CD                                               
MFA-TR*             ,EVENT_STATUS_CD                                            
MFA-TR*             ,EVENT_PROCESS_CD                                           
MFA-TR*             ,EVENT_VENDOR_NM                                            
MFA-TR*             ,EVENT_IMAGE_REQ_FL                                         
MFA-TR*             ,COMM_RECORD_FL                                             
MFA-TR*             ,EVENT_PRIORITY_CD                                          
MFA-TR*             ,EVENT_COMPONENT_NM                                         
MFA-TR*             ,STRIP(EMAIL_EVENT_DESC) AS EMAIL_EVENT_DESC                
MFA-TR*             ,COMM_TYPE_CODE                                             
MFA-TR*             ,COMM_SUBTYPE_CODE                                          
MFA-TR*       FROM CSS_EMAIL_EVENT                                              
MFA-TR*       WHERE EVENT_STATUS_CD = 'A'                                       
MFA-TR*       ORDER BY COMPANY_NO                                               
MFA-TR*              ,EMAIL_EVENT_CD                                            
MFA-TR*              ,EVENT_CHANNEL_CD                                          
MFA-TR*              ,REG_GROUP_CD                                              
MFA-TR*       FOR FETCH ONLY WITH UR                                            
MFA-TR*       QUERYNO 7210                                                      
MFA-TR*    END-EXEC.                                                            
      *                                                                         
      *********************** END OF DECLARATIVES **********************        
      *                                                                         
       LINKAGE SECTION.                                                 
       01  LS-PARM.                                                     
           05  LS-PARMLEN                    PIC S9(03) COMP.           
           05  LS-COMPANY-NO                 PIC X(02).                 
           05  LS-DLM                        PIC X(01).                 
           05  LS-PARTITION-NO               PIC X(01).                 
                                                                        
      ******************************************************************        
       PROCEDURE DIVISION USING LS-PARM.                                
      ******************************************************************        
                                                                        
      *================================================================*        
       0000-MAINLINE.                                                   
      *================================================================*        
      *                                                                         
           PERFORM 0100-INITIALIZATION      THRU 0100-EXIT.             
      *                                                                         
           PERFORM 1000-PROCESS-BATCH-EMAIL THRU 1000-EXIT              
             UNTIL FCS271-EOF-REACHED.                                  
      *                                                                         
      ******************************************************************        
      * THE FOLLOWING STATEMENTS UPGRADE THE JOB-COMPLETE FIELD TO     *        
      * INDICATE A SUCCESSFUL COMPLETION:                              *        
      ******************************************************************        
      *                                                                         
           MOVE SPACES                   TO WS-RESTART-JOB-COMPLETE.    
                                                                        
           IF WS-THIS-IS-A-RESTART                                      
              SET WS-RERUN-COMPLETED             TO TRUE                
           ELSE                                                         
              SET WS-RUN-COMPLETED-NO-PROBLEMS   TO TRUE                
           END-IF.                                                      
                                                                        
           IF  WS-CHKP-LUW-LIMIT EQUAL WS-FLAG-TO-TURN-OFF-COMMITS      
               AND WS-CHKP-UPD-LIMIT EQUAL WS-FLAG-TO-TURN-OFF-COMMITS  
               NEXT SENTENCE                                            
           ELSE                                                         
               PERFORM 6025-ISSUE-CHKP      THRU 6025-EXIT              
           END-IF.                                                      
                                                                        
           IF  WS-RESTART-REQ EQUAL WS-YES                              
               PERFORM 8893-RESET-RESTART-REQ-PARM  THRU 8893-EXIT      
           END-IF.                                                      
      *                                                                         
           PERFORM 9000-TERMINATE           THRU 9000-EXIT.             
      *                                                                         
           MOVE WS-FCSCA271-REC-CNTR     TO WS-TOTAL-RECORDS-STR.       
           DISPLAY '  '                                                 
           DISPLAY '   TOTAL RECORDS PROCESSED: ' WS-TOTAL-RECORDS-STR  
           DISPLAY ' '                                                  
      *                                                                         
           DISPLAY '  '                                                 
           DISPLAY '**********************************************'     
           DISPLAY '**             PCSCA272                     **'     
           DISPLAY '**     PROGRAM COMPLETED SUCCESSFULLY.      **'     
           DISPLAY '**                                          **'     
           DISPLAY '**********************************************'     
      *                                                                         
           STOP RUN.                                                    
      *                                                                         
       0000-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      *================================================================*        
       0100-INITIALIZATION.                                             
      *================================================================*        
      *                                                                         
           PERFORM 0110-OPEN-IO-FILES     THRU 0110-EXIT.               
      *                                                                         
      *** GET JCLPARM TO DETERMINE WHICH COMPANY THE JOB IS RUNNING FOR         
           IF LS-PARMLEN > ZERO                                         
              MOVE LS-COMPANY-NO      TO WS-RUN-FOR-COMPANY             
           END-IF.                                                      
                                                                        
           EVALUATE TRUE                                                
              WHEN SCEG-RUN                                             
                   MOVE LS-PARTITION-NO    TO WS-PARTITION-NO           
                   DISPLAY " RUNNING FOR COMPANY SCE&G "                
                           " LS-COMPANY-NO " LS-COMPANY-NO              
                   DISPLAY " "                                          
              WHEN PSNC-RUN                                             
                   MOVE LS-PARTITION-NO    TO WS-PARTITION-NO           
                   DISPLAY " RUNNING FOR COMPANY PSNC  "                
                           " LS-COMPANY-NO " LS-COMPANY-NO              
                   DISPLAY " "                                          
              WHEN SEB-RUN                                              
                   MOVE LS-PARTITION-NO    TO WS-PARTITION-NO           
                   DISPLAY " RUNNING FOR COMPANY SEB (DE-REGULATED)"    
                           " LS-COMPANY-NO " LS-COMPANY-NO              
                   DISPLAY " "                                          
              WHEN SEBR-RUN                                             
                   MOVE LS-PARTITION-NO    TO WS-PARTITION-NO           
                   DISPLAY " RUNNING FOR COMPANY SEB (REGULATED)"       
                           " LS-COMPANY-NO " LS-COMPANY-NO              
                   DISPLAY " "                                          
              WHEN OTHER                                                
                   DISPLAY '********** PCSCA272 ERROR ****************' 
                   DISPLAY "    0100-INITIALIZATION    "                
                   DISPLAY " INVALID COMPANY CODE..... "                
                   DISPLAY " LS-COMPANY-NO " LS-COMPANY-NO              
                   DISPLAY '** PROCESSING TERMINATED                **' 
                   DISPLAY '******************************************' 
                   PERFORM 9900-ABEND            THRU 9900-EXIT         
           END-EVALUATE.                                                
      *                                                                         
                                                                        
      *** GET COMMON DATE IF NO OVERRIDE DATE SPECIFIED                         
           PERFORM 6251-GET-FJC01-DATE      THRU 6251-EXIT.             
           IF  COMMON-DATE-NEEDED                                       
               PERFORM 6240-GET-FCA00-COMMON-DATE                       
                                            THRU 6240-EXIT              
               DISPLAY 'COMMON DATE USED ==> ' WS-FCA00-COMMON-DATE     
               DISPLAY ' '                                              
               MOVE WS-FCA00-COMMON-DATE  TO WS-INPUT-DATE              
           END-IF.                                                      
           DISPLAY 'RUN DATE         ==> ' WS-INPUT-DATE.               
      *                                                                         
      **** LOAD CSS_EMAIL_EVENT TABLE IN TO AN ARRAY                            
           PERFORM 0400-LOAD-EMAIL-EVENT-TAB     THRU 0400-EXIT.        
      *                                                                         
           PERFORM 6253-GET-FJC01-CHKP-LIMIT     THRU 6253-EXIT.        
           IF WS-CHKP-LUW-LIMIT EQUAL WS-FLAG-TO-TURN-OFF-COMMITS       
             AND WS-CHKP-UPD-LIMIT EQUAL WS-FLAG-TO-TURN-OFF-COMMITS    
              SET COMMITS-NOT-REQUIRE  TO TRUE                          
              DISPLAY ' '                                               
              DISPLAY '**   ' WS-PGRMNAME ' INFORMATIONAL MSG    **'    
              DISPLAY '**   CHKP-LUW AND CHKP-UPD PARMS   **'           
              DISPLAY '** BOTH SET TO ' WS-FLAG-TO-TURN-OFF-COMMITS     
                      ', INTERPRETED TO**'                              
              DISPLAY '**  INDICATE THAT INTERIM COMMIT   **'           
              DISPLAY '**   POINTS SHOULD NOT BE TAKEN.   **'           
              DISPLAY '** COMPLETE RERUN WILL BE REQUIRED **'           
              DISPLAY '**  UPON UNSUCCESSFUL COMPLETION.  **'           
              DISPLAY '**      PROCESSING CONTINUING      **'           
           END-IF.                                                      
      *                                                                         
      *** CHECK JOB_PARM TABLE TO GET WS-RESTART-REQ FLAG                       
           PERFORM 6235-GET-FJC01-RESTART-REQ  THRU 6235-EXIT.          
      *                                                                         
      *** CHECK CSS_RESTART TABLE TO GET PRIOR RUN LAST COMMITED DATA           
           PERFORM 0600-CHECK-FOR-RESTART    THRU 0600-EXIT.            
      *                                                                         
      *** VALIDATE JOB_PARM & CSS_RESTART STATUSES                              
           PERFORM 0605-VALIDATE-RESTART-REQ   THRU 0605-EXIT.          
      *                                                                         
           IF WS-THIS-IS-A-RESTART                                      
              PERFORM 0601-REPOSITION-INPUT-FILE  THRU 0601-EXIT        
           ELSE                                                         
              PERFORM 0610-INITIALIZE-RESTART     THRU 0610-EXIT        
              PERFORM 7000-READ-FCSCA271          THRU 7000-EXIT        
           END-IF.                                                      
      *                                                                         
           PERFORM 3000-GET-FCSCA271-DATA      THRU 3000-EXIT.          
      *                                                                         
       0100-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      *================================================================*        
       0110-OPEN-IO-FILES.                                              
      *================================================================*        
      *                                                                         
           OPEN INPUT FCSCA271-FILE.                                    
                                                                        
           IF  FCS271-SUCCESSFUL                                        
               CONTINUE                                                 
           ELSE                                                         
              DISPLAY '************ PCSCA272 ERROR ******************'  
              DISPLAY '** ERROR IN  0100-INITIALIZATION            **'  
              DISPLAY '**   FILE FCSCA271 OPEN INPUT               **'  
              DISPLAY '** FILE STATUS = ' WS-FCS271-STATUS              
              DISPLAY '** PROCESSING TERMINATED                    **'  
              DISPLAY '**********************************************'  
              PERFORM 9900-ABEND            THRU 9900-EXIT              
           END-IF.                                                      
      *                                                                         
       0110-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      *================================================================*        
       0400-LOAD-EMAIL-EVENT-TAB.                                       
      *================================================================*        
      *                                                                         
           INITIALIZE WS-EMAIL-EVENT-TABLE.                             
      *                                                                         
           PERFORM 7210-OPEN-EVENT-CURSOR   THRU 7210-EXIT.             
      *                                                                         
           PERFORM 7220-FETCH-EVENT-CURSOR  THRU 7220-EXIT              
      *                                                                         
           IF WS-EVENT-COUNT = 0                                        
              DISPLAY '****************************************'        
              DISPLAY '**   PCSCA271 PROCESSING ERROR        **'        
              DISPLAY '**   ABEND IN PARAGRAPH 0400          **'        
              DISPLAY '***     ZERO ROWS SELECTED            **'        
              DISPLAY '***    FROM CSS_EMAIL_EVENT           **'        
              DISPLAY '****************************************'        
              PERFORM 9900-ABEND            THRU 9900-EXIT              
           END-IF                                                       
      *                                                                         
           IF WS-EVENT-COUNT >= 100                                     
              DISPLAY '*********************************************'   
              DISPLAY '**   PCSCA271 PROCESSING ERROR             **'   
              DISPLAY '**   ABEND IN PARAGRAPH 0400               **'   
              DISPLAY '***         ARRAY OVERFLOW:                **'   
              DISPLAY '** EXPECTED EMAIL_EVENT ROWS ARE BELOW 100 **'   
              DISPLAY '*********************************************'   
              PERFORM 9900-ABEND            THRU 9900-EXIT              
           END-IF                                                       
      *                                                                         
           PERFORM 7230-CLOSE-EVENT-CURSOR  THRU 7230-EXIT.             
      *                                                                         
       0400-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      *================================================================*        
       0600-CHECK-FOR-RESTART.                                          
      *================================================================*        
      *                                                                         
           MOVE PROGRAM-NAME               TO RF-NAME-PROGRAM.          
           MOVE WS-PARTITION-NO            TO RF-PARTITION-NO.          
           MOVE 1                          TO RF-DUP-CNTRL-NO.          
           PERFORM 7400-SELECT-RESTART-DATA  THRU 7400-EXIT.            
           IF  WS-ACTIVE-RETURN-CODE EQUAL SUCCESSFUL-CALL              
               MOVE RF-RESTART-DATA-TEXT   TO WS-RESTART-DATA           
               IF  WS-RESTART-PROCESS-TYPE NUMERIC                      
                   MOVE WS-Y               TO WS-IS-THIS-A-RESTART      
               END-IF                                                   
           END-IF.                                                      
      *                                                                         
       0600-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      *================================================================*        
       0601-REPOSITION-INPUT-FILE.                                      
      *================================================================*        
      *                                                                         
           MOVE ZERO                       TO WS-FCSCA271-REC-CNTR.     
      *                                                                         
           PERFORM 7000-READ-FCSCA271          THRU 7000-EXIT           
             UNTIL WS-FCSCA271-REC-CNTR EQUAL WS-RESTART-RECORD-NO      
              OR FCS271-READ-EOF.                                       
      *                                                                         
      *****************************************************************         
      *    THE FOLLOWING CODE COMPARES KEY VALUES STORED IN                     
      *    RESTART DATA WITH REPOSITIONED RECORD KEY.                           
      *****************************************************************         
           IF WS-RESTART-REC-100-BYTES = WS-HOLD-FIRST-100-BYTES        
              CONTINUE                                                  
           ELSE                                                         
              DISPLAY '***************************************'         
              DISPLAY '** FAIL TO REPOSITION BW84 FILE      **'         
              DISPLAY '** CHECK FOR CORRECT BW84 FILE       **'         
              DISPLAY '** LAST DATA PROCESSED IN PRIOR RUN: '           
              DISPLAY WS-RESTART-REC-100-BYTES                          
              DISPLAY '** BUT FILE POSITIONED AT          : '           
              DISPLAY WS-HOLD-FIRST-100-BYTES                           
              DISPLAY '***************************************'         
              PERFORM 9900-ABEND            THRU 9900-EXIT              
           END-IF.                                                      
      *                                                                         
           DISPLAY ' '                                                  
           DISPLAY '*******************************************'.       
           DISPLAY '*****  THIS IS A RESTART OF PCSBW184  *****'.       
           DISPLAY '*******************************************'.       
           MOVE WS-RESTART-RECORD-NO         TO WS-FCSCA271-REC-CNTR.   
           MOVE WS-RESTART-CHKP-SEQ-NO       TO WS-CHKP-SEQ-NO.         
      *                                                                         
       0601-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      *================================================================*        
       0610-INITIALIZE-RESTART.                                         
      *================================================================*        
      *                                                                         
           MOVE ZEROS                      TO WS-RESTART-CHKP-SEQ-NO    
                                              WS-RESTART-RECORD-NO      
           MOVE SPACES                     TO WS-RESTART-REC-100-BYTES  
           MOVE 1                          TO WS-RESTART-PROCESS-TYPE   
           SET WS-RERUN-PENDING            TO TRUE.                     
           MOVE WS-INPUT-DATE              TO WS-RESTART-INPUT-DATE.    
      *                                                                         
       0610-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      *================================================================*        
      *  0605-VALIDATE-RESTART-REQ                                              
       COPY CPD00030.                                                           
      *================================================================*        
      *                                                                         
      *================================================================*        
       1000-PROCESS-BATCH-EMAIL.                                        
      *================================================================*        
      *                                                                         
           DISPLAY 'ACCOUNT NO: ' WS-ACCOUNT-NO ' EMAIL ID: '           
                                  WS-BATCH-EMAIL-ID.                    
                                                                        
           INITIALIZE DCLCSS-NAME-ACCT-XREF                             
                      DCLCSS-ACCOUNT.                                   
                                                                        
           MOVE WS-ACCOUNT-NO            TO AT-ACCOUNT-NO.              
           PERFORM 4000-MAIL-NAME-ADDRESS   THRU 4000-EXIT.             
                                                                        
           MOVE SPACES                   TO WS-EMAIL-EVENT-DESC         
                                            WS-EVENT-VENDOR-NM          
                                            WS-COMM-TYPE-CODE           
                                            WS-COMM-SUBTYPE-CODE.       
           PERFORM 5000-LOOKUP-EMAIL-EVENT  THRU 5000-EXIT.             
                                                                        
           IF ARR-MATCH-FOUND                                           
              PERFORM 1500-INSRT-MATCHED-RECD THRU 1500-EXIT            
           END-IF.                                                      
                                                                        
           COMPUTE WS-COMMIT-COUNTER = WS-COMMIT-COUNTER + 1            
                                                                        
           IF COMMITS-REQUIRE                                           
              AND WS-COMMIT-COUNTER >= WS-CHKP-LUW-LIMIT                
              PERFORM 6025-ISSUE-CHKP           THRU 6025-EXIT          
           END-IF.                                                      
                                                                        
           PERFORM 3000-GET-FCSCA271-DATA   THRU 3000-EXIT.             
      *                                                                         
       1000-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      *================================================================*        
       1500-INSRT-MATCHED-RECD.                                         
      *================================================================*        
      *                                                                         
           PERFORM 2000-GET-COMM-DATA       THRU 2000-EXIT.             
                                                                        
           MOVE ZEROS TO WS-803-CTR.                                    
           SET COMM-DATA-NOT-INSERTED TO TRUE.                          
                                                                        
           PERFORM 2500-CREATE-COMM-DATA    THRU 2500-EXIT              
             UNTIL COMM-DATA-INSERTED.                                  
                                                                        
A04867     IF IMAGE-REQ-FL-NOT-SET                                      
A04867        MOVE ZEROS TO WS-803-CTR                                  
A04867        SET COMM-CMNT-NOT-INSERTED TO TRUE                        
A04867                                                                  
A04867        PERFORM 5100-CREATE-COMM-COMMENT THRU 5100-EXIT           
A04867          UNTIL COMM-CMNT-INSERTED                                
A04867                                                                  
A04867     END-IF.                                                      
A04867                                                                  
           IF COMM-DATA-INSERTED                                        
              MOVE WS-Y                  TO AE-COMM-DATA-CD             
              MOVE WS-DELIVERED          TO AE-PROCESSED-CD             
              MOVE WS-INPUT-DATE         TO AE-PROCESSED-DT             
              MOVE WS-BATCH-EMAIL-ID     TO AE-BATCH-EMAIL-ID           
              PERFORM 8500-UPDATE-BATCH-EML THRU 8500-EXIT              
           END-IF.                                                      
      *                                                                         
       1500-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      *===============================================================*         
       2000-GET-COMM-DATA.                                              
      *===============================================================*         
      *                                                                         
           MOVE WS-ACCOUNT-NO            TO KO-ACCOUNT-NO.              
           MOVE WS-CUSTOMER-NO           TO KO-CUSTOMER-NO.             
           MOVE ZEROS                    TO KO-PREMISE-NO.              
           MOVE WS-COMPANY-NO            TO KO-COMPANY-NO.              
           MOVE WS-COMM-TYPE-CODE        TO KO-COMM-TYPE-CD.            
           MOVE WS-COMM-SUBTYPE-CODE     TO KO-COMM-SUBTYPE-CODE.       
           MOVE SPACES                   TO KO-RED-FLAG-IND.            
           MOVE SPACES                   TO KO-RED-FLAG-EXPIRE-DT.      
           MOVE -1                       TO WS-RED-FL-NULL-IND.         
           MOVE WS-E                     TO KO-COMM-METHOD.             
           MOVE WS-O                     TO KO-COMM-DIRECTION.          
           MOVE SPACES                   TO KO-PROMOTION-ID.            
           MOVE SPACES                   TO KO-PSC-COMPLIANCE-IND.      
           MOVE WS-USER-ID-ORIG          TO KO-USER-ID-ORIG.            
           MOVE 0                        TO KO-CALL-ORIGIN-ID.          
           MOVE SPACES                   TO KO-CALL-END-TIME.           
           MOVE -1                       TO WS-CALL-END-NULL-IND.       
           MOVE 0                        TO KO-NUMBER-TRANSFERS.        
           MOVE 0                        TO KO-HOLD-TIME.               
           MOVE 0                        TO KO-QUEUE-TIME.              
           MOVE WS-N                     TO KO-SCREEN-POP-IND.          
           MOVE 0                        TO KO-TOTAL-CALL-TIME.         
           MOVE SPACES                   TO KO-RESPONSE-REASON-CD.      
           MOVE SPACES                   TO KO-RESPONSE-TYPE-CD.        
           MOVE SPACES                   TO KO-SOLICITATION-CD.         
           MOVE WS-N                     TO KO-COMPLAINT-FL.            
           MOVE SPACES                   TO KO-DISCOVERY-MTHD-CD.       
           MOVE SPACES                   TO KO-PREV-MARKETER-CD.        
                                                                        
           IF WS-ACCOUNT-NO > 0                                         
              MOVE 'A'                   TO KO-COMM-ASSOC-CD            
           ELSE                                                         
             IF WS-CUSTOMER-NO > 0                                      
                MOVE 'C'                 TO KO-COMM-ASSOC-CD            
             ELSE                                                       
                MOVE 'P'                 TO KO-COMM-ASSOC-CD            
             END-IF                                                     
           END-IF.                                                      
                                                                        
P00585     INITIALIZE WS-FORMAT-DATE.                                   
P00585     MOVE WS-INPUT-DATE(1:4)       TO WS-FMT-YYYY.                
P00585     MOVE WS-INPUT-DATE(6:2)       TO WS-FMT-MM.                  
P00585     MOVE WS-INPUT-DATE(9:2)       TO WS-FMT-DD.                  
                                                                        
           STRING WS-EMAIL-EVENT-DESC DELIMITED BY '   '                
                  ' SENT ON '                                           
P00585            WS-FORMAT-DATE      DELIMITED BY SIZE                 
                  ' TO '                                                
                  WS-CUST-EMAIL-ID    DELIMITED BY '  '                 
                  ' BY '                                                
                  WS-EVENT-VENDOR-NM  DELIMITED BY '  '                 
                  ' - '                                                 
                  'ECS BATCH EMAIL '                                    
                  WS-EMAIL-EVENT-CD   DELIMITED BY SIZE                 
             INTO WS-INITIAL-COMMENT-TEXT.                              
                                                                        
           MOVE LENGTH OF WS-INITIAL-COMMENT-TEXT                       
                                         TO KO-INITIAL-COMMENT-TX-LEN.  
           MOVE WS-INITIAL-COMMENT-TEXT  TO KO-INITIAL-COMMENT-TX-TEXT. 
           MOVE WS-CUSTOMER-NAME         TO KO-CONTACT-NAME.            
                                                                        
           MOVE SPACES                   TO WS-CUSTOMER-NAME            
                                            WS-INITIAL-COMMENT-TEXT.    
      *                                                                         
       2000-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      *===============================================================*         
       2500-CREATE-COMM-DATA.                                           
      *===============================================================*         
      *                                                                         
           MOVE SPACES                   TO WS-CURR-TIMESTMP.           
                                                                        
           PERFORM 7200-GET-CURR-TIMESTMP   THRU 7200-EXIT.             
           MOVE WS-CURR-TIMESTMP         TO KO-COMMUNICATION-ID         
A04867                                      AE-COMMUNICATION-ID         
A04867                                      KN-COMMUNICATION-ID.        
                                                                        
           PERFORM 8400-INSERT-COMM-DATA    THRU 8400-EXIT.             
      *                                                                         
       2500-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      *===============================================================*         
       3000-GET-FCSCA271-DATA.                                          
      *===============================================================*         
      *                                                                         
           MOVE SPACES                   TO WS-HOLD-FIRST-100-BYTES.    
           PERFORM 7000-READ-FCSCA271       THRU 7000-EXIT.             
      *                                                                         
           IF FCS271-READ-EOF                                           
              GO TO 3000-EXIT
           END-IF.                                          
      *                                                                         
           IF FCS271-SUCCESSFUL                                         
              INITIALIZE  WS-UNSTRING-CA271-REC                         
              UNSTRING FIOCA271-REC DELIMITED BY '|'                    
                  INTO WS-CUSTOMER-NO                                   
                       WS-ACCOUNT-NO                                    
                       WS-FIRST-NAM                                     
                       WS-LAST-NAM                                      
                       WS-CUST-EMAIL-ID                                 
                       WS-BATCH-EMAIL-ID                                
                       WS-EMAIL-EVENT-CD                                
                       WS-EMAIL-EVENT-DT                                
                       WS-COMPANY-NO                                    
                       WS-EMAIL-DISP-CD                                 
                       WS-ACCNO-MASK                                    
                       WS-EVENT-CHANNL-CD                               
                       WS-REG-GROUP-CD                                  
                       WS-PROCESS-CD                                    
                       WS-PREM-ADDR                                     
                       WS-BANK-ACCT                                     
                       WS-DRAFT-DT                                      
                       WS-DRAFT-AMT                                     
                       WS-BILLD-DT                                      
                       WS-BILLD-AMT                                     
                       WS-CHRGE-DT                                      
                       WS-CHRGE-AMT                                     
                       WS-SCHED-DT                                      
                       WS-UTIL-TYPE                                     
                       WS-REQ-TYPE                                      
                       WS-CONTACT-INFO                                  
                       WS-APPT-ARRG                                     
                       WS-DEP-AMT                                       
                       WS-CUST-NAME                                     
P#0730                 WS-GUID-LINK                                     
              END-UNSTRING                                              
           END-IF.                                                      
A04867*                                                                         
A04867     IF WS-BILLD-DT > SPACES                                      
A04867        MOVE SPACES TO                    WS-COMMON-TXT           
A04867        MOVE WS-BILLD-DT TO               WS-COMMON-TXT           
A04867        PERFORM 3100-LOOKUP-EXTRA-SPACE  THRU 3100-EXIT           
A04867        MOVE WS-COMMON-TXT-POINTER TO     WS-BILLD-DT-POINTER     
A04867     END-IF.                                                      
A04867*                                                                         
A04867     IF WS-BILLD-AMT > SPACES                                     
A04867        MOVE SPACES TO                    WS-COMMON-TXT           
A04867        MOVE WS-BILLD-AMT TO              WS-COMMON-TXT           
A04867        PERFORM 3100-LOOKUP-EXTRA-SPACE  THRU 3100-EXIT           
A04867        MOVE WS-COMMON-TXT-POINTER TO     WS-BILLD-AMT-POINTER    
A04867     END-IF.                                                      
A04867*                                                                         
A04867     IF WS-DRAFT-DT > SPACES                                      
A04867        MOVE SPACES TO                    WS-COMMON-TXT           
A04867        MOVE WS-DRAFT-DT TO               WS-COMMON-TXT           
A04867        PERFORM 3100-LOOKUP-EXTRA-SPACE  THRU 3100-EXIT           
A04867        MOVE WS-COMMON-TXT-POINTER TO     WS-DRAFT-DT-POINTER     
A04867     END-IF.                                                      
A04867*                                                                         
A04867     IF WS-DRAFT-AMT > SPACES                                     
A04867     MOVE SPACES TO                    WS-COMMON-TXT              
A04867     MOVE WS-DRAFT-AMT TO              WS-COMMON-TXT              
A04867     PERFORM 3100-LOOKUP-EXTRA-SPACE  THRU 3100-EXIT              
A04867     MOVE WS-COMMON-TXT-POINTER TO     WS-DRAFT-AMT-POINTER       
A04867     END-IF.                                                      
A04867*                                                                         
A04867     IF WS-SCHED-DT > SPACES                                      
A04867        MOVE SPACES TO                    WS-COMMON-TXT           
A04867        MOVE WS-SCHED-DT TO               WS-COMMON-TXT           
A04867        PERFORM 3100-LOOKUP-EXTRA-SPACE  THRU 3100-EXIT           
A04867        MOVE WS-COMMON-TXT-POINTER TO     WS-SCHED-DT-POINTER     
A04867     END-IF.                                                      
A04867*                                                                         
A04867     IF WS-DEP-AMT > SPACES                                       
A04867        MOVE SPACES TO                    WS-COMMON-TXT           
A04867        MOVE WS-DEP-AMT TO                WS-COMMON-TXT           
A04867        PERFORM 3100-LOOKUP-EXTRA-SPACE  THRU 3100-EXIT           
A04867        MOVE WS-COMMON-TXT-POINTER TO     WS-DEP-AMT-POINTER      
A04867     END-IF.                                                      
A04867*                                                                         
A04867     IF WS-CHRGE-DT > SPACES                                      
A04867        MOVE SPACES TO                    WS-COMMON-TXT           
A04867        MOVE WS-CHRGE-DT TO               WS-COMMON-TXT           
A04867        PERFORM 3100-LOOKUP-EXTRA-SPACE  THRU 3100-EXIT           
A04867        MOVE WS-COMMON-TXT-POINTER TO     WS-CHRGE-DT-POINTER     
A04867     END-IF.                                                      
A04867*                                                                         
A04867     IF WS-CHRGE-AMT > SPACES                                     
A04867        MOVE SPACES TO                    WS-COMMON-TXT           
A04867        MOVE WS-CHRGE-AMT TO              WS-COMMON-TXT           
A04867        PERFORM 3100-LOOKUP-EXTRA-SPACE  THRU 3100-EXIT           
A04867        MOVE WS-COMMON-TXT-POINTER TO     WS-CHRGE-AMT-POINTER    
A04867     END-IF.                                                      
A04867*                                                                         
A04867     IF WS-BANK-ACCT > SPACES                                     
A04867        MOVE SPACES TO                    WS-COMMON-TXT           
A04867        MOVE WS-BANK-ACCT TO              WS-COMMON-TXT           
A04867        PERFORM 3100-LOOKUP-EXTRA-SPACE  THRU 3100-EXIT           
A04867        MOVE WS-COMMON-TXT-POINTER TO     WS-BANK-ACCT-POINTER    
A04867     END-IF.                                                      
      *                                                                         
       3000-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
A04867*===============================================================*         
A04867 3100-LOOKUP-EXTRA-SPACE.                                         
A04867*===============================================================*         
A04867*                                                                         
A04867     MOVE SPACES TO                WS-COMMON-TXT-REVERSED.        
A04867     MOVE ZEROES TO                WS-COMMON-TXT-CHARS.           
A04867*                                                                         
A04867*                                                                         
A04867     MOVE FUNCTION REVERSE (WS-COMMON-TXT) TO                     
A04867                                   WS-COMMON-TXT-REVERSED.        
A04867*                                                                         
A04867     INSPECT WS-COMMON-TXT-REVERSED                               
A04867     TALLYING WS-COMMON-TXT-CHARS FOR LEADING SPACES.             
A04867*                                                                         
A04867     COMPUTE WS-COMMON-TXT-POINTER =                              
A04867     FUNCTION                                                     
A04867     LENGTH(WS-COMMON-TXT-REVERSED) - WS-COMMON-TXT-CHARS.        
A04867*                                                                         
A04867 3100-EXIT.                                                       
A04867     EXIT.                                                        
A04867*                                                                         
      *================================================================*        
      ** 4000-MAIL-NAME-ADDRESS                                                 
      *================================================================*        
      **** INCLUDE COPY BOOK TO RETRIEVE NAMES AND ADDRESSES     **             
      *                                                                         
           EXEC SQL                                                             
                INCLUDE CPD00074                                                
           END-EXEC.                                                            
      *                                                                         
      *===============================================================*         
       5000-LOOKUP-EMAIL-EVENT.                                         
      *===============================================================*         
      *                                                                         
           SET ARR-MATCH-NOT-FOUND TO TRUE.                             
                                                                        
           PERFORM VARYING WS-EVENT-SUB FROM 1 BY 1                     
             UNTIL WS-EVENT-SUB > WS-EVENT-COUNT                        
                OR   WS-EVENT-SUB > 100                                 
                OR   ARR-MATCH-FOUND                                    
                                                                        
               IF TAB-COMPANY-NO (WS-EVENT-SUB) = WS-COMPANY-NO         
                  AND TAB-EMAIL-EVENT-CD (WS-EVENT-SUB) =               
                                                  WS-EMAIL-EVENT-CD     
                  AND TAB-EVENT-CHANNEL-CD (WS-EVENT-SUB) =             
                                                  WS-EVENT-CHANNL-CD    
                  MOVE TAB-EMAIL-EVENT-DESC (WS-EVENT-SUB)              
                    TO WS-EMAIL-EVENT-DESC                              
                  MOVE TAB-EVENT-VENDOR-NM (WS-EVENT-SUB)               
                    TO WS-EVENT-VENDOR-NM                               
                  MOVE TAB-COMM-TYPE-CODE (WS-EVENT-SUB)                
                    TO WS-COMM-TYPE-CODE                                
                  MOVE TAB-COMM-SUBTYPE-CODE (WS-EVENT-SUB)             
                    TO WS-COMM-SUBTYPE-CODE                             
A04867            MOVE TAB-EVENT-IMAGE-REQ-FL(WS-EVENT-SUB)             
A04867              TO WS-EVENT-IMAGE-REQ-FL                            
                  SET ARR-MATCH-FOUND TO TRUE                           
               END-IF                                                   
                                                                        
           END-PERFORM.                                                 
                                                                        
           IF ARR-MATCH-NOT-FOUND                                       
              DISPLAY ' '                                               
              DISPLAY ' RECORD NOT MATCHED WITH CSS_EMAIL_EVENT TABLE'  
              DISPLAY ' WS-COMPANY-NO      ' WS-COMPANY-NO              
              DISPLAY ' WS-EMAIL-EVENT-CD  ' WS-EMAIL-EVENT-CD          
              DISPLAY ' WS-EVENT-CHANNL-CD ' WS-EVENT-CHANNL-CD         
              DISPLAY ' WS-REG-GROUP-CD    ' WS-REG-GROUP-CD            
              DISPLAY ' '                                               
           END-IF.                                                      
      *                                                                         
       5000-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
A04867*================================================================*        
A04867 5100-CREATE-COMM-COMMENT.                                        
A04867*================================================================*        
A04867*                                                                         
A04867     INITIALIZE  KN-COMMENT-TX-TEXT.                              
A04867                                                                  
A04867     EVALUATE  WS-EMAIL-EVENT-CD                                  
A04867          WHEN "ECS02"                                            
A04867          WHEN "ECS04"                                            
A04867          WHEN "ECS08"                                            
A04867          WHEN "ECS17"                                            
A04867               STRING 'DATE DUE: '   DELIMITED BY SIZE            
A04867                      WS-BILLD-DT(1:WS-BILLD-DT-POINTER)          
A04867                                     DELIMITED BY SIZE            
A04867                      WS-SEMI-COLON  DELIMITED BY SIZE            
A04867                      'AMOUNT DUE: ' DELIMITED BY SIZE            
A04867                      WS-BILLD-AMT(1:WS-BILLD-AMT-POINTER)        
A04867                                     DELIMITED BY SIZE            
A04867                 INTO KN-COMMENT-TX-TEXT                          
A04867                 MOVE WS-USER-ID-ORIG        TO KN-USER-ID        
A04867                 MOVE +255                   TO KN-COMMENT-TX-LEN 
A04867                 PERFORM 8000-INSRT-COMM-COMMENT                  
A04867                                             THRU 8000-EXIT       
A04867          WHEN "ECS03"                                            
A04867          WHEN "ECS07"                                            
A04867          WHEN "ECS11"                                            
A04867          WHEN "ECS12"                                            
A04867               STRING 'BANK ACCT ENDING IN: '                     
A04867                                     DELIMITED BY SIZE            
A04867                      WS-BANK-ACCT(1:WS-BANK-ACCT-POINTER)        
A04867                                     DELIMITED BY SIZE            
A04867                      WS-SEMI-COLON  DELIMITED BY SIZE            
A04867                      'DATE OF BANK DRAFT: '                      
A04867                                     DELIMITED BY SIZE            
A04867                      WS-DRAFT-DT(1:WS-DRAFT-DT-POINTER)          
A04867                                     DELIMITED BY SIZE            
A04867                      WS-SEMI-COLON  DELIMITED BY SIZE            
A04867                      'AMOUNT TO BE DRAFTED: '                    
A04867                                     DELIMITED BY SIZE            
A04867                      WS-DRAFT-AMT(1:WS-DRAFT-AMT-POINTER)        
A04867                                     DELIMITED BY SIZE            
A04867                 INTO KN-COMMENT-TX-TEXT                          
A04867                 MOVE WS-USER-ID-ORIG        TO KN-USER-ID        
A04867                 MOVE +255                   TO KN-COMMENT-TX-LEN 
A04867                 PERFORM 8000-INSRT-COMM-COMMENT                  
A04867                                             THRU 8000-EXIT       
A04867          WHEN "ECS23"                                            
A04867               STRING 'DEPOSIT REQUIRED: '                        
A04867                                     DELIMITED BY SIZE            
A04867                      WS-DEP-AMT(1:WS-DEP-AMT-POINTER)            
A04867                                     DELIMITED BY SIZE            
A04867                      WS-SEMI-COLON  DELIMITED BY SIZE            
A04867                      'SCHEDULED DATE: '                          
A04867                                     DELIMITED BY SIZE            
A04867                      WS-SCHED-DT(1:WS-SCHED-DT-POINTER)          
A04867                                     DELIMITED BY SIZE            
A04867                 INTO KN-COMMENT-TX-TEXT                          
A04867                 MOVE WS-USER-ID-ORIG        TO KN-USER-ID        
A04867                 MOVE +255                   TO KN-COMMENT-TX-LEN 
A04867                 PERFORM 8000-INSRT-COMM-COMMENT                  
A04867                                             THRU 8000-EXIT       
A04867          WHEN "ECS27"                                            
A04867          WHEN "ECS28"                                            
A04867               STRING 'PAYMENT DATE: '                            
A04867                                     DELIMITED BY SIZE            
A04867                      WS-CHRGE-DT(1:WS-CHRGE-DT-POINTER)          
A04867                                     DELIMITED BY SIZE            
A04867                      WS-SEMI-COLON DELIMITED BY SIZE             
A04867                      'AMOUNT TO BE CHARGED: '                    
A04867                                     DELIMITED BY SIZE            
A04867                      WS-CHRGE-AMT(1:WS-CHRGE-AMT-POINTER)        
A04867                                     DELIMITED BY SIZE            
A04867                 INTO KN-COMMENT-TX-TEXT                          
A04867                 MOVE WS-USER-ID-ORIG        TO KN-USER-ID        
A04867                 MOVE +255                   TO KN-COMMENT-TX-LEN 
A04867                 PERFORM 8000-INSRT-COMM-COMMENT                  
A04867                                             THRU 8000-EXIT       
A04867          WHEN OTHER                                              
A04867               SET COMM-CMNT-INSERTED     TO TRUE                 
A04867          END-EVALUATE.                                           
A04867*                                                                         
A04867 5100-EXIT.                                                       
A04867     EXIT.                                                        
A04867*                                                                         
      *================================================================*        
       6025-ISSUE-CHKP.                                                 
      *================================================================*        
      *                                                                         
           ADD 1                       TO WS-CHKP-SEQ-NO.               
           MOVE WS-CHKP-SEQ-NO         TO WS-RESTART-CHKP-SEQ-NO.       
           MOVE WS-FCSCA271-REC-CNTR   TO WS-RESTART-RECORD-NO          
ACT020     IF FCS271-EOF-REACHED                                        
ACT020         MOVE SPACES             TO WS-RESTART-REC-100-BYTES      
ACT020     ELSE                                                         
ACT020         MOVE FIOCA271-REC       TO WS-RESTART-REC-100-BYTES      
ACT020     END-IF.                                                      
      *                                                                         
           PERFORM 6030-WRITE-RSDDR                  THRU 6030-EXIT.    
                                                                        
           EXEC SQL                                                             
               INCLUDE CPD00047                                                 
           END-EXEC.                                                            
                                                                        
           MOVE ZEROS                  TO WS-COMMIT-COUNTER             
           DISPLAY 'COMMIT POINT# ' WS-CHKP-SEQ-NO ' TAKEN.'            
                   'LAST BATCH EMAIL ID PROCESSED :' WS-BATCH-EMAIL-ID. 
      *                                                                         
       6025-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      *================================================================*        
       6030-WRITE-RSDDR.                                                
      *================================================================*        
      *                                                                         
           MOVE WS-PARTITION-NO        TO RF-PARTITION-NO               
           MOVE 1                      TO RF-DUP-CNTRL-NO.              
           MOVE WS-RESTART-DATA        TO RF-RESTART-DATA-TEXT.         
           MOVE PROGRAM-NAME           TO RF-NAME-PROGRAM.              
           MOVE WS-RESTART-DATA-LENGTH TO RF-RESTART-DATA-LEN.          
           PERFORM 8896-UPDATE-RESTART THRU 8896-EXIT.                  
           IF WS-ACTIVE-RETURN-CODE EQUAL NOT-FOUND                     
              PERFORM 8897-INSERT-RESTART THRU 8897-EXIT                
           END-IF.                                                      
      *                                                                         
       6030-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      *** CHECK JOB PARM TABLE TO GET WS-RESTART-REQ FLAG                       
      *================================================================*        
      * 6235-GET-FJC01-RESTART-REQ.                                             
       COPY CPD00035.                                                           
      *================================================================*        
      *                                                                         
      *================================================================*        
      * 6253-GET-FJC01-CHKP-LIMIT.                                              
       COPY CPD00034.                                                           
      *================================================================*        
      *                                                                         
      *================================================================*        
       7000-READ-FCSCA271.                                              
      *================================================================*        
           READ FCSCA271-FILE                                           
                 AT END MOVE 'Y'          TO WS-FCS271-EOF.             
      *                                                                         
           EVALUATE TRUE                                                
               WHEN FCS271-SUCCESSFUL                                   
                   ADD 1                  TO WS-FCSCA271-REC-CNTR       
                   MOVE FIOCA271-REC(1:100) TO WS-HOLD-FIRST-100-BYTES  
               WHEN FCS271-READ-EOF                                     
                   CONTINUE                                             
               WHEN OTHER                                               
                  DISPLAY '****************************************'    
                  DISPLAY '** PCSBW172 PROCESSING ERROR          **'    
                  DISPLAY '** ABEND IN PARAGRAPH 7000            **'    
                  DISPLAY '** ERROR ON READING FCS271 FILE       **'    
                  DISPLAY '** FCS271 STATUS = ' WS-FCS271-STATUS        
                  DISPLAY '****************************************'    
                  PERFORM 9900-ABEND          THRU 9900-EXIT            
           END-EVALUATE.                                                
      *                                                                         
       7000-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      *================================================================*        
       7200-GET-CURR-TIMESTMP.                                          
      *================================================================*        
      *                                                                         
           EXEC SQL                                                     
              SELECT
              REPLACE(REPLACE(CONVERT(CHAR(26), CIS.CURRENT$TIMESTAMP()
           , 121), ' ', '-'), ':', '.')
            INTO
              :WS-CURR-TIMESTMP                 
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ006
MFA-TR* MSQ028
MFA-TR* MSQ061
MFA-TR*    EXEC SQL                                                             
MFA-TR*       SET :WS-CURR-TIMESTMP = 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.    
      *                                                                         
           IF WS-ACTIVE-RETURN-CODE EQUAL SUCCESSFUL-CALL               
              CONTINUE                                                  
           ELSE                                                         
              MOVE WS-ACTIVE-RETURN-CODE   TO WS-DISPLAY-SQLCODE        
              DISPLAY '************ PCSCA272 ERROR ******************'  
              DISPLAY '** ERROR IN  7200-GET-CURR-TIMESTMP         **'  
              DISPLAY '** SQL CODE         = ' WS-DISPLAY-SQLCODE       
              DISPLAY '** PROCESSING TERMINATED                    **'  
              DISPLAY '**********************************************'  
              PERFORM 9900-ABEND              THRU 9900-EXIT            
           END-IF.                                                      
      *                                                                         
       7200-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      *================================================================*        
       7210-OPEN-EVENT-CURSOR.                                          
      *================================================================*        
      *                                                                         
           EXEC SQL                                                     
                OPEN EMAIL_EVENT                                        
           END-EXEC.                                                    

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

                                                                        
           MOVE SQLCODE                TO WS-ACTIVE-RETURN-CODE.        
                                                                        
           IF WS-ACTIVE-RETURN-CODE EQUAL SUCCESSFUL-CALL               
              CONTINUE                                                  
           ELSE                                                         
              MOVE WS-ACTIVE-RETURN-CODE  TO WS-DISPLAY-SQLCODE         
              DISPLAY '****************************************'        
              DISPLAY '** PCSCA272 PROCESSING ERROR          **'        
              DISPLAY '** ABEND IN PARAGRAPH 7210            **'        
              DISPLAY '** SELECT ALL ROWS FROM CSS_EMAIL_EVENT*'        
              DISPLAY '** SQL CODE         = ' WS-DISPLAY-SQLCODE       
              DISPLAY '****************************************'        
              PERFORM 9900-ABEND  THRU 9900-EXIT                        
           END-IF.                                                      
      *                                                                         
       7210-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      *================================================================*        
       7220-FETCH-EVENT-CURSOR.                                         

MSQ008     MOVE 100 TO MSQ008-EMAIL-EVENT
      *================================================================*        
      *                                                                         
           EXEC SQL                                                     
               FOR :MSQ008-EMAIL-EVENT
              FETCH 
              FROM EMAIL_EVENT           
                INTO :TAB-COMPANY-NO                                    
                    ,:TAB-EMAIL-EVENT-CD                                
                    ,:TAB-EVENT-CHANNEL-CD                              
                    ,:TAB-REG-GROUP-CD                                  
                    ,:TAB-EVENT-STATUS-CD                               
                    ,:TAB-EVENT-PROCESS-CD                              
                    ,:TAB-EVENT-VENDOR-NM                               
                    ,:TAB-EVENT-IMAGE-REQ-FL                            
                    ,:TAB-COMM-RECORD-FL                                
                    ,:TAB-EVENT-PRIORITY-CD                             
                    ,:TAB-EVENT-COMPONENT-NM                            
                    ,:TAB-EMAIL-EVENT-DESC                              
                    ,:TAB-COMM-TYPE-CODE                                
                    ,:TAB-COMM-SUBTYPE-CODE                             
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ008
MFA-TR*    EXEC SQL                                                             
MFA-TR*        FETCH NEXT ROWSET FROM EMAIL_EVENT FOR 100 ROWS                  
MFA-TR*         INTO :TAB-COMPANY-NO                                            
MFA-TR*             ,:TAB-EMAIL-EVENT-CD                                        
MFA-TR*             ,:TAB-EVENT-CHANNEL-CD                                      
MFA-TR*             ,:TAB-REG-GROUP-CD                                          
MFA-TR*             ,:TAB-EVENT-STATUS-CD                                       
MFA-TR*             ,:TAB-EVENT-PROCESS-CD                                      
MFA-TR*             ,:TAB-EVENT-VENDOR-NM                                       
MFA-TR*             ,:TAB-EVENT-IMAGE-REQ-FL                                    
MFA-TR*             ,:TAB-COMM-RECORD-FL                                        
MFA-TR*             ,:TAB-EVENT-PRIORITY-CD                                     
MFA-TR*             ,:TAB-EVENT-COMPONENT-NM                                    
MFA-TR*             ,:TAB-EMAIL-EVENT-DESC                                      
MFA-TR*             ,:TAB-COMM-TYPE-CODE                                        
MFA-TR*             ,:TAB-COMM-SUBTYPE-CODE                                     
MFA-TR*    END-EXEC.                                                            

MSQ008      IF SQLCODE EQUAL ZERO AND
MSQ008        SQLERRD(3) < MSQ008-EMAIL-EVENT
MSQ008         MOVE 100        TO SQLCODE
MSQ008         MOVE 2000       TO SQLSTATE
MSQ008      END-IF.
MSQ017     CALL "MFASQLCA"
MSQ017       USING SQLCA, BY VALUE MFA-PROGRAM-ID, "0", "0", "0",
MSQ017       BY REFERENCE MFSQLMESSAGETEXT
MSQ017     END-CALL

                                                                        
           MOVE SQLCODE                TO WS-ACTIVE-RETURN-CODE.        
                                                                        
           IF WS-ACTIVE-RETURN-CODE EQUAL SUCCESSFUL-CALL OR NOT-FOUND  
              MOVE SQLERRD(3)              TO WS-EVENT-COUNT            
           ELSE                                                         
              MOVE WS-ACTIVE-RETURN-CODE  TO WS-DISPLAY-SQLCODE         
              DISPLAY '****************************************'        
              DISPLAY '** PCSCA271 PROCESSING ERROR          **'        
              DISPLAY '** ABEND IN PARAGRAPH 7220            **'        
              DISPLAY '** SELECT ALL ROWS FROM EMAIL_EVENT   **'        
              DISPLAY '** SQL CODE         = ' WS-DISPLAY-SQLCODE       
              DISPLAY '****************************************'        
              PERFORM 9900-ABEND  THRU 9900-EXIT                        
           END-IF.                                                      
      *                                                                         
       7220-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      *================================================================*        
       7230-CLOSE-EVENT-CURSOR.                                         
      *================================================================*        
      *                                                                         
           EXEC SQL                                                     
                CLOSE EMAIL_EVENT                                       
           END-EXEC.                                                    

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

                                                                        
           MOVE SQLCODE                TO WS-ACTIVE-RETURN-CODE.        
                                                                        
           IF WS-ACTIVE-RETURN-CODE EQUAL SUCCESSFUL-CALL               
              CONTINUE                                                  
           ELSE                                                         
              MOVE WS-ACTIVE-RETURN-CODE  TO WS-DISPLAY-SQLCODE         
              DISPLAY '****************************************'        
              DISPLAY '** PCSCA271 PROCESSING ERROR          **'        
              DISPLAY '** ABEND IN PARAGRAPH 7230            **'        
              DISPLAY '** CLOSE ERROR FOR EMAIL_EVENT        **'        
              DISPLAY '** SQL CODE      = ' WS-DISPLAY-SQLCODE          
              DISPLAY '****************************************'        
              PERFORM 9900-ABEND  THRU 9900-EXIT                        
           END-IF.                                                      
      *                                                                         
       7230-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      *================================================================*        
       7400-SELECT-RESTART-DATA.                                        
      *================================================================*        
      *                                                                         
           EXEC SQL                                                     
              SELECT RESTART_DATA                                       
                INTO :RF-RESTART-DATA                                   
                FROM CSS_RESTART WITH(READUNCOMMITTED)                          
               WHERE NAME_PROGRAM   = :RF-NAME-PROGRAM                  
                 AND PARTITION_NO   = :RF-PARTITION-NO                  
                 AND DUP_CNTRL_NO   = :RF-DUP-CNTRL-NO                  
                                                                 
                                                            
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ003
MFA-TR* MSQ022
MFA-TR*    EXEC SQL                                                             
MFA-TR*       SELECT RESTART_DATA                                               
MFA-TR*         INTO :RF-RESTART-DATA                                           
MFA-TR*         FROM CSS_RESTART                                                
MFA-TR*        WHERE NAME_PROGRAM   = :RF-NAME-PROGRAM                          
MFA-TR*          AND PARTITION_NO   = :RF-PARTITION-NO                          
MFA-TR*          AND DUP_CNTRL_NO   = :RF-DUP-CNTRL-NO                          
MFA-TR*         WITH UR                                                         
MFA-TR*        QUERYNO 7400                                                     
MFA-TR*    END-EXEC.                                                            

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

                                                                        
           MOVE SQLCODE                    TO WS-ACTIVE-RETURN-CODE.    
                                                                        
           IF WS-ACTIVE-RETURN-CODE EQUAL SUCCESSFUL-CALL OR NOT-FOUND  
              CONTINUE                                                  
           ELSE                                                         
              MOVE WS-ACTIVE-RETURN-CODE  TO WS-DISPLAY-SQLCODE         
              DISPLAY '****************************************'        
              DISPLAY '** PCSBW184 PROCESSING ERROR          **'        
              DISPLAY '** ABEND IN PARAGRAPH 7400            **'        
              DISPLAY '** NAME_PROGRAM    = ' RF-NAME-PROGRAM           
              DISPLAY '** PARTITION_NO    = ' RF-PARTITION-NO           
              DISPLAY '** DUP_CNTRL_NO    = ' RF-DUP-CNTRL-NO           
              DISPLAY '** SQL CODE        = ' WS-DISPLAY-SQLCODE        
              DISPLAY '****************************************'        
              PERFORM 9900-ABEND THRU 9900-EXIT                         
           END-IF.                                                      
      *                                                                         
       7400-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      *================================================================*        
      * GET FCA00 COMMON DATE - 6240-GET-FCA00-COMMON-DATE *                    
       COPY CPD00040.                                                           
      *================================================================*        
      *                                                                         
       COPY CPD00004.                                                           
      *                                                                         
      *================================================================*        
      * READ PARM FILE FOR OVERRIDE DATE - 6251-GET-FJC01-DATE *                
       COPY CPD00037.                                                           
      *================================================================*        
      *                                                                         
      *==============================================================*          
      * 7600-START-FCSJC01                    *                                 
      *==============================================================*          
           EXEC SQL                                                             
              INCLUDE CPD00038                                                  
           END-EXEC.                                                            
      *                                                                         
      *==============================================================*          
      * 7620-START-FCSCA00 VSAM CTRL FILE     *                                 
      *==============================================================*          
           EXEC SQL                                                             
              INCLUDE CPD00039                                                  
           END-EXEC.                                                            
      *                                                                         
A04867*================================================================*        
A04867* 8000-INSRT-COMM-COMMENT.                                       *13030000
A04867*================================================================*        
A04867 8000-INSRT-COMM-COMMENT.                                         
A04867                                                                  
A04867     EXEC SQL                                                     
A04867          INSERT INTO CSS_COMM_COMMENT                            
A04867                  (COMMUNICATION_ID                               
A04867                  ,UPDATE_TS                                      
A04867                  ,USER_ID                                        
A04867                  ,COMMENT_TX)                                    
A04867           VALUES (CIS.CHAR2TIMESTAMP(:KN-COMMUNICATION-ID)               
A04867                  ,CIS.CURRENT$TIMESTAMP()                              
A04867                  ,:KN-USER-ID                                    
A04867                  ,:KN-COMMENT-TX)                                
A04867     END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ028
MFA-TR* MSQ054
MFA-TR*    EXEC SQL                                                             
MFA-TR*         INSERT INTO CSS_COMM_COMMENT                                    
MFA-TR*                 (COMMUNICATION_ID                                       
MFA-TR*                 ,UPDATE_TS                                              
MFA-TR*                 ,USER_ID                                                
MFA-TR*                 ,COMMENT_TX)                                            
MFA-TR*          VALUES (:KN-COMMUNICATION-ID                                   
MFA-TR*                 ,CURRENT TIMESTAMP                                      
MFA-TR*                 ,:KN-USER-ID                                            
MFA-TR*                 ,:KN-COMMENT-TX)                                        
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

A04867*                                                                 14040000
A04867     MOVE SQLCODE                TO WS-ACTIVE-RETURN-CODE.        
A04867                                                                  
A04867     IF WS-ACTIVE-RETURN-CODE EQUAL SUCCESSFUL-CALL               
A04867        SET COMM-CMNT-INSERTED TO TRUE                            
A04867     ELSE                                                         
A04867        MOVE WS-ACTIVE-RETURN-CODE   TO WS-DISPLAY-SQLCODE        
A04867        IF WS-ACTIVE-RETURN-CODE  = WS-803                        
A04867           ADD 1 TO WS-803-CTR                                    
A04867           DISPLAY ' 8000-INSRT-COMM-COMMENT ' WS-803-CTR ' Times'
A04867           IF WS-803-CTR > 5                                      
A04867              DISPLAY '*************************************'     
A04867              DISPLAY '* 8000-INSRT-COMM-COMMENT '                
A04867              DISPLAY '* COMMUNICATION_ID = ' KN-COMMUNICATION-ID 
A04867              DISPLAY '* UPDATE_TS   = ' KN-UPDATE-TS             
A04867              DISPLAY '* SQL RETURN CODE = ' WS-DISPLAY-SQLCODE   
A04867              DISPLAY '* -803 EXCEEDED 5 TIMES *'                 
A04867              DISPLAY '*************************************'     
A04867              PERFORM 9900-ABEND                THRU 9900-EXIT    
A04867           END-IF                                                 
A04867        ELSE                                                      
A04867           DISPLAY '*************************************'        
A04867           DISPLAY '* 8000-INSERT-COMM-DATA '                     
A04867           DISPLAY '* COMMUNICATION_ID = ' KN-COMMUNICATION-ID    
A04867           DISPLAY '* UPDATE_TS   = ' KN-UPDATE-TS                
A04867           DISPLAY '* SQL RETURN CODE = ' WS-DISPLAY-SQLCODE      
A04867           DISPLAY '*************************************'        
A04867           PERFORM 9900-ABEND                THRU 9900-EXIT       
A04867        END-IF                                                    
A04867     END-IF.                                                      
A04867*                                                                 14190000
A04867 8000-EXIT.                                                       
A04867     EXIT.                                                        
A04867*                                                                 14190000
      *================================================================*        
      * 8400-INSERT-COMM-DATA.                                         *13030000
      *================================================================*        
       8400-INSERT-COMM-DATA.                                           
                                                                        
           EXEC SQL                                                     
                INSERT INTO CSS_COMM_DATA                               
                        (COMMUNICATION_ID                               
                        ,ACCOUNT_NO                                     
                        ,CUSTOMER_NO                                    
                        ,PREMISE_NO                                     
                        ,COMPANY_NO                                     
                        ,RED_FLAG_IND                                   
                        ,RED_FLAG_EXPIRE_DT                             
                        ,COMM_METHOD                                    
                        ,COMM_DIRECTION                                 
                        ,COMM_TYPE_CD                                   
                        ,COMM_SUBTYPE_CODE                              
                        ,USER_ID_ORIG                                   
                        ,CONTACT_NAME                                   
                        ,PROMOTION_ID                                   
                        ,PSC_COMPLIANCE_IND                             
                        ,CALL_ORIGIN_ID                                 
                        ,CALL_END_TIME                                  
                        ,NUMBER_TRANSFERS                               
                        ,HOLD_TIME                                      
                        ,QUEUE_TIME                                     
                        ,SCREEN_POP_IND                                 
                        ,TOTAL_CALL_TIME                                
                        ,INITIAL_COMMENT_TX                             
                        ,RESPONSE_REASON_CD                             
                        ,RESPONSE_TYPE_CD                               
                        ,SOLICITATION_CD                                
                        ,COMM_ASSOC_CD                                  
                        ,COMPLAINT_FL                                   
                        ,DISCOVERY_MTHD_CD                              
                        ,PREV_MARKETER_CD)                              
                VALUES  (CIS.CHAR2TIMESTAMP(:KO-COMMUNICATION-ID)               
                        ,:KO-ACCOUNT-NO                                 
                        ,:KO-CUSTOMER-NO                                
                        ,:KO-PREMISE-NO                                 
                        ,:KO-COMPANY-NO                                 
                        ,:KO-RED-FLAG-IND                               
                        ,CIS.CHAR2TIMESTAMP(:KO-RED-FLAG-EXPIRE-DT 
                                            :WS-RED-FL-NULL-IND)      
                        ,:KO-COMM-METHOD                                
                        ,:KO-COMM-DIRECTION                             
                        ,:KO-COMM-TYPE-CD                               
                        ,:KO-COMM-SUBTYPE-CODE                          
                        ,:KO-USER-ID-ORIG                               
                        ,:KO-CONTACT-NAME                               
                        ,:KO-PROMOTION-ID                               
                        ,:KO-PSC-COMPLIANCE-IND                         
                        ,:KO-CALL-ORIGIN-ID                             
                        ,CIS.CHAR2TIMESTAMP(:KO-CALL-END-TIME 
                                            :WS-CALL-END-NULL-IND)         
                        ,:KO-NUMBER-TRANSFERS                           
                        ,:KO-HOLD-TIME                                  
                        ,:KO-QUEUE-TIME                                 
                        ,:KO-SCREEN-POP-IND                             
                        ,:KO-TOTAL-CALL-TIME                            
                        ,:KO-INITIAL-COMMENT-TX                         
                        ,:KO-RESPONSE-REASON-CD                         
                        ,:KO-RESPONSE-TYPE-CD                           
                        ,:KO-SOLICITATION-CD                            
                        ,:KO-COMM-ASSOC-CD                              
                        ,:KO-COMPLAINT-FL                               
                        ,:KO-DISCOVERY-MTHD-CD                          
                        ,:KO-PREV-MARKETER-CD)                          
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ054
MFA-TR*    EXEC SQL                                                     13410000
MFA-TR*         INSERT INTO CSS_COMM_DATA                               13420000
MFA-TR*                 (COMMUNICATION_ID                               13430000
MFA-TR*                 ,ACCOUNT_NO                                     13440000
MFA-TR*                 ,CUSTOMER_NO                                    13450000
MFA-TR*                 ,PREMISE_NO                                     13460000
MFA-TR*                 ,COMPANY_NO                                     13470000
MFA-TR*                 ,RED_FLAG_IND                                   13480000
MFA-TR*                 ,RED_FLAG_EXPIRE_DT                             13490000
MFA-TR*                 ,COMM_METHOD                                    13500000
MFA-TR*                 ,COMM_DIRECTION                                 13510000
MFA-TR*                 ,COMM_TYPE_CD                                   13520000
MFA-TR*                 ,COMM_SUBTYPE_CODE                              13530000
MFA-TR*                 ,USER_ID_ORIG                                   13540000
MFA-TR*                 ,CONTACT_NAME                                   13550000
MFA-TR*                 ,PROMOTION_ID                                   13560000
MFA-TR*                 ,PSC_COMPLIANCE_IND                             13570000
MFA-TR*                 ,CALL_ORIGIN_ID                                 13580000
MFA-TR*                 ,CALL_END_TIME                                  13590000
MFA-TR*                 ,NUMBER_TRANSFERS                               13600000
MFA-TR*                 ,HOLD_TIME                                      13610000
MFA-TR*                 ,QUEUE_TIME                                     13620000
MFA-TR*                 ,SCREEN_POP_IND                                 13630000
MFA-TR*                 ,TOTAL_CALL_TIME                                13640000
MFA-TR*                 ,INITIAL_COMMENT_TX                             13650000
MFA-TR*                 ,RESPONSE_REASON_CD                             13660000
MFA-TR*                 ,RESPONSE_TYPE_CD                               13670000
MFA-TR*                 ,SOLICITATION_CD                                13680000
MFA-TR*                 ,COMM_ASSOC_CD                                  13690000
MFA-TR*                 ,COMPLAINT_FL                                   13700000
MFA-TR*                 ,DISCOVERY_MTHD_CD                              13710000
MFA-TR*                 ,PREV_MARKETER_CD)                              13720000
MFA-TR*         VALUES  (:KO-COMMUNICATION-ID                           13730000
MFA-TR*                 ,:KO-ACCOUNT-NO                                 13740000
MFA-TR*                 ,:KO-CUSTOMER-NO                                13750000
MFA-TR*                 ,:KO-PREMISE-NO                                 13760000
MFA-TR*                 ,:KO-COMPANY-NO                                 13770000
MFA-TR*                 ,:KO-RED-FLAG-IND                               13780000
MFA-TR*                 ,:KO-RED-FLAG-EXPIRE-DT:WS-RED-FL-NULL-IND      13790000
MFA-TR*                 ,:KO-COMM-METHOD                                13800000
MFA-TR*                 ,:KO-COMM-DIRECTION                             13810000
MFA-TR*                 ,:KO-COMM-TYPE-CD                               13820000
MFA-TR*                 ,:KO-COMM-SUBTYPE-CODE                          13830000
MFA-TR*                 ,:KO-USER-ID-ORIG                               13840000
MFA-TR*                 ,:KO-CONTACT-NAME                               13850000
MFA-TR*                 ,:KO-PROMOTION-ID                               13860000
MFA-TR*                 ,:KO-PSC-COMPLIANCE-IND                         13870000
MFA-TR*                 ,:KO-CALL-ORIGIN-ID                             13880000
MFA-TR*                 ,:KO-CALL-END-TIME:WS-CALL-END-NULL-IND         13890000
MFA-TR*                 ,:KO-NUMBER-TRANSFERS                           13900000
MFA-TR*                 ,:KO-HOLD-TIME                                  13910000
MFA-TR*                 ,:KO-QUEUE-TIME                                 13920000
MFA-TR*                 ,:KO-SCREEN-POP-IND                             13930000
MFA-TR*                 ,:KO-TOTAL-CALL-TIME                            13940000
MFA-TR*                 ,:KO-INITIAL-COMMENT-TX                         13950000
MFA-TR*                 ,:KO-RESPONSE-REASON-CD                         13960000
MFA-TR*                 ,:KO-RESPONSE-TYPE-CD                           13970000
MFA-TR*                 ,:KO-SOLICITATION-CD                            13980000
MFA-TR*                 ,:KO-COMM-ASSOC-CD                              13990000
MFA-TR*                 ,:KO-COMPLAINT-FL                               14000000
MFA-TR*                 ,:KO-DISCOVERY-MTHD-CD                          14010000
MFA-TR*                 ,:KO-PREV-MARKETER-CD)                          14020000
MFA-TR*    END-EXEC.                                                    14030000

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

      *                                                                 14040000
           MOVE SQLCODE                TO WS-ACTIVE-RETURN-CODE.        
                                                                        
           IF WS-ACTIVE-RETURN-CODE EQUAL SUCCESSFUL-CALL               
              SET COMM-DATA-INSERTED TO TRUE                            
           ELSE                                                         
              MOVE WS-ACTIVE-RETURN-CODE   TO WS-DISPLAY-SQLCODE        
              IF WS-ACTIVE-RETURN-CODE  = WS-803                        
                 ADD 1 TO WS-803-CTR                                    
                 DISPLAY ' 8400-INSERT-COMM-DATA ' WS-803-CTR ' Times'  
                 IF WS-803-CTR > 5                                      
                    DISPLAY '*************************************'     
                    DISPLAY '* 8400-INSERT-COMM-DATA '                  
                    DISPLAY '* COMMUNICATION ID = ' KO-COMMUNICATION-ID 
                    DISPLAY '* CUSTOMER_NO = ' KO-CUSTOMER-NO           
                    DISPLAY '* ACCOUNT_NO  = ' KO-ACCOUNT-NO            
                    DISPLAY '* PREMISE_NO  = ' KO-PREMISE-NO            
                    DISPLAY '* COMM TYPE   = ' KO-COMM-TYPE-CD          
                    DISPLAY '* COMM SUBTYP = ' KO-COMM-SUBTYPE-CODE     
                    DISPLAY '* SQL RETURN CODE = ' WS-DISPLAY-SQLCODE   
                    DISPLAY '* -803 EXCEEDED 5 TIMES *'                 
                    DISPLAY '*************************************'     
                    PERFORM 9900-ABEND                THRU 9900-EXIT    
                 END-IF                                                 
              ELSE                                                      
                 DISPLAY '*************************************'        
                 DISPLAY '* 8400-INSERT-COMM-DATA '                     
                 DISPLAY '* COMMUNICATION ID = ' KO-COMMUNICATION-ID    
                 DISPLAY '* CUSTOMER_NO = ' KO-CUSTOMER-NO              
                 DISPLAY '* ACCOUNT_NO  = ' KO-ACCOUNT-NO               
                 DISPLAY '* PREMISE_NO  = ' KO-PREMISE-NO               
                 DISPLAY '* COMM TYPE   = ' KO-COMM-TYPE-CD             
                 DISPLAY '* COMM SUBTYP = ' KO-COMM-SUBTYPE-CODE        
                 DISPLAY '* SQL RETURN CODE = ' WS-DISPLAY-SQLCODE      
                 DISPLAY '*************************************'        
                 PERFORM 9900-ABEND                THRU 9900-EXIT       
              END-IF                                                    
           END-IF.                                                      
      *                                                                 14190000
       8400-EXIT.                                                       
           EXIT.                                                        
      *                                                                 14190000
      *================================================================*        
      * 8500-UPDATE-BATCH-EML.                                         *13030000
      *================================================================*        
       8500-UPDATE-BATCH-EML.                                           
                                                                        
           EXEC SQL                                                     
               UPDATE CSS_BATCH_EMAIL                                   
                  SET COMM_DATA_CD     = :AE-COMM-DATA-CD               
                     ,COMMUNICATION_ID = CIS.CHAR2TIMESTAMP(
                                                   :AE-COMMUNICATION-ID
              )           
                     ,PROCESSED_CD     = :AE-PROCESSED-CD               
                     ,PROCESSED_DT     = CAST(SYSDATETIMEOFFSET() 
           AS DATE)                   
                WHERE BATCH_EMAIL_ID   = :AE-BATCH-EMAIL-ID             
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ028
MFA-TR* MSQ054
MFA-TR*    EXEC SQL                                                     13410000
MFA-TR*        UPDATE CSS_BATCH_EMAIL                                   03560002
MFA-TR*           SET COMM_DATA_CD     = :AE-COMM-DATA-CD               03570002
MFA-TR*              ,COMMUNICATION_ID = :AE-COMMUNICATION-ID                   
MFA-TR*              ,PROCESSED_CD     = :AE-PROCESSED-CD                       
MFA-TR*              ,PROCESSED_DT     = CURRENT DATE                           
MFA-TR*         WHERE BATCH_EMAIL_ID   = :AE-BATCH-EMAIL-ID                     
MFA-TR*    END-EXEC.                                                    14030000

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

      *                                                                 14040000
           MOVE SQLCODE                TO WS-ACTIVE-RETURN-CODE.        
                                                                        
           IF WS-ACTIVE-RETURN-CODE EQUAL SUCCESSFUL-CALL               
              CONTINUE                                                  
           ELSE                                                         
               MOVE WS-ACTIVE-RETURN-CODE   TO WS-DISPLAY-SQLCODE       
               DISPLAY '*************************************'          
               DISPLAY '* 8500-UPDATE-BATCH-EML '                       
               DISPLAY '* COMM_DATA_CD     = ' AE-COMM-DATA-CD          
               DISPLAY '* COMMUNICATION_ID = ' AE-COMMUNICATION-ID      
               DISPLAY '* PROCESSED_CD     = ' AE-PROCESSED-CD          
               DISPLAY '* BATCH_EMAIL_ID   = ' AE-BATCH-EMAIL-ID        
               DISPLAY '* SQL RETURN CODE  = ' WS-DISPLAY-SQLCODE       
               DISPLAY '*************************************'          
               PERFORM 9900-ABEND                THRU 9900-EXIT         
           END-IF.                                                      
      *                                                                 14190000
       8500-EXIT.                                                       
           EXIT.                                                        
      *                                                                 14190000
      *================================================================*        
      * 8893-RESET-RESTART-REQ-PARM                                             
      *================================================================*        
      *                                                                         
           EXEC SQL                                                             
               INCLUDE CPD00029                                                 
           END-EXEC.                                                            
      *                                                                 14190000
      *================================================================*        
       8896-UPDATE-RESTART.                                             
      *================================================================*        
      *                                                                         
           EXEC SQL                                                     
               UPDATE CSS_RESTART                                       
                  SET RESTART_DATA = :RF-RESTART-DATA                   
                WHERE NAME_PROGRAM = :RF-NAME-PROGRAM                   
                  AND PARTITION_NO = :RF-PARTITION-NO                   
                  AND DUP_CNTRL_NO = :RF-DUP-CNTRL-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 SUCCESSFUL-CALL OR NOT-FOUND  
              CONTINUE                                                  
           ELSE                                                         
              MOVE WS-ACTIVE-RETURN-CODE  TO WS-DISPLAY-SQLCODE         
              DISPLAY '*******************************************'     
              DISPLAY '**  PCSCA272 PROCESSING ERROR            **'     
              DISPLAY '**  ABEND IN PARAGRAPH 8896              **'     
              DISPLAY '** NAME_PROGRAM     = ' RF-NAME-PROGRAM          
              DISPLAY '** PARTITION_NO     = ' RF-PARTITION-NO          
              DISPLAY '** DUP_CNTRL_NO     = ' RF-DUP-CNTRL-NO          
              DISPLAY '** SQL CODE         = ' WS-DISPLAY-SQLCODE       
              DISPLAY '*******************************************'     
              PERFORM 9900-ABEND THRU 9900-EXIT                         
           END-IF.                                                      
      *                                                                         
       8896-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      *================================================================*        
       8897-INSERT-RESTART.                                             
      *================================================================*        
      *                                                                         
           EXEC SQL                                                     
               INSERT INTO CSS_RESTART                                  
                   (NAME_PROGRAM, PARTITION_NO, DUP_CNTRL_NO,           
                    RESTART_DATA)                                       
               VALUES                                                   
                   (:RF-NAME-PROGRAM, :RF-PARTITION-NO,                 
                    :RF-DUP-CNTRL-NO, :RF-RESTART-DATA)                 
           END-EXEC.                                                    

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

                                                                        
           MOVE SQLCODE                    TO WS-ACTIVE-RETURN-CODE.    
                                                                        
           IF WS-ACTIVE-RETURN-CODE EQUAL SUCCESSFUL-CALL               
              CONTINUE                                                  
           ELSE                                                         
              MOVE WS-ACTIVE-RETURN-CODE  TO WS-DISPLAY-SQLCODE         
              DISPLAY '*******************************************'     
              DISPLAY '**  PCSCA272 PROCESSING ERROR            **'     
              DISPLAY '**  ABEND IN PARAGRAPH 8897              **'     
              DISPLAY '** NAME_PROGRAM     = ' RF-NAME-PROGRAM          
              DISPLAY '** PARTITION_NO     = ' RF-PARTITION-NO          
              DISPLAY '** DUP_CNTRL_NO     = ' RF-DUP-CNTRL-NO          
              DISPLAY '** SQL CODE         = ' WS-DISPLAY-SQLCODE       
              DISPLAY '*******************************************'     
              PERFORM 9900-ABEND THRU 9900-EXIT                         
           END-IF.                                                      
      *                                                                         
       8897-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      *===============================================================*         
       9000-TERMINATE.                                                  
      *===============================================================*         
      *                                                                         
           CLOSE FCSCA271-FILE.                                         
      *                                                                         
           IF FCS271-SUCCESSFUL                                         
               CONTINUE                                                 
           ELSE                                                         
               DISPLAY '**  PCSCA272 PROCESSING ERROR           **'     
               DISPLAY '**  CLOSE ERROR  - OUTPUT FILES         **'     
               DISPLAY '**  FILE STATUS = ' WS-FCS271-STATUS            
               DISPLAY '**  UNSUCCESSFUL CLOSE OF FCSCA271 FILE **'     
           END-IF.                                                      
       9000-EXIT.                                                       
           EXIT.                                                        
      /                                                                         
      ****************************************************************          
      * 9700-PROCESS-ABEND  (REQUIED BY CPD00040)                    *          
      ****************************************************************          
       COPY CPD0023B.                                                           
      *                                                                         
      ****************************************************************          
      *  COPY BOOK CONTAINING 9900-ABEND INCLUDES SQL ROLLBACK   ****           
      ****************************************************************          
           EXEC SQL                                                             
             INCLUDE CPD09900                                                   
           END-EXEC.                                                            
      *                                                                         
