00001  IDENTIFICATION DIVISION.                                         05/20/13
00002  PROGRAM-ID.             DTSBU520.                                DTSBU520
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV018
00004  DATE-WRITTEN.           JANUARY 1991.                            DTSBU520
00005  DATE-COMPILED.                                                   DTSBU520
00006      SKIP3                                                        DTSBU520
00007 *****                                                             DTSBU520
00008 *                                                                 DTSBU520
00009 *    FUNCTION:  PAYMENT APPLICATION.                              DTSBU520
00010 *                                                                 DTSBU520
00011 *                                                                 DTSBU520
00012 *    MODIFICATION LOG:                                            DTSBU520
00013 *                                                                 DTSBU520
00014 *    01/26/92  INITIAL DEVELOPMENT.                               DTSBU520
00015 *              WORK ORDER:                      PROGRAMMER: TCL   DTSBU520
00016 *                                                                 DTSBU520
00017 *    06/13/95  CHANGE TO CREDIT TOLERANCE LOGIC REMOVES IT FROM   DTSBU520
00018 *              THIS PROGRAM.                                      DTSBU520
00019 *              WORK ORDER: CR094                PROGRAMMER: RHC   DTSBU520
00020 *                                                                 DTSBU520
00021 *    12/10/1998  REVIEWED AND MODIFIED FOR DC.                    DTSBU520
00022 *                REFERENCE: DC DEVELOPMENT      PROGRAMMER: EHH   DTSBU520
00023 *                                                                 DTSBU520
00024 *    10/21/2002  ADDED SPECIAL RULE FOR APPLICATION OF PAYMENTS   DTSBU520
00025 *                TO QUARTERS REPORTED ANNUALLY.                   DTSBU520
00026 *                REFERENCE: HOUSEHOLD           PROGRAMMER: GD    DTSBU520
00027 *                                                                 DTSBU520
00028 *    12/16/2003  MODIFIED P0000 TO EXECUTE P1000 ONLY ONE TIME    DTSBU520
00029 *                IF THERE IS A CREDIT.                            DTSBU520
00030 *                REFERENCE: HOUSEHOLD           PROGRAMMER: GD    DTSBU520
00031 *                                                                 DTSBU520
00032 *    10/22/2012  REMOVED SPECIAL PROCESSING FOR ANNUAL FILERS.    DTSBU520
00033 *                REFERENCE: HOUSEHOLD           PROGRAMMER: GD    DTSBU520
00034 *                                                                 DTSBU520
00035 *                                                                 DTSBU520
00036 *  DESCRIPTION:                                                   DTSBU520
00037 *                                                                 DTSBU520
00038 *      PAYMENT APPLICATION.                                       DTSBU520
00039 *                                                                 DTSBU520
00040 *      APPLY UNAPPLIED CREDIT PAYMENT DISTRIBUTIONS TO BALANCES   DTSBU520
00041 *      DUE UNTIL EITHER UNAPPLIED CREDITS ARE EXHAUSTED OR        DTSBU520
00042 *      BALANCES DUE ARE EXHAUSTED.  AT EXIT FROM DTSBU520: IF     DTSBU520
00043 *      AN UNAPPLIED CREDIT EXISTS, THEN NO BALANCES DUE WILL      DTSBU520
00044 *      EXIST;  IF A BALANCE DUE EXISTS, THEN NO UNAPPLIED CREDITS DTSBU520
00045 *      WILL EXIST.                                                DTSBU520
00046 *                                                                 DTSBU520
00047 *      PLEASE SEE THE ISSUE STATEMENTS AND REQUIREMENTS DEFINITIONDTSBU520
00048 *      FOR PAYMENT APPLICATION DETAILS.                           DTSBU520
00049 *                                                                 DTSBU520
00050 *      THE DEFAULT MONEY APPLICATION LOGIC DEFINED IN THE ISSUE   DTSBU520
00051 *      STATEMENTS (OLDEST UNAPPLIED CREDITS FIRST, OLDEST BALANCE DTSBU520
00052 *      DUE FIRST, WITHIN A QUARTER CONTRIBUTIONS, INTEREST,       DTSBU520
00053 *      PENALTY, ETC) IS TEMPERED BY THE MONEY APPLICATION REQUEST DTSBU520
00054 *      INFORMATION PASSED TO DTSBU520 IN L520-LINK-AREA.          DTSBU520
00055 *                                                                 DTSBU520
00056 *      IF L520-PREF-PAY-DOC-NO IS NOT EQUAL TO NULL, THEN         DTSBU520
00057 *      L520-PREF-PAY-DOC-NO INDICATES THE FIRST PAYMENT FROM      DTSBU520
00058 *      WHICH UNAPPLIED CREDITS ARE TO BE TAKEN.                   DTSBU520
00059 *                                                                 DTSBU520
00060 *      IF L520-PREF-APPLIC-YRQ, THEN L520-PREF-APPLIC-YRQ         DTSBU520
00061 *      INDICATES THE FIRST YRQ TO WHICH UNAPPLIED CREDITS         DTSBU520
00062 *      ARE TO BE APPLIED.                                         DTSBU520
00063 *                                                                 DTSBU520
00064 *      IF L520-PREF-APPLIC-IND IS NOT EQUAL TO ZERO, THEN         DTSBU520
00065 *      L520-PREF-APPLIC-YRQ AND L520-PREF-APPLIC-IND INDICATES    DTSBU520
00066 *      THE AMOUNT DUE TO WHICH UNAPPLIED CREDITS ARE TO BE        DTSBU520
00067 *      APPLIED FIRST.                                             DTSBU520
00068 *                                                                 DTSBU520
00069 *      THE RULES ARE SLIGHTLY DIFFERENT FOR PAYMENTS ASSOICATED   DTSBU520
00070 *      WITH ORIGINAL ANNUAL REPORTS.  THE FOUR QUARTERS ARE       DTSBU520
00071 *      ESSENTIALLY TREATED AS ONE: APPLY THE PAYMENT FIRST TO     DTSBU520
00072 *      UI TAX FOR THE FIRST QUARTER, UI TAX FOR THE SECOND QTR,   DTSBU520
00073 *      UI TAX FOR THE THIRD QTR AND UI TAX FOR THE FOURTH QTR.    DTSBU520
00074 *      THEN APPLY THE PAYMENT TO SUR TAX ACROSS ALL FOUR QUARTERS.DTSBU520
00075 *                                                                 DTSBU520
00076 *                                                                 DTSBU520
00077 *      MASTER FILE RECORDS READ:                                  DTSBU520
00078 *                                                                 DTSBU520
00079 *        MQTR                                                     DTSBU520
00080 *        MPAY                                                     DTSBU520
00081 *        MDST                                                     DTSBU520
00082 *                                                                 DTSBU520
00083 *                                                                 DTSBU520
00084 *      MASTER FILE RECORDS UPDATED:                               DTSBU520
00085 *                                                                 DTSBU520
00086 *        MDST (REWRITE, WRITE)                                    DTSBU520
00087 *                                                                 DTSBU520
00088 *                                                                 DTSBU520
00089 *      REPORT RECORDS WRITTEN:                                    DTSBU520
00090 *                                                                 DTSBU520
00091 *        R907  ERROR.                                             DTSBU520
00092 *                                                                 DTSBU520
00093 *                                                                 DTSBU520
00094 *      MODULES CALLED:                                            DTSBU520
00095 *                                                                 DTSBU520
00096 *        DTSBU521  APPLY/REVERSE A PAYMENT DISTRIBUTION.          DTSBU520
00097 *        DTSBU542  MODIFY MDST AMOUNTS.                           DTSBU520
00098 *        DTSBU590  EMPLOYER UPDATE CLEANUP PROCESSING.            DTSBU520
00099 *        DTSBU910  MASTER FILE I/O.                               DTSBU520
00100 *        DTSBU946  VARIABLE LENGTH RECORD SEQUENTIAL OUTPUT 1.    DTSBU520
00101 *                                                                 DTSBU520
00102 *                                                                 DTSBU520
00103 *****                                                             DTSBU520
00104      SKIP3                                                        DTSBU520
00105  ENVIRONMENT DIVISION.                                            DTSBU520
00106      EJECT                                                        DTSBU520
00107  DATA DIVISION.                                                   DTSBU520
00108      SKIP3                                                        DTSBU520
00109  WORKING-STORAGE SECTION.                                         DTSBU520
001095 77  PAN-VALET PICTURE X(24) VALUE '018DTSBU520  05/20/13'.       DTSBU520
00110  77  PAN-VALET PICTURE X(24) VALUE '017DTSBU520  05/15/13'.       DTSBU520
00111  77  PAN-VALET PICTURE X(24) VALUE '016DTSBU520  12/17/03'.       DTSBU520
00112      SKIP3                                                        DTSBU520
00113  01  WRK-AREA.                                                    DTSBU520
00114      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +520.DTSBU520
00115                                                                   DTSBU520
00116      05  WRK-MOD-NAME                PIC  X(08)  VALUE 'DTSBU520'.DTSBU520
00117                                                                   DTSBU520
00118      05  FIRST-TIME-IND                  PIC  X(01)    VALUE 'Y'. DTSBU520
00119                                                                   DTSBU520
00120      05  ALL-NINES-DATE                  PIC S9(09)  COMP-3       DTSBU520
00121                                                 VALUE +999999999. DTSBU520
00122                                                                   DTSBU520
00123      05  AMT-DISP                        PIC ----------9.99.      DTSBU520
00124      05  AMT-DISP1                       PIC ----------9.99.      DTSBU520
00125      05  AMT-DISP2                       PIC ----------9.99.      DTSBU520
00126                                                                   DTSBU520
00127      05  WRK-NULL-DOC-NO.                                         DTSBU520
00128          10  WRK-NULL-BATCH-NO           PIC S9(05)       COMP-3. DTSBU520
00129          10  WRK-NULL-ITEM-NO            PIC S9(03)       COMP-3. DTSBU520
00130                                                                   DTSBU520
00131      05  WRK-PREF-PAY-DOC-NO             PIC  X(05).              DTSBU520
00132                                                                   DTSBU520
00133      05  WRK-PREF-APPLIC-DATA.                                    DTSBU520
00134          10  WRK-PREF-APPLIC-YRQ         PIC S9(05)       COMP-3. DTSBU520
00135          10  WRK-PREF-APPLIC-IND         PIC  X(02).              DTSBU520
00136                                                                   DTSBU520
00137 *****05  WRK-OPEN-MAPL-DEBIT             PIC  X(01).              DTSBU520
00138                                                                   DTSBU520
00139 *****05  WRK-MQTR-IN-OPEN-MAPL           PIC  X(01).              DTSBU520
00140                                                                   DTSBU520
00141      05  HOLD-MPAY-DOC-NO                PIC  X(05).              DTSBU520
00142                                                                   DTSBU520
00143      05  HOLD-RECEIVED-DATE              PIC S9(09)       COMP-3. DTSBU520
00144                                                                   DTSBU520
00145      05  HOLD-MQTR-YRQ                   PIC S9(05)       COMP-3. DTSBU520
00146                                                                   DTSBU520
00147      05  HOLD-CREDIT-AMT                 PIC S9(09)V9(02) COMP-3. DTSBU520
00148                                                                   DTSBU520
00149      05  HOLD-ACCT-SUB                   PIC S9(04)       COMP.   DTSBU520
00150                                                                   DTSBU520
00151      05  HOLD-ACCT-IND                   PIC  X(02).              DTSBU520
00152                                                                   DTSBU520
00153      05  WRK-CR-AVAIL-IND                PIC  X(01).              DTSBU520
00154                                                                   DTSBU520
00155 **   05  WRK-ANN-YRQ                     PIC  9(05).              DTSBU520
00156 *    05  FILLER REDEFINES WRK-ANN-YRQ.                            DTSBU520
00157 *        10  WRK-ANN-CCYY                PIC  9(04).              DTSBU520
00158 *        10  WRK-ANN-Q                   PIC  9(01).              DTSBU520
00159 *                                                                 DTSBU520
00160 *    05  WRK-ANN-RPT-YEAR                PIC  9(04).              DTSBU520
00161 *                                                                 DTSBU520
00162 *    05  ANN-SUB                         PIC S9(04)       COMP.   DTSBU520
00163 *    05  CURR-SUB                        PIC S9(04)       COMP.   DTSBU520
00164 *    05  NEW-SUB                         PIC S9(04)       COMP.   DTSBU520
00165 *    05  ANN-SUB-MAX                     PIC S9(04)       COMP    DTSBU520
00166 *                                          VALUE +12.             DTSBU520
00167 *    05  ANNUAL-TABLE-AREA.                                       DTSBU520
00168 *        10  FILLER              PIC S9(05)  COMP-3.              DTSBU520
00169 *        10  FILLER              PIC  X(02)  VALUE 'UI'.          DTSBU520
00170 *        10  FILLER              PIC S9(05)  COMP-3.              DTSBU520
00171 *        10  FILLER              PIC  X(02)  VALUE 'UI'.          DTSBU520
00172 *        10  FILLER              PIC S9(05)  COMP-3.              DTSBU520
00173 *        10  FILLER              PIC  X(02)  VALUE 'UI'.          DTSBU520
00174 *        10  FILLER              PIC S9(05)  COMP-3.              DTSBU520
00175 *        10  FILLER              PIC  X(02)  VALUE 'UI'.          DTSBU520
00176 *                                                                 DTSBU520
00177 *        10  FILLER              PIC S9(05)  COMP-3.              DTSBU520
00178 *        10  FILLER              PIC  X(02)  VALUE 'SU'.          DTSBU520
00179 *        10  FILLER              PIC S9(05)  COMP-3.              DTSBU520
00180 *        10  FILLER              PIC  X(02)  VALUE 'SU'.          DTSBU520
00181 *        10  FILLER              PIC S9(05)  COMP-3.              DTSBU520
00182 *        10  FILLER              PIC  X(02)  VALUE 'SU'.          DTSBU520
00183 *        10  FILLER              PIC S9(05)  COMP-3.              DTSBU520
00184 *        10  FILLER              PIC  X(02)  VALUE 'SU'.          DTSBU520
00185 *                                                                 DTSBU520
00186 *        10  FILLER              PIC S9(05)  COMP-3.              DTSBU520
00187 *        10  FILLER              PIC  X(02)  VALUE 'IN'.          DTSBU520
00188 *        10  FILLER              PIC S9(05)  COMP-3.              DTSBU520
00189 *        10  FILLER              PIC  X(02)  VALUE 'IN'.          DTSBU520
00190 *        10  FILLER              PIC S9(05)  COMP-3.              DTSBU520
00191 *        10  FILLER              PIC  X(02)  VALUE 'IN'.          DTSBU520
00192 *        10  FILLER              PIC S9(05)  COMP-3.              DTSBU520
00193 *        10  FILLER              PIC  X(02)  VALUE 'IN'.          DTSBU520
00194 *                                                                 DTSBU520
00195 *        10  FILLER              PIC S9(05)  COMP-3.              DTSBU520
00196 *        10  FILLER              PIC  X(02)  VALUE 'LP'.          DTSBU520
00197 *        10  FILLER              PIC S9(05)  COMP-3.              DTSBU520
00198 *        10  FILLER              PIC  X(02)  VALUE 'LP'.          DTSBU520
00199 *        10  FILLER              PIC S9(05)  COMP-3.              DTSBU520
00200 *        10  FILLER              PIC  X(02)  VALUE 'LP'.          DTSBU520
00201 *        10  FILLER              PIC S9(05)  COMP-3.              DTSBU520
00202 *        10  FILLER              PIC  X(02)  VALUE 'LP'.          DTSBU520
00203 *                                                                 DTSBU520
00204 *        10  FILLER              PIC S9(05)  COMP-3.              DTSBU520
00205 *        10  FILLER              PIC  X(02)  VALUE 'NP'.          DTSBU520
00206 *        10  FILLER              PIC S9(05)  COMP-3.              DTSBU520
00207 *        10  FILLER              PIC  X(02)  VALUE 'NP'.          DTSBU520
00208 *        10  FILLER              PIC S9(05)  COMP-3.              DTSBU520
00209 *        10  FILLER              PIC  X(02)  VALUE 'NP'.          DTSBU520
00210 *        10  FILLER              PIC S9(05)  COMP-3.              DTSBU520
00211 *        10  FILLER              PIC  X(02)  VALUE 'NP'.          DTSBU520
00212 *                                                                 DTSBU520
00213 *        10  FILLER              PIC S9(05)  COMP-3.              DTSBU520
00214 *        10  FILLER              PIC  X(02)  VALUE 'MP'.          DTSBU520
00215 *        10  FILLER              PIC S9(05)  COMP-3.              DTSBU520
00216 *        10  FILLER              PIC  X(02)  VALUE 'MP'.          DTSBU520
00217 *        10  FILLER              PIC S9(05)  COMP-3.              DTSBU520
00218 *        10  FILLER              PIC  X(02)  VALUE 'MP'.          DTSBU520
00219 *        10  FILLER              PIC S9(05)  COMP-3.              DTSBU520
00220 *        10  FILLER              PIC  X(02)  VALUE 'MP'.          DTSBU520
00221 *    05  ANNUAL-TABLE-ENTRY REDEFINES ANNUAL-TABLE-AREA           DTSBU520
00222 *           OCCURS 24 TIMES.                                      DTSBU520
00223 *        10  ANN-TBL-YRQ         PIC S9(05)  COMP-3.              DTSBU520
00224 *        10  ANN-TBL-IND         PIC  X(02).                      DTSBU520
00225                                                                   DTSBU520
00226      EJECT                                                        DTSBU520
00227  01  MSG-TABLE.                                                   DTSBU520
00228      05  MSG1-TOT-CREDIT-AMT.                                     DTSBU520
00229          10  MSG1-ID.                                             DTSBU520
00230              15  MSG1-ID1    PIC  X(08)  VALUE 'DTSBU520'.        DTSBU520
00231              15  MSG1-ID2    PIC  X(03)  VALUE '351'.             DTSBU520
00232          10  MSG1-SHORT-TEXT PIC  X(20)  VALUE 'INVALID CR AMT'.  DTSBU520
00233          10  MSG1-LONG-TEXT.                                      DTSBU520
00234              15  FILLER      PIC  X(30)                           DTSBU520
00235                    VALUE 'MPRF-TOT-CREDIT-AMT OUT OF SYN'.        DTSBU520
00236              15  FILLER      PIC  X(30)                           DTSBU520
00237                    VALUE 'C WITH MPAY RECORDS.  ADJUSTED'.        DTSBU520
00238                                                                   DTSBU520
00239      05  MSG2-TOT-CREDIT-AMT.                                     DTSBU520
00240          10  MSG2-ID.                                             DTSBU520
00241              15  MSG2-ID1    PIC  X(08)  VALUE 'DTSBU520'.        DTSBU520
00242              15  MSG2-ID2    PIC  X(03)  VALUE '352'.             DTSBU520
00243          10  MSG2-SHORT-TEXT PIC  X(20)  VALUE 'INVALID BAL AM'.  DTSBU520
00244          10  MSG2-LONG-TEXT.                                      DTSBU520
00245              15  FILLER      PIC  X(30)                           DTSBU520
00246                    VALUE 'MPRF-TOT-BALANCE-AMT OUT OF SY'.        DTSBU520
00247              15  FILLER      PIC  X(30)                           DTSBU520
00248                    VALUE 'NC WITH MQTR RECORDS. ADJUSTED'.        DTSBU520
00249      EJECT                                                        DTSBU520
00250  01  R907-REC.                                                    DTSBU520
00251  ++INCLUDE DTSIR907                                               DTSBU520
00252      EJECT                                                        DTSBU520
00253  01  L910-LINK-AREA.                                              DTSBU520
00254  ++INCLUDE DTSIL910                                               DTSBU520
00255      SKIP3                                                        DTSBU520
00256  01  MSKL-REC.                                                    DTSBU520
00257  ++INCLUDE DTSIMSKL                                               DTSBU520
00258      SKIP3                                                        DTSBU520
00259  01  MQTR-REC.                                                    DTSBU520
00260  ++INCLUDE DTSIMQTR                                               DTSBU520
00261      SKIP3                                                        DTSBU520
00262  01  MPAY-REC.                                                    DTSBU520
00263  ++INCLUDE DTSIMPAY                                               DTSBU520
00264      SKIP3                                                        DTSBU520
00265  01  MDST-REC.                                                    DTSBU520
00266  ++INCLUDE DTSIMDST                                               DTSBU520
00267      SKIP3                                                        DTSBU520
00268 *01  MAPL-REC.                                                    DTSBU520
00269 ***INCLUDE DTSIMAPL                                               DTSBU520
00270      EJECT                                                        DTSBU520
00271  01  L004-LINK-AREA.                                              DTSBU520
00272  ++INCLUDE DTSIL004                                               DTSBU520
00273      SKIP3                                                        DTSBU520
00274  01  L521-LINK-AREA.                                              DTSBU520
00275  ++INCLUDE DTSIL521                                               DTSBU520
00276      SKIP3                                                        DTSBU520
00277  01  L542-LINK-AREA.                                              DTSBU520
00278  ++INCLUDE DTSIL542                                               DTSBU520
00279      SKIP3                                                        DTSBU520
00280  01  L590-LINK-AREA.                                              DTSBU520
00281  ++INCLUDE DTSIL590                                               DTSBU520
00282      EJECT                                                        DTSBU520
00283  01  CACT-LITERALS.                                               DTSBU520
00284  ++INCLUDE DTSICACT                                               DTSBU520
00285      EJECT                                                        DTSBU520
00286  LINKAGE SECTION.                                                 DTSBU520
00287      SKIP3                                                        DTSBU520
00288  01  L520-LINK-AREA.                                              DTSBU520
00289  ++INCLUDE DTSIL520                                               DTSBU520
00290      EJECT                                                        DTSBU520
00291  01  LBCM-LINK-AREA.                                              DTSBU520
00292  ++INCLUDE DTSILBCM                                               DTSBU520
00293      EJECT                                                        DTSBU520
00294  01  MPRF-REC.                                                    DTSBU520
00295  ++INCLUDE DTSIMPRF                                               DTSBU520
00296      EJECT                                                        DTSBU520
00297  PROCEDURE DIVISION USING L520-LINK-AREA                          DTSBU520
00298                           LBCM-LINK-AREA                          DTSBU520
00299                           MPRF-REC.                               DTSBU520
00300                                                                   DTSBU520
00301                                                                   DTSBU520
00302      IF FIRST-TIME-IND = 'Y'                                      DTSBU520
00303          PERFORM I0000-FIRST-TIME THRU I0000-EXIT                 DTSBU520
00304          MOVE 'N' TO FIRST-TIME-IND.                              DTSBU520
00305                                                                   DTSBU520
00306      PERFORM P0000-PROCESS THRU P0000-EXIT.                       DTSBU520
00307                                                                   DTSBU520
00308                                                                   DTSBU520
00309      GOBACK.                                                      DTSBU520
00310      EJECT                                                        DTSBU520
00311  I0000-FIRST-TIME.                                                DTSBU520
00312      MOVE LBCM-TRACE-IND TO L910-TRACE-IND.                       DTSBU520
00313                                                                   DTSBU520
00314      MOVE WRK-MOD-NAME TO L910-MOD-NAME                           DTSBU520
00315                           R907-MODULE-NAME.                       DTSBU520
00316                                                                   DTSBU520
00317      MOVE +0 TO WRK-NULL-BATCH-NO                                 DTSBU520
00318                 WRK-NULL-ITEM-NO.                                 DTSBU520
00319                                                                   DTSBU520
00320      MOVE LENGTH OF R907-REC TO R907-LENGTH.                      DTSBU520
00321  I0000-EXIT.                                                      DTSBU520
00322      EXIT.                                                        DTSBU520
00323      EJECT                                                        DTSBU520
00324  P0000-PROCESS.                                                   DTSBU520
00325 *&                                                                DTSBU520
00326      IF MPRF-EMP-NO = 020852 OR 031484                            DTSBU520
00327         DISPLAY 'BU520 P0000 OPT: ' L520-OPTION                   DTSBU520
00328            '  ' L520-PREF-APPLIC-IND                              DTSBU520
00329      END-IF.                                                      DTSBU520
00330 *&                                                                DTSBU520
00331      MOVE MPRF-EMP-NO TO R907-EMP-NO.                             DTSBU520
00332                                                                   DTSBU520
00333      MOVE L520-PREF-PAY-DOC-NO TO WRK-PREF-PAY-DOC-NO.            DTSBU520
00334                                                                   DTSBU520
00335 *    IF L520-ANNUAL-RPT-PMT-88                                    DTSBU520
00336 *       PERFORM P0200-BUILD-ANN-TABLE  THRU P0200-EXIT.           DTSBU520
00337                                                                   DTSBU520
00338      IF L520-NO-PREF-88                                           DTSBU520
00339          MOVE +0 TO WRK-PREF-APPLIC-YRQ                           DTSBU520
00340          MOVE SPACE TO WRK-PREF-APPLIC-IND                        DTSBU520
00341      ELSE                                                         DTSBU520
00342      IF L520-PREF-YRQ-88                                          DTSBU520
00343          MOVE L520-PREF-APPLIC-YRQ TO WRK-PREF-APPLIC-YRQ         DTSBU520
00344          MOVE SPACE TO WRK-PREF-APPLIC-IND                        DTSBU520
00345      ELSE                                                         DTSBU520
00346      IF L520-PREF-YRQ-IND-88                                      DTSBU520
00347          MOVE L520-PREF-APPLIC-YRQ TO WRK-PREF-APPLIC-YRQ         DTSBU520
00348          MOVE L520-PREF-APPLIC-IND TO WRK-PREF-APPLIC-IND         DTSBU520
00349      ELSE                                                         DTSBU520
00350          DISPLAY 'DTSBU520:P0000'                                 DTSBU520
00351          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBU520
00352                                                                   DTSBU520
00353 *****MOVE 'N' TO WRK-OPEN-MAPL-DEBIT.                             DTSBU520
00354                                                                   DTSBU520
00355 *****IF MPRF-MAPL-EXISTS-88                                       DTSBU520
00356 *********PERFORM P0100-OPEN-MAPL THRU P0100-EXIT.                 DTSBU520
00357                                                                   DTSBU520
00358      MOVE +0 TO HOLD-MQTR-YRQ.                                    DTSBU520
00359                                                                   DTSBU520
00360      PERFORM P1000-MAIN-LOOP THRU P1000-EXIT                      DTSBU520
00361        UNTIL (MPRF-TOT-BALANCE-AMT NOT > +0)                      DTSBU520
00362        OR   (MPRF-TOT-CREDIT-AMT NOT > +0).                       DTSBU520
00363                                                                   DTSBU520
00364 **   IF L520-LAST-ANN-QTR-NULL-88                                 DTSBU520
00365 *    OR L520-LAST-ANN-QTR-YES-88                                  DTSBU520
00366 *       PERFORM P1000-MAIN-LOOP THRU P1000-EXIT                   DTSBU520
00367 *         UNTIL (MPRF-TOT-BALANCE-AMT NOT > +0)                   DTSBU520
00368 *         OR   (MPRF-TOT-CREDIT-AMT NOT > +0)                     DTSBU520
00369 *    ELSE                                                         DTSBU520
00370 *       IF (MPRF-TOT-CREDIT-AMT > +0)                             DTSBU520
00371 *          PERFORM P1000-MAIN-LOOP THRU P1000-EXIT                DTSBU520
00372 *       END-IF                                                    DTSBU520
00373 **   END-IF.                                                      DTSBU520
00374                                                                   DTSBU520
00375  P0000-EXIT.                                                      DTSBU520
00376      EXIT.                                                        DTSBU520
00377      SKIP3                                                        DTSBU520
00378 *P0100-OPEN-MAPL.                                                 DTSBU520
00379 *****MOVE LOW-VALUES TO MAPL-KEY-AREA.                            DTSBU520
00380 *****MOVE MPRF-EMP-NO TO MAPL-EMP-NO.                             DTSBU520
00381 *****SET MAPL-APL-88 TO TRUE.                                     DTSBU520
00382 *****MOVE MAPL-KEY-AREA TO MSKL-KEY-AREA.                         DTSBU520
00383 *****PERFORM S910-START-BROWSE THRU S910-EXIT.                    DTSBU520
00384 *****PERFORM P0110-MAPL-BROWSE THRU P0110-EXIT                    DTSBU520
00385 *********UNTIL L910-NO-REC-88.                                    DTSBU520
00386 *P0100-EXIT.                                                      DTSBU520
00387 *****EXIT.                                                        DTSBU520
00388      SKIP3                                                        DTSBU520
00389 *P0110-MAPL-BROWSE.                                               DTSBU520
00390 *****MOVE MSKL-REC TO MAPL-REC.                                   DTSBU520
00391                                                                   DTSBU520
00392 *****IF MAPL-STATUS-OPEN-88                                       DTSBU520
00393 *********MOVE 'Y' TO WRK-OPEN-MAPL-DEBIT                          DTSBU520
00394 *********SET L910-NO-REC-88 TO TRUE                               DTSBU520
00395 *********GO TO P0110-EXIT.                                        DTSBU520
00396                                                                   DTSBU520
00397 *****PERFORM S910-READ-NEXT THRU S910-EXIT.                       DTSBU520
00398 *P0110-EXIT.                                                      DTSBU520
00399 *****EXIT.                                                        DTSBU520
00400      EJECT                                                        DTSBU520
00401 *P0200-BUILD-ANN-TABLE.                                           DTSBU520
00402 *    IF L520-PREF-APPLIC-YRQ = ZERO                               DTSBU520
00403 *        DISPLAY 'DTSBU520:P0200 - APPLIC-YRQ = ZERO'             DTSBU520
00404 *        PERFORM S999-ABEND THRU S999-EXIT.                       DTSBU520
00405 *                                                                 DTSBU520
00406 *    MOVE L520-PREF-APPLIC-YRQ  TO L004-QTR-5-9.                  DTSBU520
00407 *                                                                 DTSBU520
00408 *    MOVE 1                     TO L004-QTR-5-Q.                  DTSBU520
00409 *    PERFORM S004-FROM-5        THRU S004-EXIT                    DTSBU520
00410 *    MOVE L004-QTR-5-9          TO ANN-TBL-YRQ (1)                DTSBU520
00411 *                                  ANN-TBL-YRQ (5)                DTSBU520
00412 *                                  ANN-TBL-YRQ (9)                DTSBU520
00413 *                                  ANN-TBL-YRQ (13)               DTSBU520
00414 *                                  ANN-TBL-YRQ (17)               DTSBU520
00415 *                                  ANN-TBL-YRQ (21).              DTSBU520
00416 *                                                                 DTSBU520
00417 *                                                                 DTSBU520
00418 *    MOVE 2                     TO L004-QTR-5-Q.                  DTSBU520
00419 *    PERFORM S004-FROM-5        THRU S004-EXIT                    DTSBU520
00420 *    MOVE L004-QTR-5-9          TO ANN-TBL-YRQ (2)                DTSBU520
00421 *                                  ANN-TBL-YRQ (6)                DTSBU520
00422 *                                  ANN-TBL-YRQ (10)               DTSBU520
00423 *                                  ANN-TBL-YRQ (14)               DTSBU520
00424 *                                  ANN-TBL-YRQ (18)               DTSBU520
00425 *                                  ANN-TBL-YRQ (22).              DTSBU520
00426 *                                                                 DTSBU520
00427 *    MOVE 3                     TO L004-QTR-5-Q.                  DTSBU520
00428 *    PERFORM S004-FROM-5        THRU S004-EXIT                    DTSBU520
00429 *    MOVE L004-QTR-5-9          TO ANN-TBL-YRQ (3)                DTSBU520
00430 *                                  ANN-TBL-YRQ (7)                DTSBU520
00431 *                                  ANN-TBL-YRQ (11)               DTSBU520
00432 *                                  ANN-TBL-YRQ (15)               DTSBU520
00433 *                                  ANN-TBL-YRQ (19)               DTSBU520
00434 *                                  ANN-TBL-YRQ (23).              DTSBU520
00435 *                                                                 DTSBU520
00436 *    MOVE 4                     TO L004-QTR-5-Q.                  DTSBU520
00437 *    PERFORM S004-FROM-5        THRU S004-EXIT                    DTSBU520
00438 *    MOVE L004-QTR-5-9          TO ANN-TBL-YRQ (4)                DTSBU520
00439 *                                  ANN-TBL-YRQ (8)                DTSBU520
00440 *                                  ANN-TBL-YRQ (12)               DTSBU520
00441 *                                  ANN-TBL-YRQ (16)               DTSBU520
00442 *                                  ANN-TBL-YRQ (20)               DTSBU520
00443 *                                  ANN-TBL-YRQ (24).              DTSBU520
00444 *                                                                 DTSBU520
00445 *P0200-EXIT.                                                      DTSBU520
00446 *    EXIT.                                                        DTSBU520
00447                                                                   DTSBU520
00448  P1000-MAIN-LOOP.                                                 DTSBU520
00449      MOVE WRK-NULL-DOC-NO TO HOLD-MPAY-DOC-NO.                    DTSBU520
00450                                                                   DTSBU520
00451      PERFORM P2000-LOCATE-MPAY THRU P2000-EXIT.                   DTSBU520
00452                                                                   DTSBU520
00453      IF HOLD-MPAY-DOC-NO = WRK-NULL-DOC-NO                        DTSBU520
00454          MOVE +0 TO MPRF-TOT-CREDIT-AMT                           DTSBU520
00455          MOVE MSG1-ID2 TO R907-MSG-ID                             DTSBU520
00456          MOVE MSG1-LONG-TEXT TO R907-MSG-TEXT                     DTSBU520
00457          PERFORM S946-R907-WRITE THRU S946-EXIT                   DTSBU520
00458          GO TO P1000-EXIT.                                        DTSBU520
00459                                                                   DTSBU520
00460      MOVE LOW-VALUES TO MPAY-KEY-AREA.                            DTSBU520
00461                                                                   DTSBU520
00462      MOVE MPRF-EMP-NO TO MPAY-EMP-NO.                             DTSBU520
00463                                                                   DTSBU520
00464      SET MPAY-PAY-88 TO TRUE.                                     DTSBU520
00465                                                                   DTSBU520
00466      MOVE HOLD-MPAY-DOC-NO TO MPAY-DOC-NO.                        DTSBU520
00467                                                                   DTSBU520
00468      MOVE MPAY-KEY-AREA TO MSKL-KEY-AREA.                         DTSBU520
00469                                                                   DTSBU520
00470      PERFORM S910-READ THRU S910-EXIT.                            DTSBU520
00471                                                                   DTSBU520
00472      IF L910-NO-REC-88                                            DTSBU520
00473          DISPLAY 'DTSBU520:P1000:1'                               DTSBU520
00474          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBU520
00475                                                                   DTSBU520
00476      MOVE MSKL-REC TO MPAY-REC.                                   DTSBU520
00477                                                                   DTSBU520
00478                                                                   DTSBU520
00479      MOVE LOW-VALUES TO MDST-KEY-AREA.                            DTSBU520
00480                                                                   DTSBU520
00481      MOVE MPRF-EMP-NO TO MDST-EMP-NO.                             DTSBU520
00482                                                                   DTSBU520
00483      SET MDST-DST-88 TO TRUE.                                     DTSBU520
00484                                                                   DTSBU520
00485      SET MDST-CREDIT-REC-88 TO TRUE.                              DTSBU520
00486                                                                   DTSBU520
00487      MOVE HOLD-MPAY-DOC-NO TO MDST-DOC-NO.                        DTSBU520
00488                                                                   DTSBU520
00489      MOVE MDST-KEY-AREA TO MSKL-KEY-AREA.                         DTSBU520
00490                                                                   DTSBU520
00491      PERFORM S910-READ THRU S910-EXIT.                            DTSBU520
00492                                                                   DTSBU520
00493      IF L910-NO-REC-88                                            DTSBU520
00494          DISPLAY 'DTSBU520:P1000:2'                               DTSBU520
00495          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBU520
00496                                                                   DTSBU520
00497      MOVE MSKL-REC TO MDST-REC.                                   DTSBU520
00498                                                                   DTSBU520
00499                                                                   DTSBU520
00500      PERFORM P3000-PROCESS-MPAY THRU P3000-EXIT.                  DTSBU520
00501                                                                   DTSBU520
00502                                                                   DTSBU520
00503      PERFORM P1100-MDST-CLEANUP THRU P1100-EXIT.                  DTSBU520
00504  P1000-EXIT.                                                      DTSBU520
00505      EXIT.                                                        DTSBU520
00506      SKIP3                                                        DTSBU520
00507  P1100-MDST-CLEANUP.                                              DTSBU520
00508 *****PERFORM P1110-MDST-ACCT-SCAN THRU P1110-EXIT                 DTSBU520
00509 *********VARYING MDST-ACCT-IDX FROM 1 BY 1                        DTSBU520
00510 *********UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT.                     DTSBU520
00511                                                                   DTSBU520
00512      MOVE MDST-KEY-AREA TO MSKL-KEY-AREA.                         DTSBU520
00513                                                                   DTSBU520
00514      PERFORM S910-READ THRU S910-EXIT.                            DTSBU520
00515                                                                   DTSBU520
00516      IF L910-NO-REC-88                                            DTSBU520
00517          DISPLAY 'DTSBU520:P1100:1'                               DTSBU520
00518          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBU520
00519                                                                   DTSBU520
00520                                                                   DTSBU520
00521      IF MDST-ACCT-CNT = +0                                        DTSBU520
00522          PERFORM S910-DELETE THRU S910-EXIT                       DTSBU520
00523      ELSE                                                         DTSBU520
00524          MOVE LBCM-CURR-RUN-DATE TO MDST-CHNG-DATE                DTSBU520
00525          MOVE MDST-REC TO MSKL-REC                                DTSBU520
00526          PERFORM S910-REWRITE THRU S910-EXIT.                     DTSBU520
00527  P1100-EXIT.                                                      DTSBU520
00528      EXIT.                                                        DTSBU520
00529      SKIP3                                                        DTSBU520
00530 *P1110-MDST-ACCT-SCAN.                                            DTSBU520
00531 *****IF MDST-ACCT-CR-AVAIL-88 (MDST-ACCT-IDX)                     DTSBU520
00532 *********NEXT SENTENCE                                            DTSBU520
00533 *****ELSE                                                         DTSBU520
00534 *********GO TO P1110-EXIT.                                        DTSBU520
00535                                                                   DTSBU520
00536 *****IF (MDST-AMT (MDST-ACCT-IDX) = +0)                           DTSBU520
00537 ************OR                                                    DTSBU520
00538 ********(MDST-AMT (MDST-ACCT-IDX) > LBCM-CR-TOL-MAX)              DTSBU520
00539 *********NEXT SENTENCE                                            DTSBU520
00540 *****ELSE                                                         DTSBU520
00541 *********PERFORM S590-CR-TOL THRU S590-EXIT.                      DTSBU520
00542 *P1110-EXIT.                                                      DTSBU520
00543 *****EXIT.                                                        DTSBU520
00544      EJECT                                                        DTSBU520
00545  P2000-LOCATE-MPAY.                                               DTSBU520
00546      IF WRK-PREF-PAY-DOC-NO NOT = WRK-NULL-DOC-NO                 DTSBU520
00547          PERFORM P2100-LOCATE-PREF-MPAY THRU P2100-EXIT           DTSBU520
00548          MOVE WRK-NULL-DOC-NO TO WRK-PREF-PAY-DOC-NO              DTSBU520
00549          IF HOLD-MPAY-DOC-NO = WRK-NULL-DOC-NO                    DTSBU520
00550              NEXT SENTENCE                                        DTSBU520
00551          ELSE                                                     DTSBU520
00552              GO TO P2000-EXIT.                                    DTSBU520
00553                                                                   DTSBU520
00554                                                                   DTSBU520
00555      MOVE ALL-NINES-DATE TO HOLD-RECEIVED-DATE.                   DTSBU520
00556                                                                   DTSBU520
00557      MOVE LOW-VALUES TO MDST-KEY-AREA.                            DTSBU520
00558                                                                   DTSBU520
00559      MOVE MPRF-EMP-NO TO MDST-EMP-NO.                             DTSBU520
00560                                                                   DTSBU520
00561      SET MDST-DST-88 TO TRUE.                                     DTSBU520
00562                                                                   DTSBU520
00563      SET MDST-CREDIT-REC-88 TO TRUE.                              DTSBU520
00564                                                                   DTSBU520
00565      MOVE MDST-KEY-AREA TO MSKL-KEY-AREA.                         DTSBU520
00566                                                                   DTSBU520
00567      PERFORM S910-START-BROWSE THRU S910-EXIT.                    DTSBU520
00568                                                                   DTSBU520
00569      PERFORM P2200-SCAN-MDST THRU P2200-EXIT                      DTSBU520
00570          UNTIL L910-NO-REC-88.                                    DTSBU520
00571  P2000-EXIT.                                                      DTSBU520
00572      EXIT.                                                        DTSBU520
00573      SKIP3                                                        DTSBU520
00574  P2100-LOCATE-PREF-MPAY.                                          DTSBU520
00575      MOVE LOW-VALUES TO MPAY-KEY-AREA.                            DTSBU520
00576                                                                   DTSBU520
00577      MOVE MPRF-EMP-NO TO MPAY-EMP-NO.                             DTSBU520
00578                                                                   DTSBU520
00579      SET MPAY-PAY-88 TO TRUE.                                     DTSBU520
00580                                                                   DTSBU520
00581      MOVE WRK-PREF-PAY-DOC-NO TO MPAY-DOC-NO.                     DTSBU520
00582                                                                   DTSBU520
00583      MOVE MPAY-KEY-AREA TO MSKL-KEY-AREA.                         DTSBU520
00584                                                                   DTSBU520
00585      PERFORM S910-READ THRU S910-EXIT.                            DTSBU520
00586                                                                   DTSBU520
00587      IF L910-NO-REC-88                                            DTSBU520
00588          GO TO P2100-EXIT.                                        DTSBU520
00589                                                                   DTSBU520
00590      MOVE MSKL-REC TO MPAY-REC.                                   DTSBU520
00591                                                                   DTSBU520
00592                                                                   DTSBU520
00593      MOVE LOW-VALUES TO MDST-KEY-AREA.                            DTSBU520
00594                                                                   DTSBU520
00595      MOVE MPRF-EMP-NO TO MDST-EMP-NO.                             DTSBU520
00596                                                                   DTSBU520
00597      SET MDST-DST-88 TO TRUE.                                     DTSBU520
00598                                                                   DTSBU520
00599      SET MDST-CREDIT-REC-88 TO TRUE.                              DTSBU520
00600                                                                   DTSBU520
00601      MOVE WRK-PREF-PAY-DOC-NO TO MDST-DOC-NO.                     DTSBU520
00602                                                                   DTSBU520
00603      MOVE MDST-KEY-AREA TO MSKL-KEY-AREA.                         DTSBU520
00604                                                                   DTSBU520
00605      PERFORM S910-READ THRU S910-EXIT.                            DTSBU520
00606                                                                   DTSBU520
00607      IF L910-NO-REC-88                                            DTSBU520
00608          GO TO P2100-EXIT.                                        DTSBU520
00609                                                                   DTSBU520
00610      MOVE MSKL-REC TO MDST-REC.                                   DTSBU520
00611                                                                   DTSBU520
00612                                                                   DTSBU520
00613      MOVE 'N' TO WRK-CR-AVAIL-IND.                                DTSBU520
00614                                                                   DTSBU520
00615      PERFORM                                                      DTSBU520
00616        VARYING MDST-ACCT-IDX FROM 1 BY 1                          DTSBU520
00617        UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT                        DTSBU520
00618          IF MDST-ACCT-CR-AVAIL-88 (MDST-ACCT-IDX)                 DTSBU520
00619              MOVE 'Y' TO WRK-CR-AVAIL-IND                         DTSBU520
00620          END-IF                                                   DTSBU520
00621      END-PERFORM.                                                 DTSBU520
00622                                                                   DTSBU520
00623      IF WRK-CR-AVAIL-IND = 'Y'                                    DTSBU520
00624          MOVE MDST-DOC-NO TO HOLD-MPAY-DOC-NO.                    DTSBU520
00625  P2100-EXIT.                                                      DTSBU520
00626      EXIT.                                                        DTSBU520
00627      SKIP3                                                        DTSBU520
00628  P2200-SCAN-MDST.                                                 DTSBU520
00629      MOVE MSKL-REC TO MDST-REC.                                   DTSBU520
00630                                                                   DTSBU520
00631      IF MDST-CREDIT-REC-88                                        DTSBU520
00632          NEXT SENTENCE                                            DTSBU520
00633      ELSE                                                         DTSBU520
00634          SET L910-NO-REC-88 TO TRUE                               DTSBU520
00635          GO TO P2200-EXIT.                                        DTSBU520
00636                                                                   DTSBU520
00637      IF MDST-RECEIVED-DATE < HOLD-RECEIVED-DATE                   DTSBU520
00638          PERFORM P2300-LOOK-FOR-CREDIT THRU P2300-EXIT.           DTSBU520
00639                                                                   DTSBU520
00640      PERFORM S910-READ-NEXT THRU S910-EXIT.                       DTSBU520
00641  P2200-EXIT.                                                      DTSBU520
00642      EXIT.                                                        DTSBU520
00643      SKIP3                                                        DTSBU520
00644  P2300-LOOK-FOR-CREDIT.                                           DTSBU520
00645      MOVE 'N' TO WRK-CR-AVAIL-IND.                                DTSBU520
00646                                                                   DTSBU520
00647      PERFORM                                                      DTSBU520
00648        VARYING MDST-ACCT-IDX FROM 1 BY 1                          DTSBU520
00649        UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT                        DTSBU520
00650          IF MDST-ACCT-CR-AVAIL-88 (MDST-ACCT-IDX)                 DTSBU520
00651              MOVE 'Y' TO WRK-CR-AVAIL-IND                         DTSBU520
00652          END-IF                                                   DTSBU520
00653      END-PERFORM.                                                 DTSBU520
00654                                                                   DTSBU520
00655      IF WRK-CR-AVAIL-IND = 'N'                                    DTSBU520
00656          GO TO P2300-EXIT.                                        DTSBU520
00657                                                                   DTSBU520
00658                                                                   DTSBU520
00659      MOVE LOW-VALUES TO MPAY-KEY-AREA.                            DTSBU520
00660                                                                   DTSBU520
00661      MOVE MPRF-EMP-NO TO MPAY-EMP-NO.                             DTSBU520
00662                                                                   DTSBU520
00663      SET MPAY-PAY-88 TO TRUE.                                     DTSBU520
00664                                                                   DTSBU520
00665      MOVE MDST-DOC-NO TO MPAY-DOC-NO.                             DTSBU520
00666                                                                   DTSBU520
00667      MOVE MPAY-KEY-AREA TO MSKL-KEY-AREA.                         DTSBU520
00668                                                                   DTSBU520
00669      PERFORM S910-READ THRU S910-EXIT.                            DTSBU520
00670                                                                   DTSBU520
00671      IF L910-NO-REC-88                                            DTSBU520
00672          DISPLAY 'DTSBU520:P2300:1'                               DTSBU520
00673          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBU520
00674                                                                   DTSBU520
00675      MOVE MSKL-REC TO MPAY-REC.                                   DTSBU520
00676                                                                   DTSBU520
00677                                                                   DTSBU520
00678      IF MDST-RECEIVED-DATE NOT = MPAY-RECEIVED-DATE               DTSBU520
00679          DISPLAY 'DTSBU520:P2300:2'                               DTSBU520
00680          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBU520
00681                                                                   DTSBU520
00682      MOVE MDST-RECEIVED-DATE TO HOLD-RECEIVED-DATE.               DTSBU520
00683                                                                   DTSBU520
00684      MOVE MDST-DOC-NO TO HOLD-MPAY-DOC-NO.                        DTSBU520
00685  P2300-EXIT.                                                      DTSBU520
00686      EXIT.                                                        DTSBU520
00687      EJECT                                                        DTSBU520
00688  P3000-PROCESS-MPAY.                                              DTSBU520
00689      MOVE +0 TO HOLD-CREDIT-AMT.                                  DTSBU520
00690                                                                   DTSBU520
00691      PERFORM P3100-CREDIT-FROM-MDST THRU P3100-EXIT.              DTSBU520
00692                                                                   DTSBU520
00693      MOVE MDST-REC TO MSKL-REC.                                   DTSBU520
00694                                                                   DTSBU520
00695      PERFORM S910-REWRITE THRU S910-EXIT.                         DTSBU520
00696                                                                   DTSBU520
00697 *&                                                                DTSBU520
00698      IF MPRF-EMP-NO = 020852 OR 031484                            DTSBU520
00699         MOVE HOLD-CREDIT-AMT          TO AMT-DISP                 DTSBU520
00700         DISPLAY 'BU520 P3000 HOLD CR: ' AMT-DISP                  DTSBU520
00701            '  ' MDST-BATCH-NO ' ' MDST-ITEM-NO                    DTSBU520
00702      END-IF.                                                      DTSBU520
00703 *&                                                                DTSBU520
00704 **   MOVE +1 TO CURR-SUB.                                         DTSBU520
00705                                                                   DTSBU520
00706      PERFORM P4000-APPLIC-HOLD-CREDIT-AMT THRU P4000-EXIT         DTSBU520
00707         UNTIL (HOLD-CREDIT-AMT NOT > +0)                          DTSBU520
00708         OR    (MPRF-TOT-BALANCE-AMT NOT > +0).                    DTSBU520
00709                                                                   DTSBU520
00710 **   IF L520-LAST-ANN-QTR-NULL-88                                 DTSBU520
00711 *    OR L520-LAST-ANN-QTR-YES-88                                  DTSBU520
00712 *       PERFORM P4000-APPLIC-HOLD-CREDIT-AMT THRU P4000-EXIT      DTSBU520
00713 *          UNTIL (HOLD-CREDIT-AMT NOT > +0)                       DTSBU520
00714 *          OR    (MPRF-TOT-BALANCE-AMT NOT > +0)                  DTSBU520
00715 *    ELSE                                                         DTSBU520
00716 *       PERFORM P4000-APPLIC-HOLD-CREDIT-AMT THRU P4000-EXIT      DTSBU520
00717 **   END-IF.                                                      DTSBU520
00718                                                                   DTSBU520
00719      MOVE LOW-VALUES TO MDST-KEY-AREA.                            DTSBU520
00720                                                                   DTSBU520
00721      MOVE MPRF-EMP-NO TO MDST-EMP-NO.                             DTSBU520
00722                                                                   DTSBU520
00723      SET MDST-DST-88 TO TRUE.                                     DTSBU520
00724                                                                   DTSBU520
00725      SET MDST-CREDIT-REC-88 TO TRUE.                              DTSBU520
00726                                                                   DTSBU520
00727      MOVE MPAY-DOC-NO TO MDST-DOC-NO.                             DTSBU520
00728                                                                   DTSBU520
00729      MOVE MDST-KEY-AREA TO MSKL-KEY-AREA.                         DTSBU520
00730                                                                   DTSBU520
00731      PERFORM S910-READ THRU S910-EXIT.                            DTSBU520
00732                                                                   DTSBU520
00733      IF L910-NO-REC-88                                            DTSBU520
00734          DISPLAY 'DTSBU520:P3000:1'                               DTSBU520
00735          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBU520
00736                                                                   DTSBU520
00737      MOVE MSKL-REC TO MDST-REC.                                   DTSBU520
00738                                                                   DTSBU520
00739                                                                   DTSBU520
00740      IF HOLD-CREDIT-AMT > +0                                      DTSBU520
00741          PERFORM P3200-CREDIT-TO-MDST THRU P3200-EXIT.            DTSBU520
00742  P3000-EXIT.                                                      DTSBU520
00743      EXIT.                                                        DTSBU520
00744      SKIP3                                                        DTSBU520
00745  P3100-CREDIT-FROM-MDST.                                          DTSBU520
00746      PERFORM P3110-CR-AVAIL-LOOP THRU P3110-EXIT                  DTSBU520
00747          VARYING MDST-ACCT-IDX FROM 1 BY 1                        DTSBU520
00748          UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT.                     DTSBU520
00749  P3100-EXIT.                                                      DTSBU520
00750      EXIT.                                                        DTSBU520
00751      SKIP3                                                        DTSBU520
00752  P3110-CR-AVAIL-LOOP.                                             DTSBU520
00753      IF MDST-ACCT-CR-AVAIL-88 (MDST-ACCT-IDX)                     DTSBU520
00754          NEXT SENTENCE                                            DTSBU520
00755      ELSE                                                         DTSBU520
00756          GO TO P3110-EXIT.                                        DTSBU520
00757                                                                   DTSBU520
00758      ADD MDST-AMT (MDST-ACCT-IDX) TO HOLD-CREDIT-AMT.             DTSBU520
00759                                                                   DTSBU520
00760      COMPUTE L542-AMT                                             DTSBU520
00761        = MDST-AMT (MDST-ACCT-IDX) * -1.                           DTSBU520
00762                                                                   DTSBU520
00763      MOVE MDST-ACCT-IND (MDST-ACCT-IDX) TO L542-ACCT-IND.         DTSBU520
00764                                                                   DTSBU520
00765      PERFORM S542-MODIFY-MDST THRU S542-EXIT.                     DTSBU520
00766  P3110-EXIT.                                                      DTSBU520
00767      EXIT.                                                        DTSBU520
00768      SKIP3                                                        DTSBU520
00769  P3200-CREDIT-TO-MDST.                                            DTSBU520
00770 *&                                                                DTSBU520
00771      IF MPRF-EMP-NO = 081547                                      DTSBU520
00772         MOVE HOLD-CREDIT-AMT          TO AMT-DISP                 DTSBU520
00773         DISPLAY 'BU520 P3200 HOLD CR: ' AMT-DISP                  DTSBU520
00774            '  ' MDST-BATCH-NO ' ' MDST-ITEM-NO                    DTSBU520
00775      END-IF.                                                      DTSBU520
00776 *&                                                                DTSBU520
00777      MOVE HOLD-CREDIT-AMT TO L542-AMT.                            DTSBU520
00778                                                                   DTSBU520
00779      MOVE CACT-CR-AVAIL TO L542-ACCT-IND.                         DTSBU520
00780                                                                   DTSBU520
00781      PERFORM S542-MODIFY-MDST THRU S542-EXIT.                     DTSBU520
00782  P3200-EXIT.                                                      DTSBU520
00783      EXIT.                                                        DTSBU520
00784      EJECT                                                        DTSBU520
00785  P4000-APPLIC-HOLD-CREDIT-AMT.                                    DTSBU520
00786      SET L521-UPDATE-88 TO TRUE.                                  DTSBU520
00787                                                                   DTSBU520
00788      MOVE MPAY-DOC-NO TO L521-MPAY-DOC-NO.                        DTSBU520
00789                                                                   DTSBU520
00790      MOVE MPAY-RECEIVED-DATE TO L521-RECEIVED-DATE.               DTSBU520
00791                                                                   DTSBU520
00792      SET L521-WAIVE-INT-NO-88 TO TRUE.                            DTSBU520
00793                                                                   DTSBU520
00794 *****SET L521-WAIVE-LATE-PEN-NO-88 TO TRUE.                       DTSBU520
00795                                                                   DTSBU520
00796      MOVE +0 TO L521-APPLIC-AMT.                                  DTSBU520
00797                                                                   DTSBU520
00798      MOVE SPACE TO L521-APPLIC-ACCT-IND.                          DTSBU520
00799                                                                   DTSBU520
00800      MOVE +0 TO L521-APPLIC-YRQ.                                  DTSBU520
00801                                                                   DTSBU520
00802                                                                   DTSBU520
00803      PERFORM P5000-LOCATE-DEBIT THRU P5000-EXIT.                  DTSBU520
00804                                                                   DTSBU520
00805 *&                                                                DTSBU520
00806 *    IF MPRF-EMP-NO = 081547                                      DTSBU520
00807 *       MOVE L521-APPLIC-AMT TO AMT-DISP                          DTSBU520
00808 *       DISPLAY 'BD520 P4000 L521 AMT ' AMT-DISP                  DTSBU520
00809 *          '  IND ' L521-APPLIC-ACCT-IND                          DTSBU520
00810 *          '  YRQ ' L521-APPLIC-YRQ                               DTSBU520
00811 *    END-IF.                                                      DTSBU520
00812 *&                                                                DTSBU520
00813 **   IF L521-APPLIC-AMT = +0                                      DTSBU520
00814 *       IF MPRF-TOT-BALANCE-AMT > +0                              DTSBU520
00815 *          IF L520-ANNUAL-RPT-WD-88                               DTSBU520
00816 *             GO TO P4000-EXIT                                    DTSBU520
00817 *          END-IF                                                 DTSBU520
00818 *       END-IF                                                    DTSBU520
00819 **   END-IF.                                                      DTSBU520
00820                                                                   DTSBU520
00821      IF L521-APPLIC-AMT = +0                                      DTSBU520
00822          IF MPRF-TOT-BALANCE-AMT > +0                             DTSBU520
00823              MOVE +0 TO MPRF-TOT-BALANCE-AMT                      DTSBU520
00824              MOVE MSG2-ID2 TO R907-MSG-ID                         DTSBU520
00825              MOVE MSG2-LONG-TEXT TO R907-MSG-TEXT                 DTSBU520
00826              PERFORM S946-R907-WRITE THRU S946-EXIT               DTSBU520
00827              GO TO P4000-EXIT                                     DTSBU520
00828          ELSE                                                     DTSBU520
00829              GO TO P4000-EXIT                                     DTSBU520
00830          END-IF                                                   DTSBU520
00831       END-IF.                                                     DTSBU520
00832                                                                   DTSBU520
00833                                                                   DTSBU520
00834      PERFORM P4100-SET-WAIVE-IND THRU P4100-EXIT.                 DTSBU520
00835                                                                   DTSBU520
00836                                                                   DTSBU520
00837      PERFORM P4200-ESTB-DSTRB THRU P4200-EXIT.                    DTSBU520
00838                                                                   DTSBU520
00839      PERFORM S521-APPLIC-PROCESS THRU S521-EXIT.                  DTSBU520
00840                                                                   DTSBU520
00841      IF L521-NOT-VALID-88                                         DTSBU520
00842          DISPLAY 'DTSBU520:P4000:1'                               DTSBU520
00843          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBU520
00844                                                                   DTSBU520
00845                                                                   DTSBU520
00846      COMPUTE HOLD-CREDIT-AMT = HOLD-CREDIT-AMT - L521-APPLIC-AMT. DTSBU520
00847  P4000-EXIT.                                                      DTSBU520
00848      EXIT.                                                        DTSBU520
00849      SKIP3                                                        DTSBU520
00850  P4100-SET-WAIVE-IND.                                             DTSBU520
00851      IF MPAY-ESTB-DATE = LBCM-CURR-RUN-DATE                       DTSBU520
00852          NEXT SENTENCE                                            DTSBU520
00853      ELSE                                                         DTSBU520
00854          GO TO P4100-EXIT.                                        DTSBU520
00855                                                                   DTSBU520
00856      IF MPAY-APPLIC-YRQ = +0                                      DTSBU520
00857          MOVE MPAY-WAIVE-INT-IND                                  DTSBU520
00858            TO L521-WAIVE-INT-IND                                  DTSBU520
00859 *********MOVE MPAY-WAIVE-LATE-PEN-IND                             DTSBU520
00860 ***********TO L521-WAIVE-LATE-PEN-IND                             DTSBU520
00861          GO TO P4100-EXIT.                                        DTSBU520
00862                                                                   DTSBU520
00863      IF MPAY-APPLIC-YRQ = L521-APPLIC-YRQ                         DTSBU520
00864          IF MPAY-APPLIC-IND = SPACES                              DTSBU520
00865              MOVE MPAY-WAIVE-INT-IND                              DTSBU520
00866                TO L521-WAIVE-INT-IND                              DTSBU520
00867 *************MOVE MPAY-WAIVE-LATE-PEN-IND                         DTSBU520
00868 ***************TO L521-WAIVE-LATE-PEN-IND                         DTSBU520
00869          ELSE                                                     DTSBU520
00870              IF MPAY-APPLIC-IND = L521-APPLIC-ACCT-IND            DTSBU520
00871                  MOVE MPAY-WAIVE-INT-IND                          DTSBU520
00872                    TO L521-WAIVE-INT-IND                          DTSBU520
00873 *****************MOVE MPAY-WAIVE-LATE-PEN-IND                     DTSBU520
00874 *******************TO L521-WAIVE-LATE-PEN-IND                     DTSBU520
00875              ELSE                                                 DTSBU520
00876                  NEXT SENTENCE                                    DTSBU520
00877      ELSE                                                         DTSBU520
00878          NEXT SENTENCE.                                           DTSBU520
00879  P4100-EXIT.                                                      DTSBU520
00880      EXIT.                                                        DTSBU520
00881      SKIP3                                                        DTSBU520
00882  P4200-ESTB-DSTRB.                                                DTSBU520
00883      MOVE LOW-VALUES TO MDST-KEY-AREA.                            DTSBU520
00884                                                                   DTSBU520
00885      MOVE MPRF-EMP-NO TO MDST-EMP-NO.                             DTSBU520
00886                                                                   DTSBU520
00887      SET MDST-DST-88 TO TRUE.                                     DTSBU520
00888                                                                   DTSBU520
00889      MOVE L521-APPLIC-YRQ TO MDST-YRQ.                            DTSBU520
00890                                                                   DTSBU520
00891      MOVE MPAY-DOC-NO TO MDST-DOC-NO.                             DTSBU520
00892                                                                   DTSBU520
00893      MOVE MDST-KEY-AREA TO MSKL-KEY-AREA.                         DTSBU520
00894                                                                   DTSBU520
00895      PERFORM S910-READ THRU S910-EXIT.                            DTSBU520
00896                                                                   DTSBU520
00897      IF L910-NO-REC-88                                            DTSBU520
00898          PERFORM P4210-ADD-MDST THRU P4210-EXIT                   DTSBU520
00899      ELSE                                                         DTSBU520
00900          PERFORM P4220-MOD-MDST THRU P4220-EXIT.                  DTSBU520
00901  P4200-EXIT.                                                      DTSBU520
00902      EXIT.                                                        DTSBU520
00903      SKIP3                                                        DTSBU520
00904  P4210-ADD-MDST.                                                  DTSBU520
00905      MOVE LOW-VALUES TO MDST-DATA-AREA.                           DTSBU520
00906                                                                   DTSBU520
00907      MOVE +0 TO MDST-PURGE-DATE.                                  DTSBU520
00908                                                                   DTSBU520
00909      MOVE MPAY-RECEIVED-DATE TO MDST-RECEIVED-DATE.               DTSBU520
00910                                                                   DTSBU520
00911      SET MDST-NOT-CONVERTED-88 TO TRUE.                           DTSBU520
00912                                                                   DTSBU520
00913      MOVE LBCM-CURR-RUN-DATE TO MDST-ESTB-DATE                    DTSBU520
00914                                 MDST-CHNG-DATE.                   DTSBU520
00915                                                                   DTSBU520
00916      MOVE L521-APPLIC-AMT TO L542-AMT.                            DTSBU520
00917                                                                   DTSBU520
00918      MOVE L521-APPLIC-ACCT-IND TO L542-ACCT-IND.                  DTSBU520
00919                                                                   DTSBU520
00920 *&                                                                DTSBU520
00921      IF MPRF-EMP-NO = 081547                                      DTSBU520
00922         MOVE L542-AMT                 TO AMT-DISP                 DTSBU520
00923         DISPLAY 'BU520 P4210 ADD DST: ' AMT-DISP                  DTSBU520
00924            '  ' MDST-BATCH-NO ' ' MDST-ITEM-NO                    DTSBU520
00925      END-IF.                                                      DTSBU520
00926 *&                                                                DTSBU520
00927      PERFORM S542-MODIFY-MDST THRU S542-EXIT.                     DTSBU520
00928                                                                   DTSBU520
00929      IF MDST-ACCT-CNT = +0                                        DTSBU520
00930           NEXT SENTENCE                                           DTSBU520
00931      ELSE                                                         DTSBU520
00932          MOVE MDST-REC TO MSKL-REC                                DTSBU520
00933          PERFORM S910-WRITE THRU S910-EXIT.                       DTSBU520
00934  P4210-EXIT.                                                      DTSBU520
00935      EXIT.                                                        DTSBU520
00936      SKIP3                                                        DTSBU520
00937  P4220-MOD-MDST.                                                  DTSBU520
00938      MOVE MSKL-REC TO MDST-REC.                                   DTSBU520
00939                                                                   DTSBU520
00940      MOVE LBCM-CURR-RUN-DATE TO MDST-CHNG-DATE.                   DTSBU520
00941                                                                   DTSBU520
00942      MOVE L521-APPLIC-ACCT-IND TO L542-ACCT-IND.                  DTSBU520
00943                                                                   DTSBU520
00944      MOVE L521-APPLIC-AMT TO L542-AMT.                            DTSBU520
00945                                                                   DTSBU520
00946      PERFORM S542-MODIFY-MDST THRU S542-EXIT.                     DTSBU520
00947                                                                   DTSBU520
00948      IF MDST-ACCT-CNT = +0                                        DTSBU520
00949          MOVE MDST-KEY-AREA TO MSKL-KEY-AREA                      DTSBU520
00950          PERFORM S910-DELETE THRU S910-EXIT                       DTSBU520
00951      ELSE                                                         DTSBU520
00952          MOVE MDST-REC TO MSKL-REC                                DTSBU520
00953          PERFORM S910-REWRITE THRU S910-EXIT.                     DTSBU520
00954  P4220-EXIT.                                                      DTSBU520
00955      EXIT.                                                        DTSBU520
00956      EJECT                                                        DTSBU520
00957  P5000-LOCATE-DEBIT.                                              DTSBU520
00958      IF WRK-PREF-APPLIC-YRQ NOT = +0                              DTSBU520
00959          PERFORM P5200-LOCATE-MQTR THRU P5200-EXIT                DTSBU520
00960          IF L521-APPLIC-AMT > +0                                  DTSBU520
00961              GO TO P5000-EXIT                                     DTSBU520
00962          ELSE                                                     DTSBU520
00963              MOVE +0 TO WRK-PREF-APPLIC-YRQ                       DTSBU520
00964              MOVE SPACE TO WRK-PREF-APPLIC-IND.                   DTSBU520
00965                                                                   DTSBU520
00966 **    IF L520-ANNUAL-RPT-WD-88                                    DTSBU520
00967 *        MOVE L520-WITHDRAW-ANN-YRQ TO WRK-ANN-YRQ                DTSBU520
00968 *        MOVE WRK-ANN-CCYY          TO WRK-ANN-RPT-YEAR           DTSBU520
00969 *     ELSE                                                        DTSBU520
00970 *        MOVE ZERO                  TO WRK-ANN-RPT-YEAR           DTSBU520
00971 **    END-IF.                                                     DTSBU520
00972                                                                   DTSBU520
00973 *****IF WRK-OPEN-MAPL-DEBIT = 'Y'                                 DTSBU520
00974 *********PERFORM P5500-LOCATE-NOT-MAPL-DEBIT THRU P5500-EXIT      DTSBU520
00975 *********IF L521-APPLIC-AMT > +0                                  DTSBU520
00976 *************GO TO P5000-EXIT                                     DTSBU520
00977 *********ELSE                                                     DTSBU520
00978 *************MOVE 'N' TO WRK-OPEN-MAPL-DEBIT.                     DTSBU520
00979                                                                   DTSBU520
00980                                                                   DTSBU520
00981      MOVE LOW-VALUES TO MQTR-KEY-AREA.                            DTSBU520
00982                                                                   DTSBU520
00983      MOVE MPRF-EMP-NO TO MQTR-EMP-NO.                             DTSBU520
00984                                                                   DTSBU520
00985      SET MQTR-QTR-88 TO TRUE.                                     DTSBU520
00986                                                                   DTSBU520
00987      MOVE HOLD-MQTR-YRQ TO MQTR-YRQ.                              DTSBU520
00988                                                                   DTSBU520
00989      MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA.                         DTSBU520
00990                                                                   DTSBU520
00991      PERFORM S910-START-BROWSE THRU S910-EXIT.                    DTSBU520
00992                                                                   DTSBU520
00993      PERFORM P5800-MQTR-SCAN THRU P5800-EXIT                      DTSBU520
00994          UNTIL (L910-NO-REC-88)                                   DTSBU520
00995                    OR                                             DTSBU520
00996                (L521-APPLIC-AMT > +0).                            DTSBU520
00997                                                                   DTSBU520
00998  P5000-EXIT.                                                      DTSBU520
00999      EXIT.                                                        DTSBU520
01000      SKIP3                                                        DTSBU520
01001  P5200-LOCATE-MQTR.                                               DTSBU520
01002      PERFORM P5210-MQTR          THRU P5210-EXIT.                 DTSBU520
01003                                                                   DTSBU520
01004 **   IF L520-ANNUAL-RPT-PMT-88                                    DTSBU520
01005 *       PERFORM P5220-ANN-MQTR   THRU P5220-EXIT                  DTSBU520
01006 *    ELSE                                                         DTSBU520
01007 **      PERFORM P5210-REG-MQTR   THRU P5210-EXIT.                 DTSBU520
01008  P5200-EXIT.                                                      DTSBU520
01009      EXIT.                                                        DTSBU520
01010      SKIP3                                                        DTSBU520
01011  P5210-MQTR.                                                      DTSBU520
01012      MOVE LOW-VALUES TO MQTR-KEY-AREA.                            DTSBU520
01013                                                                   DTSBU520
01014      MOVE MPRF-EMP-NO TO MQTR-EMP-NO.                             DTSBU520
01015                                                                   DTSBU520
01016      SET MQTR-QTR-88 TO TRUE.                                     DTSBU520
01017                                                                   DTSBU520
01018      MOVE WRK-PREF-APPLIC-YRQ TO MQTR-YRQ.                        DTSBU520
01019                                                                   DTSBU520
01020      MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA.                         DTSBU520
01021                                                                   DTSBU520
01022      PERFORM S910-READ THRU S910-EXIT.                            DTSBU520
01023                                                                   DTSBU520
01024      MOVE MSKL-REC TO MQTR-REC.                                   DTSBU520
01025                                                                   DTSBU520
01026      IF L910-OK-88                                                DTSBU520
01027          PERFORM P5900-PROCESS-MQTR THRU P5900-EXIT.              DTSBU520
01028  P5210-EXIT.                                                      DTSBU520
01029      EXIT.                                                        DTSBU520
01030      SKIP3                                                        DTSBU520
01031 *P5220-ANN-MQTR.                                                  DTSBU520
01032 *    PERFORM                                                      DTSBU520
01033 *       VARYING ANN-SUB FROM CURR-SUB BY +1                       DTSBU520
01034 *       UNTIL L521-APPLIC-AMT > +0                                DTSBU520
01035 *       OR ANN-SUB > ANN-SUB-MAX                                  DTSBU520
01036 *          MOVE ANN-SUB TO NEW-SUB                                DTSBU520
01037 *          PERFORM P5221-PROCESS-MQTR  THRU P5221-EXIT            DTSBU520
01038 *    END-PERFORM.                                                 DTSBU520
01039 *                                                                 DTSBU520
01040 *    COMPUTE CURR-SUB = (NEW-SUB + 1).                            DTSBU520
01041 *                                                                 DTSBU520
01042 *P5220-EXIT.                                                      DTSBU520
01043 *    EXIT.                                                        DTSBU520
01044 *    SKIP3                                                        DTSBU520
01045 *P5221-PROCESS-MQTR.                                              DTSBU520
01046 *    MOVE LOW-VALUES TO MQTR-KEY-AREA.                            DTSBU520
01047 *                                                                 DTSBU520
01048 *    MOVE MPRF-EMP-NO TO MQTR-EMP-NO.                             DTSBU520
01049 *                                                                 DTSBU520
01050 *    SET MQTR-QTR-88 TO TRUE.                                     DTSBU520
01051 *                                                                 DTSBU520
01052 *    MOVE ANN-TBL-YRQ (ANN-SUB) TO MQTR-YRQ.                      DTSBU520
01053 *                                                                 DTSBU520
01054 *    MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA.                         DTSBU520
01055 *                                                                 DTSBU520
01056 *    PERFORM S910-READ THRU S910-EXIT.                            DTSBU520
01057 *                                                                 DTSBU520
01058 *    MOVE MSKL-REC TO MQTR-REC.                                   DTSBU520
01059 *                                                                 DTSBU520
01060 *    IF L910-OK-88                                                DTSBU520
01061 *        MOVE ANN-TBL-IND (ANN-SUB) TO WRK-PREF-APPLIC-IND        DTSBU520
01062 *        PERFORM P5900-PROCESS-MQTR THRU P5900-EXIT.              DTSBU520
01063 *P5221-EXIT.                                                      DTSBU520
01064 *    EXIT.                                                        DTSBU520
01065      SKIP3                                                        DTSBU520
01066 *P5500-LOCATE-NOT-MAPL-DEBIT.                                     DTSBU520
01067 *****MOVE LOW-VALUES TO MQTR-KEY-AREA.                            DTSBU520
01068 *****MOVE MPRF-EMP-NO TO MQTR-EMP-NO.                             DTSBU520
01069 *****SET MQTR-QTR-88 TO TRUE.                                     DTSBU520
01070 *****MOVE +0 TO MQTR-YRQ.                                         DTSBU520
01071 *****MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA.                         DTSBU520
01072 *****PERFORM S910-START-BROWSE THRU S910-EXIT.                    DTSBU520
01073 *****PERFORM P5510-MQTR-SCAN THRU P5510-EXIT                      DTSBU520
01074 *********UNTIL (L910-NO-REC-88)                                   DTSBU520
01075 *******************OR                                             DTSBU520
01076 ***************(L521-APPLIC-AMT > +0).                            DTSBU520
01077 *P5500-EXIT.                                                      DTSBU520
01078 *****EXIT.                                                        DTSBU520
01079      SKIP3                                                        DTSBU520
01080 *P5510-MQTR-SCAN.                                                 DTSBU520
01081 *****MOVE MSKL-REC TO MQTR-REC.                                   DTSBU520
01082                                                                   DTSBU520
01083 *****MOVE LOW-VALUES TO MAPL-KEY-AREA.                            DTSBU520
01084 *****MOVE MPRF-EMP-NO TO MAPL-EMP-NO.                             DTSBU520
01085 *****SET MAPL-APL-88 TO TRUE.                                     DTSBU520
01086 *****MOVE MAPL-KEY-AREA TO MSKL-KEY-AREA.                         DTSBU520
01087 *****PERFORM S910-START-BROWSE THRU S910-EXIT.                    DTSBU520
01088 *****MOVE 'N' TO WRK-MQTR-IN-OPEN-MAPL.                           DTSBU520
01089 *****PERFORM P5511-MAPL-BROWSE THRU P5511-EXIT                    DTSBU520
01090 *********UNTIL (L910-NO-REC-88)                                   DTSBU520
01091 *******************OR                                             DTSBU520
01092 ***************(WRK-MQTR-IN-OPEN-MAPL = 'Y').                     DTSBU520
01093                                                                   DTSBU520
01094 *****IF WRK-MQTR-IN-OPEN-MAPL = 'N'                               DTSBU520
01095 *********PERFORM P5900-PROCESS-MQTR THRU P5900-EXIT               DTSBU520
01096 *********IF L521-APPLIC-AMT > +0                                  DTSBU520
01097 *************GO TO P5510-EXIT.                                    DTSBU520
01098                                                                   DTSBU520
01099 *****MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA.                         DTSBU520
01100 *****PERFORM S910-READ THRU S910-EXIT.                            DTSBU520
01101 *****IF L910-NO-REC-88                                            DTSBU520
01102 *********DISPLAY 'DTSBU520:P5510:1'                               DTSBU520
01103 *********PERFORM S999-ABEND THRU S999-EXIT.                       DTSBU520
01104                                                                   DTSBU520
01105 *****PERFORM S910-READ-NEXT THRU S910-EXIT.                       DTSBU520
01106 *P5510-EXIT.                                                      DTSBU520
01107 *****EXIT.                                                        DTSBU520
01108      SKIP3                                                        DTSBU520
01109 *P5511-MAPL-BROWSE.                                               DTSBU520
01110 *****MOVE MSKL-REC TO MAPL-REC.                                   DTSBU520
01111                                                                   DTSBU520
01112 *****PERFORM                                                      DTSBU520
01113 *******VARYING MAPL-COV-IDX FROM 1 BY 1                           DTSBU520
01114 *******UNTIL MAPL-COV-IDX > MAPL-COVERED-CNT                      DTSBU520
01115 *********IF MAPL-COVERED-YRQ (MAPL-COV-IDX) = MQTR-YRQ            DTSBU520
01116 *************MOVE 'Y' TO WRK-MQTR-IN-OPEN-MAPL                    DTSBU520
01117 *********END-IF                                                   DTSBU520
01118 *****END-PERFORM.                                                 DTSBU520
01119                                                                   DTSBU520
01120 *****PERFORM S910-READ-NEXT THRU S910-EXIT.                       DTSBU520
01121 *P5511-EXIT.                                                      DTSBU520
01122 *****EXIT.                                                        DTSBU520
01123      EJECT                                                        DTSBU520
01124  P5800-MQTR-SCAN.                                                 DTSBU520
01125      MOVE MSKL-REC TO MQTR-REC.                                   DTSBU520
01126                                                                   DTSBU520
01127 **   IF L520-ANNUAL-RPT-WD-88                                     DTSBU520
01128 *       MOVE MQTR-YRQ            TO WRK-ANN-YRQ                   DTSBU520
01129 *       IF WRK-ANN-CCYY           = WRK-ANN-RPT-YEAR              DTSBU520
01130 *          PERFORM S910-READ-NEXT THRU S910-EXIT                  DTSBU520
01131 *          GO TO P5800-EXIT                                       DTSBU520
01132 *       END-IF                                                    DTSBU520
01133 **   END-IF.                                                      DTSBU520
01134                                                                   DTSBU520
01135      PERFORM P5900-PROCESS-MQTR THRU P5900-EXIT.                  DTSBU520
01136                                                                   DTSBU520
01137      IF L521-APPLIC-AMT > +0                                      DTSBU520
01138          MOVE MQTR-YRQ TO HOLD-MQTR-YRQ                           DTSBU520
01139          GO TO P5800-EXIT.                                        DTSBU520
01140                                                                   DTSBU520
01141      PERFORM S910-READ-NEXT THRU S910-EXIT.                       DTSBU520
01142  P5800-EXIT.                                                      DTSBU520
01143      EXIT.                                                        DTSBU520
01144      SKIP3                                                        DTSBU520
01145  P5900-PROCESS-MQTR.                                              DTSBU520
01146 *****                                                             DTSBU520
01147 *                                                                 DTSBU520
01148 *    NOTE:  IF ACCOUNT SEQUENCE (UI, SUR,ETC) IS MODIFIED         DTSBU520
01149 *           OR IF NEW ACCOUNTS ARE ADDED, THEN MAKE               DTSBU520
01150 *           CORRESPONDING MODIFICATIONS IN DTSBD372:P4221.        DTSBU520
01151 *                                                                 DTSBU520
01152 *****                                                             DTSBU520
01153                                                                   DTSBU520
01154 *&                                                                DTSBU520
01155      IF MPRF-EMP-NO = 020852 OR 031484                            DTSBU520
01156         MOVE HOLD-CREDIT-AMT          TO AMT-DISP                 DTSBU520
01157         DISPLAY 'BU520 P5900 WRK-IND: '                           DTSBU520
01158            WRK-PREF-APPLIC-IND '  ' MQTR-YRQ                      DTSBU520
01159      END-IF.                                                      DTSBU520
01160 *&                                                                DTSBU520
01161      MOVE +0 TO HOLD-ACCT-SUB.                                    DTSBU520
01162                                                                   DTSBU520
01163      IF WRK-PREF-APPLIC-IND NOT = SPACE                           DTSBU520
01164          MOVE WRK-PREF-APPLIC-IND TO HOLD-ACCT-IND                DTSBU520
01165          PERFORM P5910-SCAN-FOR-BALANCE THRU P5910-EXIT           DTSBU520
01166              VARYING MQTR-ACCT-IDX FROM 1 BY 1                    DTSBU520
01167              UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT.                 DTSBU520
01168                                                                   DTSBU520
01169      IF HOLD-ACCT-SUB = +0                                        DTSBU520
01170          MOVE CACT-ACCT-UI TO HOLD-ACCT-IND                       DTSBU520
01171          PERFORM P5910-SCAN-FOR-BALANCE THRU P5910-EXIT           DTSBU520
01172              VARYING MQTR-ACCT-IDX FROM 1 BY 1                    DTSBU520
01173              UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT.                 DTSBU520
01174                                                                   DTSBU520
01175      IF HOLD-ACCT-SUB = +0                                        DTSBU520
01176          MOVE CACT-ACCT-SUR TO HOLD-ACCT-IND                      DTSBU520
01177          PERFORM P5910-SCAN-FOR-BALANCE THRU P5910-EXIT           DTSBU520
01178              VARYING MQTR-ACCT-IDX FROM 1 BY 1                    DTSBU520
01179              UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT.                 DTSBU520
01180                                                                   DTSBU520
01181      IF HOLD-ACCT-SUB = +0                                        DTSBU520
01182          MOVE CACT-ACCT-INT TO HOLD-ACCT-IND                      DTSBU520
01183          PERFORM P5910-SCAN-FOR-BALANCE THRU P5910-EXIT           DTSBU520
01184              VARYING MQTR-ACCT-IDX FROM 1 BY 1                    DTSBU520
01185              UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT.                 DTSBU520
01186                                                                   DTSBU520
01187      IF HOLD-ACCT-SUB = +0                                        DTSBU520
01188          MOVE CACT-ACCT-LATE-PEN TO HOLD-ACCT-IND                 DTSBU520
01189          PERFORM P5910-SCAN-FOR-BALANCE THRU P5910-EXIT           DTSBU520
01190              VARYING MQTR-ACCT-IDX FROM 1 BY 1                    DTSBU520
01191              UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT.                 DTSBU520
01192                                                                   DTSBU520
01193      IF HOLD-ACCT-SUB = +0                                        DTSBU520
01194          MOVE CACT-ACCT-NSF-PEN TO HOLD-ACCT-IND                  DTSBU520
01195          PERFORM P5910-SCAN-FOR-BALANCE THRU P5910-EXIT           DTSBU520
01196              VARYING MQTR-ACCT-IDX FROM 1 BY 1                    DTSBU520
01197              UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT.                 DTSBU520
01198                                                                   DTSBU520
01199      IF HOLD-ACCT-SUB = +0                                        DTSBU520
01200          MOVE CACT-ACCT-MISC-PEN TO HOLD-ACCT-IND                 DTSBU520
01201          PERFORM P5910-SCAN-FOR-BALANCE THRU P5910-EXIT           DTSBU520
01202              VARYING MQTR-ACCT-IDX FROM 1 BY 1                    DTSBU520
01203              UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT.                 DTSBU520
01204                                                                   DTSBU520
01205      IF HOLD-ACCT-SUB = +0                                        DTSBU520
01206          GO TO P5900-EXIT.                                        DTSBU520
01207                                                                   DTSBU520
01208                                                                   DTSBU520
01209      IF MQTR-BALANCE-AMT (HOLD-ACCT-SUB) < HOLD-CREDIT-AMT        DTSBU520
01210          MOVE MQTR-BALANCE-AMT (HOLD-ACCT-SUB)                    DTSBU520
01211            TO L521-APPLIC-AMT                                     DTSBU520
01212      ELSE                                                         DTSBU520
01213          MOVE HOLD-CREDIT-AMT TO L521-APPLIC-AMT.                 DTSBU520
01214                                                                   DTSBU520
01215      MOVE MQTR-ACCT-IND (HOLD-ACCT-SUB) TO L521-APPLIC-ACCT-IND.  DTSBU520
01216                                                                   DTSBU520
01217      MOVE MQTR-YRQ TO L521-APPLIC-YRQ.                            DTSBU520
01218                                                                   DTSBU520
01219 *&                                                                DTSBU520
01220      IF MPRF-EMP-NO = 020852 OR 031484                            DTSBU520
01221         MOVE MQTR-BALANCE-AMT (HOLD-ACCT-SUB) TO AMT-DISP         DTSBU520
01222         MOVE HOLD-CREDIT-AMT                  TO AMT-DISP1        DTSBU520
01223         MOVE L521-APPLIC-AMT                  TO AMT-DISP2        DTSBU520
01224         DISPLAY 'BU520 P5900: ' MQTR-YRQ                          DTSBU520
01225         '  ' MQTR-ACCT-IND (HOLD-ACCT-SUB)                        DTSBU520
01226           '  QBAL ' AMT-DISP '  HOLD ' AMT-DISP1                  DTSBU520
01227         DISPLAY  '   521AMT ' AMT-DISP2                           DTSBU520
01228      END-IF.                                                      DTSBU520
01229 *&                                                                DTSBU520
01230  P5900-EXIT.                                                      DTSBU520
01231      EXIT.                                                        DTSBU520
01232      SKIP3                                                        DTSBU520
01233  P5910-SCAN-FOR-BALANCE.                                          DTSBU520
01234      IF MQTR-ACCT-IND (MQTR-ACCT-IDX) = HOLD-ACCT-IND             DTSBU520
01235          IF MQTR-BALANCE-AMT (MQTR-ACCT-IDX) > +0                 DTSBU520
01236              SET HOLD-ACCT-SUB TO MQTR-ACCT-IDX.                  DTSBU520
01237  P5910-EXIT.                                                      DTSBU520
01238      EXIT.                                                        DTSBU520
01239      EJECT                                                        DTSBU520
01240  S004-FROM-5.                                                     DTSBU520
01241      SET L004-FROM-5 TO TRUE.                                     DTSBU520
01242      GO TO S004-QTR.                                              DTSBU520
01243                                                                   DTSBU520
01244  S004-QTR.                                                        DTSBU520
01245      CALL 'DTSBU004' USING L004-LINK-AREA.                        DTSBU520
01246  S004-EXIT.                                                       DTSBU520
01247      EXIT.                                                        DTSBU520
01248                                                                   DTSBU520
01249  S521-APPLIC-PROCESS.                                             DTSBU520
01250      CALL 'DTSBU521' USING L521-LINK-AREA                         DTSBU520
01251                            LBCM-LINK-AREA                         DTSBU520
01252                            MPRF-REC.                              DTSBU520
01253  S521-EXIT.                                                       DTSBU520
01254      EXIT.                                                        DTSBU520
01255      SKIP3                                                        DTSBU520
01256  S542-MODIFY-MDST.                                                DTSBU520
01257      MOVE 'DTSBU520'      TO L542-CALLED-BY.                      DTSBU520
01258      MOVE LBCM-TRN-DOC-NO TO L542-TRN-DOC-NO.                     DTSBU520
01259                                                                   DTSBU520
01260      CALL 'DTSBU542' USING L542-LINK-AREA                         DTSBU520
01261                            MPRF-REC                               DTSBU520
01262                            MDST-REC.                              DTSBU520
01263  S542-EXIT.                                                       DTSBU520
01264      EXIT.                                                        DTSBU520
01265      SKIP3                                                        DTSBU520
01266 *S590-CR-TOL.                                                     DTSBU520
01267 *****SET L590-CR-TOL-88 TO TRUE.                                  DTSBU520
01268 *****MOVE +0 TO L590-YRQ.                                         DTSBU520
01269 *****MOVE MDST-DOC-NO TO L590-PAY-DOC-NO.                         DTSBU520
01270 *****GO TO S590-EMP-CLEANUP.                                      DTSBU520
01271                                                                   DTSBU520
01272 *S590-EMP-CLEANUP.                                                DTSBU520
01273 *****MOVE LBCM-TRN-DOC-NO TO L590-TOL-DOC-NO.                     DTSBU520
01274                                                                   DTSBU520
01275 *****CALL 'DTSBU590' USING L590-LINK-AREA                         DTSBU520
01276 ***************************LBCM-LINK-AREA                         DTSBU520
01277 ***************************MPRF-REC.                              DTSBU520
01278 *S590-EXIT.                                                       DTSBU520
01279 *****EXIT.                                                        DTSBU520
01280      SKIP3                                                        DTSBU520
01281  S910-READ.                                                       DTSBU520
01282      SET L910-READ-88 TO TRUE.                                    DTSBU520
01283      GO TO S910-MSTR-IO.                                          DTSBU520
01284                                                                   DTSBU520
01285  S910-START-BROWSE.                                               DTSBU520
01286      SET L910-START-BROWSE-88 TO TRUE.                            DTSBU520
01287      GO TO S910-MSTR-IO.                                          DTSBU520
01288                                                                   DTSBU520
01289  S910-READ-NEXT.                                                  DTSBU520
01290      SET L910-READ-NEXT-88 TO TRUE.                               DTSBU520
01291      GO TO S910-MSTR-IO.                                          DTSBU520
01292                                                                   DTSBU520
01293 *S910-COUNT.                                                      DTSBU520
01294 *****SET L910-COUNT-88 TO TRUE.                                   DTSBU520
01295 *****GO TO S910-MSTR-IO.                                          DTSBU520
01296                                                                   DTSBU520
01297  S910-WRITE.                                                      DTSBU520
01298      SET LBCM-EMP-UPDATE-YES-88 TO TRUE.                          DTSBU520
01299      SET L910-WRITE-88 TO TRUE.                                   DTSBU520
01300      GO TO S910-MSTR-IO.                                          DTSBU520
01301                                                                   DTSBU520
01302  S910-REWRITE.                                                    DTSBU520
01303      SET LBCM-EMP-UPDATE-YES-88 TO TRUE.                          DTSBU520
01304      SET L910-REWRITE-88 TO TRUE.                                 DTSBU520
01305      GO TO S910-MSTR-IO.                                          DTSBU520
01306                                                                   DTSBU520
01307  S910-DELETE.                                                     DTSBU520
01308      SET LBCM-EMP-UPDATE-YES-88 TO TRUE.                          DTSBU520
01309      SET L910-DELETE-88 TO TRUE.                                  DTSBU520
01310      GO TO S910-MSTR-IO.                                          DTSBU520
01311                                                                   DTSBU520
01312  S910-MSTR-IO.                                                    DTSBU520
01313      CALL 'DTSBU910' USING L910-LINK-AREA                         DTSBU520
01314                            MSKL-REC.                              DTSBU520
01315  S910-EXIT.                                                       DTSBU520
01316      EXIT.                                                        DTSBU520
01317      SKIP3                                                        DTSBU520
01318  S946-R907-WRITE.                                                 DTSBU520
01319      CALL 'DTSBU946' USING R907-REC.                              DTSBU520
01320  S946-EXIT.                                                       DTSBU520
01321      EXIT.                                                        DTSBU520
01322      SKIP3                                                        DTSBU520
01323  S999-ABEND.                                                      DTSBU520
01324      CALL 'DTSBU999' USING WRK-ABEND-CD.                          DTSBU520
01325  S999-EXIT.                                                       DTSBU520
01326      EXIT.                                                        DTSBU520
