*S*************************************************************************         
*S***       
*S***                              WolffPack    
*S***       
*S*** Program  : WFADDLDB           
*S*** System   : FINANCIER          
*S*** Title    : FINANCIER ADD File Load        
*S*** Function : This program loads the ADD file into FINANCIER.  It calls          
*S***            year specific subroutines to handle year-specific      
*S***            processing issues. 
*S***       
*S***       
*S***      Copyright 1995 - 2006 WolffPack, Inc.  All rights reserved.  
*S***       
*S*************************************************************************         
*S**DEFINE DATA         
*S**  GLOBAL USING WWGDA
*S***       
*S**  LOCAL USING WWREQIBD /* Input parameter PDA           
*S**  LOCAL USING WFADDDSD /* Passed to object subprogram (WW-ADD)      
*S**  LOCAL USING WFADDDSR /* Passed to object subprogram (WW-ADD)      
*S**  LOCAL USING WWAOBJ   /* Used by object subprograms    
*S***       
*S**  LOCAL USING WWCONST  /* Constants LDA     
*S***       
*S**  LOCAL 
*S**  01 #MAX-READ(P3) INIT<50>     
*S**  01 #MAX-WRITE(P3) INIT<10>    
*S**  01 #ET-READ-COUNTER(P7)       
*S**  01 #ET-WRITE-COUNTER(P7)      
*S***       
*S**  01 #PRINT-LOG(L) INIT<TRUE>   
*S**  01 #HOLD-TERM(A1) 
*S**  01 #SUB(N2)       
*S***       
*S*** ADD process reject reasons    
*S**  01 #ADD-REJECTS   
*S**    02 #REJ-NO-ID(A1)   CONST<'I'>     /* No student ID 
*S**    02 #REJ-NO-FAO(A1)  CONST<'F'>     /* No FAO        
*S**    02 #REJ-NO-NAME(A1) CONST<'N'>     /* No name or match in FINANCIER         
*S**    02 #REJ-STATUS(A1)  CONST<'S'>     /* Status not allowed for load           
*S**    02 #REJ-C-PEND(A1)  CONST<'C'>     /* Correction record pending 
*S**    02 #REJ-C-XMIT(A1)  CONST<'T'>     /* Correction record transmitted         
*S**    02 #REJ-LOCKED(A1)  CONST<'L'>     /* Application locked        
*S**    02 #REJ-PACKGD(A1)  CONST<'P'>     /* Packaging complete        
*S**    02 #REJ-VERIFD(A1)  CONST<'V'>     /* Verification complete     
*S**    02 #REJ-FEDERAL(A1) CONST<'R'>     /* Federal reject case       
*S**    02 #REJ-ACG(A1)     CONST<'G'>     /* ACG without ISIR          
*S**    02 #REJ-NCP(A1)     CONST<'2'>     /* NCP without Profile       
*S**  01 #REJECTED(A1)      CONST<'R'>          
*S**  01 #HOLD-REJECTS  
*S**    02 WF-AD-REJ-OVERRIDE(A1)   
*S**    02 WF-AD-REJ1(A1)           
*S**    02 WF-AD-REJ2(A1)           
*S**    02 WF-AD-REJ3(A1)           
*S**    02 WF-AD-REJ4(A1)           
*S**    02 WF-AD-REJ5(A1)           
*S***       
*S**  01 #PASS-FIELDS   
*S**    02 #PASS-NM-LAST(A20)       
*S**    02 #PASS-NM-FIRST(A20)      
*S**    02 #PASS-NM-MI(A1)          
*S**    02 #PASS-SOURCE(A1)         
*S**    02 #PASS-DOB(A8)
*S**    02 #PASS-SSN(A9)
*S**    02 #PASS-SID(A9)
*S**    02 #PASS-FAO(A2)
*S**    02 #PASS-COLLEGE-CODE(A7)   
*S**    02 #PASS-STAT(A1)           
*S**    02 #PASS-EXISTS(L)          
*S**    02 #CORR-PEND(L)
*S**    02 #CORR-XMIT(L)
*S**    02 #CORR-XMIT-DATE(D)       
*S**    02 #STATUS-FUNCTION(A8)     
*S**    02 #STATUS-DECISION(A1)     
*S***       
*S**  01 #EFC-COMPARE   
*S**    02 #REC-CPS(L)  
*S**    02 #REJ-CPS(L)  
*S**    02 #EFC-CPS(P7) 
*S**    02 #EFC-FIN(P7) 
*S**  01 #EFC-MSG(A12)  
*S***       
*S**  01 #REJECT-PROCESSING         
*S**    02 #CHECK-REJECT(A1)        
*S**    02 #CHECK-OCCURENCE(A1)     
*S**    02 #CHECK-AVAILABLE(A1)     
*S**    02 #PREVIOUSLY-REJECTED(L)  
*S**    02 #REC-PREVIOUSLY-REJECTED(L)          
*S**    02 #REJ-FIRST-TIME(L) INIT <TRUE>       
*S**    02 #ADD-REJECT(L)           
*S***       
*S**  01 #PARAMETER-FIELDS          
*S**    02 #PGM-PARAMETERS          
*S**      03 #EARLIER-REC(A1)       
*S**      03 #FED-REJ-CASE(A1)      
*S**      03 #OVR-FED-REJ(A1)       
*S**      03 #OVR-C-PEND(A1)        
*S**      03 #OVR-C-XMIT(A1)        
*S**      03 #OVR-LOCKED(A1)        
*S**      03 #OVR-VERIFD(A1)        
*S**      03 #OVR-PACKGD(A1)        
*S**    02 #PASSED-PARAMETERS       
*S**      03 #INPUT-COUNTER(P7)     
*S**      03 #NEW-REJ-COUNTER(P7)   
*S**      03 #RE-REJ-COUNTER(P7)    
*S**      03 #BYPASS-COUNTER(P7)    
*S**      03 #ADD-RECORD-COUNTER(P7)
*S**      03 #PROCESSED-RECORD(L)   
*S**END-DEFINE          
*S***       
*S*** Define printers, formats, headings        
*S**DEFINE PRINTER(1)   
*S**FORMAT(1) LS=80 PS=60 ZP=ON IS=OFF ES=OFF SG=OFF        
*S**DEFINE PRINTER(2)   
*S**FORMAT(2) LS=80 PS=60 ZP=ON IS=OFF ES=OFF SG=OFF        
*S**DEFINE PRINTER(3)   
*S**FORMAT(3) LS=80 PS=60 ZP=ON IS=OFF ES=OFF SG=OFF        
*S**DEFINE PRINTER(4)   
*S**FORMAT(4) LS=80 PS=60 ZP=ON IS=OFF ES=OFF SG=OFF        
*S***       
*S**AT TOP OF PAGE(1)   
*S**  WRITE(1) NOTITLE ##PGM-ID     
*S**        27T '*** FINANCIER ADD LOAD ***'    
*S**        71T 'Page' *PAGE-NUMBER(1)(EM=ZZ9)  
*S**      / *DATX(EM=LLL' 'DD', 'YYYY)          
*S**        28T 'Processing Counts/Errors'      
*S**        71T *TIMX(EM=HH':'II' 'AP)          
*S**END-TOPPAGE         
*S**AT TOP OF PAGE(2)   
*S**  WRITE(2) NOTITLE ##PGM-ID     
*S**        27T '*** FINANCIER ADD LOAD ***'    
*S**        71T 'Page' *PAGE-NUMBER(2)(EM=ZZ9)  
*S**      / *DATX(EM=LLL' 'DD', 'YYYY)          
*S**        31T 'Field Value Errors'
*S**        71T *TIMX(EM=HH':'II' 'AP)          
*S**     // 31T 'Aid Year:' ##DISP-AY           
*S**      / 36T ##DISP-LIT ##DISP-FAO           
*S**    /// 'StudentID     Name                      Src    Error'      
*S**  SKIP(2) 1         
*S**END-TOPPAGE         
*S**AT TOP OF PAGE(3)   
*S**  WRITE(3) NOTITLE ##PGM-ID     
*S**        27T '*** FINANCIER ADD LOAD ***'    
*S**        71T 'Page' *PAGE-NUMBER(3)(EM=ZZ9)  
*S**      / *DATX(EM=LLL' 'DD', 'YYYY)          
*S**        33T 'Loaded Students'   
*S**        71T *TIMX(EM=HH':'II' 'AP)          
*S**     // 31T 'Aid Year:' ##DISP-AY           
*S**      / 36T ##DISP-LIT ##DISP-FAO           
*S**    /// 'Src StudentID        Name                         '        
*S**        '    Birthdate      SSN'
*S**  SKIP(3) 1         
*S**END-TOPPAGE         
*S**AT TOP OF PAGE(4)   
*S**  WRITE(4) NOTITLE ##PGM-ID     
*S**        27T '*** FINANCIER ADD LOAD ***'    
*S**        71T 'Page' *PAGE-NUMBER(4)(EM=ZZ9)  
*S**      / *DATX(EM=LLL' 'DD', 'YYYY)          
*S**        27T 'CPS/FINANCIER EFC Mismatches'  
*S**        71T *TIMX(EM=HH':'II' 'AP)          
*S**     // 31T 'Aid Year:' ##DISP-AY           
*S**      / 36T ##DISP-LIT ##DISP-FAO           
*S**    /// ' StudentID      Name                         ' 
*S**        ' CPS EFC    FIN EFC'   
*S**  SKIP(4) 1         
*S**END-TOPPAGE         
*S***       
*S**ASSIGN ##PGM-ID = *PROGRAM      
*S**ASSIGN ##BYPASS-TRANSLATION = 'B'           
*S***       
*S**IF *DEVICE = 'BATCH' THEN       
*S**  SET CONTROL 'D' /* Set delimiter mode for batch input 
*S**END-IF  
*S***       
*S*************************************************************************         
*S***       
*S*** Read and edit input parameters
*S**  INPUT(AD=MITL'_' SG=ON IP=OFF ZP=OFF)     
*S**          'Aid Year:' #INPUT-AID-YEAR /     
*S**          'Term:' #INPUT-TERM / 
*S**          'FAO:' #INPUT-FAO /   
*S**          'Run Mode:' #INPUT-RUNMODE /      
*S**          'Effective Date:' #INPUT-EFF-DATE /           
*S**          'Override edits:' /   
*S**          '  Federal Rejects:    ' #OVRD-FED-REJ /      
*S**          '  Corrections pending:' #OVRD-C-PEND /       
*S**          '  Corrections transmt:' #OVRD-C-XMIT /       
*S**          '  Application locked: ' #OVRD-LOCKED /       
*S**          '  Student Verified:'    #OVRD-VERIFD /       
*S**          '  Student Packaged:'    #OVRD-PACKGD /       
*S**  WRITE(1) ' '      
*S**  PERFORM REQUIRED-FIELD-BATCH WWREQIBD     
*S**  WRITE(1)          
*S**    31T 'Aid Year:' ##DISP-AY / 
*S**    36T ##DISP-LIT ##DISP-FAO ///           
*S**  ASSIGN #HOLD-TERM = ##TERM    
*S***       
*S*** Set up keys for sequential file processing
*S**  MOVE ##AID-YEAR TO WFADDDSD.WF-AID-YEAR   
*S**  MOVE ##FAO-ID TO WFADDDSD.WF-FAO          
*S***       
*S***       
*S**PROG.   
*S**  REPEAT
*S**    /*  
*S**    /* Read next ADD record     
*S**    MOVE 'NEXT' TO WWAOBJ.#FUNCTION         
*S**    PERFORM CALL-OBJECT-ADD     
*S**    /*  
*S**    /* End of records to be processed       
*S**    IF NOT WWAOBJ.#EXISTS OR    
*S**       WFADDDSD.WF-AID-YEAR > ##AID-YEAR OR 
*S**       WFADDDSD.WF-FAO > ##FAO-ID           
*S**      ESCAPE BOTTOM(PROG.) IMMEDIATE        
*S**    END-IF          
*S**    /*  
*S**    ADD 1 TO #INPUT-COUNTER     
*S**    ADD 1 TO #ET-READ-COUNTER   
*S**    IF #ET-READ-COUNTER > #MAX-READ         
*S**      PERFORM COMMIT-OR-BACKOUT 
*S**    END-IF          
*S**    /*  
*S**    RESET INITIAL #REJ-FIRST-TIME           
*S**                  #ADD-REJECT   
*S**                  #REC-PREVIOUSLY-REJECTED  
*S**    MOVE BY NAME WF-ADD-REJECT TO #HOLD-REJECTS         
*S**    RESET WFADDDSD.WF-AD-REJ1 WFADDDSD.WF-AD-REJ2       
*S**          WFADDDSD.WF-AD-REJ3 WFADDDSD.WF-AD-REJ4       
*S**          WFADDDSD.WF-AD-REJ5   
*S**    /*  
*S**    /* Verify SID exists        
*S**    MOVE WFADDDSD.WW-ST-SSN TO #PASS-SSN    
*S**    MOVE WFADDDSD.WW-ST-NM-LAST TO #PASS-NM-LAST        
*S**    MOVE WFADDDSD.WW-ST-NM-FIRST TO #PASS-NM-FIRST      
*S**    MOVE WFADDDSD.WW-ST-NM-MI TO #PASS-NM-MI
*S**    MOVE WFADDDSD.WW-ST-DOB TO #PASS-DOB    
*S**    PERFORM DETERMINE-SID #PASS-SSN #PASS-NM-LAST #PASS-NM-FIRST    
*S**                          #PASS-NM-MI #PASS-DOB #PASS-SID           
*S**    IF #PASS-SID NE SPACE       
*S**      MOVE #PASS-SID TO ##SID   
*S**      PERFORM GET-STUDENT-KEY   
*S**    ELSE                                     /* ID reject           
*S**      MOVE #REJ-NO-ID TO #CHECK-REJECT      
*S**      PERFORM PROCESS-REJECT    
*S**      PERFORM UPDATE-REJECT     
*S**      ESCAPE TOP    
*S**    END-IF          
*S**    /*  
*S**    /* Get Student data         
*S**    PERFORM GET-STUDENT-INFO    
*S**    /*  
*S**    /* No name available        
*S**    IF (WFADDDSD.WW-ST-NM-LAST = SPACE OR   
*S**        WFADDDSD.WW-ST-NM-FIRST = SPACE) AND
*S**       ##COMP-NAME = SPACE      
*S**      MOVE #REJ-NO-NAME TO #CHECK-REJECT    
*S**      PERFORM PROCESS-REJECT    
*S**      PERFORM UPDATE-REJECT     
*S**      ESCAPE TOP    
*S**    ELSE
*S**      IF ##COMP-NAME = SPACE    
*S**        COMPRESS WFADDDSD.WW-ST-NM-LAST COMMA INTO      
*S**          ##COMP-NAME LEAVING NO SPACE      
*S**        COMPRESS ##COMP-NAME WFADDDSD.WW-ST-NM-FIRST    
*S**                             WFADDDSD.WW-ST-NM-MI INTO  
*S**          ##COMP-NAME WITH DELIMITER SPACE  
*S**        MOVE WFADDDSD.WW-ST-SSN TO ##SSN    
*S**        MOVE WFADDDSD.WW-ST-DOB TO ##DOB    
*S**      END-IF        
*S**    END-IF          
*S**    /*  
*S**    /* Processing record, store previous rejects        
*S**    MOVE BY NAME WF-ADD-REJECT TO #HOLD-REJECTS         
*S**    RESET WFADDDSD.WF-AD-REJ1 WFADDDSD.WF-AD-REJ2       
*S**          WFADDDSD.WF-AD-REJ3 WFADDDSD.WF-AD-REJ4       
*S**          WFADDDSD.WF-AD-REJ5   
*S**    /*  
*S**    /* Check processing for student's status
*S**    DECIDE ON FIRST VALUE OF WFADDDSD.WF-AD-SOURCE      
*S**      VALUE 'F','G' 
*S**        MOVE 'Fedl ADD' TO #STATUS-FUNCTION 
*S**      VALUE 'C','N' 
*S**        MOVE 'Prof ADD' TO #STATUS-FUNCTION 
*S**      NONE          
*S**        RESET #STATUS-FUNCTION  
*S**    END-DECIDE      
*S**    PERFORM GET-STATUS-FUNCTION #STATUS-FUNCTION #STATUS-DECISION   
*S**    IF #STATUS-DECISION NE 'Y'  
*S**      IF WFADDDSD.WF-AD-REJ-OVERRIDE NE 'O' 
*S**        FOR #SUB = 1 TO 12      
*S**          IF ##SCHED-RT(#SUB) NE ##SCHED-RT(1) AND      
*S**             ##SCHED-RT (#SUB) NE ' '       
*S**            MOVE ##SCHED-RT(#SUB) TO ##TERM 
*S**            PERFORM GET-STUDENT-INFO        
*S**            PERFORM GET-STATUS-FUNCTION #STATUS-FUNCTION
*S**                                        #STATUS-DECISION
*S**            IF #STATUS-DECISION = 'Y'       
*S**              ESCAPE BOTTOM     
*S**            END-IF  
*S**          END-IF    
*S**        END-FOR     
*S**        MOVE #HOLD-TERM TO ##TERM           
*S**        IF #STATUS-DECISION NE 'Y'          
*S**          MOVE #REJ-STATUS TO #CHECK-REJECT 
*S**          PERFORM PROCESS-REJECT
*S**        END-IF      
*S**      END-IF        
*S**    END-IF          
*S**    /*  
*S**    /* Edits specific to input data type    
*S**    IF WFADDDSD.WF-AD-SOURCE = 'F' AND      
*S**       WFADDDSD.WF-AD-SEND-RSN NE 'C'       
*S**        /*          
*S**        /* Edits specific to automatic federal records  
*S**        /*          
*S**        /* Corrections status   
*S**        IF (#OVRD-C-PEND NE 'Y' OR          
*S**            #OVRD-C-XMIT NE 'Y') AND        
*S**           WFADDDSD.WF-AD-REJ-OVERRIDE NE 'O'           
*S**          PERFORM GET-CORRECTIONS-STATUS #CORR-PEND     
*S**                                         #CORR-XMIT #CORR-XMIT-DATE 
*S**        END-IF      
*S**        /*          
*S**        /*  Pending corrections 
*S**        IF #OVRD-C-PEND = 'Y' OR
*S**           WFADDDSD.WF-AD-REJ-OVERRIDE = 'O'
*S**          IGNORE                                 /* Edit override   
*S**        ELSE        
*S**          IF #CORR-PEND                          /* Corrections pending         
*S**            MOVE #REJ-C-PEND TO #CHECK-REJECT           
*S**            PERFORM PROCESS-REJECT          
*S**          END-IF    
*S**        END-IF      
*S**        /*          
*S**        /*  Transmitted Corrections         
*S**        IF #OVRD-C-XMIT = 'Y' OR
*S**           WFADDDSD.WF-AD-REJ-OVERRIDE = 'O'
*S**          IGNORE                                 /* Edit override   
*S**        ELSE        
*S**          IF #CORR-XMIT                          /* Corrections xmitted         
*S**            MOVE #REJ-C-XMIT TO #CHECK-REJECT           
*S**            PERFORM PROCESS-REJECT          
*S**          END-IF    
*S**        END-IF      
*S**        /*          
*S**        /*  Application record lock status  
*S**        IF #OVRD-LOCKED = 'Y' OR
*S**           WFADDDSD.WF-AD-REJ-OVERRIDE = 'O'
*S**          IGNORE                             /* Edit override       
*S**        ELSE        
*S**          PERFORM GET-FEDERAL-LOCK #PASS-STAT           
*S**          IF #PASS-STAT = 'L'                /* Record locked       
*S**            MOVE #REJ-LOCKED TO #CHECK-REJECT           
*S**            PERFORM PROCESS-REJECT          
*S**          END-IF    
*S**        END-IF      
*S**        /*          
*S**        /*  Verification complete           
*S**        IF #OVRD-VERIFD = 'Y' OR
*S**           WFADDDSD.WF-AD-REJ-OVERRIDE = 'O'
*S**          IGNORE                             /* Edit override       
*S**        ELSE        
*S**          PERFORM GET-VERIF-STAT #PASS-STAT 
*S**          IF #PASS-STAT = 'T' OR             /* Within tolerance    
*S**                        = 'P'                /* Exact match         
*S**            MOVE #REJ-VERIFD TO #CHECK-REJECT           
*S**            PERFORM PROCESS-REJECT          
*S**          END-IF    
*S**        END-IF      
*S**    END-IF          
*S**    /*  
*S**    /* Edits appropriate for automatic federal records  
*S**    /*   and all non-federal records        
*S**    IF (WFADDDSD.WF-AD-SOURCE = 'F' AND     
*S**        WFADDDSD.WF-AD-SEND-RSN NE 'C') OR  
*S**       WFADDDSD.WF-AD-SOURCE NE 'F'         
*S**        /*          
*S**        /*  Packaging complete  
*S**        IF #OVRD-PACKGD = 'Y' OR
*S**           WFADDDSD.WF-AD-REJ-OVERRIDE = 'O'
*S**          IGNORE                             /* Edit override       
*S**        ELSE        
*S**          PERFORM GET-PACK-STAT #PASS-STAT  
*S**          IF #PASS-STAT NE ' '               /* Student packaged    
*S**            MOVE #REJ-PACKGD TO #CHECK-REJECT           
*S**            PERFORM PROCESS-REJECT          
*S**          END-IF    
*S**        END-IF      
*S**    END-IF          
*S**    /*  
*S**    /* Edits appropriate for CSS records    
*S**    IF WFADDDSD.WF-AD-SOURCE = 'C' OR = 'N' 
*S**        /*          
*S**        /*  Application record lock status  
*S**        IF #OVRD-LOCKED = 'Y' OR
*S**           WFADDDSD.WF-AD-REJ-OVERRIDE = 'O'
*S**          IGNORE                             /* Edit override       
*S**        ELSE        
*S**          PERFORM GET-CSS-STATUS #PASS-STAT 
*S**          IF #PASS-STAT = 'L'                /* Record locked       
*S**            MOVE #REJ-LOCKED TO #CHECK-REJECT           
*S**            PERFORM PROCESS-REJECT          
*S**          END-IF    
*S**        END-IF      
*S**    END-IF          
*S**    IF WFADDDSD.WF-AD-SOURCE = 'N'          
*S**        /*          
*S**        /*  NCP record without Profile record           
*S**        PERFORM GET-CSS-STATUS #PASS-STAT   
*S**        IF #PASS-STAT = ' '                /* Record does not exist 
*S**          MOVE #REJ-NCP TO #CHECK-REJECT    
*S**          PERFORM PROCESS-REJECT
*S**        END-IF      
*S**    END-IF          
*S**    /*  
*S**    /* Edits appropriate for ACG records    
*S**    IF WFADDDSD.WF-AD-SOURCE = 'G'          
*S**      /*
*S**      /*  ACG record without ISIR record    
*S**      PERFORM GET-ISIR-EXISTENCE #PASS-EXISTS           
*S**      IF NOT #PASS-EXISTS                  /* Record does not exist 
*S**        MOVE #REJ-ACG TO #CHECK-REJECT      
*S**        PERFORM PROCESS-REJECT  
*S**      END-IF        
*S**      /*
*S**      /*  ACG data lock status  
*S**      IF #OVRD-LOCKED = 'Y' OR  
*S**         WFADDDSD.WF-AD-REJ-OVERRIDE = 'O'  
*S**        IGNORE                             /* Edit override         
*S**      ELSE          
*S**        PERFORM GET-ACG-LOCK #PASS-STAT     
*S**        IF #PASS-STAT NE ' ' AND #PASS-STAT NE 'N'    /* Record locked          
*S**          MOVE #REJ-LOCKED TO #CHECK-REJECT 
*S**          PERFORM PROCESS-REJECT
*S**        END-IF      
*S**      END-IF        
*S**    END-IF          
*S**    /*  
*S**    /* Perform subroutine to load data and perform calcs
*S**    MOVE #OVRD-FED-REJ TO #OVR-FED-REJ      
*S**    MOVE #OVRD-C-PEND  TO #OVR-C-PEND       
*S**    MOVE #OVRD-C-XMIT  TO #OVR-C-XMIT       
*S**    MOVE #OVRD-LOCKED  TO #OVR-LOCKED       
*S**    MOVE #OVRD-VERIFD  TO #OVR-VERIFD       
*S**    MOVE #OVRD-PACKGD  TO #OVR-PACKGD       
*S**    /*  
*S**    PERFORM LOAD-STUDENT #PARAMETER-FIELDS  
*S**                         WFADDDSD WFADDDSD-ID           
*S**    /*  
*S**    /*  Print log   
*S**    IF #PROCESSED-RECORD        
*S**      IF #PRINT-LOG 
*S**        WRITE(3)    
*S**          2T WFADDDSD.WF-AD-SOURCE          
*S**          5T ##SID  
*S**         18T ##COMP-NAME        
*S**         55T ##DOB(EM=MM/DD/YYYY)           
*S**         67T ##SSN(EM=XXX-XX-XXXX)          
*S**      END-IF        
*S**      /*
*S**      IF WFADDDSD.WF-AD-SOURCE = 'F'        
*S**        IF WFADDDSD.WF-AID-YEAR < '2025'    
*S**          RESET #EFC-MSG        
*S**          PERFORM GET-EFCS #EFC-COMPARE     
*S**          IF #EFC-CPS NE #EFC-FIN           
*S**            IF #REJ-CPS         
*S**              ASSIGN #EFC-MSG = 'CPS Reject'
*S**            END-IF  
*S**            WRITE(4)
*S**              2T ##SID          
*S**              13T ##COMP-NAME(AL=30)        
*S**              45T #EFC-CPS(EM=Z,ZZZ,ZZ9)    
*S**              56T #EFC-FIN(EM=Z,ZZZ,ZZ9)    
*S**              67T #EFC-MSG      
*S**          END-IF    
*S**        END-IF      
*S**      END-IF        
*S**      /*
*S**      /* Purge ADD record       
*S**      ASSIGN WWAOBJ.#FUNCTION = 'DELETE'    
*S**      PERFORM CALL-OBJECT-ADD   
*S**    ELSE
*S**      IF #EARLIER-REC = 'Y'     
*S**        /*          
*S**        /* Record pre-dates already-loaded data         
*S**        ADD 1 TO #BYPASS-COUNTER
*S**        /*          
*S**        /* Purge ADD record     
*S**        ASSIGN WWAOBJ.#FUNCTION = 'DELETE'  
*S**        PERFORM CALL-OBJECT-ADD 
*S**      ELSE          
*S**        IF #FED-REJ-CASE = 'F'  
*S**          MOVE #REJ-FEDERAL TO #CHECK-REJECT
*S**          PERFORM PROCESS-REJECT
*S**        END-IF      
*S**        PERFORM UPDATE-REJECT   
*S**      END-IF        
*S**    END-IF          
*S**    /*  
*S**    /* Check for limited-run maximum        
*S**    IF (#INPUT-RUNMODE = 'TRIAL' OR = 'SAMPLE')         
*S**        AND #INPUT-LIMIT-COUNT > 0          
*S**      IF #ADD-RECORD-COUNTER GE #INPUT-LIMIT-COUNT      
*S**        ESCAPE BOTTOM(PROG.) IMMEDIATE      
*S**      END-IF        
*S**    END-IF          
*S**    /*  
*S**    ADD 1 TO #ET-WRITE-COUNTER   /* Counter used to invoke ET       
*S**    IF #ET-WRITE-COUNTER > #MAX-WRITE       
*S**      PERFORM COMMIT-OR-BACKOUT 
*S**    END-IF          
*S**  END-REPEAT        
*S***       
*S*** Issue final END TRANSACTION   
*S**  PERFORM COMMIT-OR-BACKOUT     
*S***       
*S*** Print job statistics          
*S**  WRITE(1)          
*S**    15T 'ADD input:' /          
*S**    17T 'Records read:'         
*S**                        (I) 55T #INPUT-COUNTER (EM=Z,ZZZ,ZZ9) //    
*S**    15T 'FINANCIER processing:' /           
*S**    17T 'Applications loaded:'  
*S**                        (I) 55T #ADD-RECORD-COUNTER (EM=Z,ZZZ,ZZ9) /
*S**    17T 'ADD records rejected:' 
*S**                        (I) 55T #NEW-REJ-COUNTER (EM=Z,ZZZ,ZZ9) /   
*S**    17T 'ADD records re-rejected:'          
*S**                        (I) 55T #RE-REJ-COUNTER (EM=Z,ZZZ,ZZ9) /    
*S**    17T 'ADD records purged:'   
*S**                        (I) 55T #BYPASS-COUNTER (EM=Z,ZZZ,ZZ9) /    
*S***       
*S***       
*S*************************************************************************         
*S**DEFINE SUBROUTINE CALL-OBJECT-ADD           
*S*************************************************************************         
*S**  /*    
*S**  /* Call WF-ADD file object subprogram     
*S**  CALLNAT 'WFADDDSO' WW-GDA     
*S**           WFADDDSD 
*S**           WFADDDSD-ID          
*S**           WFADDDSR 
*S**           WWAOBJ   
*S**END-SUBROUTINE /* CALL-OBJECT-ADD           
*S***       
*S*************************************************************************         
*S**DEFINE SUBROUTINE CHECK-REJECT  
*S*************************************************************************         
*S**  /*    
*S**  /* Determine if record was previously rejected, also  
*S**  /*  occurrence of passed reject reason    
*S**  RESET #PREVIOUSLY-REJECTED #CHECK-OCCURENCE #CHECK-AVAILABLE      
*S**  DECIDE FOR FIRST CONDITION    
*S**    WHEN WFADDDSD.WF-AD-REJ1 NE SPACE OR      /* Previously rejected
*S**         WFADDDSD.WF-AD-REJ2 NE SPACE OR    
*S**         WFADDDSD.WF-AD-REJ3 NE SPACE OR    
*S**         WFADDDSD.WF-AD-REJ4 NE SPACE OR    
*S**         WFADDDSD.WF-AD-REJ5 NE SPACE       
*S**      ASSIGN #PREVIOUSLY-REJECTED = TRUE    
*S**    WHEN NONE       
*S**      IGNORE        
*S**  END-DECIDE        
*S**  /*    
*S**  DECIDE FOR FIRST CONDITION                  /* Save location of   
*S**    WHEN WFADDDSD.WF-AD-REJ1 = #CHECK-REJECT  /*  passed reject     
*S**      ASSIGN #CHECK-OCCURENCE = '1'         
*S**    WHEN WFADDDSD.WF-AD-REJ2 = #CHECK-REJECT
*S**      ASSIGN #CHECK-OCCURENCE = '2'         
*S**    WHEN WFADDDSD.WF-AD-REJ3 = #CHECK-REJECT
*S**      ASSIGN #CHECK-OCCURENCE = '3'         
*S**    WHEN WFADDDSD.WF-AD-REJ4 = #CHECK-REJECT
*S**      ASSIGN #CHECK-OCCURENCE = '4'         
*S**    WHEN WFADDDSD.WF-AD-REJ5 = #CHECK-REJECT
*S**      ASSIGN #CHECK-OCCURENCE = '5'         
*S**    WHEN NONE       
*S**      IGNORE        
*S**  END-DECIDE        
*S**  /*    
*S**  DECIDE FOR FIRST CONDITION                  /* Save location of   
*S**    WHEN WFADDDSD.WF-AD-REJ1 = SPACE          /*  first available   
*S**      ASSIGN #CHECK-AVAILABLE = '1'           /*  reject
*S**    WHEN WFADDDSD.WF-AD-REJ2 = SPACE        
*S**      ASSIGN #CHECK-AVAILABLE = '2'         
*S**    WHEN WFADDDSD.WF-AD-REJ3 = SPACE        
*S**      ASSIGN #CHECK-AVAILABLE = '3'         
*S**    WHEN WFADDDSD.WF-AD-REJ4 = SPACE        
*S**      ASSIGN #CHECK-AVAILABLE = '4'         
*S**    WHEN WFADDDSD.WF-AD-REJ5 = SPACE        
*S**      ASSIGN #CHECK-AVAILABLE = '5'         
*S**    WHEN NONE       
*S**      IGNORE        
*S**  END-DECIDE        
*S**END-SUBROUTINE /* CHECK-REJECT  
*S***       
*S*************************************************************************         
*S**DEFINE SUBROUTINE LOAD-REJECT   
*S*************************************************************************         
*S**  /*    
*S**  /* Load reject code into first available slot.        
*S**  DECIDE ON FIRST VALUE OF #CHECK-AVAILABLE 
*S**    VALUE '1'       
*S**      ASSIGN WFADDDSD.WF-AD-REJ1 = #CHECK-REJECT        
*S**    VALUE '2'       
*S**      ASSIGN WFADDDSD.WF-AD-REJ2 = #CHECK-REJECT        
*S**    VALUE '3'       
*S**      ASSIGN WFADDDSD.WF-AD-REJ3 = #CHECK-REJECT        
*S**    VALUE '4'       
*S**      ASSIGN WFADDDSD.WF-AD-REJ4 = #CHECK-REJECT        
*S**    VALUE '5'       
*S**      ASSIGN WFADDDSD.WF-AD-REJ5 = #CHECK-REJECT        
*S**    NONE
*S**      IGNORE        
*S**  END-DECIDE        
*S**END-SUBROUTINE /* LOAD-REJECT   
*S***       
*S*************************************************************************         
*S**DEFINE SUBROUTINE PROCESS-REJECT
*S*************************************************************************         
*S**  /*    
*S**  PERFORM CHECK-REJECT          
*S**  IF #REJ-FIRST-TIME
*S**    ASSIGN #REJ-FIRST-TIME = FALSE          
*S**    IF WF-AD-NEW-REJ = 'R'      
*S**      ASSIGN #REC-PREVIOUSLY-REJECTED = TRUE
*S**    END-IF          
*S**  END-IF
*S**  IF #CHECK-OCCURENCE = SPACE            /* Not previously rejected 
*S**    PERFORM LOAD-REJECT                  /*  for #CHECK-REJECT      
*S**  END-IF
*S**  ASSIGN #ADD-REJECT = TRUE     
*S**END-SUBROUTINE /* PROCESS-REJECT
*S***       
*S*************************************************************************         
*S**DEFINE SUBROUTINE UPDATE-REJECT 
*S*************************************************************************         
*S**  /*    
*S**  /* Update ADD file with rejects           
*S**  IF #REC-PREVIOUSLY-REJECTED   
*S**    ADD 1 TO #RE-REJ-COUNTER    
*S**  ELSE  
*S**    ADD 1 TO #NEW-REJ-COUNTER              /* New reject
*S**    MOVE #REJECTED TO WFADDDSD.WF-AD-NEW-REJ
*S**  END-IF
*S**  MOVE 'UPDATE' TO WWAOBJ.#FUNCTION         
*S**  PERFORM CALL-OBJECT-ADD       
*S**  ADD 1 TO #ET-WRITE-COUNTER    
*S**  IF #ET-WRITE-COUNTER > #MAX-WRITE         
*S**    PERFORM COMMIT-OR-BACKOUT   
*S**  END-IF
*S**END-SUBROUTINE /* UPDATE-REJECT 
*S***       
*S*************************************************************************         
*S**DEFINE SUBROUTINE COMMIT-OR-BACKOUT         
*S*************************************************************************         
*S**  /*    
*S**  /* Periodically issue END TRANSACTION     
*S**  IF #INPUT-RUNMODE = 'TRIAL'   
*S**    BACKOUT TRANSACTION         
*S**  ELSE  
*S**     END TRANSACTION
*S**  END-IF
*S**  RESET #ET-READ-COUNTER #ET-WRITE-COUNTER  
*S**END-SUBROUTINE /* COMMIT-OR-BACKOUT         
*S**END     
