*S*************************************************************************         
*S***       
*S***                              WolffPack    
*S***       
*S*** Program  : WFFLI26B           
*S*** System   : FINANCIER          
*S*** Title    : Federal Grant XML Import       
*S*** Function : This program imports Federal Grant XML documents       
*S***            transmitted from COD and converts them to fixed        
*S***            records to be processed by WFFLAyyB.       
*S***       
*S***            COD Schema Version 5.0c        
*S***       
*S***      Copyright 1995 - 2025 WolffPack, Inc.  All rights reserved.  
*S***       
*S*************************************************************************         
*S**DEFINE DATA         
*S**  GLOBAL USING WWGDA
*S***       
*S**  LOCAL USING WWREQIBD          
*S**  LOCAL USING WFFLI26D          
*S**  LOCAL USING WWCONST           
*S**  LOCAL 
*S***       
*S** 01 #LONG-STRING    
*S**  02 #L1 (A250)     
*S**  02 #L2 (A150)     
*S***       
*S** 01 #XML-STRING(A100)           
*S** 01 REDEFINE #XML-STRING        
*S**   02 #STRING-A(A1/100)         
*S***       
*S** 01 #STRING-TOT(N3) 
*S** 01 #TAG-NAME(A50)  
*S** 01 REDEFINE #TAG-NAME          
*S**   02 #TAG-N(A1/50) 
*S** 01 #TAG-VALUE(A50) 
*S** 01 REDEFINE #TAG-VALUE         
*S**   02 #TAG-V(A1/50) 
*S** 01 #END-TAG-NAME-POS (N20)     
*S** 01 #END-TAG (N20)  
*S** 01 #LOC(A3)        
*S** 01 #SUB(P5)        
*S** 01 #SUB2(P5)       
*S** 01 #SUBE(P5)       
*S** 01 #SUBF(P5)       
*S** 01 #SUBT(P5) INIT <0>          
*S** 01 #SUBV(P5) INIT <0>          
*S** 01 #SUBM(P5)       
*S** 01 #SUBU(P5)       
*S** 01 #D(P3)          
*S** 01 #A-E(P3)        
*S** 01 #S-E(P3)        
*S** 01 #D-E(P3)        
*S** 01 #ATT-E(P3)      
*S** 01 #R-E(P3)        
*S** 01 #X-E(P3)        
*S** 01 #A-F(P3)        
*S** 01 #D-F(P3)        
*S** 01 #S-F(P3)        
*S** 01 #EQUALSIGNS (N1)
*S** 01 #STD-COUNTER (P7)           
*S** 01 #AWD-EXISTS (L) INIT <FALSE>
*S** 01 #LOOP (N1)      
*S** 01 #N    (N2)      
*S** 01 #CONTINUE-LOADING(L)INIT <FALSE>        
*S** 01 END-OF-STUDENT(L)INIT <FALSE>           
*S** 01 #END-DOC (L)    
*S** 01 #COUNT-LT(N1)   
*S** 01 #CHK-TYPE(A30)  
*S** 01 #CHK-YEAR(A4)   
*S** 01 #TYPE(L)        
*S** 01 #YEAR(L)        
*S***       
*S** 01 #SUMMARY-COUNTER (P7)       
*S** 01 #READ-COUNTER (P7)          
*S** 01 #WRITE-STD-COUNTER(P7)      
*S** 01 #WRITE-SUM-COUNTER(P7)      
*S**END-DEFINE          
*S***       
*S*** Load Parameters   
*S**MOVE ##PASS-TEMP TO PASS-BATCH-FLDS         
*S**PROG.   
*S**REPEAT  
*S**READ WORK FILE 3 #LONG-STRING   
*S**MOVE SUBSTRING(#L1,1,100) TO #XML-STRING    
*S**ADD 1 TO #READ-COUNTER          
*S** IF #XML-STRING = ' '           
*S**   ESCAPE TOP       
*S** END-IF 
*S** MOVE LEFT #XML-STRING TO #XML-STRING       
*S***       
*S** IF SUBSTRING(#XML-STRING,1,9) = '<Receipt>'
*S**   ESCAPE BOTTOM (PROG.) IMMEDIATE          
*S** END-IF 
*S***       
*S** EXAMINE #XML-STRING FOR ' ' GIVING LENGTH #STRING-TOT  
*S** IF #CONTINUE-LOADING = FALSE   
*S**   IF SUBSTRING(#XML-STRING,1,17) = '<ReportingSchool>' 
*S**     ASSIGN #CONTINUE-LOADING = TRUE        
*S**   ELSE 
*S**     ESCAPE TOP     
*S**   END-IF           
*S** END-IF 
*S***       
*S** EXAMINE #XML-STRING FOR '=' GIVING #EQUALSIGNS         
*S** DECIDE ON FIRST VALUE OF #EQUALSIGNS       
*S**   VALUE 0          
*S**     EXAMINE #XML-STRING FOR '<' GIVING #COUNT-LT       
*S**     EXAMINE #XML-STRING FOR '>' GIVING POSITION #END-TAG-NAME-POS  
*S**     IF #COUNT-LT = 2           
*S**       PERFORM GET-TAG-NAME     
*S**       PERFORM GET-TAG-VALUE    
*S**     ELSE           
*S**       PERFORM GET-TAG-NAME     
*S**     END-IF         
*S**     PERFORM EVAL-TAG-NAME      
*S**   VALUE 1          
*S**     EXAMINE #XML-STRING FOR '=' GIVING POSITION #END-TAG-NAME-POS  
*S**     PERFORM GET-TAG-NAME       
*S**     ADD 1 TO #END-TAG-NAME-POS 
*S**     PERFORM GET-TAG-VALUE      
*S**     PERFORM EVAL-TAG-NAME      
*S**   NONE 
*S**     IGNORE         
*S** END-DECIDE         
*S***       
*S** IF #YEAR AND #TYPE 
*S**   IF (#CHK-TYPE NE 'Pell' AND  
*S**       #CHK-TYPE NE 'TEACH') OR 
*S**      #CHK-YEAR NOT = #INPUT-AID-YEAR       
*S**     SKIP(1) 3      
*S**     WRITE(1) 3T 'Input parameters do not match XML file'           
*S**     WRITE(1) 3T '  Program: ' #CHK-TYPE    
*S**     WRITE(1) 3T '  AidYear: ' #CHK-YEAR    
*S**     SKIP(1) 1      
*S**     WRITE(1) 3T 'Correct invalid or missing parameters and re-run job'         
*S**     TERMINATE      
*S**   END-IF           
*S** END-IF 
*S***       
*S** IF END-OF-STUDENT = TRUE       
*S**   PERFORM REMOVE-WARNINGS      
*S**   WRITE WORK FILE 2 WFFLI26D   
*S**   ADD 1 TO #WRITE-STD-COUNTER  
*S**   RESET #SUB #SUBT #SUB2 #SUBV 
*S**         #IMPORT-ORIGINATION #IMPORT-DISBURSEMENT(*)    
*S**   ASSIGN END-OF-STUDENT = FALSE
*S** END-IF 
*S***       
*S** IF #END-DOC = TRUE 
*S**   ESCAPE BOTTOM IMMEDIATE      
*S** END-IF 
*S***       
*S** IF (#INPUT-RUNMODE = 'TRIAL' OR = 'SAMPLE') AND        
*S**   #INPUT-LIMIT-COUNT > 0       
*S**    IF #STD-COUNTER GE #INPUT-LIMIT-COUNT   
*S**      ESCAPE BOTTOM IMMEDIATE   
*S**    END-IF          
*S** END-IF 
*S**END-WORK
*S**MOVE 'FederalGrant' TO WFFLT26D.#IMPORT-PROGRAM         
*S**WRITE WORK FILE 1 WFFLT26D      
*S**ADD 1 TO #WRITE-SUM-COUNTER     
*S**ESCAPE BOTTOM (PROG.) IMMEDIATE 
*S**END-REPEAT          
*S***       
*S**  WRITE(1) NOTITLE  
*S**    15T 'FINANCIER processing:' /           
*S**    17T 'XML lines read:'       
*S**                        (I) 55T #READ-COUNTER (EM=Z,ZZZ,ZZ9) //     
*S**    17T 'Student records written:'          
*S**                        (I) 55T #WRITE-STD-COUNTER (EM=Z,ZZZ,ZZ9) / 
*S**    17T 'Summary records written:'          
*S**                        (I) 55T #WRITE-SUM-COUNTER (EM=Z,ZZZ,ZZ9) / 
*S***       
*S*************************************************************************         
*S**DEFINE SUBROUTINE GET-TAG-NAME  
*S*************************************************************************         
*S**  RESET #SUBT #SUB #TAG-NAME    
*S**  FOR #SUB = 1 TO #END-TAG-NAME-POS         
*S**    ADD 1 TO #SUBT  
*S**    MOVE #STRING-A(#SUB) TO #TAG-N(#SUBT)   
*S**  END-FOR           
*S**END-SUBROUTINE      
*S***       
*S*************************************************************************         
*S**DEFINE SUBROUTINE GET-TAG-VALUE 
*S*************************************************************************         
*S**  RESET #SUBV #SUB2 #TAG-VALUE  
*S**  COMPUTE #END-TAG-NAME-POS = #END-TAG-NAME-POS + 1     
*S**  FOR #SUB2 = #END-TAG-NAME-POS  TO #STRING-TOT         
*S**    ADD 1 TO #SUBV  
*S**    IF (#STRING-A(#SUB2) NE '<') AND        
*S**       (#STRING-A(#SUB2) NE DOUBLE-QUOTE)   
*S**      MOVE #STRING-A(#SUB2) TO #TAG-V(#SUBV)
*S**    ELSE
*S**      ESCAPE BOTTOM 
*S**    END-IF          
*S**  END-FOR           
*S**END-SUBROUTINE      
*S***       
*S**************************************************************************        
*S**DEFINE SUBROUTINE EVAL-TAG-NAME 
*S************************************************************************          
*S**  MOVE LEFT #TAG-NAME TO #TAG-NAME          
*S**  MOVE LEFT #TAG-VALUE TO #TAG-VALUE        
*S***       
*S**  DECIDE FOR FIRST CONDITION    
*S**    /*  
*S**    /* Tags related to the <ReportingSchool> block      
*S**    WHEN #TAG-NAME = '<ReportingSchool>'    
*S**      ASSIGN #LOC = 'RPT'       
*S**    WHEN #TAG-NAME = '<FinancialAwardType>' 
*S**      ASSIGN #TYPE = TRUE       
*S**      DECIDE ON FIRST VALUE OF #TAG-VALUE   
*S**        VALUE 'Pell'
*S**          MOVE 'Pell'  TO #CHK-TYPE         
*S**        VALUE 'TEACH'           
*S**          MOVE 'TEACH' TO #CHK-TYPE         
*S**        NONE        
*S**          RESET #CHK-TYPE       
*S**      END-DECIDE    
*S**    WHEN #TAG-NAME = '<FinancialAwardYear>' 
*S**      ASSIGN #YEAR = TRUE       
*S**      MOVE #TAG-VALUE TO WFFLI26D.#IMPORT-AIDYEAR       
*S**                         WFFLT26D.#IMPORT-AIDYEAR       
*S**                         #CHK-YEAR          
*S**    /*  
*S**    /* Tags related to the <AttendedSchool> block       
*S**    WHEN #TAG-NAME = '<AttendedSchool>'     
*S**      ASSIGN #LOC = 'ATT'       
*S**    WHEN #TAG-NAME = '<RoutingID>' AND #LOC = 'ATT'     
*S**      MOVE #TAG-VALUE TO WFFLI26D.#IMPORT-ENTITY        
*S**                         WFFLT26D.#IMPORT-ENTITY        
*S**    /*  
*S**    /* Tags related to the <Student> block  
*S**    WHEN #TAG-NAME = '<Student>'
*S**      ASSIGN #LOC = 'STD'       
*S**      RESET #D #D-E #A-E #S-E #A-F #D-F #S-F
*S**    WHEN #TAG-NAME = '<SSN>'    
*S**      MOVE #TAG-VALUE TO #I-ORIG-SSN        
*S**    WHEN #TAG-NAME = '<BirthDate>'          
*S**      MOVE EDITED #TAG-VALUE TO #I-ORIG-DOB(EM=YYYY-MM-DD)          
*S**    WHEN #TAG-NAME = '<LastName>'           
*S**      MOVE #TAG-VALUE TO #I-ORIG-LAST       
*S**    WHEN #TAG-NAME = '<SchoolAssignedPersonID>'         
*S**      MOVE #TAG-VALUE TO #I-ORIG-STUDENT-ID 
*S**    /*  
*S**    /* Tags related to the various type Award blocks    
*S**    WHEN #TAG-NAME = '<Pell>'   
*S**      ASSIGN #LOC = 'AWD'       
*S**      MOVE 'Pell'  TO WFFLI26D.#IMPORT-PROGRAM          
*S**                      #CHK-TYPE 
*S**    WHEN #TAG-NAME = '<TEACH>'  
*S**      ASSIGN #LOC = 'AWD'       
*S**      MOVE 'TEACH' TO WFFLI26D.#IMPORT-PROGRAM          
*S**                      #CHK-TYPE 
*S**    WHEN #TAG-NAME = '<SchoolNoteMessage>' AND #LOC = 'AWD'         
*S**      MOVE #TAG-VALUE TO #I-ORIG-UPDATE     
*S**    /*  
*S**    WHEN #TAG-NAME = '<FinancialAwardNumber>'           
*S**      ASSIGN #I-ORIG-GRANT-NUM = VAL(#TAG-VALUE)        
*S**    WHEN #TAG-NAME = '<FPSTransactionNumber>'           
*S**      MOVE #TAG-VALUE TO #I-ORIG-TRANS-NO   
*S**    WHEN #TAG-NAME = '<FinancialAwardAmount>'           
*S**      ASSIGN #I-ORIG-AWARD = VAL(#TAG-VALUE)
*S**    WHEN #TAG-NAME = '<EnrollmentDate>'     
*S**      MOVE EDITED #TAG-VALUE TO #I-ORIG-ENR-DATE(EM=YYYY-MM-DD)     
*S**    WHEN #TAG-NAME = '<AttendanceCost>'     
*S**      ASSIGN #I-ORIG-BUDGET = VAL(#TAG-VALUE)           
*S**    WHEN #TAG-NAME = '<VerificationStatusCode>'         
*S**      MOVE #TAG-VALUE TO #I-ORIG-VER-STATUS 
*S**    WHEN #TAG-NAME = '<EligibilityPaymentReasonCode>'   
*S**      MOVE #TAG-VALUE TO #I-ORIG-PMT-RSN    
*S**    WHEN #TAG-NAME = '<RigorousHighSchoolProgramCode>'  
*S**      MOVE #TAG-VALUE TO #I-ORIG-HS-PROG    
*S**    WHEN #TAG-NAME = '<ProgramCIPCode>'     
*S**      MOVE #TAG-VALUE TO #I-ORIG-CIP        
*S**    WHEN #TAG-NAME = '<StudentLevelCode>'   
*S**      MOVE #TAG-VALUE TO #I-ORIG-YR-COL     
*S**    /*  
*S**    WHEN #TAG-NAME = '<ScheduledGrant>'     
*S**      ASSIGN #I-ORIG-SCHED-GRANT = VAL(#TAG-VALUE)      
*S**    WHEN #TAG-NAME = '<LifetimeEligibilityUsed>'        
*S**      ASSIGN #I-ORIG-GRANT-LEU = VAL(#TAG-VALUE)        
*S**    WHEN #TAG-NAME = '<YTDDisbursementAmount>'          
*S**      ASSIGN #I-ORIG-DISB-YTD = VAL(#TAG-VALUE)         
*S**    WHEN #TAG-NAME = '<AgreementToServeID>' 
*S**      MOVE #TAG-VALUE TO #I-ORIG-ATS-ID     
*S**    WHEN #TAG-NAME = '<ElectronicAgreementToServeIndicator>'        
*S**      IF #TAG-VALUE = 'true'    
*S**        MOVE 'Y' TO #I-ORIG-ATS-ELEC        
*S**      ELSE          
*S**        MOVE 'N' TO #I-ORIG-ATS-ELEC        
*S**      END-IF        
*S**    WHEN #TAG-NAME = '<AgreementToServeStatusCode>'     
*S**      MOVE #TAG-VALUE TO #I-ORIG-ATS-STAT   
*S**    WHEN #TAG-NAME = '<AgreementToServeLinkIndicator>'  
*S**      IF #TAG-VALUE = 'true'    
*S**        MOVE 'Y' TO #I-ORIG-ATS-LINK        
*S**      ELSE          
*S**        MOVE 'N' TO #I-ORIG-ATS-LINK        
*S**      END-IF        
*S**    /*  
*S**    /* Tags related to the Disbursement blocks          
*S**    WHEN #TAG-NAME = '<Disbursement Number='
*S**      ASSIGN #LOC = 'DSB'       
*S**      RESET #D-E #D-F           
*S**      ADD 1 TO #D   
*S**      ASSIGN #I-DISB-NUMBER(#D) = VAL(#TAG-VALUE)       
*S**    WHEN #TAG-NAME = '<SchoolNoteMessage>' AND #LOC = 'DSB'         
*S**      MOVE #TAG-VALUE TO #I-DISB-DP(#D)     
*S**    WHEN #TAG-NAME = '<DisbursementSequenceNumber>'     
*S**      ASSIGN #I-DISB-SEQ(#D) = VAL(#TAG-VALUE)          
*S**    WHEN #TAG-NAME = '<DisbursementAmount>' 
*S**      ASSIGN #I-DISB-AMOUNT(#D) = VAL(#TAG-VALUE)       
*S**    WHEN #TAG-NAME = '<DisbursementDate>'   
*S**      MOVE EDITED #TAG-VALUE TO #I-DISB-DATE(#D)(EM=YYYY-MM-DD)     
*S**    WHEN #TAG-NAME = '<DisbursementReleaseIndicator>'   
*S**      IF #TAG-VALUE = 'true'    
*S**        MOVE 'Y' TO #I-DISB-REL(#D)         
*S**      ELSE          
*S**        MOVE 'N' TO #I-DISB-REL(#D)         
*S**      END-IF        
*S**    /*  
*S**    /* Tags containing COD Response information to various blocks   
*S**    WHEN #TAG-NAME = '<DocumentTypeCode>'   
*S**      MOVE #TAG-VALUE TO #I-DOCT-TYPE       
*S**    WHEN #TAG-NAME = '<ProcessDate>'        
*S**      MOVE EDITED #TAG-VALUE TO #I-DOCT-PROC-DATE(EM=YYYY-MM-DD)    
*S**    WHEN #TAG-NAME = '<DocumentStatusCode>' 
*S**      MOVE #TAG-VALUE TO #I-DOCT-RESP       
*S**    /*  
*S**    WHEN #TAG-NAME = '<ResponseCode>'       
*S**      DECIDE ON FIRST VALUE OF #LOC         
*S**        VALUE 'RPT' 
*S**          MOVE #TAG-VALUE TO #I-REPT-RESP   
*S**        VALUE 'ATT' 
*S**          MOVE #TAG-VALUE TO #I-ATTN-RESP   
*S**        VALUE 'STD' 
*S**          MOVE #TAG-VALUE TO #I-STDN-RESP   
*S**        VALUE 'AWD' 
*S**          MOVE #TAG-VALUE TO #I-AWRD-RESP   
*S**        VALUE 'DSB' 
*S**          MOVE #TAG-VALUE TO #I-DISB-RESP(#D)           
*S**        NONE        
*S**          IGNORE    
*S**      END-DECIDE    
*S**    WHEN #TAG-NAME = '<ResponseErrorCode>'  
*S**      DECIDE ON FIRST VALUE OF #LOC         
*S**        VALUE 'REC' 
*S**          IF #X-E < 10          
*S**            ADD 1 TO #X-E       
*S**          END-IF    
*S**          MOVE #TAG-VALUE TO #I-DOCT-ERR-CODE(#X-E)     
*S**        VALUE 'RPT' 
*S**          IF #R-E < 10          
*S**            ADD 1 TO #R-E       
*S**          END-IF    
*S**          MOVE #TAG-VALUE TO #I-REPT-ERR-CODE(#R-E)     
*S**        VALUE 'ATT' 
*S**          IF #ATT-E < 10        
*S**            ADD 1 TO #ATT-E     
*S**          END-IF    
*S**          MOVE #TAG-VALUE TO #I-ATTN-ERR-CODE(#ATT-E)   
*S**        VALUE 'STD' 
*S**          IF #S-E < 10          
*S**            ADD 1 TO #S-E       
*S**          END-IF    
*S**          MOVE #TAG-VALUE TO #I-STDN-ERR-CODE(#S-E)     
*S**        VALUE 'AWD' 
*S**          IF #A-E < 10          
*S**            ADD 1 TO #A-E       
*S**          END-IF    
*S**          MOVE #TAG-VALUE TO #I-AWRD-ERR-CODE(#A-E)     
*S**        VALUE 'DSB' 
*S**          IF #D-E < 10          
*S**            ADD 1 TO #D-E       
*S**          END-IF    
*S**          MOVE #TAG-VALUE TO #I-DISB-ERR-CODE(#D,#D-E)  
*S**       NONE         
*S**          IGNORE    
*S**      END-DECIDE    
*S**    WHEN #TAG-NAME = '<ResponseErrorField>' 
*S**      DECIDE ON FIRST VALUE OF #LOC         
*S**        VALUE 'REC' 
*S**          MOVE #TAG-VALUE TO #I-DOCT-ERR-FIELD(#X-E)    
*S**        VALUE 'RPT' 
*S**          MOVE #TAG-VALUE TO #I-REPT-ERR-FIELD(#R-E)    
*S**        VALUE 'ATT' 
*S**          MOVE #TAG-VALUE TO #I-ATTN-ERR-FIELD(#ATT-E)  
*S**        VALUE 'STD' 
*S**          MOVE #TAG-VALUE TO #I-STDN-ERR-FIELD(#S-E)    
*S**        VALUE 'AWD' 
*S**          MOVE #TAG-VALUE TO #I-AWRD-ERR-FIELD(#A-E)    
*S**        VALUE 'DSB' 
*S**          MOVE #TAG-VALUE TO #I-DISB-ERR-FIELD(#D,#D-E) 
*S**        NONE        
*S**          IGNORE    
*S**      END-DECIDE    
*S**    WHEN #TAG-NAME = '<FSACode>'
*S**      IF #LOC = 'STD'           
*S**        ADD 1 TO #S-F           
*S**        MOVE #TAG-VALUE TO #I-STDN-FSA-CODE(#S-F)       
*S**      END-IF        
*S**      IF #LOC = 'AWD'           
*S**        ADD 1 TO #A-F           
*S**        MOVE #TAG-VALUE TO #I-AWRD-FSA-CODE(#A-F)       
*S**      END-IF        
*S**      IF #LOC = 'DSB'           
*S**        ADD 1 TO #D-F           
*S**        MOVE #TAG-VALUE TO #I-DISB-FSA-CODE(#D,#D-F)    
*S**      END-IF        
*S**    /*  
*S**    /* Tags that mark the ends of blocks    
*S**    WHEN #TAG-NAME = '</Pell>'  
*S**                OR = '</TEACH>' 
*S**      ASSIGN #LOC = 'STD'       
*S**    WHEN #TAG-NAME = '</Student>'           
*S**      ASSIGN #LOC = 'ATT'       
*S**      ASSIGN END-OF-STUDENT = TRUE          
*S**    WHEN #TAG-NAME = '</AttendedSchool>'    
*S**      ASSIGN #LOC = 'RPT'       
*S**    WHEN #TAG-NAME = '</ReportingSchool>'   
*S**      ASSIGN #LOC = 'REC'       
*S**    WHEN #TAG-NAME = '</CommonRecord>'      
*S**      ASSIGN #END-DOC = TRUE    
*S**    WHEN NONE       
*S**      IGNORE        
*S**  END-DECIDE        
*S**  /*    
*S**  RESET #TAG-VALUE #TAG-NAME    
*S**END-SUBROUTINE      
*S***       
*S*************************************************************************         
*S**DEFINE SUBROUTINE REMOVE-WARNINGS           
*S*************************************************************************         
*S**  /*    
*S**  /* Address warnings           
*S**  FOR #SUBE = 1 TO 10           
*S**    IF #I-STDN-ERR-CODE(#SUBE) = ' '        
*S**      ESCAPE BOTTOM 
*S**    END-IF          
*S**    IF #I-STDN-ERR-CODE(#SUBE) = '120'      
*S**      FOR #SUB = #SUBE TO 10    
*S**        IF #I-STDN-ERR-CODE(#SUB) = ' '     
*S**          ESCAPE BOTTOM         
*S**        END-IF      
*S**        IF #SUB = 10
*S**          MOVE ' ' TO #I-STDN-ERR-CODE(#SUB)
*S**                      #I-STDN-ERR-FIELD(#SUB)           
*S**        ELSE        
*S**          MOVE #I-STDN-ERR-CODE(#SUB+1)  TO #I-STDN-ERR-CODE(#SUB)  
*S**          MOVE #I-STDN-ERR-FIELD(#SUB+1) TO #I-STDN-ERR-FIELD(#SUB) 
*S**        END-IF      
*S**      END-FOR       
*S**      SUBTRACT 1 FROM #SUBE     
*S**    END-IF          
*S**  END-FOR           
*S**  /*    
*S**  /* Anticipated disbursement warnings      
*S**  FOR #D = 1 TO 12  
*S**    IF #I-DISB-NUMBER(#D) NOT > 0           
*S**      ESCAPE BOTTOM 
*S**    END-IF          
*S**    FOR #SUBE = 1 TO 10         
*S**      IF #I-DISB-ERR-CODE(#D,#SUBE) = ' '   
*S**        ESCAPE BOTTOM           
*S**      END-IF        
*S**      IF #I-DISB-ERR-CODE(#D,#SUBE) = '054' 
*S**        FOR #SUB = #SUBE TO 10  
*S**          IF #I-DISB-ERR-CODE(#D,#SUB) = ' '
*S**            ESCAPE BOTTOM       
*S**          END-IF    
*S**          IF #SUB = 10          
*S**            MOVE ' ' TO #I-DISB-ERR-CODE(#D,#SUB)       
*S**                        #I-DISB-ERR-FIELD(#D,#SUB)      
*S**          ELSE      
*S**            MOVE #I-DISB-ERR-CODE(#D,#SUB+1)
*S**                                        TO #I-DISB-ERR-CODE(#D,#SUB)
*S**            MOVE #I-DISB-ERR-FIELD(#D,#SUB+1)           
*S**                                        TO #I-DISB-ERR-FIELD(#D,#SUB)           
*S**          END-IF    
*S**        END-FOR     
*S**        SUBTRACT 1 FROM #SUBE   
*S**      END-IF        
*S**    END-FOR         
*S**  END-FOR           
*S**END-SUBROUTINE /* REMOVE-WARNINGS           
*S**END     
*E          
