       IDENTIFICATION DIVISION.                                         
       PROGRAM-ID.    PCSCA550.                                         
       DATE-WRITTEN.  DEC-2004.                                         
       DATE-COMPILED.                                                   
       AUTHOR.        GOKUL                                             
      *****************************************************************         
      **              SOUTH CAROLINA ELECTRICITY  & GAS              **         
      **                                                             **         
      ********            CUSTOMER SERVICE SYSTEM             *********         
      ********                   DB2                          *********         
      *****************************************************************         
      **                                                             **         
      **              PROGRAM  MODIFICATION  LOG                     **         
      **                                                             **         
      ** DATE       INITIALS       REASON                            **         
      **                                                             **         
      ** 12/07/04   GOKUL          DEVELOPMENT OF NEW PROGRAM        **         
T35434** 06/08/07   MK92804        REPLACED MODEL_SQL WITH SET       **         
T35434**                           COMMAND AND ADDED WITH UR TO AVOID**         
T35434**                           -911.                             **         
C33971** 05/01/08   MC95456        PROGRAM LOGIC CHANGED TO USE LAST **         
C33971**                           RUN DATE & TIME IN PLACE OF THE   **         
C33971**                           PREVIOUS BUSINESS DATE.           **         
C36013** 05/08/08   MJ13662        REMOVED LOGIC THAT WAS MOVE 'Y' TO**         
C36013**                           E-FCA550-CONTACT-INFO IF CONTACT-FL*         
C36013**                           = SPACES.                         **         
C36013** 08/22/08   MJ13662        REMOVED REFERENCE TO CSS_IVR_NOTICE*         
      *****************************************************************         
      *                   PCSCA550   NARRATIVE                        *         
      *                                                               *         
      * THIS PROGRAM EXTRACTS DATA FROM CSS_CREDIT_HIST,              *         
      * CSS_CRED_ITPA_HIST AND CSS_NAME_ACCT_XREF TABLES FOR DAILY    *         
      * ITPA REPORT.                                                  *         
      *****************************************************************         
      *                                                                         
                    ---- BASIC SEQUENCE STRUCTURE ----                  
                0000 - 0999     MAIN CONTROL PATH AND INITIALIZATION    
                1000 - 1999     INPUT PROCESSING CONTROL PATH           
                2000 - 2999     OUTPUT PROCESSING CONTROL PATH          
                7000 - 7999     DATABASE ACCESS / INPUT MODULES         
                8000 - 8999     OUTPUT MODULES                          
                9000 - 9799     TERMINATION MODULES                     
HPCCDM*EJECT                                                                    
       ENVIRONMENT DIVISION.                                            
       CONFIGURATION SECTION.                                           
       SOURCE-COMPUTER.    IBM-370.                                     
       OBJECT-COMPUTER.    IBM-370.                                     
       SPECIAL-NAMES.      C01 IS TOP-OF-PAGE.                          
      *                                                                         
       INPUT-OUTPUT SECTION.                                            
       FILE-CONTROL.                                                    
       COPY CSSCA550.                                                           
      *                                                                         
       DATA DIVISION.                                                   
       FILE SECTION.                                                    
      ******************************************************************        
      * CFDC0550 - FD FOR DAILY ITPA ALERTS REPORT                     *        
      ******************************************************************        
       COPY CFDCA550.                                                           
       COPY FIOCA550.                                                           
                                                                        
       WORKING-STORAGE SECTION.                                         

MSQ017 01 MFA-PROGRAM-ID PIC X(8) VALUE 'PCSCA550'.
MSQ017     COPY MFASQLM.
      *                                                                         
       01  WS-START                      PIC X(40) VALUE                
           'WORKING STORAGE FOR PCSCA550 STARTS HERE'.                  
                                                                        
       01  WS-MISC.                                                     
                                                                        
           05 WS-YES                     PIC X(01) VALUE 'Y'.           
           05 WS-NO                      PIC X(01) VALUE 'N'.           
           05 WS-PGRMNAME                PIC X(08) VALUE 'PCSCA550'.    
           05 WS-COMPANY-NO              PIC X(02).                     
           05 WS-FULL-NAME               PIC X(28).                     
           05 WS-SYSIN-EXIST             PIC X(01) VALUE 'Y'.           
              88 SYSIN-EXISTS                      VALUE 'Y'.           
           05 WS-TIMESTAMP.                                             
              10 FILLER                  PIC X(11).                     
              10 WS-TIME                 PIC X(08).                     
              10 FILLER                  PIC X(07).                     
           05 WS-DAYS                    PIC 9(01).                     
           05 WS-COMMON-DATE             PIC X(10).                     
           05 WS-FCA550-STATUS           PIC X(02).                     
               88 FCA550-SUCCESS                   VALUE '00'.          
           05  WS-SYSIN-COMP-NO          PIC X(02) VALUE '  '.          
           05 WS-EXTT-TIME               PIC 9(08).                     
      *                                                                         
           05 WS-TMP-TIME REDEFINES WS-EXTT-TIME.                       
              10 WS-TMP-TIME-HH          PIC X(02).                     
              10 WS-TMP-TIME-MM          PIC X(02).                     
              10 WS-TMP-TIME-SS          PIC X(02).                     
              10 FILLER                  PIC X(02).                     
                                                                        
