       IDENTIFICATION DIVISION.                                         
       PROGRAM-ID.     PCSCA273.                                        
       INSTALLATION.                                                    
       DATE-WRITTEN.   MAY 2012.                                        
           DATE-COMPILED.                                               
      *****************************************************************         
      **             SOUTH CAROLINA ELECTRIC & GAS                   **         
      **                                                             **         
      ********            CUSTOMER SERVICE SYSTEM             *********         
      ********                 COBOL/DB2                      *********         
      *****************************************************************         
      *****************************************************************         
      **                                                             **         
      **              PROGRAM  MODIFICATION  LOG                     **         
      **                                                             **         
      ** DATE       INITIALS      REASON                             **         
      ** =====      ========      ======                             **         
      ** 09/24/12   SS95855       P#00585 DEVELOPMENT OF NEW PROGRAM **         
      ** 12/07/12   SS95855       P#00585 FIX LIST DET COMMENT FIELD **         
      ** 01/11/13   SS95855       P#0585B BOUNCED EMAIL ENHANCEMENTS **         
      **                          a. Format Bounced email output     **         
      **                          b. Update Domain in BTCHEMAIL TABLE**         
      **                          C. Add Blocked domain in Job Parm  **         
      **                          d. Create Report of Blocked domains**         
      **                          d. Update Processed date with Curr **         
      **                             date and use the same for Rept. **         
      ** 02/15/13   SS95855       P#0585B HEADER RECORD FIXED        **         
      ** 02/18/13   SS95855       P#00730 ADD GUID LINK              **         
      ** 03/19/13   SS95855       A0501H  Reduce number of Get Pages.**         
A04527** 05/20/13   SS95855       ACT065  Get latest row from the    **         
A04527**                          COMM_ID_CSR cursor.                **         
A05136** 02/11/15   DB41297       CHANGE CURSOR TO 2 SELECTS TO      **         
ACT037**                          IMPROVE PERFORMANCE.               **         
A05136** 02/11/15   DB41297       Change cursor to look for either   **         
ACT071**                          upper or lower case address.       **         
A05744** 02/21/17   DB41297       Reformat data because of LIST     **          
ACT034**                          Detective reformat.                **         
      *****************************************************************         
           REMARKS.                                                     
                              PCSCA273 NARRATIVE                        
                              ==================                        
      *                                                                         
           THIS PROGRAM RECEIVES THE VENDOR FILE IN DIFFERENT FORMATS.  
           IT WRITES A ROW IN CSS_COMM_COMMENT AND UPDATES PROCESS-CODE 
           IN CSS_BATCH_EMAIL.                                          
      *                                                                         
       ENVIRONMENT DIVISION.                                            
                                                                        
       CONFIGURATION SECTION.                                           
       INPUT-OUTPUT SECTION.                                            
                                                                        
       FILE-CONTROL.                                                    
       COPY CSSCA273.                                                           
P#585B COPY CSSCB273.                                                           
                                                                        
       DATA DIVISION.                                                   
       FILE SECTION.                                                    
       COPY CFDCA273.                                                           
       01  FIOCA273-REC                PIC X(700).                      
                                                                        
P#585B COPY CFDCB273.                                                           
P#585B 01  FIOCB273-REC                PIC X(80).                       
                                                                        
      **************************                                                
       WORKING-STORAGE SECTION.                                         

MSQ017 01 MFA-PROGRAM-ID PIC X(8) VALUE 'PCSCA273'.
MSQ017     COPY MFASQLM.
      **************************                                                
      *                                                                         
       01  WS-START                    PIC X(40)                        
           VALUE 'WORKING STORAGE FOR PCSCA273 STARTS HERE'.            
                                                                        
      *** FIOCA273 FILE LAYOUT                                                  
       01 FIOCA273                     PIC X(700).                      
                                                                        
      *** ABEND SWITCH                                                          
       COPY CWS09900.                                                           
                                                                        
      *** WS ABEND WORK AREA                                                    
       COPY CWS00010.                                                           
                                                                        
      *** DB2 ERROR PROCESSING                                                  
       COPY CWS00303.                                                           
                                                                        
      ******************************************************************        
      ***                         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_COMM_COMMENT (KN)                            *        
      ******************************************************************        
           EXEC SQL                                                             
               INCLUDE TBCOMCMT                                                 
           END-EXEC.                                                            
      *                                                                         
      ******************************************************************        
      *    DCLGEN FOR CSS_CUST_EMAIL     (NE)                          *        
      ******************************************************************        
           EXEC SQL                                                             
               INCLUDE TBCSTEML                                                 
           END-EXEC.                                                            
      *                                                                         
P#585B******************************************************************        
P#585B*    DCLGEN FOR CSS_DELINQUENCY  (C8)                            *        
P#585B******************************************************************        
P#585B     EXEC SQL                                                             
P#585B         INCLUDE TBDELQ                                                   
P#585B     END-EXEC.                                                            
      *                                                                         
      ******************************************************************        
      *    DCLGEN FOR CSS_JOB_PARM     (G6)                            *        
      ******************************************************************        
           EXEC SQL                                                             
               INCLUDE TBJBPARM                                                 
           END-EXEC.                                                            
      *                                                                         
           EXEC SQL                                                             
              INCLUDE TBRESTRT                                                  
           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.                                                            
      *                                                                         
P#585B* DELINQUENCY                                                             
P#585B     COPY CWS00314.                                                       
      *                                                                         
       01 WS-LITERALS.                                                  
          05 WS-Y                      PIC X(01)  VALUE 'Y'.            
          05 WS-N                      PIC X(01)  VALUE 'N'.            
          05 WS-YES                    PIC X(01)  VALUE 'Y'.            
          05 WS-I                      PIC X(01)  VALUE 'I'.            
          05 WS-PGRMNAME               PIC X(08)  VALUE 'PCSCA273'.     
          05 PROGRAM-NAME              PIC X(08)  VALUE 'PCSCA273'.     
P#585B    05 WS-COMPANY-01             PIC X(02)  VALUE '01'.           
P0585A    05 WS-HARD-BOUNCE            PIC X(01)  VALUE 'B'.            
P0585A    05 WS-SOFT-BOUNCE            PIC X(01)  VALUE 'F'.            
          05 WS-RETURNED               PIC X(01)  VALUE 'B'.            
          05 WS-DELIVERED              PIC X(01)  VALUE 'D'.            
          05 WS-LIST-DETECTIV1         PIC X(10)  VALUE 'CustomerNo'.   
          05 WS-LIST-DETECTIV2         PIC X(10)  VALUE 'Row Number'.   
          05 WS-BOUNCED-EMAIL          PIC X(10)  VALUE 'EmailAddre'.   
          05 WS-HEADER-RECORD          PIC X(10)  VALUE '          '.   
          05 WS-USER-ID-ORIG           PIC X(07)  VALUE 'SYSTEM'.       
          05 WS-ONE                    PIC X(01)  VALUE '1'.            
                                                                        
          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'.            
P#585B    05 WS-REPORT-FLAG            PIC X(01)  VALUE 'N'.            
P#585B       88 DO-NOT-EMAIL-REPORT               VALUE 'N'.            
P#585B       88 DO-EMAIL-REPORT                   VALUE 'Y'.            
P#585B    05 WS-FCS273B-STATUS         PIC X(02).                       
P#585B       88 FCS273B-SUCCESSFUL                VALUE '00'.           
          05 WS-FCS273-STATUS          PIC X(02).                       
             88 FCS273-SUCCESSFUL                 VALUE '00'.           
             88 FCS273-READ-EOF                   VALUE '10'.           
          05 WS-FCS273-EOF             PIC X(01)  VALUE 'N'.            
             88 FCS273-EOF-REACHED                VALUE 'Y'.            
          05 WS-FILE-TYPE-PROCESS      PIC X(01)  VALUE ' '.            
             88 LIST-DETECTIVE-PROCESS            VALUE '1'.            
             88 BOUNCED-EMAIL-PROCESS             VALUE '2'.            
          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'.           
      *                                                                         
       01  WS-CURRENT-DATE.                                             
           05  WS-CCYY                 PIC 9(04).                       
           05  WS-CM                   PIC 9(02).                       
           05  WS-CD                   PIC 9(02).                       
           05  WS-CHH                  PIC 9(02).                       
           05  WS-CMM                  PIC 9(02).                       
           05  WS-CSS                  PIC 9(02).                       
      *                                                                         
       01  WS-RUN-DATE.                                                 
           05  WS-RD-MM                PIC XX.                          
           05  FILLER                  PIC X     VALUE '/'.             
           05  WS-RD-DD                PIC XX.                          
           05  FILLER                  PIC X     VALUE '/'.             
           05  WS-RD-CCYY              PIC XXXX.                        
      *                                                                         
       01  WS-RUN-TIME.                                                 
           05  WS-RT-HH                PIC XX.                          
           05  FILLER                  PIC X     VALUE ':'.             
           05  WS-RT-MM                PIC XX.                          
           05  FILLER                  PIC X     VALUE ':'.             
           05  WS-RT-SS                PIC XX.                          
      *                                                                         
       01  WS-REPT-HEADER-1.                                            
           05 WS-REPT-HDR               PIC X(11)  VALUE 'PCSCA273-01'. 
           05 FILLER                    PIC X(09)  VALUE SPACES.        
           05 WS-REPT-TITLE             PIC X(40)  VALUE SPACES.        
           05 FILLER                    PIC X(05)  VALUE SPACES.        
           05 WS-REPT-DT-HDR            PIC X(05)  VALUE 'DATE:'.       
           05 WS-REPT-DATE              PIC X(10)  VALUE SPACES.        
      *                                                                         
       01  WS-REPT-HEADER-2.                                            
           05 WS-REPT-PROG              PIC X(08)  VALUE SPACES.        
           05 FILLER                    PIC X(12)  VALUE SPACES.        
           05 FILLER                    PIC X(40)  VALUE                
              '****************************************'.               
           05 FILLER                    PIC X(07)  VALUE SPACES.        
           05 WS-REPT-TM-HDR            PIC X(05)  VALUE 'TIME:'.       
           05 WS-REPT-TIME              PIC X(08)  VALUE SPACES.        
      *                                                                         
       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-FCSCA273-REC-CNTR      PIC 9(08)  VALUE ZERO.           
          05 WS-CURR-TIMESTMP          PIC X(26)  VALUE SPACES.         
          05 WS-HOLD-FIRST-100-BYTES   PIC X(100) VALUE SPACES.         
          05 WS-COMMUNICATION-ID       PIC X(26)  VALUE SPACES.         
          05 WS-PARTITION-NO           PIC 9(01)  VALUE 0.              
          05 WS-STR-LENGTH             PIC S9(4) USAGE COMP.            
