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