C33971     05 WS-LAST-RUN-DATE           PIC X(10).                     
C33971     05 WS-LAST-RUN-TIME           PIC X(08).                     
                                                                        
           05 WS-SCORE-TIME.                                            
              10 WS-SCR-TIME-HH          PIC X(02).                     
              10 FILLER                  PIC X(01) VALUE ':'.           
              10 WS-SCR-TIME-MM          PIC X(02).                     
              10 FILLER                  PIC X(01) VALUE ':'.           
              10 WS-SCR-TIME-SS          PIC X(02).                     
      *                                                                         
       01  WS-SWITCHES.                                                 
           05  WS-PREV-BUSINESS-DAY      PIC X(01) VALUE 'N'.           
               88 PREV-BUSINESS-DAY-FOUND          VALUE 'Y'.           
           05  WS-END-CURSOR             PIC X(01) VALUE 'N'.           
               88 END-CURSOR                       VALUE 'Y'.           
                                                                        
      ****************************************************************          
      **                COMMON COPYBOOK FOR WS-VARIABLES            **          
      ****************************************************************          
       COPY CWS00038.                                                           
C33971 01  WS-INPUT-DATA-R8                                             
C33971     REDEFINES  WS-INPUT-DATA-BREAKDOWN.                          
C33971     05  WS-LAST-PRG-RUN-DATE         PIC X(14).                  
C33971         88  LAST-PRG-RUN-DT                                      
C33971         VALUE 'LAST RUN DATE='.                                  
C33971     05  WS-LAST-PRG-RUN-DT           PIC X(10).                  
C33971     05  WS-FILLER                    PIC X(01).                  
C33971     05  WS-LAST-PRG-RUN-TIME.                                    
C33971        10 WS-LST-TIME-HH          PIC X(02).                     
C33971        10 WS-FILLER1              PIC X(01).                     
C33971        10 WS-LST-TIME-MM          PIC X(02).                     
C33971        10 WS-FILLER2              PIC X(01).                     
C33971        10 WS-LST-TIME-SS          PIC X(02).                     
       COPY CWS00039.                                                           
       COPY CWS00027.                                                           
       COPY CWS09900.                                                           
       COPY CWS00303.                                                           
       COPY FIOCA01.                                                            
       COPY FIOJC01.                                                            
       COPY FIOCA00.                                                            
                                                                        
      *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*         
      * SQL COMMUNICATION AREA                                        *         
      *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*         
                                                                        
            EXEC SQL                                                            
                INCLUDE SQLCA                                                   
            END-EXEC.                                                           
                                                                        
      *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*         
      * CSS_HOLIDAY                                                   *         
      *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*         
            EXEC SQL                                                            
               INCLUDE TBHLDAY                                                  
            END-EXEC.                                                           
      *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*         
      * CSS_JOB_PARM                                                  *         
      *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*         
                                                                        
            EXEC SQL                                                            
                INCLUDE TBJBPARM                                                
            END-EXEC.                                                           
                                                                        
      *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*         
      *   CSS_NAME                                                    *         
      *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*         
                                                                        
            EXEC SQL                                                            
                INCLUDE TBNAME                                                  
            END-EXEC.                                                           
                                                                        
      *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*         
      *   CSS_LOCAL_OFFICE                                            *         
      *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*         
                                                                        
           EXEC SQL                                                             
                INCLUDE TBLOCOFC                                                
           END-EXEC.                                                            
                                                                        
      *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*         
      *   CSS_NAME_ACCT_XREF                                          *         
      *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*         
                                                                        
           EXEC SQL                                                             
                INCLUDE TBNMACTX                                                
           END-EXEC.                                                            
                                                                        
           EXEC SQL                                                     01239099
              INCLUDE TBCRITPA                                          01240099
           END-EXEC.                                                    01241099
      *                                                                         
           EXEC SQL                                                     01239099
              INCLUDE TBITPHON                                          01240099
           END-EXEC.                                                    01241099
                                                                        
           EXEC SQL                                                     01232865
              INCLUDE TBCRHIST                                          01232993
           END-EXEC.                                                    01233065
                                                                        
           EXEC SQL                                                             
                INCLUDE CWS00315                                                
           END-EXEC.                                                            
                                                                        
                                                                        
      *****************************************************************         
      **  CURSOR FOR FETCHING DAILY ITPA DATA.                       **         
      *****************************************************************         
                                                                        
           EXEC SQL                                                     
              DECLARE DAILY-ITPA    CURSOR FOR                          
              SELECT CK.CUSTOMER_NO                                     
                    ,CK.CR_HIST_TRAN_DT                                 
                    ,REPLACE(CONVERT(CHAR(8), CK.CR_HIST_TRAN_TM, 108), 
           ':', '.') CR_HIST_TRAN_TM                                 
                    ,LF.ITPA_RSLT_CURR_CD                               
                    ,LTRIM(RTRIM(DQ.LAST_NAME)) + ', ' + CIS.SUBSTR3(
           DQ.FIRST_NAME,1,1) AS CUSTOMER_NAME         
                    ,CK.CR_ACTION_FL                                    
                    ,LF.CONTACT_INFO_FL                                 
                    ,CK.CR_RQST_REASON_CD                               
                    ,CK.BEACON_SCORE                                    
                    ,CK.ITPA_EXISTS_CD                                  
                    ,CK.REG_GROUP_CD                                    
                    ,HT.COMPANY_NO                                      
               FROM  CSS_CREDIT_HIST    CK WITH(READUNCOMMITTED)                
                    ,CSS_NAME_ACCT_XREF HT WITH(READUNCOMMITTED)                
                    ,CSS_NAME           DQ WITH(READUNCOMMITTED)                
                    ,CSS_CUST_STATS     CE WITH(READUNCOMMITTED)                
                    ,CSS_CRED_ITPA_HIST LF WITH(READUNCOMMITTED)                
               WHERE  CK.CUSTOMER_NO              = LF.CUSTOMER_NO      
                 AND  LF.CUSTOMER_NO              = HT.CUSTOMER_NO      
                 AND  HT.CUSTOMER_NO              = CE.CUSTOMER_NO      
                 AND  CE.NAME_ID                  = HT.NAME_ID          
                 AND  HT.NAME_ID                  = DQ.NAME_ID          
                 AND  CK.CR_HIST_TRAN_DT          = LF.CR_HIST_TRAN_DT  
                 AND  CK.CR_HIST_TRAN_TM          = LF.CR_HIST_TRAN_TM  
                 AND  HT.COMPANY_NO               = :WS-COMPANY-NO      
                 AND  CE.CUSTOMER_TYPE            = 'C'                 
                 AND  CK.ITPA_EXISTS_CD          <> ' '                 