COB305    05 WS-MAX-DOMAIN-COUNT        PIC S9(4)V9(5) USAGE COMP-3 
COB305       VALUE 0.     
      *                                                                         
P#585B 01 WS-DOMAIN-COUNT              PIC S9(4) USAGE COMP.            
P#585B 01 WS-DOM-CNT-NUM               PIC 9(04) VALUE 0.               
P#585B 01 WS-DOM-CNT-STR                                                
P#585B       REDEFINES WS-DOM-CNT-NUM  PIC X(04).                       
      *                                                                         
P#585B 01 WS-PARM-DATA.                                                 
P#585B    10 FILLER                    PIC X(07) VALUE 'DOMAIN='.       
P#585B    10 WS-BLOCK-COMP             PIC X(02) VALUE SPACES.          
P#585B    10 FILLER                    PIC X(01) VALUE ';'.             
P#585B    10 WS-BLOCK-DOMAIN           PIC X(40) VALUE SPACES.          
P#585B    10 FILLER                    PIC X(30) VALUE SPACES.          
      *                                                                         
       01 WS-LIST-DETECTIVE-HLD        PIC X(700).                      
COB305 01 WS-SUB1        PIC S9(3) COMP-3 VALUE 0.                
COB305 01 WS-SUB2        PIC S9(3) COMP-3 VALUE 0.                
      *                                                                         
       01 WS-LIST-DETECTIVE-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).                       
P#585B    05 WS-PROCESSED-CD           PIC X(01).                       
          05 WS-PREM-ADDR              PIC X(75).                       
          05 WS-BANK-ACCT              PIC X(20).                       
          05 WS-DRAFT-DT               PIC X(20).                       
          05 WS-DRAFT-AMT              PIC X(20).                       
          05 WS-BILLD-DT               PIC X(20).                       
          05 WS-BILLD-AMT              PIC X(20).                       
          05 WS-CHRGE-DT               PIC X(20).                       
          05 WS-CHRGE-AMT              PIC X(20).                       
          05 WS-SCHED-DT               PIC X(10).                       
          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).                       
          05 WS-DEP-AMT                PIC X(15).                       
          05 WS-CUST-NAME              PIC X(30).                       
P#0730    05 WS-GUID-LINK              PIC X(35).                       
P00585    05 WS-VENDOR-FILLER          PIC X(05).                       
          05 WS-LISTDET-COMMENT        PIC X(200).                      
      *                                                                         
       01 WS-BOUNCED-EMAIL-REC.                                         
          05 WS-EMAIL-ADDRESS          PIC X(100).                      
P#585B    05 WS-EMAIL-STATUS           PIC X(15).                       
P#585B    05 WS-BOUNCE-COUNT           PIC 9(01).                       
P#585B    05 WS-EVENT-DT               PIC X(30).                       
P#585B    05 WS-DOMAIN                 PIC X(40).                       
P#585B    05 WS-BOUNCE-CAT-ID          PIC 9(01).                       
P#585B    05 WS-BOUNCE-CAT             PIC X(25).                       
P#585B    05 WS-BOUNCE-SUBCAT-ID       PIC 9(04).                       
P#585B    05 WS-BOUNCE-SUBCAT          PIC X(50).                       
P#585B    05 WS-SMTP-BOUNCE-REASON     PIC X(100).                      
ACT037 01 WS-EMAIL-ADDR                PIC X(100).                      
COB305 01 WS-CNT        PIC S9(3) COMP-3 VALUE 0.                
                                                                        
      * 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.        
          05 WS-RESTART-FILE-TYPE          PIC X(01) VALUE SPACES.      
      *                                                                         
       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 +130.  
          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.   
      *                                                                         
      *                                                                         
P#585B*****************************************************************         
P#585B**  CURSOR TO GET DOMAIN COUNT REPORT.                         **         
P#585B*****************************************************************         
P#585B*                                                                         
P#585B     EXEC SQL                                                     
P#585B        DECLARE DOMAIN_CSR CURSOR FOR                             
P#585B           SELECT CIS.SUBSTR3(VENDOR_RESP_DATA,1,40)                   
P#585B                 ,COUNT(*)                                        
P#585B           FROM  CSS_BATCH_EMAIL WITH(READUNCOMMITTED)                    
P#585B         WHERE PROCESSED_DT  = CAST(SYSDATETIMEOFFSET() AS DATE)          
P#585B           AND PROCESSED_CD  = :WS-SOFT-BOUNCE                    
P#585B           AND COMPANY_NO    = :AE-COMPANY-NO                     
P#585B           GROUP BY VENDOR_RESP_DATA                              
P#585B           HAVING CIS.SUBSTR3(VENDOR_RESP_DATA,1,40) > ' '             
P#585B           ORDER BY 2 DESC                                        
P#585B           FOR READ ONLY                                  
P#585B                                                      
P#585B     END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ003
MFA-TR* MSQ004
MFA-TR* MSQ022
MFA-TR* MSQ028
MFA-TR* MSQ029
MFA-TR*    EXEC SQL                                                             
MFA-TR*       DECLARE DOMAIN_CSR CURSOR FOR                                     
MFA-TR*          SELECT SUBSTR(VENDOR_RESP_DATA,1,40)                           
MFA-TR*                ,COUNT(*)                                                
MFA-TR*          FROM  CSS_BATCH_EMAIL                                          
MFA-TR*        WHERE PROCESSED_DT  = CURRENT DATE                               
MFA-TR*          AND PROCESSED_CD  = :WS-SOFT-BOUNCE                            
MFA-TR*          AND COMPANY_NO    = :AE-COMPANY-NO                             
MFA-TR*          GROUP BY VENDOR_RESP_DATA                                      
MFA-TR*          HAVING SUBSTR(VENDOR_RESP_DATA,1,40) > ' '                     
MFA-TR*          ORDER BY 2 DESC                                                
MFA-TR*          FOR FETCH ONLY WITH UR                                         
MFA-TR*          QUERYNO 7310                                                   
MFA-TR*    END-EXEC.                                                            
P#585B*                                                                         
       01 WS-END                            PIC X(40)                   
           VALUE 'WORKING STORAGE FOR PCSCA273 ENDS HERE  '.            
      *                                                                         
       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 FCS273-EOF-REACHED.                                  
      *                                                                         
P#585B     IF BOUNCED-EMAIL-PROCESS                                     
P#585B        PERFORM 6025-ISSUE-CHKP     THRU 6025-EXIT                
P#585B        PERFORM 1100-CREATE-REPORT  THRU 1100-EXIT                
P#585B     END-IF.                                                      
      ******************************************************************        
      * THE FOLLOWING STATEMENTS UPGRADE THE JOB-COMPLETE FIELD TO     *        
      * INDICATE A SUCCESSFUL COMPLETION:                              *        
      ******************************************************************        
      *                                                                         
           MOVE SPACES                   TO WS-RESTART-JOB-COMPLETE     
                                            WS-HOLD-FIRST-100-BYTES.    
                                                                        
           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.             
      *                                                                         
           DISPLAY '  '                                                 
           DISPLAY '**********************************************'     
           DISPLAY '** RECORDS PROCESSED: ' WS-FCSCA273-REC-CNTR        
           DISPLAY '**             PCSCA273                     **'     
           DISPLAY '**     PROGRAM COMPLETED SUCCESSFULLY.      **'     
           DISPLAY '**                                          **'     
           DISPLAY '**********************************************'     
