       IDENTIFICATION DIVISION.                                         
       PROGRAM-ID.  PCSXP310.                                           
       DATE-WRITTEN.  30 OCT 2008                                       
       DATE-COMPILED.                                                   
       AUTHOR.   MADHAVI CH.                                            
      ****************************************************************          
      **              SOUTH CAROLINA ELECTRICITY  & GAS              *          
      **                                                             *          
      ********            CUSTOMER SERVICE SYSTEM             ********          
      ********                   DB2                          ********          
      ****************************************************************          
      **                                                             *          
      **              PROGRAM  MODIFICATION  LOG                     *          
      **                                                             *          
      ** DATE       INITIALS       REASON                            *          
      ** 10/30/08  MC95456         APPL37648-ACT 7 & ACT 63                     
      **                                                             *          
      ** 02/10/10  SP94986         APPL37648-ACT 100                 *          
      **                                                             *          
      ** 07/15/10  SP94986         CHANGED THE CNT_STATUS_CD FROM    *          
      **                           ('C','D','E','R') TO              *          
      **                           ('C','D','E','R','P')             *          
ACT075** 07/25/12  MC95456          APPL3967-ACT 75 - CONTRACT SHOULD*          
ACT075**                            BE DELETED WHEN SUMM_CNT_ID = 0 *           
ACT075**                            (NON-MSE CONTRACTS)              *          
ACT278** 09/21/16  TP7R341          REMOVE UNWANTED COLUMNS FROM     *          
ACT278**                            CONTRACT TABLE AND REMOVE        *          
ACT278**                            EST USAGE TABLE RELATED CODE     *          
      ****************************************************************          
      *                   PCSXP310   NARRATIVE                       *          
                                                                     *  
      * THIS PROGRAM DELETES THE RECORDS FROM TABLES                 *          
      * 1.  CSS_EST_USAGE                                            *          
      * 2.  CSS_CONTRACT                                                        
      *                                                              *          
      * PURGE CRITERIA CAN BE FOUND IN THE CSS_JOB_PARM TABLE        *          
      * FOR EACH TABLE. TO SAFEGUARD AGAINST JOB PARM ERRORS AND     *          
      * ACCIDENTALY DELETING MORE DATA THAN INTENDED, THE FOLLOWING  *          
      * HARD CODED VALUES HAVE BEEN ESTABLISHED AS MINIMUM VALUES    *          
      * OF DATA THAT CAN BE DELETED FROM EACH TABLE WITHOUT REQUIRING*          
      * A PROGRAMMING CHANGE. JOB PARM MONTHS CAN BE CHANGED TO      *          
      * GREATER THAN THE MINIMUM BUT NOT LESS THAN MINIMUM           *          
      * 1.  CSS_EST_USAGE   - 12 MONTHS                              *          
      * 2.  CSS_CONTRACT    - 72 MONTHS                              *          
      *         ( CONTRACT TYPES 'I','J','K','L','M','N'             *          
      *           AND NO BALANCE IN CSS_AR_CNTL OR CSS_CHRG_OFF )    *          
      *                                                              *          
      * TO NOT PURGE DATA FOR A PARTICULAR TABLE, SET THE JOB PARM   *          
      * STATUS FOR THE PARTICULAR TABLE TO 'I' (INACTIVE)            *          
      *                                                              *          
      * IF PROGRAM ABENDS, IT CAN BE RERUN FROM THE START- NO        *          
      * RESTART IS NEEDED.                                           *          
      *                                                              *          
      * COMMITS ARE TAKEN                                            *          
      ****************************************************************          
      *                                                                         
                    ---- 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 - 9900     TERMINATION MODULES                     
      *                                                                         
       ENVIRONMENT DIVISION.                                            
       CONFIGURATION SECTION.                                           
       SOURCE-COMPUTER.    IBM-370.                                     
       OBJECT-COMPUTER.    IBM-370.                                     
       SPECIAL-NAMES.      C01 IS TOP-OF-PAGE.                          
      *                                                                         
       INPUT-OUTPUT SECTION.                                            
       FILE-CONTROL.                                                    
      *                                                                         
       DATA DIVISION.                                                   
       FILE SECTION.                                                    
      *                                                                         
       WORKING-STORAGE SECTION.                                         