C33971           AND  CK.CR_HIST_TRAN_DT         >= 
              IIF(TRY_CONVERT(DATE, :WS-LAST-RUN-DATE
              ) IS NULL OR (PATINDEX('%.%', :WS-LAST-RUN-DATE
              ) <> 0) OR (LEN(:WS-LAST-RUN-DATE) <> 10), CIS.CHAR2DATE(
                                                      :WS-LAST-RUN-DATE
              ), CONVERT(DATE, :WS-LAST-RUN-DATE) )   
            ORDER BY  CK.CR_HIST_TRAN_DT                                
                     ,CR_HIST_TRAN_TM                                
T35434           FOR READ ONLY                                  
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ004
MFA-TR* MSQ022
MFA-TR* MSQ029
MFA-TR* MSQ031
MFA-TR* MSQ054
MFA-TR* MSQ061
MFA-TR*    EXEC SQL                                                             
MFA-TR*       DECLARE DAILY-ITPA    CURSOR FOR                                  
MFA-TR*       SELECT CK.CUSTOMER_NO                                             
MFA-TR*             ,CK.CR_HIST_TRAN_DT                                         
MFA-TR*             ,CK.CR_HIST_TRAN_TM                                         
MFA-TR*             ,LF.ITPA_RSLT_CURR_CD                                       
MFA-TR*             ,CHAR(STRIP(DQ.LAST_NAME) || ', ' ||                00043500
MFA-TR*             SUBSTR(DQ.FIRST_NAME,1,1)) AS CUSTOMER_NAME         00043900
MFA-TR*             ,CK.CR_ACTION_FL                                            
MFA-TR*             ,LF.CONTACT_INFO_FL                                         
MFA-TR*             ,CK.CR_RQST_REASON_CD                                       
MFA-TR*             ,CK.BEACON_SCORE                                            
MFA-TR*             ,CK.ITPA_EXISTS_CD                                          
MFA-TR*             ,CK.REG_GROUP_CD                                            
MFA-TR*             ,HT.COMPANY_NO                                              
MFA-TR*        FROM  CSS_CREDIT_HIST    CK                                      
MFA-TR*             ,CSS_NAME_ACCT_XREF HT                                      
MFA-TR*             ,CSS_NAME           DQ                                      
MFA-TR*             ,CSS_CUST_STATS     CE                                      
MFA-TR*             ,CSS_CRED_ITPA_HIST LF                                      
MFA-TR*        WHERE  CK.CUSTOMER_NO              = LF.CUSTOMER_NO              
MFA-TR*          AND  LF.CUSTOMER_NO              = HT.CUSTOMER_NO              
MFA-TR*          AND  HT.CUSTOMER_NO              = CE.CUSTOMER_NO              
MFA-TR*          AND  CE.NAME_ID                  = HT.NAME_ID                  
MFA-TR*          AND  HT.NAME_ID                  = DQ.NAME_ID                  
MFA-TR*          AND  CK.CR_HIST_TRAN_DT          = LF.CR_HIST_TRAN_DT          
MFA-TR*          AND  CK.CR_HIST_TRAN_TM          = LF.CR_HIST_TRAN_TM          
MFA-TR*          AND  HT.COMPANY_NO               = :WS-COMPANY-NO              
MFA-TR*          AND  CE.CUSTOMER_TYPE            = 'C'                         
MFA-TR*          AND  CK.ITPA_EXISTS_CD          <> ' '                         
MFA-TR*          AND  CK.CR_HIST_TRAN_DT         >= :WS-LAST-RUN-DATE           
MFA-TR*     ORDER BY  CK.CR_HIST_TRAN_DT                                        
MFA-TR*              ,CK.CR_HIST_TRAN_TM                                        
MFA-TR*          FOR FETCH ONLY WITH UR                                         
MFA-TR*    END-EXEC.                                                            
                                                                        
       01  WS-END                        PIC X(40) VALUE                
           'WORKING STORAGE FOR PCSCA550 ENDS HERE  '.                  
                                                                        
      *                                                                         
       PROCEDURE DIVISION.                                              
                                                                        
      *                                                                         
      ****************************************************************          
      **                                                            **          
      **   0000-MAINLINE                                            **          
      **       CONTROLS THE MAIN PROCESSING OF THE PROGRAM          **          
      **                                                            **          
      ****************************************************************          
      *                                                                         
       0000-MAINLINE.                                                   
                                                                        
           MOVE '0000'                   TO  WS-ACTIVE-PARAGRAPH.       
                                                                        
           PERFORM 0100-INITIALIZATION   THRU 0100-EXIT.                
                                                                        
           PERFORM 1000-MAIN-PROCESS-PARA                               
                                         THRU 1000-EXIT.                
                                                                        