P#585B*                                                                         
P#585B*** SET RETURNCODE TO 03 TO EMAIL REPORT TO GROUP                         
P#585B     IF DO-EMAIL-REPORT                                           
P#585B        MOVE 03                       TO  RETURN-CODE             
P#585B        DISPLAY ' RETURN CODE SET TO 03 TO EMAIL REPORT '         
P#585B     END-IF.                                                      
      *                                                                         
           STOP RUN.                                                    
      *                                                                         
       0000-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      *================================================================*        
       0100-INITIALIZATION.                                             
      *================================================================*        
      *                                                                         
           MOVE FUNCTION CURRENT-DATE(1:14)                             
                                       TO WS-CURRENT-DATE.              
           MOVE WS-CCYY                TO WS-RD-CCYY.                   
           MOVE WS-CM                  TO WS-RD-MM.                     
           MOVE WS-CD                  TO WS-RD-DD.                     
           MOVE WS-RUN-DATE            TO WS-REPT-DATE.                 
                                                                        
           MOVE WS-CHH                 TO WS-RT-HH.                     
           MOVE WS-CMM                 TO WS-RT-MM.                     
           MOVE WS-CSS                 TO WS-RT-SS.                     
           MOVE WS-RUN-TIME            TO WS-REPT-TIME.                 
      *                                                                         
           PERFORM 0110-OPEN-IO-FILES     THRU 0110-EXIT.               
                                                                        
      *** GET JCLPARM TO DETERMINE WHICH COMPANY THE JOB IS RUNNING FOR         
      *** AND THE PARTITION.                                                    
           IF LS-PARMLEN > ZERO                                         
              MOVE LS-COMPANY-NO      TO WS-RUN-FOR-COMPANY             
              MOVE LS-PARTITION-NO    TO WS-PARTITION-NO                
              DISPLAY ' PARTITION RUNNING: ' WS-PARTITION-NO            
           END-IF.                                                      
                                                                        
           EVALUATE TRUE                                                
              WHEN SCEG-RUN                                             
                   DISPLAY 'RUNNING FOR COMPANY SCE&G ' LS-COMPANY-NO   
                   MOVE ' DOMAIN EXCEPTION REPROT FOR S C E & G  '      
                                      TO WS-REPT-TITLE                  
                   MOVE 'CSRD273'     TO WS-REPT-PROG                   
              WHEN PSNC-RUN                                             
                   DISPLAY 'RUNNING FOR COMPANY PSNC  ' LS-COMPANY-NO   
                   MOVE ' DOMAIN EXCEPTION REPORT FOR P S N C    '      
                                      TO WS-REPT-TITLE                  
                   MOVE 'PNCD273'     TO WS-REPT-PROG                   
              WHEN SEB-RUN                                              
                   DISPLAY 'RUNNING FOR COMPANY SEB   ' LS-COMPANY-NO   
                   MOVE 'DOMAIN EXCEPTION REPORT FOR SCANA ENERGY'      
                                      TO WS-REPT-TITLE                  
                   MOVE 'SEBD273'     TO WS-REPT-PROG                   
              WHEN SEBR-RUN                                             
                   DISPLAY 'RUNNING FOR COMPANY SEBR  ' LS-COMPANY-NO   
                   MOVE 'DOMAIN EXCEPTION REPORT FOR SCANA ENERGY'      
                                      TO WS-REPT-TITLE                  
                   MOVE 'SEBD273'     TO WS-REPT-PROG                   
              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.                                                
                                                                        
           MOVE WS-REPT-HEADER-1         TO FIOCB273-REC.               
           PERFORM 8800-WRITE-FIOCB273      THRU 8800-EXIT.             
           MOVE WS-REPT-HEADER-2         TO FIOCB273-REC.               
           PERFORM 8800-WRITE-FIOCB273      THRU 8800-EXIT.             
           MOVE SPACES                   TO FIOCB273-REC.               
           PERFORM 8800-WRITE-FIOCB273      THRU 8800-EXIT.             
                                                                        
      *** 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.               
      *                                                                         
           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 0650-CHECK-FILE-PROCESS  THRU 0650-EXIT           
              PERFORM 0610-INITIALIZE-RESTART  THRU 0610-EXIT           
           END-IF.                                                      
      *                                                                         
P#585B*** GET DELINQUENCY VALUE TO DETERMINE THE BLOCK COUNT                    
P#585B                                                                  
P#585B     MOVE 'DOMAIN-CNT'     TO C8-DELINQ-CD.                       
P#585B     MOVE WS-COMPANY-01    TO C8-COMPANY-NO.                      
P#585B                                                                  
P#585B     PERFORM 6520-GET-DELINQ-VALUE THRU                           
P#585B             6520-GET-DELINQ-VALUE-EXIT.                          
P#585B                                                                  
P#585B     IF SQLCODE = SUCCESSFUL-CALL                                 
P#585B        MOVE C8-DELINQ-VALUE TO WS-MAX-DOMAIN-COUNT               
P#585B        DISPLAY ' BLOCK COUNT:' WS-MAX-DOMAIN-COUNT               
P#585B     END-IF.                                                      
P#585B*                                                                         
           PERFORM 7000-READ-FCSCA273          THRU 7000-EXIT.          
      *                                                                         
       0100-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      *================================================================*        
       0110-OPEN-IO-FILES.                                              
      *================================================================*        
      *                                                                         
           OPEN INPUT FCSCA273-FILE.                                    
                                                                        
           IF  FCS273-SUCCESSFUL                                        
               CONTINUE                                                 
           ELSE                                                         
              DISPLAY '************ PCSCA273 ERROR ******************'  
              DISPLAY '** ERROR IN  0110-INITIALIZATION            **'  
              DISPLAY '**   FILE FCSCA273 OPEN INPUT               **'  
              DISPLAY '** FILE STATUS = ' WS-FCS273-STATUS              
              DISPLAY '** PROCESSING TERMINATED                    **'  
              DISPLAY '**********************************************'  
              PERFORM 9900-ABEND            THRU 9900-EXIT              
           END-IF.                                                      
      *                                                                         
P#585B     OPEN OUTPUT FCSCB273-FILE.                                   
P#585B                                                                  
P#585B     IF  FCS273B-SUCCESSFUL                                       
P#585B         CONTINUE                                                 
P#585B     ELSE                                                         
P#585B        DISPLAY '************ PCSCA273 ERROR ******************'  
P#585B        DISPLAY '** ERROR IN  0110-INITIALIZATION            **'  
P#585B        DISPLAY '**   FILE FCSCB273 OPEN OUTPUT              **'  
P#585B        DISPLAY '** FILE STATUS = ' WS-FCS273B-STATUS             
P#585B        DISPLAY '** PROCESSING TERMINATED                    **'  
P#585B        DISPLAY '**********************************************'  
P#585B        PERFORM 9900-ABEND            THRU 9900-EXIT              
P#585B     END-IF.                                                      
      *                                                                         
       0110-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-FCSCA273-REC-CNTR.     
      *                                                                         
           PERFORM 7000-READ-FCSCA273      THRU 7000-EXIT               
             UNTIL WS-FCSCA273-REC-CNTR EQUAL WS-RESTART-RECORD-NO      
              OR FCS273-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 PCSCA273  *****'.       
           DISPLAY '*******************************************'.       
           MOVE WS-RESTART-RECORD-NO         TO WS-FCSCA273-REC-CNTR.   
           MOVE WS-RESTART-CHKP-SEQ-NO       TO WS-CHKP-SEQ-NO.         
           MOVE WS-RESTART-FILE-TYPE         TO WS-FILE-TYPE-PROCESS.   
      *                                                                         
       0601-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      *================================================================*        
      *  0605-VALIDATE-RESTART-REQ                                              
       COPY CPD00030.                                                           
      *================================================================*        
      *                                                                         
      *================================================================*        
       0610-INITIALIZE-RESTART.                                         
      *================================================================*        
      *                                                                         
           MOVE ZEROS                      TO WS-RESTART-CHKP-SEQ-NO    
                                              WS-RESTART-RECORD-NO      
           MOVE SPACES                     TO WS-RESTART-REC-100-BYTES  
                                              WS-RESTART-FILE-TYPE      
           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.                                                        
      *                                                                         
      *================================================================*        
       0650-CHECK-FILE-PROCESS.                                         
      *================================================================*        
      *                                                                         
           PERFORM 7000-READ-FCSCA273         THRU 7000-EXIT.           
                                                                        
           IF FCS273-READ-EOF                                           
              DISPLAY ' '                                               
              DISPLAY '************** PCSCA273 **********************'  
              DISPLAY '**        EMPTY INPUT FILE.....             **'  
              DISPLAY '**        =====================             **'  
              DISPLAY '**    NO HEADER RECORD PRESENT, OK IF FILE  **'  
              DISPLAY '**    IS MEANT TO BE EMPTY.                 **'  
              DISPLAY '**********************************************'  
           END-IF.                                                      
      *                                                                         
           IF NOT FCS273-READ-EOF                                       
              MOVE FIOCA273-REC               TO WS-HEADER-RECORD       
              IF WS-HEADER-RECORD EQUAL WS-LIST-DETECTIV1 OR            
                  WS-LIST-DETECTIV2                                     
                 SET LIST-DETECTIVE-PROCESS   TO TRUE                   
                 DISPLAY '***  PROCESSING LIST DETECTIVE FILE ***'      
              ELSE                                                      
                 IF WS-HEADER-RECORD EQUAL WS-BOUNCED-EMAIL             
                    SET BOUNCED-EMAIL-PROCESS TO TRUE                   
                    DISPLAY '***  PROCESSING BOUNCED EMAIL FILE ***'    
                 ELSE                                                   
                    DISPLAY '************ PCSCA273 ERROR **********'    
                    DISPLAY '**      0650-CHECK-FILE-PROCESS     **'    
                    DISPLAY '**   COULD NOT DETERMINE FILE TYPE  **'    
                    DISPLAY '**       PROCESSING TERMINATED      **'    
                    DISPLAY '**************************************'    
                    PERFORM 9900-ABEND           THRU 9900-EXIT         
                 END-IF                                                 
              END-IF                                                    
           END-IF.                                                      
      *                                                                         
       0650-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      *================================================================*        
       1000-PROCESS-BATCH-EMAIL.                                        
      *================================================================*        
      *                                                                         
           MOVE SPACES                   TO WS-COMMUNICATION-ID.        
P#585B     MOVE +40                      TO AE-VENDOR-RESP-DATA-LEN.    
P#585B     MOVE SPACES                   TO AE-VENDOR-RESP-DATA-TEXT.   
                                                                        
      *                                                                         
           IF LIST-DETECTIVE-PROCESS                                    
              PERFORM 2000-UNSTRING-LIST-FILE THRU 2000-EXIT            
                                                                        
              MOVE WS-BATCH-EMAIL-ID     TO AE-BATCH-EMAIL-ID           
              PERFORM 7100-GET-COMMUNCTN-ID THRU 7100-EXIT              
              MOVE AE-COMMUNICATION-ID   TO WS-COMMUNICATION-ID         
                                                                        
              IF WS-ACTIVE-RETURN-CODE EQUAL SUCCESSFUL-CALL            
