*S*************************************************************************         
*S***       
*S***                              WolffPack    
*S***       
*S*** Subprogram: WFPER23N          
*S*** System    : FINANCIER         
*S*** Title     : Federal Grant Export          
*S*** Function  : This subprogram produces Pell Federal Grant records   
*S***             to be converted by WFFLEyyB to XML documents ready    
*S***             for transmittal to COD.       
*S***       
*S***      Copyright 1995 - 2022 WolffPack, Inc.  All rights reserved.  
*S***       
*S*************************************************************************         
*S**DEFINE DATA         
*S**  GLOBAL USING WWGDA
*S**  PARAMETER USING WWPDA         
*S**  PARAMETER USING WWREQIBD      
*S**  PARAMETER USING WFPEL23D      
*S**  PARAMETER USING WWTABLED      
*S**  PARAMETER USING WWSTDNCD      
*S**  PARAMETER USING WFCPS23D      
*S**  PARAMETER USING WFFED23D      
*S**  PARAMETER USING WFISW23D      
*S**  PARAMETER         
*S**   01 #REPORT-PELL(L)           
*S**  PARAMETER         
*S**   01 #ACCUMULATORS 
*S**     02 #STUDENT-COUNT(P7)      
*S**     02 #P-STNT-COUNT (P7)      
*S**     02 #P-AWRD-TOTAL (P13.2)   
*S**     02 #P-AWRD-NET   (P13.2)   
*S**     02 #P-DISB-TOTAL (P13.2)   
*S**     02 #P-DISB-NET   (P13.2)   
*S**     02 #T-STNT-COUNT (P7)      
*S**     02 #T-AWRD-TOTAL (P13.2)   
*S**     02 #T-AWRD-NET   (P13.2)   
*S**     02 #T-DISB-TOTAL (P13.2)   
*S**     02 #T-DISB-NET   (P13.2)   
*S**  PARAMETER         
*S**   01 #PRINT-LINE   
*S**     02 #PRT-STUDENT-ID(A9)     
*S**     02 #PRT-STUDENT-NAME(A20)  
*S**     02 #PRT-FED-TRAN(A2)       
*S**     02 #FILLER(A1) 
*S**     02 #PRT-GRANT(A6)          
*S**     02 #PRT-RECTYPE(A4)        
*S**     02 #PRT-AMT(A8)
*S**     02 #PRT-COMMENT(A20)       
*S**  PARAMETER         
*S**   01 #ERROR-LINE   
*S**     02 #ERR-STUDENT-ID(A9)     
*S**     02 #ERR-STUDENT-NAME(A20)  
*S**     02 #ERR-FED-TRAN(A2)       
*S**     02 #FILLER(A1) 
*S**     02 #ERR-GRANT(A6)          
*S**     02 #ERR-RECTYPE(A4)        
*S**     02 #ERR-AMT(A8)
*S**     02 #ERR-COMMENT(A20)       
*S***       
*S**  LOCAL USING WWCONST           
*S**  LOCAL USING WFFLE23D          
*S**  LOCAL USING WFFID23D /* Instituional Data Load        
*S**  LOCAL USING WWCALEND          
*S**  LOCAL USING WWCALENR          
*S**  LOCAL USING WWAOBJ
*S***       
*S**  LOCAL 
*S**   01 #REPORT-ORIG(L)           
*S**   01 #REPORT-DISB(L)           
*S**   01 #REPORT-ERROR(L)          
*S***       
*S**   01 #EVENT-TYPE(A5)           
*S**   01 #EVENT-DESC(A40)          
*S**   01 #EVENT-ORIGINATION        
*S**     02 #EO-ORIG-LABEL(A6)  INIT<'Orig  '>  
*S**     02 #EO-CLAS-LABEL(A6)  INIT<'Class='>  
*S**     02 #EO-CLAS-VALUE(A1)      
*S**     02 #EO-TRAN-LABEL(A14) INIT<' FederalTran#='>      
*S**     02 #EO-TRAN-VALUE(A2)      
*S**     02 #EO-AWRD-LABEL(A5)  INIT<' Awd='>   
*S**     02 #EO-AWRD-VALUE(A6)      
*S**   01 REDEFINE #EVENT-ORIGINATION           
*S**     02 #EVENT-ORIG(A40)        
*S**   01 #EVENT-DISBURSEMENT       
*S**     02 #ED-DISB-LABEL(A6)  INIT<'Disb  '>  
*S**     02 #ED-DSBN-LABEL(A5)  INIT<'Dsb#='>   
*S**     02 #ED-DSBN-VALUE(A2)      
*S**     02 #ED-SEQN-LABEL(A6)  INIT<' Seq#='>  
*S**     02 #ED-SEQN-VALUE(A2)      
*S**     02 #ED-FILLER    (A1)  INIT<' '>       
*S**     02 #ED-DPNM-VALUE(A7)      
*S**     02 #ED-DSBV-LABEL(A5)  INIT<' Dsb='>   
*S**     02 #ED-DSBV-VALUE(A6)      
*S**   01 REDEFINE #EVENT-DISBURSEMENT          
*S**     02 #EVENT-DISB(A40)        
*S***       
*S**   01 #WW-CALENDAR  
*S**     02 WW-RT01-BEG-DATE(D)     
*S**     02 WW-RT02-BEG-DATE(D)     
*S**     02 WW-RT03-BEG-DATE(D)     
*S**     02 WW-RT04-BEG-DATE(D)     
*S**     02 WW-RT05-BEG-DATE(D)     
*S**     02 WW-RT06-BEG-DATE(D)     
*S**     02 WW-RT07-BEG-DATE(D)     
*S**     02 WW-RT08-BEG-DATE(D)     
*S**     02 WW-RT09-BEG-DATE(D)     
*S**     02 WW-RT10-BEG-DATE(D)     
*S**     02 WW-RT11-BEG-DATE(D)     
*S**     02 WW-RT12-BEG-DATE(D)     
*S**     02 WW-RT01-END-DATE(D)     
*S**     02 WW-RT02-END-DATE(D)     
*S**     02 WW-RT03-END-DATE(D)     
*S**     02 WW-RT04-END-DATE(D)     
*S**     02 WW-RT05-END-DATE(D)     
*S**     02 WW-RT06-END-DATE(D)     
*S**     02 WW-RT07-END-DATE(D)     
*S**     02 WW-RT08-END-DATE(D)     
*S**     02 WW-RT09-END-DATE(D)     
*S**     02 WW-RT10-END-DATE(D)     
*S**     02 WW-RT11-END-DATE(D)     
*S**     02 WW-RT12-END-DATE(D)     
*S**   01 REDEFINE #WW-CALENDAR     
*S**     02 #WW-TERM-START-DATE(D/12)           
*S**     02 #WW-TERM-END-DATE(D/12) 
*S***       
*S**   01 #CAL-TBL-VAL(A10)         
*S**   01 REDEFINE #CAL-TBL-VAL     
*S**     02 #CAL-AY(A4) 
*S**     02 #CAL-FAO(A2)
*S**     02 #CAL-SCHED(A1)          
*S***       
*S**   01 #SUB(N2)       /* Used for passed array and schedule array    
*S**   01 #DSUB(N2)      /* Used for passed array searches  
*S**   01 #ESUB(N2)      /* Used for export array           
*S**   01 #HOLD-NUM(N2) 
*S***       
*S**   01 #GRANT-ID(A23)
*S**   01 REDEFINE #GRANT-ID        
*S**     02 #GID-SSN(A9)
*S**     02 #GID-TYPE(A1)           
*S**     02 #GID-YEAR(A2)           
*S**     02 #GID-SCHOOL(A6)         
*S**     02 #GID-NUM(N3)
*S***       
*S**   01 #AID-CCYY(A4) 
*S**   01 REDEFINE #AID-CCYY        
*S**     02 #AID-CC(A2) 
*S**     02 #AID-YY(A2) 
*S***       
*S**   01 #FID-TYPE(A5)     INIT<'Pell'>        
*S**   01 #FID-FUNCTION(A6) INIT<'EXPORT'>      
*S***       
*S**   01 #DISB-SUB(P3) 
*S**   01 #TERM-SUB(P3) 
*S**   01 #SCHED-DP(A1/12)          
*S**END-DEFINE          
*S***       
*S*** Define printers, formats, headings        
*S**FORMAT(2) LS=80 PS=60 ZP=ON IS=OFF ES=OFF SG=OFF        
*S**FORMAT(3) LS=80 PS=60 ZP=ON IS=OFF ES=OFF SG=OFF        
*S***       
*S**AT TOP OF PAGE(2)   
*S**  WRITE(2) NOTITLE ##PGM-ID     
*S**        21T '*** FINANCIER FEDERAL GRANT EXPORT ***'    
*S**        71T 'Page' *PAGE-NUMBER(2)(EM=ZZ9)  
*S**      / *DATX(EM=LLL' 'DD', 'YYYY)          
*S**        31T 'Students in Error' 
*S**        71T *TIMX(EM=HH':'II' 'AP)          
*S**     // 31T 'Aid Year:' ##DISP-AY           
*S**      / 36T ##DISP-LIT ##DISP-FAO           
*S**    /// 'StudentID     Name            Tran  Grant   Transaction'   
*S**        'Errors'    
*S**  SKIP(2) 1         
*S**END-TOPPAGE         
*S**AT TOP OF PAGE(3)   
*S**  WRITE(3) NOTITLE *PROGRAM     
*S**        21T '*** FINANCIER FEDERAL GRANT EXPORT ***'    
*S**        71T 'Page' *PAGE-NUMBER(3)(EM=ZZ9)  
*S**      / *DATX(EM=LLL' 'DD', 'YYYY)          
*S**        31T 'Reported Students' 
*S**        71T *TIMX(EM=HH':'II' 'AP)          
*S**     // 31T 'Aid Year:' ##DISP-AY           
*S**      / 36T ##DISP-LIT ##DISP-FAO           
*S**    /// 'StudentID     Name            Tran  Grant   Transaction'   
*S**  SKIP(3) 1         
*S**END-TOPPAGE         
*S***       
*S***       
*S*** Populate WW-GDA from WW-PDA   
*S**MOVE BY POSITION WW-PDA TO WW-GDA           
*S**MOVE ##AID-YEAR TO #AID-CCYY    
*S***       
*S**ASSIGN #PELL-ACTION = 'G'       
*S**RESET #PELL-DATA #PELL-ACTIVE-FUND(*)       
*S**PERFORM PELL-REPORT-2223 #INPUT-EFF-DATE-D WFPEL23D     
*S***       
*S**PERFORM GET-TERM-DATES          
*S***       
*S**PERFORM DECIDE-TO-REPORT-PELL   
*S**IF #REPORT-PELL     
*S**  ASSIGN #PELL-ACTION = 'R'     
*S**  PERFORM PELL-REPORT-2223 #INPUT-EFF-DATE-D WFPEL23D   
*S**END-IF  
*S***       
*S*** Populate WW-GDA from WW-PDA   
*S**MOVE BY POSITION WW-GDA TO WW-PDA           
*S***       
*S***       
*S*************************************************************************         
*S**DEFINE SUBROUTINE DECIDE-TO-REPORT-PELL     
*S*************************************************************************         
*S**  /*    
*S**  /* If Runmode is not RECOVER, skip anyone who has a "hold" action;
*S**  /*  skip anyone who has been reported and the COD response has not
*S**  /*  been received and processed unless re-report has been requested;          
*S**  /*  skip anyone who has no award and no previously-reported award 
*S**  /* If Runmode is RECOVER, skip anyone who was not reported        
*S**  /*  on the Effective Date     
*S**  IF #INPUT-RUNMODE NE 'RECOVER' AND        
*S**     (WFCPS23D.WF-CP-RP-ACT = 'H' OR        
*S**     (WFCPS23D.WF-CP-RP-RPT-DATE > WFCPS23D.WF-CP-RP-O-ACK-DATE AND 
*S**      WFCPS23D.WF-CP-RP-RPT-DATE > WFCPS23D.WF-CP-RP-D-ACK-DATE AND 
*S**      WFCPS23D.WF-CP-RP-ACT NE 'R') OR      
*S**     (#CUR-P-AWARD = 0 AND WFCPS23D.WF-CP-RP-A-AWARD = 0))          
*S**    ESCAPE ROUTINE  
*S**  END-IF
*S**  IF #INPUT-RUNMODE = 'RECOVER' 
*S**    IF WFCPS23D.WF-CP-RP-RPT-DATE NE #INPUT-EFF-DATE-D  
*S**      ESCAPE ROUTINE
*S**    END-IF          
*S**  END-IF
*S**  /*    
*S**  RESET #REPORT-ORIG #REPORT-DISB #REPORT-ERROR         
*S**  RESET WFFLE23D #ESUB          
*S**  /*    
*S**  /* Retrieve institutional data
*S**  FOR #DISB-SUB = 1 TO 12       
*S**    IF #CUR-P-D-DP(#DISB-SUB) <> ' ' AND    
*S**        (#CUR-P-D-OFF(#DISB-SUB) <> 0 OR    
*S**        #CUR-P-D-DIS(#DISB-SUB) <> 0)       
*S**      MOVE #CUR-P-D-DP(#DISB-SUB) TO #SCHED-DP(#DISB-SUB)           
*S**    END-IF          
*S**  END-FOR           
*S**  PERFORM LOAD-INST-DATA        
*S**  /*    
*S**  /* Set up print line          
*S**  MOVE 'Pell' TO #PRT-GRANT #ERR-GRANT      
*S**  MOVE 'Orig' TO #PRT-RECTYPE #ERR-RECTYPE  
*S**  MOVE EDITED #CUR-P-AWARD (EM=Z,ZZZ.99) TO #PRT-AMT    
*S**  MOVE EDITED #CUR-P-AWARD (EM=Z,ZZZ.99) TO #ERR-AMT    
*S**  /*    
*S**    IF #CUR-P-AWARD > 0         
*S**      IF NOT WFISW23D.#EXISTS   
*S**        ASSIGN #REPORT-ERROR = TRUE         
*S**        MOVE 'No ISIR' TO #ERR-COMMENT      
*S**        WRITE(2) #ERROR-LINE    
*S**        RESET #ERROR-LINE       
*S**      END-IF        
*S**      IF WFCPS23D.WF-CP-FED-ID = ' '        
*S**        ASSIGN #REPORT-ERROR = TRUE         
*S**        MOVE 'Federal ID' TO #ERR-COMMENT   
*S**        WRITE(2) #ERROR-LINE    
*S**        RESET #ERROR-LINE       
*S**      END-IF        
*S**      IF WFISW23D.#PELL-ELIG NE 'Y'         
*S**        ASSIGN #REPORT-ERROR = TRUE         
*S**        MOVE 'Not Pell eligible' TO #ERR-COMMENT        
*S**        WRITE(2) #ERROR-LINE    
*S**        RESET #ERROR-LINE       
*S**      END-IF        
*S**      IF #CUR-P-COST = 0        
*S**        ASSIGN #REPORT-ERROR = TRUE         
*S**        MOVE '9month budget' TO #ERR-COMMENT
*S**        WRITE(2) #ERROR-LINE    
*S**        RESET #ERROR-LINE       
*S**      END-IF        
*S**      IF (WFISW23D.#VER = 'Y' OR = '*') AND #CUR-P-VER-FED = ' '    
*S**        ASSIGN #REPORT-ERROR = TRUE         
*S**        MOVE 'Verification' TO #ERR-COMMENT 
*S**        WRITE(2) #ERROR-LINE    
*S**        RESET #ERROR-LINE       
*S**      END-IF        
*S**      IF #CUR-P-VER-FED = 'V' AND           
*S**         #CUR-P-VER-TRAN NE WFCPS23D.WF-CP-FED-ID3 AND  
*S**         WFFED23D.WF-FE-F-PROF-JUDG NE 'Y'  
*S**        ASSIGN #REPORT-ERROR = TRUE         
*S**        MOVE 'Verification xaction' TO #ERR-COMMENT     
*S**        WRITE(2) #ERROR-LINE    
*S**        RESET #ERROR-LINE       
*S**      END-IF        
*S**      IF #CUR-P-ENR-DATE = INIT-DATE        
*S**        ASSIGN #REPORT-ERROR = TRUE         
*S**        MOVE 'Enrollment date' TO #ERR-COMMENT          
*S**        WRITE(2) #ERROR-LINE    
*S**        RESET #ERROR-LINE       
*S**      END-IF        
*S**      /* Invalid ATB codes      
*S**      /*   (03 & 05 retired)    
*S**      IF WWSTDNCD.WW-ST-ATB-CODE = '  ' OR  
*S**         (WWSTDNCD.WW-ST-ATB-CODE = '03' OR 
*S**          WWSTDNCD.WW-ST-ATB-CODE = '05')   
*S**        ASSIGN #REPORT-ERROR = TRUE         
*S**        MOVE 'ATB code' TO #ERR-COMMENT     
*S**        WRITE(2) #ERROR-LINE    
*S**        RESET #ERROR-LINE       
*S**      END-IF        
*S**      IF #REPORT-ERROR          
*S**        ESCAPE ROUTINE          
*S**      END-IF        
*S**    END-IF          
*S**  IF (#INPUT-RUNMODE = 'RECOVER' AND        
*S**      WFCPS23D.WF-CP-RP-RPT-DATE = #INPUT-EFF-DATE-D) OR
*S**     WFCPS23D.WF-CP-RP-ACT = 'R' OR         
*S**     #CUR-P-COST     NE WFCPS23D.WF-CP-RP-A-COST OR     
*S**     #CUR-P-VER-FED  NE WFCPS23D.WF-CP-RP-A-VER OR      
*S**     #CUR-P-ENR-DATE NE WFCPS23D.WF-CP-RP-A-ENR-DATE OR 
*S**     #CUR-P-AWARD    NE WFCPS23D.WF-CP-RP-A-AWARD       
*S**    ASSIGN #REPORT-ORIG = TRUE  
*S**    ADD #CUR-P-AWARD TO #P-AWRD-NET         
*S**    SUBTRACT WFCPS23D.WF-CP-RP-A-AWARD FROM #P-AWRD-NET 
*S**    /*  
*S**    /* Move origination data to be reported to "report" CPS fields  
*S**    MOVE WFCPS23D.WF-CP-FED-ID3 TO WFCPS23D.WF-CP-RP-R-FED-TRAN     
*S**    IF #PELL-ELIG NE 'Y'        
*S**      MOVE WFCPS23D.WF-CP-RP-A-FED-TRAN     
*S**                                TO WFCPS23D.WF-CP-RP-R-FED-TRAN     
*S**    END-IF          
*S**    MOVE #CUR-P-COST            TO WFCPS23D.WF-CP-RP-R-COST         
*S**    MOVE #CUR-P-VER-FED         TO WFCPS23D.WF-CP-RP-R-VER          
*S**    MOVE #CUR-P-ENR-DATE        TO WFCPS23D.WF-CP-RP-R-ENR-DATE     
*S**    MOVE #CUR-P-AWARD           TO WFCPS23D.WF-CP-RP-R-AWARD        
*S**    /*  
*S**    /* Create origination event 
*S**    MOVE 'PGRpt' TO #EVENT-TYPE 
*S**    RESET INITIAL #EVENT-ORIGINATION        
*S**    RESET #EO-CLAS-LABEL        
*S**    MOVE WFCPS23D.WF-CP-FED-ID3 TO #EO-TRAN-VALUE       
*S**    MOVE EDITED #CUR-P-AWARD (EM=ZZ,ZZ9) TO #EO-AWRD-VALUE          
*S**    MOVE #EVENT-ORIG TO #EVENT-DESC         
*S**    PERFORM ADD-EVENT #EVENT-TYPE #EVENT-DESC           
*S**    /*  
*S**    /* Print on report of processed records 
*S**    WRITE(3) #PRINT-LINE        
*S**    RESET #PRINT-LINE           
*S**  END-IF
*S**  /*    
*S**  /* Clear any old reported/unacknowledged data         
*S**  RESET #RPT-P-D-NUM(*)  #RPT-P-D-SEQ(*)    
*S**        #RPT-P-D-DIS(*)  #RPT-P-D-DATE(*)   
*S**  /*    
*S**  /* Cycle through disbursements
*S**  FOR #SUB = 1 TO 12
*S**    IF #CUR-P-D-DP(#SUB) = ' ' AND          
*S**       #ACK-P-D-NUM(#SUB) = 0   
*S**      ESCAPE TOP    
*S**    END-IF          
*S**    /*  
*S**    /* If previously reported and amount is unchanged, skip         
*S**    IF #CUR-P-D-DIS(#SUB) = #ACK-P-D-DIS(#SUB)          
*S**      ESCAPE TOP    
*S**    END-IF          
*S**    /*  
*S**    /* Set up print line        
*S**    MOVE 'Disb' TO #PRT-RECTYPE 
*S**    MOVE EDITED #CUR-P-D-DIS(#SUB) (EM=Z,ZZZ.99) TO #PRT-AMT        
*S**    IF ##SCHED-DP-TITLE(#SUB) = ' '         
*S**      MOVE 'CODRptErr' TO #PRT-COMMENT      
*S**    ELSE
*S**      MOVE ##SCHED-DP-TITLE(#SUB) TO #PRT-COMMENT       
*S**    END-IF          
*S**    /*  
*S**    ASSIGN #REPORT-DISB = TRUE  
*S**    ADD #CUR-P-D-DIS(#SUB) TO #P-DISB-TOTAL 
*S**    ADD #CUR-P-D-DIS(#SUB) TO #P-DISB-NET   
*S**    SUBTRACT #ACK-P-D-DIS(#SUB) FROM #P-DISB-NET        
*S**    /*  
*S**    /* Move disbursements to be reported to "report" fields in array
*S**      IF #ACK-P-D-NUM(#SUB) = 0 
*S**        RESET #HOLD-NUM         
*S**        FOR #DSUB = 1 TO 12     
*S**          IF #ACK-P-D-NUM(#DSUB) > #HOLD-NUM
*S**            MOVE #ACK-P-D-NUM(#DSUB) TO #HOLD-NUM       
*S**          END-IF    
*S**          IF #RPT-P-D-NUM(#DSUB) > #HOLD-NUM
*S**            MOVE #RPT-P-D-NUM(#DSUB) TO #HOLD-NUM       
*S**          END-IF    
*S**        END-FOR     
*S**        COMPUTE #RPT-P-D-NUM(#SUB) = #HOLD-NUM + 1      
*S**        MOVE 1 TO #RPT-P-D-SEQ(#SUB)        
*S**      ELSE          
*S**        MOVE #ACK-P-D-NUM(#SUB) TO #RPT-P-D-NUM(#SUB)   
*S**        COMPUTE #RPT-P-D-SEQ(#SUB) = #ACK-P-D-SEQ(#SUB) + 1         
*S**      END-IF        
*S**      MOVE #CUR-P-D-DIS(#SUB) TO #RPT-P-D-DIS(#SUB)     
*S**      IF #CUR-P-D-DATE(#SUB) = INIT-DATE    
*S**        MOVE #ACK-P-D-DATE(#SUB) TO #RPT-P-D-DATE(#SUB) 
*S**      ELSE          
*S**        MOVE #CUR-P-D-DATE(#SUB) TO #RPT-P-D-DATE(#SUB) 
*S**      END-IF        
*S**    /*  
*S**    /* Create disbursement event
*S**    MOVE 'PGRpt' TO #EVENT-TYPE 
*S**    RESET INITIAL #EVENT-DISBURSEMENT       
*S**    MOVE EDITED #RPT-P-D-NUM(#SUB) (EM=99)     TO #ED-DSBN-VALUE    
*S**    MOVE EDITED #RPT-P-D-SEQ(#SUB) (EM=99)     TO #ED-SEQN-VALUE    
*S**    IF ##SCHED-DP-TITLE(#SUB) = ' '         
*S**      MOVE 'CODRptErr'                         TO #ED-DPNM-VALUE    
*S**    ELSE
*S**      MOVE ##SCHED-DP-TITLE(#SUB)              TO #ED-DPNM-VALUE    
*S**    END-IF          
*S**    MOVE EDITED #RPT-P-D-DIS(#SUB) (EM=ZZ,ZZ9) TO #ED-DSBV-VALUE    
*S**    MOVE #EVENT-DISB TO #EVENT-DESC         
*S**    PERFORM ADD-EVENT #EVENT-TYPE #EVENT-DESC           
*S**    /*  
*S**    /* Print on report of processed records 
*S**    WRITE(3) #PRINT-LINE        
*S**    RESET #PRINT-LINE           
*S**  END-FOR           
*S**  /*    
*S**  IF #REPORT-ORIG OR #REPORT-DISB           
*S**    ASSIGN #REPORT-PELL = TRUE  
*S**    ADD 1 TO #P-STNT-COUNT      
*S**    ADD #CUR-P-AWARD TO #P-AWRD-TOTAL       
*S**    /*  
*S**    /* Load CPS updates         
*S**    RESET WFCPS23D.WF-CP-RP-ACT 
*S**          WFCPS23D.WF-CP-RP-ACT-RSN         
*S**          WFCPS23D.WF-CP-RP-ACT-DATE        
*S**    MOVE #INPUT-EFF-DATE-D TO WFCPS23D.WF-CP-RP-RPT-DATE
*S**    IF #REPORT-DISB 
*S**      MOVE #CUR-P-DISB TO WFCPS23D.WF-CP-RP-R-DISB      
*S**    END-IF          
*S**    /*  
*S**    /* Load export data         
*S**    ASSIGN WFFLE23D.#EXPORT-PROGRAM = 'Pell'
*S**    ASSIGN WFFLE23D.#EXPORT-AIDYEAR = ##AID-YEAR        
*S**    ASSIGN WFFLE23D.#EXPORT-FAO     = ##FAO-ID          
*S**    ASSIGN WFFLE23D.#EXPORT-OPEID   = WWTABLED.WW-OPE-ID
*S**    /*  
*S**    MOVE WFISW23D.#SSN TO #E-ORIG-SSN       
*S**    IF WFISW23D.#DOB = MASK(YYYYMMDD)       
*S**      MOVE EDITED WFISW23D.#DOB TO #E-ORIG-DOB (EM=YYYYMMDD)        
*S**    END-IF          
*S**    MOVE WFISW23D.#NM-LAST  TO #E-ORIG-LAST 
*S**    MOVE WFISW23D.#NM-FIRST TO #E-ORIG-FIRST
*S**    MOVE WFISW23D.#NM-MI    TO #E-ORIG-MI   
*S**    MOVE ##SID TO #E-ORIG-STUDENT-ID        
*S**    /*  
*S**    MOVE WFISW23D.#AD-STRT  TO #E-ORIG-AD-STRT          
*S**    MOVE WFISW23D.#AD-CITY  TO #E-ORIG-AD-CITY          
*S**    MOVE WFISW23D.#AD-STATE TO #E-ORIG-AD-STATE         
*S**    MOVE WFISW23D.#AD-ZIP   TO #E-ORIG-AD-ZIP           
*S**    /*  
*S**    DECIDE FOR FIRST CONDITION  
*S**      WHEN WFFED23D.WF-FE-S-CIT = 'U'       
*S**        ASSIGN #E-ORIG-CIT = '1'
*S**      WHEN WFFED23D.WF-FE-S-CIT = 'E'       
*S**        ASSIGN #E-ORIG-CIT = '2'
*S**      WHEN NONE     
*S**        IGNORE      
*S**    END-DECIDE      
*S**    DECIDE FOR FIRST CONDITION  
*S**      WHEN #REPORT-ORIG AND NOT #REPORT-DISB
*S**        MOVE 'ORIG' TO #E-ORIG-UPDATE       
*S**      WHEN NOT #REPORT-ORIG AND #REPORT-DISB
*S**        MOVE 'DISB' TO #E-ORIG-UPDATE       
*S**      WHEN NONE     
*S**        MOVE 'BOTH' TO #E-ORIG-UPDATE       
*S**    END-DECIDE      
*S**    /*  
*S**    MOVE WWSTDNCD.WW-ST-ATB-STATE TO #E-ORIG-ATB-STATE  
*S**    MOVE WWSTDNCD.WW-ST-ATB-CODE  TO #E-ORIG-ATB-CODE   
*S**    MOVE WWSTDNCD.WW-ST-ATB-ADMN  TO #E-ORIG-ATB-ADMN   
*S**    MOVE WWSTDNCD.WW-ST-ATB-TEST  TO #E-ORIG-ATB-TEST   
*S**    MOVE WWSTDNCD.WW-ST-ATB-DATE  TO #E-ORIG-ATB-DATE   
*S**    MOVE WFCPS23D.WF-CP-RP-AEI TO #E-ORIG-AEI           
*S**    MOVE WFCPS23D.WF-CP-FED-ID3 TO #E-ORIG-FEDID-TRAN   
*S**    IF #PELL-ELIG NE 'Y'        
*S**      MOVE WFCPS23D.WF-CP-RP-A-FED-TRAN TO #E-ORIG-FEDID-TRAN       
*S**    END-IF          
*S**    MOVE #CUR-P-COST     TO #E-ORIG-BUDGET  
*S**    MOVE #CUR-P-VER-FED  TO #E-ORIG-VER-STATUS          
*S**    MOVE #CUR-P-ENR-DATE TO #E-ORIG-ENR-DATE
*S**    MOVE #CUR-P-AWARD    TO #E-ORIG-AWARD   
*S**    FOR #DSUB = 1 TO 12         
*S**      IF #RPT-P-D-NUM(#DSUB) NE 0           
*S**        ADD 1 TO #ESUB          
*S**        MOVE #RPT-P-D-NUM(#DSUB)  TO #E-DISB-NUMBER(#ESUB)          
*S**        MOVE #RPT-P-D-SEQ(#DSUB)  TO #E-DISB-SEQ(#ESUB) 
*S**        MOVE #CUR-P-D-DP(#DSUB)   TO #E-DISB-DP(#ESUB)  
*S**        MOVE #RPT-P-D-DIS(#DSUB)  TO #E-DISB-AMOUNT(#ESUB)          
*S**        MOVE #RPT-P-D-DATE(#DSUB) TO #E-DISB-DATE(#ESUB)
*S**        MOVE 'Y'                  TO #E-DISB-REL(#ESUB) 
*S**        /*          
*S**        /* Enrollment,CIP and pgm length,etc
*S**        /*          
*S**        IF ##SCHED-DP(#DSUB) = #CUR-P-D-DP(#DSUB)       
*S**          MOVE BY NAME WFFID23D.#EXPORT-DISBURSEMENT(#DSUB) TO      
*S**                       WFFLE23D.#EXPORT-DISBURSEMENT(#ESUB)         
*S**          MOVE #WW-TERM-START-DATE(#DSUB) TO
*S**            WFFLE23D.#E-DISB-PAYPD-START-DATE(#ESUB)    
*S**          MOVE #WW-TERM-END-DATE(#DSUB) TO  
*S**            WFFLE23D.#E-DISB-PAYPD-END-DATE(#ESUB)      
*S**        END-IF      
*S**      END-IF        
*S**    END-FOR         
*S**    WRITE WORK FILE 2 WFFLE23D  
*S**  END-IF
*S**END-SUBROUTINE /* DECIDE-TO-REPORT-PELL     
*S***       
*S*************************************************************************         
*S**DEFINE SUBROUTINE LOAD-INST-DATA
*S*************************************************************************         
*S**  /* Retrieve Pell Export data from outside of Financier
*S**  CALLNAT 'WFFID23N' WW-GDA     
*S**           #FID-TYPE
*S**           #FID-FUNCTION        
*S**           #SCHED-DP(*)         
*S**           WFFID23D 
*S**  /* Move instituional data from PDA to Grant data PDA  
*S**  MOVE BY NAME WFFID23D TO WFFLE23D         
*S***       
*S**END-SUBROUTINE /* LOAD-INST-DATA
*S***       
*S*************************************************************************         
*S**DEFINE SUBROUTINE GET-TERM-DATES
*S*************************************************************************         
*S**  /* Get calendar for student's schedule    
*S**  ASSIGN WWCALEND.WW-RECORD-TYPE = TABLE-TYPE           
*S**  ASSIGN WWCALEND.WW-TABLE-ID = 'CALEN'       /* Calendar table     
*S**  MOVE ##AID-YEAR TO #CAL-AY    
*S**  MOVE ##FAO-ID TO #CAL-FAO     
*S**  MOVE ##SCHED-ID TO #CAL-SCHED 
*S**  ASSIGN WWCALEND.WW-TABLE-VALUE = #CAL-TBL-VAL         
*S**  ASSIGN WWAOBJ.#FUNCTION = 'GET'           
*S**  CALLNAT 'WWCALENO' WW-GDA     
*S**           WWCALEND 
*S**           WWCALEND-ID          
*S**           WWCALENR 
*S**           WWAOBJ   
*S**  MOVE BY NAME WWCALEND TO #WW-CALENDAR     
*S**  /*    
*S**END-SUBROUTINE /* GET-TERM-DATES
*S***       
*S**END     
*E          