C33971     PERFORM 5400-UPDATE-RUN-DT-TIME THRU 5400-EXIT.              
                                                                        
           PERFORM 9000-TERMINATE        THRU 9000-EXIT.                
                                                                        
           STOP RUN.                                                    
                                                                        
       0000-EXIT.                                                       
           EXIT.                                                        
      ***********************************************************               
      **                                                       **               
      **   0100-INITIALIZATION.                                **               
      **       INITIALIZATION ROUTINE                          **               
      ***********************************************************               
                                                                        
       0100-INITIALIZATION.                                             
      *                                                                         
           MOVE '0100'                   TO WS-ACTIVE-PARAGRAPH.        
                                                                        
           OPEN OUTPUT FCSCA550-FILE.                                   
                                                                        
           IF WS-FCA550-STATUS NOT = '00'                               
               DISPLAY 'OPEN SUCCESS FILE ERROR'  WS-FCA550-STATUS      
               DISPLAY '**************************************'         
               DISPLAY '**   0100-INITIALIZATION              '         
               DISPLAY '**   ERROR OPENING SUCCESS FILE'                
               DISPLAY '**   FILE STATUS = ' WS-FCA550-STATUS           
               DISPLAY '**************************************'         
               MOVE 12                   TO RETURN-CODE                 
               PERFORM 9000-TERMINATE    THRU 9000-EXIT                 
           END-IF.                                                      
                                                                        
           ACCEPT WS-SYSIN-COMP-NO FROM SYSIN.                          
           IF WS-SYSIN-COMP-NO EQUAL SPACES OR LOW-VALUES               
               MOVE WS-N               TO WS-SYSIN-EXIST                
           END-IF.                                                      
      *                                                                         
           IF SYSIN-EXISTS                                              
               MOVE WS-SYSIN-COMP-NO   TO WS-COMPANY-NO                 
           ELSE                                                         
               DISPLAY 'COMPANY NO NOT PRESENT '                        
               DISPLAY '**************************************'         
               DISPLAY '**   0100-INITIALIZATION              '         
               DISPLAY '**   ERROR GETTING COMPANY NO  '                
               DISPLAY '**************************************'         
               MOVE 12                   TO RETURN-CODE                 
               PERFORM 9000-TERMINATE    THRU 9000-EXIT                 
           END-IF.                                                      
      *                                                                         