P0585A           MOVE WS-RETURNED        TO AE-PROCESSED-CD             
                 PERFORM 5000-COMMON-PROCESS THRU 5000-EXIT             
              ELSE                                                      
                 DISPLAY 'MISSING COMMUNICATION-ID'                     
              END-IF                                                    
           END-IF.                                                      
                                                                        
           IF BOUNCED-EMAIL-PROCESS                                     
              PERFORM 3000-UNSTRING-BOUNCEM  THRU 3000-EXIT             
              MOVE +0                    TO  NE-EMAIL-ADDRESS-TX-LEN    
                                             WS-STR-LENGTH              
              MOVE SPACES                TO  NE-EMAIL-ADDRESS-TX-TEXT   
                                                                        
A0501H*       STRING WS-EMAIL-ADDRESS DELIMITED BY SPACE                        
A0501H*                           '%' DELIMITED BY SPACE                        
A0501H*         INTO WS-EMAIL-ADDRESS                                           
A0501H*       END-STRING                                                        
                                                                        
              MOVE WS-EMAIL-ADDRESS      TO  NE-EMAIL-ADDRESS-TX-TEXT   
                                             WS-EMAIL-ADDR              
              INSPECT NE-EMAIL-ADDRESS-TX-TEXT TALLYING WS-STR-LENGTH   
                  FOR CHARACTERS BEFORE INITIAL SPACE                   
              MOVE WS-STR-LENGTH         TO  NE-EMAIL-ADDRESS-TX-LEN    
                                                                        
ACT037        MOVE 0 TO WS-CNT                                          
ACT037        PERFORM 7210-SELECT-EMAIL-ADDR THRU 7210-EXIT             
ACT037        IF WS-ACTIVE-RETURN-CODE EQUAL SUCCESSFUL-CALL            
ACT037           PERFORM 7220-SELECT-COMM-ID    THRU 7220-EXIT          
ACT037        END-IF                                                    
P#585B                                                                  
P#585B        IF WS-ACTIVE-RETURN-CODE EQUAL SUCCESSFUL-CALL            
P#585B           MOVE AE-COMMUNICATION-ID   TO WS-COMMUNICATION-ID      
                 DISPLAY 'PROCESSING BATCH EMAIL ID: ' AE-BATCH-EMAIL-ID
P#585B           PERFORM 5000-COMMON-PROCESS THRU 5000-EXIT             
P#585B        ELSE                                                      
P#585B           DISPLAY '*** MISSING BATCH EMAIL ID ***'               
P#585B        END-IF                                                    
P#585B                                                                  
           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 7000-READ-FCSCA273        THRU 7000-EXIT.            
      *                                                                         
       1000-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
P#585B*================================================================*        
P#585B 1100-CREATE-REPORT.                                              
P#585B*================================================================*        
P#585B*                                                                         
P#585B     SET DO-NOT-EMAIL-REPORT    TO TRUE.                          
P#585B                                                                  
P#585B     MOVE WS-INPUT-DATE         TO AE-PROCESSED-DT.               
P#585B                                                                  
P#585B     IF PSNC-RUN                                                  
P#585B        MOVE WS-RUN-FOR-COMPANY TO AE-COMPANY-NO                  
P#585B     ELSE                                                         
P#585B        MOVE WS-COMPANY-01      TO AE-COMPANY-NO                  
P#585B     END-IF.                                                      
P#585B                                                                  
P#585B     PERFORM 7310-OPEN-DOMAIN-CSR  THRU 7310-EXIT.                
P#585B     PERFORM 7320-FETCH-DOMAIN-CSR THRU 7320-EXIT.                
P#585B                                                                  
P#585B     PERFORM 1200-GET-DOMAIN-DATA  THRU 1200-EXIT                 
P#585B       UNTIL WS-ACTIVE-RETURN-CODE EQUAL NOT-FOUND                
P#585B                                                                  
P#585B     PERFORM 7330-CLOSE-DOMAIN-CSR THRU 7330-EXIT.                
P#585B*                                                                         
P#585B 1100-EXIT.                                                       
P#585B     EXIT.                                                        
P#585B*                                                                         
P#585B*================================================================*        
P#585B 1200-GET-DOMAIN-DATA.                                            
P#585B*================================================================*        
P#585B*                                                                         
P#585B     MOVE SPACES                TO FIOCB273-REC                   
P#585B                                   WS-DOM-CNT-STR.                
P#585B                                                                  
P#585B     MOVE WS-DOMAIN-COUNT       TO WS-DOM-CNT-NUM.                
P#585B                                                                  
P#585B     STRING AE-VENDOR-RESP-DATA-TEXT DELIMITED BY SPACE           
P#585B            ' - '                                                 
P#585B            WS-DOM-CNT-STR      DELIMITED BY SIZE                 
P#585B       INTO FIOCB273-REC                                          
P#585B     END-STRING.                                                  
P#585B                                                                  
P#585B     IF WS-DOM-CNT-NUM > WS-MAX-DOMAIN-COUNT                      
P#585B        PERFORM 1300-BLOCK-THE-DOMAIN THRU 1300-EXIT              
P#585B        SET DO-EMAIL-REPORT     TO TRUE                           
P#585B     END-IF                                                       
P#585B                                                                  
P#585B     PERFORM 8800-WRITE-FIOCB273   THRU 8800-EXIT.                
P#585B                                                                  
P#585B     PERFORM 7320-FETCH-DOMAIN-CSR THRU 7320-EXIT.                
P#585B*                                                                         
P#585B 1200-EXIT.                                                       
P#585B     EXIT.                                                        
P#585B*                                                                         
P#585B*===============================================================*         
P#585B 1300-BLOCK-THE-DOMAIN.                                           
P#585B*===============================================================*         
P#585B*                                                                         
P#585B     INITIALIZE WS-PARM-DATA.                                     
P#585B                                                                  
P#585B     MOVE AE-VENDOR-RESP-DATA-TEXT(1:40)  TO WS-BLOCK-DOMAIN.     
P#585B                                                                  
P#585B     MOVE WS-RUN-FOR-COMPANY     TO WS-BLOCK-COMP.                
P#585B                                                                  
P#585B     IF SEB-RUN OR SEBR-RUN                                       
P#585B        MOVE WS-COMPANY-01       TO WS-BLOCK-COMP                 
P#585B     END-IF.                                                      
P#585B                                                                  
P#585B     MOVE WS-BLOCK-COMP          TO G6-COMPANY-NO.                
P#585B     MOVE WS-PARM-DATA           TO G6-PARM-DATA.                 
P#585B                                                                  
P#585B     PERFORM 7500-CHECK-IF-BLOCKED  THRU 7500-EXIT.               
P#585B                                                                  
P#585B     IF WS-ACTIVE-RETURN-CODE EQUAL SUCCESSFUL-CALL               
P#585B        IF G6-STATUS NOT EQUAL WS-A                               
P#585B           PERFORM 8600-ACTIVATE-DOMAIN THRU 8600-EXIT            
P#585B           DISPLAY 'BLOCK DOMAIN ACTIVATED: ' WS-BLOCK-DOMAIN     
P#585B        ELSE                                                      
P#585B           DISPLAY 'BLOCK DOMAIN UPDATED: ' WS-BLOCK-DOMAIN       
P#585B        END-IF                                                    
P#585B     ELSE                                                         
P#585B        PERFORM 7700-GET-NEXT-SEQ-NO THRU 7700-EXIT               
P#585B        PERFORM 8700-INSERT-DOMAIN   THRU 8700-EXIT               
P#585B        DISPLAY 'BLOCK DOMAIN INSERTED: ' WS-BLOCK-DOMAIN         
P#585B     END-IF.                                                      
P#585B*                                                                         
P#585B 1300-EXIT.                                                       
P#585B     EXIT.                                                        
      *                                                                         
      *===============================================================*         
       2000-UNSTRING-LIST-FILE.                                         
      *===============================================================*         
      *                                                                         
           INITIALIZE  WS-LIST-DETECTIVE-REC.                           
                                                                        
ACT034     PERFORM VARYING WS-SUB1 FROM 1 BY 1 UNTIL WS-SUB1 > 700      
ACT034        IF FIOCA273-REC(WS-SUB1:1) = '|'                          
ACT034           COMPUTE WS-SUB2 = 700 - WS-SUB1                        
ACT034           ADD 1 TO WS-SUB1                                       
ACT034           MOVE FIOCA273-REC(WS-SUB1:WS-SUB2) TO                  
ACT034              WS-LIST-DETECTIVE-HLD                               
ACT034           MOVE 701 TO WS-SUB1                                    
ACT034        END-IF                                                    
ACT034     END-PERFORM.                                                 
                                                                        
           UNSTRING WS-LIST-DETECTIVE-HLD 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                                     
P#585B              WS-PROCESSED-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                                        
P00585              WS-VENDOR-FILLER                                    
                    WS-LISTDET-COMMENT                                  
           END-UNSTRING.                                                
                                                                        
P#585B     DISPLAY 'PROCESSING BATCH EMAIL ID: ' WS-BATCH-EMAIL-ID.     
                                                                        
           MOVE WS-CUSTOMER-NO TO AE-CUSTOMER-NO.                       
      *                                                                         
       2000-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      *===============================================================*         
       3000-UNSTRING-BOUNCEM.                                           
      *===============================================================*         
      *                                                                         
P#585B     MOVE SPACES             TO WS-BOUNCED-EMAIL-REC.             
P#585B                                                                  
           IF FCS273-SUCCESSFUL                                         