MSQ017 01 MFA-PROGRAM-ID PIC X(8) VALUE 'PCSXP310'.
MSQ017     COPY MFASQLM.
      *                                                                         
       01  WS-VARIABLES.                                                
           05  WS-COMMIT-COUNT             PIC 9(4)  VALUE ZEROS.       
           05  WS-1000                     PIC 9(4)  VALUE 1000.        
           05  WS-1                        PIC 9     VALUE 1.           
           05  WS-I                        PIC S9(04) COMP VALUE 0.     
           05  WS-NBR-COMMIT               PIC 9(9)  VALUE ZEROS.       
           05  WS-ESTUSG-COUNT             PIC 9(9)  VALUE ZEROS.       
           05  WS-CONTRACT-COUNT           PIC 9(9)  VALUE ZEROS.       
           05  WS-ESTUSG-DELETE-DT         PIC X(10) VALUE SPACES.      
           05  WS-CONTRACT-DEL-DT          PIC X(10) VALUE SPACES.      
      *                                                                         
           05  WS-PGRMNAME                 PIC X(8)  VALUE 'PCSXP310'.  
           05  WS-CURRENT-TIMESTAMP        PIC X(26) VALUE SPACES.      
           05  WS-MONTHS                   PIC X(03) VALUE SPACES.      
           05  WS-MONTHS-VALUE                                          
               REDEFINES WS-MONTHS         PIC 9(03).                   
           05  WS-EST-USAGE-MO             PIC S9(3) COMP VALUE 0.      
           05  WS-CONTRACT-MO              PIC S9(3) COMP VALUE 0.      
           05  WS-NO-MORE-RECORDS          PIC X(01) VALUE 'N'.         
               88 NO-MORE-RECORDS          VALUE 'Y'.                   
           05  WS-EST-USG-DEL              PIC X(01) VALUE 'N'.         
               88 EST-USG-DEL              VALUE 'Y'.                   
           05  WS-CONTRACT-DEL             PIC X(01) VALUE 'N'.         
               88 CONTRACT-DEL             VALUE 'Y'.                   
           05  WS-NULL-IND                 PIC S9(4) COMP.              
           05  WS-JOB-PARM-ERR-CODE        PIC 9(02) VALUE 0.           
      ****************************************************************          
      **      APPLICATION  TABLE DCLGENS                             *          
      ****************************************************************          
      *                                                                         
           EXEC SQL                                                             
               INCLUDE SQLCA                                                    
           END-EXEC.                                                            
      *                                                                         
      ****************************************************************          
      *  CSS_CIS_PURGE     PU                                        *          
      ****************************************************************          
      *                                                                         
           EXEC SQL                                                             
               INCLUDE TBPURGE                                                  
           END-EXEC.                                                            
      *                                                                         
      ****************************************************************          
      *  CSS_BUDGET_PLAN    BU                                       *          
      ****************************************************************          
      *                                                                         
           EXEC SQL                                                             
               INCLUDE TBBGTPLN                                                 
           END-EXEC.                                                            
      *                                                                         
      ****************************************************************          
      *  CSS_CONTRACT       CT                                       *          
      ****************************************************************          
      *                                                                         
           EXEC SQL                                                             
               INCLUDE TBCNTRCT                                                 
           END-EXEC.                                                            
      *                                                                         
      ****************************************************************          
      **  CSS_JOB_PARM                                               *          
      ****************************************************************          
      *                                                                         
           EXEC SQL                                                             
               INCLUDE TBJBPARM                                                 
           END-EXEC.                                                            
      *                                                                         
      ****************************************************************          
      * FIOJC01 - IO AREA FOR PARAMETER INPUT FILE 'A'               *          
      ****************************************************************          
      *                                                                         
       COPY FIOJC01.                                                            
      *                                                                         
      ****************************************************************          
      *  ABEND SWITCH COPYBOOK                                       *          
      ****************************************************************          
      *                                                                         
       COPY CWS00038.                                                           
      *                                                                         
       COPY CWS00303.                                                           
      *-- COPY BOOK HAVING SUCCESSFUL-CALL AND NOT-FOUND                        
                                                                        
       COPY CWSPURGE.                                                           
      *-- COPY BOOK HAVING SUCCESSFUL-CALL AND NOT-FOUND                        
                                                                        
      *  ABEND SWITCH COPYBOOK                                                  
       COPY CWS09900.                                                           
      * -- USED BY CPD0303B                                                     
      * WS ABEND WORK AREA                                                      
       COPY CWS00010.                                                           
      *                                                                         
      ****************************************************************          
      * CURSOR DECLARATION TO SELECT ALL THE RECORDS                 *          
      * FROM CSS_CONTRACT                                            *          
      ****************************************************************          
      *                                                                         
           EXEC SQL                                                     
               DECLARE  CSS_CONTRACT CURSOR WITH HOLD FOR               
                  SELECT CT.ACCOUNT_NO                                  
                        ,CT.PYMT_PRIORITY_LVL                           
                        ,CT.CNT_ITEM_ID                                 
                  FROM   CSS_CONTRACT CT WITH(READUNCOMMITTED)                  
                  WHERE  CT.CODE_CONTRACT_TYPE IN                       
                                      ('I','J','K','L','M','N')         
                  AND    CT.CNT_STATUS_CD IN                            