C33971     MOVE  WS-COMPANY-NO TO G6-COMPANY-NO.                        
      *                                                                         
           PERFORM 6251-GET-FJC01-DATE    THRU 6251-EXIT.               
           IF  COMMON-DATE-NEEDED                                       
               MOVE 'COMMON  '           TO WS-PGRMNAME                 
               MOVE ' '                  TO G6-COMPANY-NO               
               MOVE SPACES               TO WS-INPUT-AREA               
               MOVE SPACES               TO WS-INPUT-DATA-BREAKDOWN     
               PERFORM 6251-GET-FJC01-DATE                              
                                         THRU 6251-EXIT                 
               MOVE 'PCSCA550'           TO WS-PGRMNAME                 
           END-IF.                                                      
           MOVE WS-INPUT-RUN-DATE        TO WS-COMMON-DATE.             
                                                                        
C33971     MOVE  WS-PGRMNAME   TO WS-PROGRAM.                           
C33971     MOVE  WS-DATE       TO G6-CMND-CODE.                         
C33971     MOVE  WS-COMPANY-NO TO G6-COMPANY-NO.                        
      *                                                                         
C33971     PERFORM  7600-START-FCSJC01       THRU 7600-EXIT.            
      *                                                                         
C33971     MOVE SPACES TO WS-SYSIPT.                                    
      *                                                                         
C33971     PERFORM 7610-READ-FCSJC01        THRU 7610-EXIT              
C33971             UNTIL END-OF-SYSIPT OR                               
C33971         (G6-STATUS = 'A' AND LAST-PRG-RUN-DT).                   
      *                                                                         
C33971     IF END-OF-SYSIPT                                             
C33971         DISPLAY ' '                                              
C33971         DISPLAY '**  PCSCA550 PROCESSING ERROR             **'   
C33971         DISPLAY '**LAST RUN DATE&TIME NOT FOUND IN CSS_JOB_PARM' 
C33971         DISPLAY '**  PROCESSING TERMINATED                 **'   
C33971         PERFORM 9900-ABEND                    THRU 9900-EXIT     
C33971     END-IF.                                                      
                                                                        
C33971     MOVE G6-PARM-DATA                 TO WS-INPUT-DATA-R8.       
C33971     MOVE WS-LAST-PRG-RUN-DT           TO WS-LAST-RUN-DATE.       
C33971     MOVE WS-LAST-PRG-RUN-TIME         TO WS-LAST-RUN-TIME.       
                                                                        
C33971     IF WS-LAST-RUN-DATE   > WS-COMMON-DATE                       
C33971        DISPLAY '********** PCSCA550 ABORT **************'        
C33971        DISPLAY '*       0100-INITIALIZATION            *'        
C33971        DISPLAY '* PROGRAM LAST RUN DATE SHOULD BE      *'        
C33971        DISPLAY '*     LESS THAN CURRENT DATE           *'        
C33971        DISPLAY '* PROGRAM ABORTING...                  *'        
C33971        DISPLAY '********** PCSCA550 ABORT **************'        
C33971        PERFORM 9900-ABEND               THRU 9900-EXIT           
C33971     END-IF.                                                      
      *                                                                         
           ACCEPT WS-EXTT-TIME     FROM TIME.                           
           MOVE WS-TMP-TIME-HH           TO WS-SCR-TIME-HH.             
           MOVE WS-TMP-TIME-MM           TO WS-SCR-TIME-MM.             
           MOVE WS-TMP-TIME-SS           TO WS-SCR-TIME-SS.             
      *                                                                         
      *                                                                         
       0100-EXIT.                                                       
           EXIT.                                                        
      *************************************************************             
      **                                                         **             
      **      1000-MAIN-PROCESS-PARA                             **             
      **           MAIN PROCESS BEGINS HERE                      **             
      **                                                         **             
      *************************************************************             
                                                                        
       1000-MAIN-PROCESS-PARA.                                          
      *                                                                         
           PERFORM 2100-PROCESS-HEADER-REC                              
                                         THRU 2100-EXIT.                
           PERFORM 2000-PROCESS-RECORDS  THRU 2000-EXIT.                
      *                                                                         
       1000-EXIT.                                                       
           EXIT.                                                        
      *************************************************************             
      **                                                         **             
      **      2000-PROCESS-RECORDS                               **             
      **      PROCESSES THE DAILY ITPA RECORDS.                  **             
      **                                                         **             
      *************************************************************             
                                                                        
       2000-PROCESS-RECORDS.                                            
      *                                                                         
           PERFORM 7300-OPEN-DAILY-ITPA-CURSOR                          
                                         THRU 7300-EXIT.                
           PERFORM 7400-FETCH-DAILY-ITPA-CURSOR                         
                                         THRU 7400-EXIT.                
           PERFORM 2200-MOVE-ITPA-PARA  THRU 2200-EXIT                  
            UNTIL END-CURSOR                                            
           PERFORM 7500-CLOSE-DAILY-ITPA-CURSOR                         
                                         THRU 7500-EXIT.                
        2000-EXIT.                                                      
           EXIT.                                                        
                                                                        
                                                                        
      *************************************************************             
      **                                                         **             
      **      2100-PROCESS-HEADER-REC                            **             
      **                                                         **             
      **                                                         **             
      *************************************************************             
                                                                        
       2100-PROCESS-HEADER-REC.                                         
      *                                                                         
           INITIALIZE E-FCA550-BEGIN-REC.                               
           MOVE WS-COMMON-DATE           TO E-FCA550-SCORE-DATE-BREC.   
           MOVE WS-SCORE-TIME            TO E-FCA550-SCORE-TIME-BREC.   
           MOVE LOW-VALUES               TO E-FCA550-KEY-BREC.          
           PERFORM 8000-WRITE-FCA550-PARA                               
                                         THRU 8000-EXIT.                
      *                                                                         
       2100-EXIT.                                                       
           EXIT.                                                        
      ***************************************************************           
      **    2200-MOVE-ITPA-PARA                                    **           
      **    MOVE TABLE VALUES TO FCSCA550 FILE                     **           
      ***************************************************************           
       2200-MOVE-ITPA-PARA.                                             
                                                                        