P#585B        UNSTRING FIOCA273-REC DELIMITED BY '|'                    
                  INTO WS-EMAIL-ADDRESS                                 
                       WS-EMAIL-STATUS                                  
                       WS-BOUNCE-COUNT                                  
P#585B                 WS-EVENT-DT                                      
P#585B                 WS-DOMAIN                                        
P#585B                 WS-BOUNCE-CAT-ID                                 
P#585B                 WS-BOUNCE-CAT                                    
P#585B                 WS-BOUNCE-SUBCAT-ID                              
P#585B                 WS-BOUNCE-SUBCAT                                 
P#585B                 WS-SMTP-BOUNCE-REASON                            
              END-UNSTRING                                              
           END-IF.                                                      
                                                                        
P#585B     DISPLAY 'PROCESSING EMAIL: ' WS-EMAIL-ADDRESS                
                                                                        
           INSPECT WS-EMAIL-STATUS CONVERTING                           
           "abcdefghijklmnopqrstuvwxyz" TO "ABCDEFGHIJKLMNOPQRSTUVWXYZ" 
                                                                        
P#585B     IF WS-EMAIL-STATUS EQUAL 'BOUNCED'                           
P#585B        EVALUATE WS-BOUNCE-CAT-ID                                 
P#585B            WHEN 1                                                
P#585B            WHEN 2                                                
P#585B                 MOVE WS-HARD-BOUNCE TO AE-PROCESSED-CD           
P#585B            WHEN 3                                                
P#585B                 MOVE WS-SOFT-BOUNCE TO AE-PROCESSED-CD           
P#585B                 MOVE +40            TO AE-VENDOR-RESP-DATA-LEN   
P#585B                 MOVE WS-DOMAIN      TO AE-VENDOR-RESP-DATA-TEXT  
P#585B            WHEN 4                                                
P#585B            WHEN 5                                                
P#585B                 MOVE WS-SOFT-BOUNCE TO AE-PROCESSED-CD           
P#585B            WHEN OTHER                                            
P#585B                 MOVE WS-HARD-BOUNCE TO AE-PROCESSED-CD           
P#585B        END-EVALUATE                                              
P#585B     ELSE                                                         
P#585B        MOVE WS-HARD-BOUNCE          TO AE-PROCESSED-CD           
P#585B     END-IF.                                                      
      *                                                                         
       3000-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      *===============================================================*         
       5000-COMMON-PROCESS.                                             
      *===============================================================*         
      *                                                                         
           MOVE ZEROS TO WS-803-CTR.                                    
           SET COMM-DATA-NOT-INSERTED TO TRUE.                          
                                                                        
           PERFORM 5100-CREATE-COMM-COMMENT THRU 5100-EXIT              
             UNTIL COMM-DATA-INSERTED.                                  
      *                                                                         
           IF COMM-DATA-INSERTED                                        
              MOVE WS-INPUT-DATE            TO AE-PROCESSED-DT          
              PERFORM 8500-UPDATE-BATCH-EMAIL THRU 8500-EXIT            
           END-IF.                                                      
      *                                                                         
       5000-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      *===============================================================*         
       5100-CREATE-COMM-COMMENT.                                        
      *===============================================================*         
      *                                                                         
           MOVE SPACES                   TO WS-CURR-TIMESTMP.           
           PERFORM 7200-GET-CURR-TIMESTMP   THRU 7200-EXIT.             
      *                                                                         
           MOVE WS-CURR-TIMESTMP         TO KN-UPDATE-TS.               
           MOVE WS-COMMUNICATION-ID      TO KN-COMMUNICATION-ID.        
           MOVE WS-USER-ID-ORIG          TO KN-USER-ID.                 
P#585B     MOVE +255                     TO KN-COMMENT-TX-LEN.          
           IF LIST-DETECTIVE-PROCESS                                    
              MOVE WS-LISTDET-COMMENT    TO KN-COMMENT-TX-TEXT          
           ELSE                                                         
P#585B        MOVE FIOCA273-REC(1:255)   TO KN-COMMENT-TX-TEXT          
           END-IF.                                                      
                                                                        
           PERFORM 8000-INSRT-COMM-COMMENT THRU 8000-EXIT.              
      *                                                                         
       5100-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      *================================================================*        
       6025-ISSUE-CHKP.                                                 
      *================================================================*        
      *                                                                         
           ADD 1                       TO WS-CHKP-SEQ-NO.               
           MOVE WS-CHKP-SEQ-NO         TO WS-RESTART-CHKP-SEQ-NO.       
           MOVE WS-FCSCA273-REC-CNTR   TO WS-RESTART-RECORD-NO          
           MOVE WS-HOLD-FIRST-100-BYTES TO WS-RESTART-REC-100-BYTES.    
           MOVE WS-FILE-TYPE-PROCESS   TO WS-RESTART-FILE-TYPE.         
      *                                                                         
           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.'.           
      *                                                                         
       6025-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      *================================================================*        
       6030-WRITE-RSDDR.                                                
      *================================================================*        
      *                                                                         
           MOVE WS-PARTITION-NO        TO RF-PARTITION-NO.              
           MOVE PROGRAM-NAME           TO RF-NAME-PROGRAM.              
           MOVE WS-ONE                 TO RF-DUP-CNTRL-NO.              
           MOVE WS-RESTART-DATA        TO RF-RESTART-DATA-TEXT.         
           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.                                                           
      *================================================================*        
P#585B*                                                                         
P#585B*================================================================*        
P#585B* 6520-GET-DELINQ-VALUE.                                                  
P#585B*================================================================*        
P#585B*                                                                         
P#585B     EXEC SQL                                                             
P#585B         INCLUDE CPD00314                                                 
P#585B     END-EXEC.                                                            
      *                                                                         
      *================================================================*        
       7000-READ-FCSCA273.                                              
      *================================================================*        
           READ FCSCA273-FILE                                           
                 AT END MOVE 'Y'          TO WS-FCS273-EOF.             
      *                                                                         
           EVALUATE TRUE                                                
               WHEN FCS273-SUCCESSFUL                                   
                   MOVE FIOCA273-REC(1:100) TO WS-HOLD-FIRST-100-BYTES  
                   ADD 1                    TO WS-FCSCA273-REC-CNTR     
               WHEN FCS273-READ-EOF                                     
                   CONTINUE                                             
               WHEN OTHER                                               
                  DISPLAY '****************************************'    
                  DISPLAY '** PCSBW172 PROCESSING ERROR          **'    
                  DISPLAY '** ABEND IN PARAGRAPH 7000            **'    
                  DISPLAY '** ERROR ON READING FCS273 FILE       **'    
                  DISPLAY '** FCS273 STATUS = ' WS-FCS273-STATUS        
                  DISPLAY '****************************************'    
                  PERFORM 9900-ABEND          THRU 9900-EXIT            
           END-EVALUATE.                                                
      *                                                                         
       7000-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      *================================================================*        
       7100-GET-COMMUNCTN-ID.                                           
      *================================================================*        
      *                                                                         
           EXEC SQL                                                     
                SELECT REPLACE(REPLACE(CONVERT(CHAR(26), 
           COMMUNICATION_ID, 121), ' ', '-'), ':', '.') 
           COMMUNICATION_ID                                 
                  INTO :AE-COMMUNICATION-ID                             
                  FROM CSS_BATCH_EMAIL WITH(READUNCOMMITTED)                    
                WHERE BATCH_EMAIL_ID = :AE-BATCH-EMAIL-ID               
                                                                 
                                                            
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ003
MFA-TR* MSQ022
MFA-TR* MSQ061
MFA-TR*    EXEC SQL                                                             
MFA-TR*         SELECT COMMUNICATION_ID                                         
MFA-TR*           INTO :AE-COMMUNICATION-ID                                     
MFA-TR*           FROM CSS_BATCH_EMAIL                                          
MFA-TR*         WHERE BATCH_EMAIL_ID = :AE-BATCH-EMAIL-ID                       
MFA-TR*         WITH UR                                                         
MFA-TR*         QUERYNO 7100                                                    
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 '************ PCSCA273 ERROR ******************'  
              DISPLAY '** ERROR IN  7100-GET-COMMUNCTN-ID          **'  
              DISPLAY '** SELECT ERROR IN CSS_BATCH_EMAIL          **'  
              DISPLAY '** BATCH_EMAIL_ID   = ' AE-BATCH-EMAIL-ID        
              DISPLAY '** ACCOUNT NO       = ' WS-ACCOUNT-NO            
              DISPLAY '** CUSTOMER NO      = ' WS-CUSTOMER-NO           
              DISPLAY '** SQL CODE         = ' WS-DISPLAY-SQLCODE       
              DISPLAY '** PROCESSING TERMINATED                    **'  
              DISPLAY '**********************************************'  
              PERFORM 9900-ABEND            THRU 9900-EXIT              
           END-IF.                                                      
      *                                                                         
       7100-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 '************ PCSCA273 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.                                                        
      *                                                                         
      *================================================================*        
ACT037 7210-SELECT-EMAIL-ADDR.                                          
ACT037*================================================================*        
ACT037*                                                                         
                                                                        
ACT037     ADD 1 TO WS-CNT.                                             
ACT037     IF WS-CNT > 2                                                
ACT037        GO TO 7210-EXIT                                           
ACT037     END-IF.                                                      
                                                                        
ACT037     EXEC SQL                                                     
ACT037         SELECT TOP(1) NE.CUSTOMER_NO,
              NE.EMAIL_ADDRESS_TX                               