A37648                                      ('C','D','E','R','P')       
                  AND CT.STATUS_CHANGE_DT                        
                                       <= IIF(TRY_CONVERT(DATE, 
                                                    :WS-CONTRACT-DEL-DT
              ) IS NULL OR (PATINDEX('%.%', :WS-CONTRACT-DEL-DT
              ) <> 0) OR (LEN(:WS-CONTRACT-DEL-DT
              ) <> 10), CIS.CHAR2DATE(:WS-CONTRACT-DEL-DT
              ), CONVERT(DATE, :WS-CONTRACT-DEL-DT) )           
                  AND NOT EXISTS                                        
                          (SELECT 1 FROM CSS_AR_CNTL AC
                           WITH(READUNCOMMITTED)                 
                           WHERE AC.ACCOUNT_NO      = CT.ACCOUNT_NO     
                           AND AC.PYMT_PRIORITY_LVL = 100               
                           AND AC.ITEM_ID           = CT.CNT_ITEM_ID    
                           AND AC.AMT_TRAN_BALANCE  > 0)                
                  AND NOT EXISTS                                        
                          (SELECT 1 FROM CSS_CHRG_OFF CO
                           WITH(READUNCOMMITTED)                
                           WHERE CO.ACCOUNT_NO      = CT.ACCOUNT_NO     
                           AND CO.PYMT_PRIORITY_LVL = 100               
                           AND CO.ITEM_ID           = CT.CNT_ITEM_ID    
                           AND CO.AMT_TRANS         > 0 )               
                FOR READ ONLY                                   
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ004
MFA-TR* MSQ022
MFA-TR* MSQ029
MFA-TR* MSQ054
MFA-TR*    EXEC SQL                                                             
MFA-TR*        DECLARE  CSS_CONTRACT CURSOR WITH HOLD FOR                       
MFA-TR*           SELECT CT.ACCOUNT_NO                                          
MFA-TR*                 ,CT.PYMT_PRIORITY_LVL                                   
MFA-TR*                 ,CT.CNT_ITEM_ID                                         
MFA-TR*           FROM   CSS_CONTRACT CT                                        
MFA-TR*           WHERE  CT.CODE_CONTRACT_TYPE IN                               
MFA-TR*                               ('I','J','K','L','M','N')                 
MFA-TR*           AND    CT.CNT_STATUS_CD IN                                    
MFA-TR*                                     ('C','D','E','R','P')               
MFA-TR*           AND DATE (CT.STATUS_CHANGE_DT)                                
MFA-TR*                                <= :WS-CONTRACT-DEL-DT                   
MFA-TR*           AND NOT EXISTS                                                
MFA-TR*                   (SELECT 1 FROM CSS_AR_CNTL AC                         
MFA-TR*                    WHERE AC.ACCOUNT_NO      = CT.ACCOUNT_NO             
MFA-TR*                    AND AC.PYMT_PRIORITY_LVL = 100                       
MFA-TR*                    AND AC.ITEM_ID           = CT.CNT_ITEM_ID            
MFA-TR*                    AND AC.AMT_TRAN_BALANCE  > 0)                        
MFA-TR*           AND NOT EXISTS                                                
MFA-TR*                   (SELECT 1 FROM CSS_CHRG_OFF CO                        
MFA-TR*                    WHERE CO.ACCOUNT_NO      = CT.ACCOUNT_NO             
MFA-TR*                    AND CO.PYMT_PRIORITY_LVL = 100                       
MFA-TR*                    AND CO.ITEM_ID           = CT.CNT_ITEM_ID            
MFA-TR*                    AND CO.AMT_TRANS         > 0 )                       
MFA-TR*         FOR FETCH ONLY WITH UR                                          
MFA-TR*    END-EXEC.                                                            
      *                                                                         
       PROCEDURE DIVISION.                                              
      *                                                                         
       0000-MAINLINE.                                                   
      *                                                                         
           PERFORM 0100-GET-PARM-PURGE-MONTHS  THRU 0100-EXIT.          
      *                                                                         
           IF CONTRACT-DEL                                              
              PERFORM 7300-SET-CONTRACT-PURGE-DT  THRU 7300-EXIT        
              PERFORM 1400-PROCESS-CSS-CONTRACT   THRU 1400-EXIT        
           END-IF.                                                      
      *                                                                         
           MOVE WS-JOB-PARM-ERR-CODE              TO RETURN-CODE.       
      *                                                                         
           PERFORM 2000-PRINT-TOTALS           THRU 2000-EXIT.          
           DISPLAY '******PROCESS COMPLETED SUCCESSFULLY******'.        
           STOP RUN.                                                    
      *                                                                         
       0000-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ****************************************************************          
      * GET NUMBER OF MONTHS FROM CSS_JOB_PARM                       *          
      ****************************************************************          
      *                                                                         
       0100-GET-PARM-PURGE-MONTHS.                                      
      *                                                                         
           MOVE WS-PGRMNAME TO WS-PROGRAM.                              
           MOVE ZEROS       TO WS-SEQUENCE.                             
           MOVE SPACES      TO WS-SYSIPT.                               
           MOVE WS-KEY-AREA TO E-FJC01-KEY.                             
           PERFORM 7600P-START-FCSJC01 THRU 7600P-EXIT.                 
           PERFORM 0125-READ-FCSJC01   THRU 0125-EXIT.                  
           PERFORM 7611P-CLOSE         THRU 7611P-EXIT.                 
                                                                        
       0100-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ****************************************************************          
      * READ MONTHS FROM CSS_JOB_PARM                       *                   
      ****************************************************************          
       0125-READ-FCSJC01.                                               
      *                                                                         
           MOVE  +1                    TO   WS-I.                       
           INITIALIZE WS-SYSIPT.                                        
           PERFORM 7610P-READ-FCSJC01  THRU 7610P-EXIT UNTIL            
             (WS-INPUT-DATA-BREAKDOWN(1:18) = 'CSS_CONTRACT      ')     
             OR END-OF-SYSIPT                                           
           IF WS-INPUT-DATA-BREAKDOWN(1:18) = 'CSS_CONTRACT      '      
              IF INPUT-ACTIVE                                           
                 MOVE G6-PARM-DATA          TO  WS-JOB-PARM-DATA        
                 MOVE WS-JP-PURGE-MO-1      TO  WS-MONTHS-VALUE         
                 MOVE WS-MONTHS-VALUE       TO  WS-CONTRACT-MO          
                 IF WS-CONTRACT-MO >= 072                               
                    MOVE 'Y'                TO WS-CONTRACT-DEL          
                 ELSE                                                   
                   MOVE    3        TO  WS-JOB-PARM-ERR-CODE            
                   DISPLAY '       '                                    
                   DISPLAY 'MONTHS SUPPLIED THRU JOB PARM ARE NOT VALID'
                   DISPLAY 'MTHS VALUE FROM JOB PARM TBL CONTRACT : '   
                           WS-CONTRACT-MO                               
                   DISPLAY 'NO RECORDS ARE PROCESSED FOR CSS_CONTRACT'  
                   DISPLAY '       '                                    
                 END-IF                                                 
              ELSE                                                      
                 DISPLAY '       '                                      
                 DISPLAY 'JOB PARM NOT ACTIVE FOR CSS_CONTRACT'         
                 DISPLAY 'NO ROWS ARE PROCESSED IN CSS_CONTRACT'        
                 DISPLAY '       '                                      
              END-IF                                                    
           END-IF.                                                      
      *                                                                         
       0125-EXIT.                                                       
            EXIT.                                                       
      *                                                                         
      ****************************************************************          
      * DELETES THE RECORDS FROM CSS_CONTRACT TABLE FOR 72 MONTHS.   *          
      ****************************************************************          
      *                                                                         
       1400-PROCESS-CSS-CONTRACT.                                       
           IF CONTRACT-DEL                                              
      *                                                                         
              INITIALIZE WS-COMMIT-COUNT                                
              INITIALIZE WS-NO-MORE-RECORDS                             
      *                                                                         
              PERFORM 7310-OPEN-CONTRACT-CURSOR   THRU 7310-EXIT        
              PERFORM 7320-FETCH-CONTRACT-CURSOR  THRU 7320-EXIT        
              IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL                
                 DISPLAY '      '                                       
                 DISPLAY 'BEGINNING 1400-PROCESS-CSS-CONTRACT'          
                 DISPLAY '      '                                       
              ELSE                                                      
                 DISPLAY '      '                                       
                 DISPLAY '****************************'                 
                 DISPLAY '* NO RECORDS TO DELETE IN  *'                 
                 DISPLAY '* CSS_CONTRACT     TABLE   *'                 
                 DISPLAY '****************************'                 
                 DISPLAY '      '                                       
              END-IF                                                    
              PERFORM UNTIL NO-MORE-RECORDS                             
                  PERFORM 8130-DELETE-CSS-CONTRACT    THRU 8130-EXIT    
                  IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL            
                     ADD WS-1 TO WS-COMMIT-COUNT                        
                     ADD WS-1 TO WS-CONTRACT-COUNT                      
                     IF WS-COMMIT-COUNT >= WS-1000                      
                        PERFORM 8900-COMMIT THRU 8900-EXIT              
                        INITIALIZE WS-COMMIT-COUNT                      
                     END-IF                                             
                  END-IF                                                
                  PERFORM 7320-FETCH-CONTRACT-CURSOR  THRU 7320-EXIT    
              END-PERFORM                                               
              PERFORM 7330-CLOSE-CONTRACT-CURSOR      THRU 7330-EXIT    
      *                                                                         
              PERFORM 8900-COMMIT THRU 8900-EXIT                        
      *                                                                         
              DISPLAY '      '                                          
              DISPLAY '** NUMBER OF COMMITS FOR'                        
              DISPLAY '** CSS_CONTRACT   TABLE = ' WS-NBR-COMMIT        
              DISPLAY '      '                                          
              INITIALIZE WS-NBR-COMMIT                                  
           END-IF.                                                      
      *                                                                         
       1400-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ****************************************************************          
      * PRINTS THE TOTAL NO.OF RECORDS DELETED                       *          
      ****************************************************************          
      *                                                                         
       2000-PRINT-TOTALS.                                               
      *                                                                         
            IF CONTRACT-DEL                                             
               DISPLAY '* NO OF RECORDS DELETED IN *'                   
               DISPLAY '* CSS_CONTRACT   TABLE:  * ' WS-CONTRACT-COUNT  
               DISPLAY '         '                                      
            END-IF.                                                     
      *                                                                         
       2000-EXIT.                                                       
            EXIT.                                                       
      ****************************************************************          
      **    DETERMINE DATES USING CURRENT DATE FOR ALL CURSORS      **          
      ****************************************************************          
      *                                                                         
       7200-SET-EST-PURGE-DT.                                           
      *                                                                         
           MOVE '7200' TO WS-ACTIVE-PARAGRAPH.                          
      *                                                                         
           EXEC SQL                                                     
            SELECT
              DATEADD( MONTH, -(:WS-EST-USAGE-MO), 
           CAST(SYSDATETIMEOFFSET() AS DATE) )
            INTO
              :WS-ESTUSG-DELETE-DT     
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ006
MFA-TR* MSQ028
MFA-TR* MSQ029
MFA-TR* MSQ044
MFA-TR*    EXEC SQL                                                             
MFA-TR*     SET                                                                 
MFA-TR*       :WS-ESTUSG-DELETE-DT                                              
MFA-TR*         = (DATE (CURRENT DATE) - (:WS-EST-USAGE-MO) MONTHS)             
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

                                                                        
              DISPLAY 'WS-ESTUSG-DELETE-DT   = ' WS-ESTUSG-DELETE-DT    
              DISPLAY 'CURRENT DATE - ' WS-EST-USAGE-MO ' MONTHS AGO'   
      *                                                                         
           MOVE SQLCODE TO WS-ACTIVE-RETURN-CODE.                       
           IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL                   
               NEXT SENTENCE                                            
           ELSE                                                         
               DISPLAY '*****************PCSXP310******************'    
               DISPLAY '* 7200-SET-EST-PURGE-DT              *'         
               DISPLAY '* SQLCODE = ' WS-ACTIVE-RETURN-CODE             
               DISPLAY '* WS-ESTUSG-DELETE-DT   *' WS-ESTUSG-DELETE-DT  
               DISPLAY '* PROGRAM ABENDING...                     *'    
               DISPLAY '*****************PCSXP310******************'    
               PERFORM 9900-ABEND  THRU  9900-EXIT                      
           END-IF.                                                      
      *                                                                         
       7200-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ****************************************************************          
      **    DETERMINE DATES USING CURRENT DATE FOR ALL CURSORS      **          
      ****************************************************************          
      *                                                                         
       7300-SET-CONTRACT-PURGE-DT.                                      
      *                                                                         
           MOVE '7300' TO WS-ACTIVE-PARAGRAPH.                          
      *                                                                         
           EXEC SQL                                                     
            SELECT
              DATEADD( MONTH, -:WS-CONTRACT-MO, 
           CAST(SYSDATETIMEOFFSET() AS DATE) )
            INTO
              :WS-CONTRACT-DEL-DT                 
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ006
MFA-TR* MSQ028
MFA-TR* MSQ044
MFA-TR*    EXEC SQL                                                             
MFA-TR*     SET                                                                 
MFA-TR*       :WS-CONTRACT-DEL-DT                                               
MFA-TR*         = CURRENT DATE - :WS-CONTRACT-MO MONTHS                         
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

                                                                        
              DISPLAY 'WS-CONTRACT-DEL-DT   = ' WS-CONTRACT-DEL-DT      
              DISPLAY 'CURRENT DATE - ' WS-CONTRACT-MO  ' MONTHS AGO'   
      *                                                                         
           MOVE SQLCODE TO WS-ACTIVE-RETURN-CODE.                       
           IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL                   
               NEXT SENTENCE                                            
           ELSE                                                         
               DISPLAY '*****************PCSXP310******************'    
               DISPLAY '* 7300-SET-CONTRACT-PURGE-DT        *'          
               DISPLAY '* SQLCODE = ' WS-ACTIVE-RETURN-CODE             
               DISPLAY '* WS-CONTRACT-DEL-DT *' WS-CONTRACT-DEL-DT      
               DISPLAY '* PROGRAM ABENDING...                     *'    
               DISPLAY '*****************PCSXP310******************'    
               PERFORM 9900-ABEND  THRU  9900-EXIT                      
           END-IF.                                                      
      *                                                                         
       7300-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      *----------------------------------------------------------------*        
      * SELECT CSS_JOB_PARM TABLE                                      *        
      * 7600P-,7610P-, 7611P- PARAGRAPHS                               *        
      *----------------------------------------------------------------*        
           EXEC SQL                                                             
               INCLUDE CPDPURGE                                                 
           END-EXEC                                                             
      *                                                                         
      ****************************************************************          
      * OPENS CSS_CONTRACT   CURSOR                                  *          
      ****************************************************************          
      *                                                                         
       7310-OPEN-CONTRACT-CURSOR.                                       
      *                                                                         
           EXEC SQL                                                     
               OPEN  CSS_CONTRACT                                       
           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 = SUCCESSFUL-CALL                   
              CONTINUE                                                  
           ELSE                                                         
              DISPLAY '********** PCSXP310 ABORT  ************'         
              DISPLAY '* 7310-OPEN-CONTRACT-CURSOR           *'         
              DISPLAY '* SQLCODE IS ', WS-ACTIVE-RETURN-CODE            
              DISPLAY '* PROGRAM ABORTING...                 *'         
              DISPLAY '********** PCSXP310  ABORT ************'         
              PERFORM 9900-ABEND THRU 9900-EXIT                         
           END-IF.                                                      
      *                                                                         
       7310-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ****************************************************************          
      * FETCHES CSS_CONTRACT                                                    
      ****************************************************************          
      *                                                                         
       7320-FETCH-CONTRACT-CURSOR.                                      
      *                                                                         
           EXEC SQL                                                     
               FETCH  CSS_CONTRACT                                      
                INTO  :CT-ACCOUNT-NO                                    
                     ,:CT-PYMT-PRIORITY-LVL                             
                     ,:CT-CNT-ITEM-ID                                   
           END-EXEC.                                                    

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

      *                                                                         
           MOVE SQLCODE TO WS-ACTIVE-RETURN-CODE.                       
           IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL                   
              CONTINUE                                                  
           ELSE                                                         
                IF WS-ACTIVE-RETURN-CODE = NOT-FOUND                    
                   MOVE  'Y'   TO WS-NO-MORE-RECORDS                    
                ELSE                                                    
                   DISPLAY '********** PCSXP310 ABORT  ************'    
                   DISPLAY '* 7320-FETCH-CONTRACT-CURSOR         *'     
                   DISPLAY '* SQLCODE IS ', WS-ACTIVE-RETURN-CODE       
                   DISPLAY '* PROGRAM ABORTING...                 *'    
                   DISPLAY 'CT-ACCOUNT-NO'        CT-ACCOUNT-NO         
                   DISPLAY 'CT-PYMT-PRIORITY-LVL' CT-PYMT-PRIORITY-LVL  
                   DISPLAY 'CT-CNT-ITEM-ID'       CT-CNT-ITEM-ID        
                   DISPLAY '********** PCSXP310  ABORT ************'    
                   PERFORM 9900-ABEND THRU 9900-EXIT                    
                END-IF                                                  
           END-IF.                                                      
      *                                                                         
       7320-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ****************************************************************          
      * CLOSES CSS_CONTRACT CURSOR                                   *          
      ****************************************************************          
      *                                                                         
       7330-CLOSE-CONTRACT-CURSOR.                                      
      *                                                                         
           EXEC SQL                                                     
               CLOSE CSS_CONTRACT                                       
           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 = SUCCESSFUL-CALL                   
              CONTINUE                                                  
           ELSE                                                         
              DISPLAY '********** PCSXP310 ABORT  ************'         
              DISPLAY '* 7330-CLOSE-CONTRACT-CURSOR          *'         
              DISPLAY '* SQLCODE IS ', WS-ACTIVE-RETURN-CODE            
              DISPLAY '* PROGRAM ABORTING...                 *'         
              DISPLAY '********** PCSXP310  ABORT ************'         
              PERFORM 9900-ABEND THRU 9900-EXIT                         
           END-IF.                                                      
      *                                                                         
       7330-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ****************************************************************          
      * DELETES RECORDS FROM CSS_CONTRACT                                       
      ****************************************************************          
      *                                                                         
       8130-DELETE-CSS-CONTRACT.                                        
      *                                                                         
           EXEC SQL                                                     
                DELETE FROM CT                              
                FROM CSS_CONTRACT CT
                 WHERE  CT.ACCOUNT_NO        = :CT-ACCOUNT-NO           
                  AND   CT.PYMT_PRIORITY_LVL = :CT-PYMT-PRIORITY-LVL    
                  AND   CT.CNT_ITEM_ID       = :CT-CNT-ITEM-ID          
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ019
MFA-TR*    EXEC SQL                                                             
MFA-TR*         DELETE FROM CSS_CONTRACT  CT                                    
MFA-TR*          WHERE  CT.ACCOUNT_NO        = :CT-ACCOUNT-NO                   
MFA-TR*           AND   CT.PYMT_PRIORITY_LVL = :CT-PYMT-PRIORITY-LVL            
MFA-TR*           AND   CT.CNT_ITEM_ID       = :CT-CNT-ITEM-ID                  
MFA-TR*    END-EXEC.                                                            

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

      *                                                                         
           MOVE SQLCODE TO WS-ACTIVE-RETURN-CODE.                       
      *                                                                         
           IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL                   
              CONTINUE                                                  
           ELSE                                                         
              IF  WS-ACTIVE-RETURN-CODE = NOT-FOUND                     
                  NEXT SENTENCE                                         
              ELSE                                                      
                  DISPLAY '********** PCSXP310 ABORT  ************'     
                  DISPLAY '* 8130-DELETE-CSS-CONTRACT            *'     
                  DISPLAY '* SQLCODE IS: '  WS-ACTIVE-RETURN-CODE       
                  DISPLAY '*CT-ACCOUNT-NO        =' CT-ACCOUNT-NO       
                  DISPLAY '*CT-PYMT-PRIORITY-LVL =' CT-PYMT-PRIORITY-LVL
                  DISPLAY '*CT-CNT-ITEM-ID       =' CT-CNT-ITEM-ID      
                  DISPLAY '* PROGRAM ABORTING...                 *'     
                  DISPLAY '********** PCSXP310  ABORT ************'     
                  PERFORM 9900-ABEND THRU 9900-EXIT                     
              END-IF                                                    
           END-IF.                                                      
      *                                                                         
       8130-EXIT.                                                       
           EXIT.                                                        
      ****************************************************************          
      *  ISSUES A COMMIT POINT                                       *          
      ****************************************************************          
      *                                                                         
       8900-COMMIT.                                                     
      *                                                                         
           EXEC SQL                                                     
              COMMIT                                                    
           END-EXEC.                                                    

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

      *                                                                         
           COMPUTE WS-NBR-COMMIT = WS-NBR-COMMIT + 1.                   
      *                                                                         
       8900-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ****************************************************************          
      *  PERFORMED IF BAD TERMINATION OCCURS.                        *          
      ****************************************************************          
      *                                                                         
       9900-ABEND.                                                      
      *                                                                         
           DISPLAY 'PERFORMING 9900-ABEND'.                             
SCA003     EXEC SQL
SCA003         ROLLBACK
SCA003     END-EXEC.                                                  

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

           MOVE 12 TO RETURN-CODE.                                      
           STOP RUN.                                                    
      *                                                                         
       9900-EXIT.                                                       
           EXIT.                                                        