C33971     IF    CK-CR-HIST-TRAN-DT = WS-LAST-RUN-DATE                  
C33971           AND CK-CR-HIST-TRAN-TM <= WS-LAST-RUN-TIME             
C33971           NEXT SENTENCE                                          
C33971     ELSE                                                         
                 INITIALIZE E-FCA550-DATA-REC                           
                 MOVE SPACES                   TO E-FCA550-DATA-REC     
                 MOVE HT-COMPANY-NO            TO                       
                                             E-FCA550-COMPANY-NO        
                 MOVE CK-CUSTOMER-NO           TO                       
                                             E-FCA550-CUSTOMER-NO       
                 MOVE CK-CR-HIST-TRAN-DT       TO                       
                                             E-FCA550-SCORE-DATE        
                 MOVE CK-CR-HIST-TRAN-TM       TO                       
                                             E-FCA550-SCORE-TIME        
                 INSPECT E-FCA550-SCORE-TIME REPLACING ALL '.' BY ':'   
                                                                        
                 MOVE WS-FULL-NAME             TO                       
                                             E-FCA550-CUST-NAME         
                 MOVE LF-ITPA-RSLT-CURR-CD     TO                       
                                             E-FCA550-RESULT-STATUS     
                 MOVE CK-CR-ACTION-FL          TO                       
                                             E-FCA550-CRED-ACTION       
                 MOVE LF-CONTACT-INFO-FL       TO                       
                                             E-FCA550-CONTACT-INFO      
                                                                        
                 IF CK-REG-GROUP-CD = '100' OR '200'                    
                    MOVE   '1'                 TO E-FCA550-REG-GROUP-CD 
                 ELSE                                                   
                    MOVE   '2'                 TO E-FCA550-REG-GROUP-CD 
                 END-IF                                                 
                 MOVE CK-CR-RQST-REASON-CD     TO                       
                                             E-FCA550-RQST-REASON       
                 MOVE CK-BEACON-SCORE          TO                       
                                             E-FCA550-BEACON-SCORE      
                 MOVE CK-ITPA-EXISTS-CD        TO                       
                                             E-FCA550-ITPA-TYPE         
                 PERFORM 8000-WRITE-FCA550-PARA                         
                                                 THRU 8000-EXIT         
C33971     END-IF.                                                      
                                                                        
           PERFORM 7400-FETCH-DAILY-ITPA-CURSOR                         
                                         THRU 7400-EXIT.                
                                                                        
       2200-EXIT.                                                       
           EXIT.                                                        
                                                                        
      *****************************************************************         
      ** 6251-GET-FJC01-DATE                                         **         
      *****************************************************************         
      *                                                                         
           EXEC SQL                                                             
                INCLUDE CPD00037                                                
           END-EXEC.                                                            
                                                                        
           EXEC SQL                                                             
                INCLUDE CPD00038                                                
           END-EXEC.                                                            
                                                                        
           EXEC SQL                                                             
                INCLUDE CPD00039                                                
           END-EXEC.                                                            
      *                                                                         
      *                                                                         