ACT037         INTO :AE-CUSTOMER-NO                                     
ACT037              ,:NE-EMAIL-ADDRESS-TX                               
ACT037         FROM  CSS_CUST_EMAIL  NE WITH(READUNCOMMITTED)                   
ACT071         WHERE NE.EMAIL_ADDRESS_TX = LOWER(:NE-EMAIL-ADDRESS-TX)  
ACT037           AND   NE.EMAIL_TYPE_CD  = 'P1'                         
ACT037                                       
ACT037                                                      
ACT037     END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ003
MFA-TR* MSQ020
MFA-TR* MSQ022
MFA-TR* MSQ029
MFA-TR*    EXEC SQL                                                             
MFA-TR*        SELECT NE.CUSTOMER_NO                                            
MFA-TR*              ,NE.EMAIL_ADDRESS_TX                                       
MFA-TR*        INTO :AE-CUSTOMER-NO                                             
MFA-TR*             ,:NE-EMAIL-ADDRESS-TX                                       
MFA-TR*        FROM  CSS_CUST_EMAIL  NE                                         
MFA-TR*        WHERE NE.EMAIL_ADDRESS_TX = LOWER(:NE-EMAIL-ADDRESS-TX)          
MFA-TR*          AND   NE.EMAIL_TYPE_CD  = 'P1'                                 
MFA-TR*          FETCH FIRST ROW ONLY WITH UR                                   
MFA-TR*          QUERYNO 7210                                                   
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

ACT037                                                                  
ACT037     MOVE SQLCODE             TO WS-ACTIVE-RETURN-CODE.           
ACT037                                                                  
ACT037     EVALUATE WS-ACTIVE-RETURN-CODE                               
ACT037        WHEN SUCCESSFUL-CALL                                      
ACT037           CONTINUE                                               
ACT037        WHEN NOT-FOUND                                            
ACT037           INSPECT NE-EMAIL-ADDRESS-TX-TEXT CONVERTING            
ACT037           "abcdefghijklmnopqrstuvwxyz" TO                        
ACT037           "ABCDEFGHIJKLMNOPQRSTUVWXYZ"                           
ACT037           IF WS-EMAIL-ADDR NOT = NE-EMAIL-ADDRESS-TX-TEXT        
ACT037              GO TO 7210-SELECT-EMAIL-ADDR                        
ACT037           ELSE                                                   
ACT037              INSPECT NE-EMAIL-ADDRESS-TX-TEXT CONVERTING         
ACT037              "ABCDEFGHIJKLMNOPQRSTUVWXYZ" TO                     
ACT037              "abcdefghijklmnopqrstuvwxyz"                        
ACT037              IF WS-EMAIL-ADDR NOT = NE-EMAIL-ADDRESS-TX-TEXT     
ACT037                 GO TO 7210-SELECT-EMAIL-ADDR                     
ACT037              END-IF                                              
ACT037           END-IF                                                 
ACT037        WHEN OTHER                                                
ACT037        MOVE WS-ACTIVE-RETURN-CODE  TO WS-DISPLAY-SQLCODE         
ACT037        DISPLAY '************ PCSCA273 ERROR ******************'  
ACT037        DISPLAY '** ERROR IN 7210-SELECT-EMAIL-ADDR            **'
ACT037        DISPLAY '** SELECT ERROR IN SELECT-COMM-ID             **'
ACT037        DISPLAY '** EMAIL_ADDRESS  = '  NE-EMAIL-ADDRESS-TX       
ACT037        DISPLAY '** SQL CODE       = '  WS-DISPLAY-SQLCODE        
ACT037        DISPLAY '** PROCESSING TERMINATED                    **'  
ACT037        DISPLAY '**********************************************'  
ACT037        PERFORM 9900-ABEND            THRU 9900-EXIT              
ACT037     END-EVALUATE.                                                
ACT037*                                                                         
ACT037 7210-EXIT.                                                       
ACT037     EXIT.                                                        
ACT037*                                                                         
ACT037*================================================================*        
ACT037 7220-SELECT-COMM-ID.                                             
ACT037*================================================================*        
ACT037*                                                                         
ACT037     EXEC SQL                                                     
ACT037         SELECT TOP(1) REPLACE(REPLACE(CONVERT(CHAR(26), 
           AE.COMMUNICATION_ID, 121), ' ', '-'), ':', '.') 
           COMMUNICATION_ID,
              AE.BATCH_EMAIL_ID                               
ACT037          INTO :AE-COMMUNICATION-ID                               
ACT037              ,:AE-BATCH-EMAIL-ID                                 
ACT037           FROM  CSS_BATCH_EMAIL AE WITH(READUNCOMMITTED)                 
ACT037                ,CSS_CUST_EMAIL  NE WITH(READUNCOMMITTED)                 
ACT037         WHERE   AE.CUSTOMER_NO      = :AE-CUSTOMER-NO            
ACT037           AND   AE.CUSTOMER_NO      = NE.CUSTOMER_NO             
ACT037           AND NE.EMAIL_ADDRESS_TX   = :NE-EMAIL-ADDRESS-TX       
ACT037           AND   NE.EMAIL_TYPE_CD    = 'P1'                       
ACT037           AND   AE.PROCESSED_CD    IN ('D','S','B')              
ACT037           AND   AE.COMMUNICATION_ID IS NOT NULL                  
ACT037           ORDER BY EMAIL_EVENT_DT DESC                           
ACT037                                       
ACT037                                                      
ACT037     END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ003
MFA-TR* MSQ020
MFA-TR* MSQ022
MFA-TR* MSQ061
MFA-TR*    EXEC SQL                                                             
MFA-TR*        SELECT AE.COMMUNICATION_ID                                       
MFA-TR*                ,AE.BATCH_EMAIL_ID                                       
MFA-TR*         INTO :AE-COMMUNICATION-ID                                       
MFA-TR*             ,:AE-BATCH-EMAIL-ID                                         
MFA-TR*          FROM  CSS_BATCH_EMAIL AE                                       
MFA-TR*               ,CSS_CUST_EMAIL  NE                                       
MFA-TR*        WHERE   AE.CUSTOMER_NO      = :AE-CUSTOMER-NO                    
MFA-TR*          AND   AE.CUSTOMER_NO      = NE.CUSTOMER_NO                     
MFA-TR*          AND NE.EMAIL_ADDRESS_TX   = :NE-EMAIL-ADDRESS-TX               
MFA-TR*          AND   NE.EMAIL_TYPE_CD    = 'P1'                               
MFA-TR*          AND   AE.PROCESSED_CD    IN ('D','S','B')                      
MFA-TR*          AND   AE.COMMUNICATION_ID IS NOT NULL                          
MFA-TR*          ORDER BY EMAIL_EVENT_DT DESC                                   
MFA-TR*          FETCH FIRST ROW ONLY WITH UR                                   
MFA-TR*          QUERYNO 7220                                                   
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

ACT037*                                                                         
ACT037     MOVE SQLCODE             TO WS-ACTIVE-RETURN-CODE.           
ACT037*                                                                         
ACT037     EVALUATE WS-ACTIVE-RETURN-CODE                               
ACT037        WHEN SUCCESSFUL-CALL                                      
ACT037        WHEN NOT-FOUND                                            
ACT037           CONTINUE                                               
ACT037        WHEN OTHER                                                
ACT037           MOVE WS-ACTIVE-RETURN-CODE  TO WS-DISPLAY-SQLCODE      
ACT037           DISPLAY '************ PCSCA273 ERROR ****************' 
ACT037           DISPLAY '** ERROR IN 7220-SELECT-COMM-ID           **' 
ACT037           DISPLAY '** FETCH ERROR IN COMM_ID_CSR             **' 
ACT037           DISPLAY '** EMAIL_ADDRESS  = '  NE-EMAIL-ADDRESS-TX    
ACT037           DISPLAY '** SQL CODE       = '  WS-DISPLAY-SQLCODE     
ACT037           DISPLAY '** PROCESSING TERMINATED                  **' 
ACT037           DISPLAY '********************************************' 
ACT037           PERFORM 9900-ABEND         THRU 9900-EXIT              
ACT037     END-EVALUATE.                                                
ACT037*                                                                         
ACT037 7220-EXIT.                                                       
ACT037     EXIT.                                                        
      *                                                                         
P#585B*================================================================*        
P#585B 7310-OPEN-DOMAIN-CSR.                                            
P#585B*================================================================*        
P#585B*                                                                         
P#585B     EXEC SQL                                                     
P#585B          OPEN DOMAIN_CSR                                         
P#585B     END-EXEC.                                                    

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

P#585B*                                                                         
P#585B     MOVE SQLCODE             TO WS-ACTIVE-RETURN-CODE.           
P#585B*                                                                         
P#585B     IF WS-ACTIVE-RETURN-CODE EQUAL SUCCESSFUL-CALL               
P#585B        CONTINUE                                                  
P#585B     ELSE                                                         
P#585B        MOVE WS-ACTIVE-RETURN-CODE  TO WS-DISPLAY-SQLCODE         
P#585B        DISPLAY '************ PCSCA273 ERROR ******************'  
P#585B        DISPLAY '** ERROR IN 7310-OPEN-DOMAIN-CSR            **'  
P#585B        DISPLAY '** OPEN ERROR IN DOMAIN_CSR                 **'  
P#585B        DISPLAY '** COMPANY NO     = '  AE-COMPANY-NO             
P#585B        DISPLAY '** PROCESSED DATE = '  AE-PROCESSED-DT           
P#585B        DISPLAY '** SQL CODE       = '  WS-DISPLAY-SQLCODE        
P#585B        DISPLAY '** PROCESSING TERMINATED                    **'  
P#585B        DISPLAY '**********************************************'  
P#585B        PERFORM 9900-ABEND            THRU 9900-EXIT              
P#585B     END-IF.                                                      
P#585B*                                                                         
P#585B 7310-EXIT.                                                       
P#585B     EXIT.                                                        
P#585B*                                                                         
P#585B*================================================================*        
P#585B 7320-FETCH-DOMAIN-CSR.                                           
P#585B*================================================================*        
P#585B*                                                                         
P#585B     EXEC SQL                                                     
P#585B         FETCH FROM DOMAIN_CSR                                    
P#585B          INTO :AE-VENDOR-RESP-DATA                               
P#585B              ,:WS-DOMAIN-COUNT                                   
P#585B     END-EXEC.                                                    

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

P#585B*                                                                         
P#585B     MOVE SQLCODE             TO WS-ACTIVE-RETURN-CODE.           
P#585B*                                                                         
P#585B     EVALUATE WS-ACTIVE-RETURN-CODE                               
P#585B        WHEN SUCCESSFUL-CALL                                      
P#585B        WHEN NOT-FOUND                                            
P#585B           CONTINUE                                               
P#585B        WHEN OTHER                                                
P#585B           MOVE WS-ACTIVE-RETURN-CODE  TO WS-DISPLAY-SQLCODE      
P#585B           DISPLAY '************ PCSCA273 ERROR ****************' 
P#585B           DISPLAY '** ERROR IN 7320-FETCH-DOMAIN-CSR         **' 
P#585B           DISPLAY '** FETCH ERROR IN DOMAIN_CSR              **' 
P#585B           DISPLAY '** COMPANY NO     = '  AE-COMPANY-NO          
P#585B           DISPLAY '** PROCESSED DATE = '  AE-PROCESSED-DT        
P#585B           DISPLAY '** SQL CODE       = '  WS-DISPLAY-SQLCODE     
P#585B           DISPLAY '** PROCESSING TERMINATED                  **' 
P#585B           DISPLAY '********************************************' 
P#585B           PERFORM 9900-ABEND         THRU 9900-EXIT              
P#585B     END-EVALUATE.                                                
P#585B*                                                                         
P#585B 7320-EXIT.                                                       
P#585B     EXIT.                                                        
P#585B*                                                                         
P#585B*================================================================*        
P#585B 7330-CLOSE-DOMAIN-CSR.                                           
P#585B*================================================================*        
P#585B*                                                                         
P#585B     EXEC SQL                                                     
P#585B          CLOSE DOMAIN_CSR                                        
P#585B     END-EXEC.                                                    

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

P#585B*                                                                         
P#585B     MOVE SQLCODE             TO WS-ACTIVE-RETURN-CODE.           
P#585B*                                                                         
P#585B     IF WS-ACTIVE-RETURN-CODE EQUAL SUCCESSFUL-CALL               
P#585B        CONTINUE                                                  
P#585B     ELSE                                                         
P#585B        MOVE WS-ACTIVE-RETURN-CODE  TO WS-DISPLAY-SQLCODE         
P#585B        DISPLAY '************ PCSCA273 ERROR ******************'  
P#585B        DISPLAY '** ERROR IN 7330-CLOSE-DOMAIN-CSR           **'  
P#585B        DISPLAY '** CLOSE ERROR IN DOMAIN_CSR                **'  
P#585B        DISPLAY '** COMPANY NO     = '  AE-COMPANY-NO             
P#585B        DISPLAY '** PROCESSED DATE = '  AE-PROCESSED-DT           
P#585B        DISPLAY '** SQL CODE       = '  WS-DISPLAY-SQLCODE        
P#585B        DISPLAY '** PROCESSING TERMINATED                    **'  
P#585B        DISPLAY '**********************************************'  
P#585B        PERFORM 9900-ABEND            THRU 9900-EXIT              
P#585B     END-IF.                                                      
P#585B*                                                                         
P#585B 7330-EXIT.                                                       
P#585B     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 '** PCSCA273 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.                                                        
P#585B*                                                                         
P#585B*================================================================*        
P#585B 7500-CHECK-IF-BLOCKED.                                           
P#585B*================================================================*        
P#585B*                                                                         
P#585B     EXEC SQL                                                     
P#585B        SELECT  STATUS                                            
P#585B          INTO :G6-STATUS                                         
P#585B          FROM CSS_JOB_PARM WITH(READUNCOMMITTED)                         
P#585B         WHERE PROGRAM_NAME   = 'PCSCA271'                        
P#585B           AND COMPANY_NO     = :G6-COMPANY-NO                    
P#585B           AND PARM_DATA      = :G6-PARM-DATA                     
P#585B                                                           
P#585B                                                      
P#585B     END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ003
MFA-TR* MSQ022
MFA-TR*    EXEC SQL                                                             
MFA-TR*       SELECT  STATUS                                                    
MFA-TR*         INTO :G6-STATUS                                                 
MFA-TR*         FROM CSS_JOB_PARM                                               
MFA-TR*        WHERE PROGRAM_NAME   = 'PCSCA271'                                
MFA-TR*          AND COMPANY_NO     = :G6-COMPANY-NO                            
MFA-TR*          AND PARM_DATA      = :G6-PARM-DATA                             
MFA-TR*         WITH UR                                                         
MFA-TR*        QUERYNO 7500                                                     
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

P#585B                                                                  
P#585B     MOVE SQLCODE                    TO WS-ACTIVE-RETURN-CODE.    
P#585B                                                                  
P#585B     IF WS-ACTIVE-RETURN-CODE EQUAL SUCCESSFUL-CALL OR NOT-FOUND  
P#585B        CONTINUE                                                  
P#585B     ELSE                                                         
P#585B        MOVE WS-ACTIVE-RETURN-CODE  TO WS-DISPLAY-SQLCODE         
P#585B        DISPLAY '****************************************'        
P#585B        DISPLAY '** PCSCA273 PROCESSING ERROR          **'        
P#585B        DISPLAY '** ABEND IN 7500-CHECK-IF-BLOCKED     **'        
P#585B        DISPLAY '** PROGRAM_NAME    = ' 'PCSCA271'                
P#585B        DISPLAY '** COMPANY-NO      = ' G6-COMPANY-NO             
P#585B        DISPLAY '** PARM_DATA       = ' G6-PARM-DATA              
P#585B        DISPLAY '** SQL CODE        = ' WS-DISPLAY-SQLCODE        
P#585B        DISPLAY '****************************************'        
P#585B        PERFORM 9900-ABEND THRU 9900-EXIT                         
P#585B     END-IF.                                                      
P#585B*                                                                         
P#585B 7500-EXIT.                                                       
P#585B     EXIT.                                                        
P#585B*                                                                         
P#585B*================================================================*        
P#585B 7700-GET-NEXT-SEQ-NO.                                            
P#585B*================================================================*        
P#585B*                                                                         
P#585B     EXEC SQL                                                     
P#585B        SELECT  MAX(SEQ_NO) + 1                                   
P#585B          INTO :G6-SEQ-NO                                         
P#585B          FROM CSS_JOB_PARM WITH(READUNCOMMITTED)                         
P#585B         WHERE PROGRAM_NAME   = 'PCSCA271'                        
P#585B                                                           
P#585B                                                      
P#585B     END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ003
MFA-TR* MSQ022
MFA-TR*    EXEC SQL                                                             
MFA-TR*       SELECT  MAX(SEQ_NO) + 1                                           
MFA-TR*         INTO :G6-SEQ-NO                                                 
MFA-TR*         FROM CSS_JOB_PARM                                               
MFA-TR*        WHERE PROGRAM_NAME   = 'PCSCA271'                                
MFA-TR*         WITH UR                                                         
MFA-TR*        QUERYNO 7600                                                     
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

P#585B                                                                  
P#585B     MOVE SQLCODE                    TO WS-ACTIVE-RETURN-CODE.    
P#585B                                                                  
P#585B     IF WS-ACTIVE-RETURN-CODE EQUAL SUCCESSFUL-CALL               
P#585B        CONTINUE                                                  
P#585B     ELSE                                                         
P#585B        MOVE WS-ACTIVE-RETURN-CODE  TO WS-DISPLAY-SQLCODE         
P#585B        DISPLAY '****************************************'        
P#585B        DISPLAY '** PCSCA273 PROCESSING ERROR          **'        
P#585B        DISPLAY '** ABEND IN 7700-GET-NEXT-SEQ-NO      **'        
P#585B        DISPLAY '** PROGRAM_NAME    = ' 'PCSCA271'                
P#585B        DISPLAY '** SQL CODE        = ' WS-DISPLAY-SQLCODE        
P#585B        DISPLAY '****************************************'        
P#585B        PERFORM 9900-ABEND THRU 9900-EXIT                         
P#585B     END-IF.                                                      
P#585B*                                                                         
P#585B 7700-EXIT.                                                       
P#585B     EXIT.                                                        
      *                                                                         
      *================================================================*        
       8000-INSRT-COMM-COMMENT.                                         
      *================================================================*        
      *                                                                         
           EXEC SQL                                                     
                INSERT INTO CSS_COMM_COMMENT                            
                        (COMMUNICATION_ID                               
                        ,UPDATE_TS                                      
                        ,USER_ID                                        
                        ,COMMENT_TX)                                    
                 VALUES (CIS.CHAR2TIMESTAMP(:KN-COMMUNICATION-ID)               
                        ,CIS.CHAR2TIMESTAMP(:KN-UPDATE-TS)                      
                        ,:KN-USER-ID                                    
                        ,:KN-COMMENT-TX)                                
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
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*                 ,:KN-UPDATE-TS                                          
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

      *                                                                         
           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                                    
                 IF WS-803-CTR > 5                                      
                    DISPLAY '*************************************'     
                    DISPLAY '* 8000-INSRT-COMM-COMMENT *'               
                    DISPLAY '* COMMUNICATION_ID = ' KN-COMMUNICATION-ID 
                    DISPLAY '* UPDATE_TS        = ' KN-UPDATE-TS        
                    DISPLAY '* SQL RETURN CODE  = ' WS-DISPLAY-SQLCODE  
                    DISPLAY '* -803 EXCEEDED 5 TIMES *'                 
                    DISPLAY '*************************************'     
                    PERFORM 9900-ABEND            THRU 9900-EXIT        
                 END-IF                                                 
              ELSE                                                      
                 DISPLAY '*************************************'        
                 DISPLAY '* 8000-INSRT-COMM-COMMENT *'                  
                 DISPLAY '* COMMUNICATION_ID = ' KN-COMMUNICATION-ID    
                 DISPLAY '* UPDATE_TS        = ' KN-UPDATE-TS           
                 DISPLAY '* SQL RETURN CODE  = ' WS-DISPLAY-SQLCODE     
                 DISPLAY '*************************************'        
                 PERFORM 9900-ABEND                THRU 9900-EXIT       
              END-IF                                                    
           END-IF.                                                      
      *                                                                         
       8000-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      *================================================================*        
      * 8500-UPDATE-BATCH-EMAIL                                        *        
      *================================================================*        
       8500-UPDATE-BATCH-EMAIL.                                         
                                                                        
           EXEC SQL                                                     
               UPDATE CSS_BATCH_EMAIL                                   
                  SET PROCESSED_CD     = :AE-PROCESSED-CD               
                     ,PROCESSED_DT     = CAST(SYSDATETIMEOFFSET() 
           AS DATE)                   