C33971*****************************************************************         
C33971*                                                               *         
C33971* 5400-UPDATE-RUN-DT-TIME.                                      *         
C33971*****************************************************************         
C33971 5400-UPDATE-RUN-DT-TIME.                                         
      *                                                                         
C33971     INITIALIZE G6-PARM-DATA.                                     
C33971     MOVE  WS-COMMON-DATE          TO WS-LAST-PRG-RUN-DT.         
C33971     MOVE  WS-SCORE-TIME           TO WS-LAST-PRG-RUN-TIME.       
C33971     MOVE  '.'                     TO WS-FILLER1                  
C33971                                      WS-FILLER2.                 
C33971     MOVE  WS-INPUT-DATA-R8        TO G6-PARM-DATA.               
C33971     MOVE  WS-PGRMNAME             TO G6-PROGRAM-NAME.            
C33971     MOVE  WS-DATE                 TO G6-CMND-CODE.               
C33971     MOVE  10                      TO G6-SEQ-NO.                  
                                                                        
C33971     PERFORM 8100-UPDATE-LAST-RUN-DATE   THRU 8100-EXIT.          
                                                                        
C33971 5400-EXIT.                                                       
C33971     EXIT.                                                        
      ***************************************************************           
      **                                                           **           
      **    7300-OPEN-DAILY-ITPA-CURSOR                            **           
      **       OPEN IVE NOTICE CURSOR                              **           
      ***************************************************************           
                                                                        
       7300-OPEN-DAILY-ITPA-CURSOR.                                     
                                                                        
           EXEC SQL                                                     
                OPEN DAILY-ITPA                                         
           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.      
           EVALUATE WS-ACTIVE-RETURN-CODE                               
               WHEN SUCCESSFUL-CALL                                     
                   CONTINUE                                             
               WHEN OTHER                                               
                   DISPLAY '** PCSCA550 PROCESSING ERROR        **'     
                   DISPLAY '** ERROR ON CURSOR OPEN             **'     
                   DISPLAY '** PARA 7300-OPEN-DAILY-ITPA-CURSOR **'     
                   DISPLAY '** SQLCODE IS  ** ' SQLCODE                 
                   DISPLAY '** PROCESSING TERMINATED            **'     
                   PERFORM 9900-ABEND    THRU 9900-EXIT                 
           END-EVALUATE.                                                
                                                                        
       7300-EXIT.                                                       
           EXIT.                                                        
                                                                        
      ***************************************************************           
      **                                                           **           
      **    7400-FETCH-DAILY-ITPA-CURSOR                           **           
      ***************************************************************           
       7400-FETCH-DAILY-ITPA-CURSOR.                                    
                                                                        
           EXEC SQL                                                     
                FETCH DAILY-ITPA  INTO                                  
                    :CK-CUSTOMER-NO                                     
                   ,:CK-CR-HIST-TRAN-DT                                 
                   ,:CK-CR-HIST-TRAN-TM                                 
                   ,:LF-ITPA-RSLT-CURR-CD                               
                   ,:WS-FULL-NAME                                       
                   ,:CK-CR-ACTION-FL                                    
                   ,:LF-CONTACT-INFO-FL                                 
                   ,:CK-CR-RQST-REASON-CD                               
                   ,:CK-BEACON-SCORE                                    
                   ,:CK-ITPA-EXISTS-CD                                  
                   ,:CK-REG-GROUP-CD                                    
                   ,:HT-COMPANY-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.      
           EVALUATE WS-ACTIVE-RETURN-CODE                               
               WHEN SUCCESSFUL-CALL                                     
                   CONTINUE                                             
               WHEN NOT-FOUND                                           
                   SET END-CURSOR        TO TRUE                        
               WHEN OTHER                                               
                   DISPLAY '** PCSCA550 PROCESSING ERROR        **'     
                   DISPLAY '** ERROR ON CURSOR OPEN             **'     
                   DISPLAY '** PARA 7400-FETCH-DAILY-ITPA-CURSOR**'     
                   DISPLAY '** SQLCODE IS  ** ' SQLCODE                 
                   DISPLAY '** PROCESSING TERMINATED            **'     
                   PERFORM 9900-ABEND    THRU 9900-EXIT                 
           END-EVALUATE.                                                
                                                                        
       7400-EXIT.                                                       
           EXIT.                                                        
      ***************************************************************           
      **    7500-CLOSE-DAILY-ITPA-CURSOR                           **           
      **    CLOSE CURSOR CALLSTATUS                                **           
      ***************************************************************           
       7500-CLOSE-DAILY-ITPA-CURSOR.                                    
                                                                        
           EXEC SQL                                                     
             CLOSE DAILY-ITPA                                           
           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.      
           EVALUATE WS-ACTIVE-RETURN-CODE                               
               WHEN SUCCESSFUL-CALL                                     
                   CONTINUE                                             
               WHEN OTHER                                               
                   DISPLAY '** PCSCA550 PROCESSING ERROR        **'     
                   DISPLAY '** ERROR ON CURSOR CLOSE            **'     
                   DISPLAY '** PARA 7500-CLOSE-DAILY-ITPA-CURSOR  **'   
                   DISPLAY '** SQLCODE IS  ** ' SQLCODE                 
                   DISPLAY '** PROCESSING TERMINATED            **'     
                   PERFORM 9900-ABEND    THRU 9900-EXIT                 
           END-EVALUATE.                                                
       7500-EXIT.                                                       
           EXIT.                                                        
                                                                        
      ******************************************************************        
      *                                                                *        
      * 8000-WRITE-FCA550-PARA.                                        *        
      *      WRITE INTO SUCCESS FILE.                                  *        
      ******************************************************************        
      *                                                                         
       8000-WRITE-FCA550-PARA.                                          
      *                                                                         
            WRITE FIOCA550.                                             
            IF FCA550-SUCCESS                                           
               CONTINUE                                                 
            ELSE                                                        
               DISPLAY 'ERROR IN WRITING SUCCESSFUL FILE'               
                                                  WS-FCA550-STATUS      
               PERFORM 9900-ABEND           THRU 9900-EXIT              
            END-IF.                                                     
      *                                                                         
       8000-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