P#585B               ,VENDOR_RESP_DATA = :AE-VENDOR-RESP-DATA           
                WHERE BATCH_EMAIL_ID   = :AE-BATCH-EMAIL-ID             
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ028
MFA-TR*    EXEC SQL                                                             
MFA-TR*        UPDATE CSS_BATCH_EMAIL                                           
MFA-TR*           SET PROCESSED_CD     = :AE-PROCESSED-CD                       
MFA-TR*              ,PROCESSED_DT     = CURRENT DATE                           
MFA-TR*              ,VENDOR_RESP_DATA = :AE-VENDOR-RESP-DATA                   
MFA-TR*         WHERE BATCH_EMAIL_ID   = :AE-BATCH-EMAIL-ID                     
MFA-TR*    END-EXEC.                                                            

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

      *                                                                         
           MOVE SQLCODE                     TO WS-ACTIVE-RETURN-CODE.   
                                                                        
           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 '* PROCESSED_CD     = ' AE-PROCESSED-CD          
               DISPLAY '* PROCESSED_DT     = ' AE-PROCESSED-DT          
               DISPLAY '* BATCH_EMAIL_ID   = ' AE-BATCH-EMAIL-ID        
               DISPLAY '* SQL RETURN CODE  = ' WS-DISPLAY-SQLCODE       
               DISPLAY '*************************************'          
               PERFORM 9900-ABEND                THRU 9900-EXIT         
           END-IF.                                                      
      *                                                                         
       8500-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
P#585B*================================================================*        
P#585B* 8600-ACTIVATE-DOMAIN                                           *        
P#585B*================================================================*        
P#585B 8600-ACTIVATE-DOMAIN.                                            
P#585B                                                                  
P#585B     EXEC SQL                                                     
P#585B         UPDATE CSS_JOB_PARM                                      
P#585B            SET STATUS         = :WS-A                            
P#585B          WHERE PROGRAM_NAME   = 'PCSCA271'                       
P#585B            AND COMPANY_NO     = :G6-COMPANY-NO                   
P#585B            AND PARM_DATA      = :G6-PARM-DATA                    
P#585B     END-EXEC.                                                    

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

P#585B*                                                                         
P#585B     MOVE SQLCODE                     TO WS-ACTIVE-RETURN-CODE.   
P#585B                                                                  
P#585B     IF WS-ACTIVE-RETURN-CODE EQUAL SUCCESSFUL-CALL               
P#585B        CONTINUE                                                  
P#585B     ELSE                                                         
P#585B         MOVE WS-ACTIVE-RETURN-CODE   TO WS-DISPLAY-SQLCODE       
P#585B         DISPLAY '*************************************'          
P#585B         DISPLAY '* 8600-ACTIVATE-DOMAIN  '                       
P#585B         DISPLAY '* PROGRAM_NAME     = ' 'PCSCA271'               
P#585B         DISPLAY '* COMPANY-NO       = ' G6-COMPANY-NO            
P#585B         DISPLAY '* PARM_DATA        = ' G6-PARM-DATA             
P#585B         DISPLAY '* SQL RETURN CODE  = ' WS-DISPLAY-SQLCODE       
P#585B         DISPLAY '*************************************'          
P#585B         PERFORM 9900-ABEND                THRU 9900-EXIT         
P#585B     END-IF.                                                      
P#585B*                                                                         
P#585B 8600-EXIT.                                                       
P#585B     EXIT.                                                        
P#585B*                                                                         
P#585B*================================================================*        
P#585B* 8700-INSERT-DOMAIN.                                            *        
P#585B*================================================================*        
P#585B 8700-INSERT-DOMAIN.                                              
P#585B                                                                  
P#585B     EXEC SQL                                                     
P#585B         INSERT INTO CSS_JOB_PARM                                 
P#585B            (PROGRAM_NAME                                         
P#585B            ,COMPANY_NO                                           
P#585B            ,CMND_CODE                                            
P#585B            ,SEQ_NO                                               
P#585B            ,STATUS                                               
P#585B            ,PARM_DATA)                                           
P#585B         VALUES                                                   
P#585B            ('PCSCA271'                                           
P#585B             ,:G6-COMPANY-NO                                      
P#585B             ,:WS-PARM                                            
P#585B             ,:G6-SEQ-NO                                          
P#585B             ,:WS-A                                               
P#585B             ,:G6-PARM-DATA)                                      
P#585B     END-EXEC.                                                    

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

P#585B*                                                                         
P#585B     MOVE SQLCODE                     TO WS-ACTIVE-RETURN-CODE.   
P#585B                                                                  
P#585B     IF WS-ACTIVE-RETURN-CODE EQUAL SUCCESSFUL-CALL               
P#585B        CONTINUE                                                  
P#585B     ELSE                                                         
P#585B         MOVE WS-ACTIVE-RETURN-CODE   TO WS-DISPLAY-SQLCODE       
P#585B         DISPLAY '************ PCSCA273 ERROR ******************' 
P#585B         DISPLAY '* 8700-INSERT-DOMAIN    '                       
P#585B         DISPLAY '* PROGRAM_NAME     = ' 'PCSCA271'               
P#585B         DISPLAY '* COMPANY-NO       = ' G6-COMPANY-NO            
P#585B         DISPLAY '* PARM_DATA        = ' G6-PARM-DATA             
P#585B         DISPLAY '* SQL RETURN CODE  = ' WS-DISPLAY-SQLCODE       
P#585B         DISPLAY '**********************************************' 
P#585B         PERFORM 9900-ABEND           THRU 9900-EXIT              
P#585B     END-IF.                                                      
P#585B*                                                                         
P#585B 8700-EXIT.                                                       
P#585B     EXIT.                                                        
P#585B*                                                                         
P#585B*================================================================*        
P#585B 8800-WRITE-FIOCB273.                                             
P#585B*================================================================*        
P#585B*                                                                         
P#585B     WRITE FIOCB273-REC.                                          
P#585B*                                                                         
P#585B     IF FCS273B-SUCCESSFUL                                        
P#585B        CONTINUE                                                  
P#585B     ELSE                                                         
P#585B         DISPLAY '8800-WRITE-FIOCB273 WRITE.  STATUS IS '         
P#585B                  WS-FCS273B-STATUS                               
P#585B         PERFORM 9900-ABEND                THRU 9900-EXIT         
P#585B     END-IF.                                                      
P#585B*                                                                         
P#585B 8800-EXIT.                                                       
P#585B     EXIT.                                                        
P#585B*                                                                         
      *================================================================*        
      * GET FCA00 COMMON DATE - 6240-GET-FCA00-COMMON-DATE *                    
       COPY CPD00040.                                                           
      *================================================================*        
      *                                                                         
      *================================================================*        
      * 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.                                                            
      *                                                                         
      *================================================================*        
      * 8893-RESET-RESTART-REQ-PARM                                             
      *================================================================*        
      *                                                                         
           EXEC SQL                                                             
               INCLUDE CPD00029                                                 
           END-EXEC.                                                            
      *                                                                         
      *================================================================*        
       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 '**  PCSCA273 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 '**  PCSCA273 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 FCSCA273-FILE.                                         
      *                                                                         
           IF FCS273-SUCCESSFUL                                         
               CONTINUE                                                 
           ELSE                                                         
               DISPLAY '**  PCSCA273 PROCESSING ERROR           **'     
               DISPLAY '**  9000-TERMINATE                      **'     
               DISPLAY '**  CLOSE ERROR  - INPUT FILES          **'     
               DISPLAY '**  FILE STATUS = ' WS-FCS273-STATUS            
               DISPLAY '**  UNSUCCESSFUL CLOSE OF FCSCA273 FILE **'     
           END-IF.                                                      
      *                                                                         
P#585B     CLOSE FCSCB273-FILE.                                         
P#585B*                                                                         
P#585B     IF FCS273B-SUCCESSFUL                                        
P#585B         CONTINUE                                                 
P#585B     ELSE                                                         
P#585B         DISPLAY '**  PCSCA273 PROCESSING ERROR           **'     
P#585B         DISPLAY '**  9000-TERMINATE                      **'     
P#585B         DISPLAY '**  CLOSE ERROR  - OUTPUT FILES         **'     
P#585B         DISPLAY '**  FILE STATUS = ' WS-FCS273B-STATUS           
P#585B         DISPLAY '**  UNSUCCESSFUL CLOSE OF FCSCB273 FILE **'     
P#585B     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.                                                            
      *                                                                         