C33971*****************************************************************         
C33971*                                                               *         
C33971* 8100-UPDATE-LAST-RUN-DATE                                     *         
C33971*****************************************************************         
C33971 8100-UPDATE-LAST-RUN-DATE.                                       
                                                                        
C33971     EXEC SQL                                                     
C33971          UPDATE CSS_JOB_PARM                                     
C33971             SET PARM_DATA     = :G6-PARM-DATA                    
C33971           WHERE PROGRAM_NAME  = :G6-PROGRAM-NAME                 
C33971             AND CMND_CODE     = :G6-CMND-CODE                    
C33971             AND COMPANY_NO    = :G6-COMPANY-NO                   
C33971             AND SEQ_NO        = :G6-SEQ-NO                       
C33971     END-EXEC.                                                    

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

                                                                        
C33971     MOVE SQLCODE                  TO WS-ACTIVE-RETURN-CODE.      
                                                                        
C33971     IF WS-ACTIVE-RETURN-CODE EQUAL SUCCESSFUL-CALL               
C33971        NEXT SENTENCE                                             
C33971     ELSE                                                         
              DISPLAY '********** PCSCA550 ABORT **************'        
C33971        DISPLAY '*     8100-UPDATE-LAST-RUN-DATE        *'        
C33971        DISPLAY '* PROGRAM NAME   : ' G6-PROGRAM-NAME             
C33971        DISPLAY '* COMPANY NO     : ' G6-COMPANY-NO               
C33971        DISPLAY '* CMD CODE       : ' G6-CMND-CODE                
C33971        DISPLAY '* SQLCODE        : ' WS-ACTIVE-RETURN-CODE       
C33971        DISPLAY '* PROGRAM ABORTING...                  *'        
C33971        DISPLAY '********** PCSCA550 ABORT **************'        
C33971        PERFORM 9900-ABEND               THRU 9900-EXIT           
C33971     END-IF.                                                      
                                                                        
C33971 8100-EXIT.                                                       
C33971     EXIT.                                                        
      ******************************************************************        
      *                                                                *        
      * COPYBOOK FOR ABEND ROUTINE                                     *        
      *                                                                *        
      ******************************************************************        
      *                                                                         
           EXEC SQL                                                             
               INCLUDE CPD09900                                                 
           END-EXEC.                                                            
      *                                                                         
      ******************************************************************        
      **                                                              **        
      **  9000-TERMINATE.                                             **        
      **       TERMINATION ROUTINE                                    **        
      **                                                              **        
      ******************************************************************        
      *                                                                         
       9000-TERMINATE.                                                  
                                                                        
           CLOSE FCSCA550-FILE.                                         
                                                                        
C33971      IF FCA550-SUCCESS                                           
C33971         CONTINUE                                                 
C33971      ELSE                                                        
C33971         DISPLAY 'ERROR IN CLOSING FILE'                          
C33971                                            WS-FCA550-STATUS      
C33971         PERFORM 9900-ABEND           THRU 9900-EXIT              
C33971      END-IF.                                                     
                                                                        
       9000-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
