00001 IDENTIFICATION DIVISION. 04/30/08 00002 PROGRAM-ID. DTSBU522. DTSBU522 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV010 00004 DATE-WRITTEN. JANUARY 1991. DTSBU522 00005 DATE-COMPILED. DTSBU522 00006 SKIP3 DTSBU522 00007 ***** DTSBU522 00008 * DTSBU522 00009 * FUNCTION: RETURN A PAID AMOUNT TO UNAPPLIED CREDIT. DTSBU522 00010 * DTSBU522 00011 * DTSBU522 00012 * MODIFICATION LOG: DTSBU522 00013 * DTSBU522 00014 * 01/26/92 INITIAL DEVELOPMENT. DTSBU522 00015 * WORK ORDER: PROGRAMMER: TCL DTSBU522 00016 * DTSBU522 00017 * 06/13/95 CHANGE TO CREDIT TOLERANCE LOGIC REMOVES IT FROM DTSBU522 00018 * THIS PROGRAM. DTSBU522 00019 * WORK ORDER: CR094 PROGRAMMER: RHC DTSBU522 00020 * DTSBU522 00021 * 12/10/1998 REVIEWED AND MODIFIED FOR DC. DTSBU522 00022 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH DTSBU522 00023 * DTSBU522 00024 * 02/20/2006 INTEREST CALCULATION MODIFIED - ONLY UI TAX DTSBU522 00025 * BALANCE INCLUDED. P0100. DTSBU522 00026 * REFERENCE: ADMIN ASSESSMENT PROGRAMMER: GD DTSBU522 00027 * DTSBU522 00028 * 02/12/2008 INTEREST CALCULATION MODIFIED - INCLUDE SUR DTSBU522 00029 * TAX. P0100. DTSBU522 00030 * REFERENCE: ADMIN ASSESSMENT PROGRAMMER: ZL1 DTSBU522 00031 * DTSBU522 00032 * DTSBU522 00033 * DESCRIPTION: DTSBU522 00034 * DTSBU522 00035 * RETURN A PAID AMOUNT TO UNAPPLIED CREDIT. DTSBU522 00036 * DTSBU522 00037 * WHEN IT HAS BEEN DETERMINED THAT A PAID AMOUNT MUST BE DTSBU522 00038 * REMOVED FROM AN ACCOUNT, THEN DTSBU522 IS CALLED. DTSBU522 00039 * DTSBU522 00040 * L522-AMT IS A NEGATIVE NUMBER REPRESENTING THE AMOUNT DTSBU522 00041 * OF PAYMENT TO BE REVERSED. L522-ACCT-IND, IN COMBINATION DTSBU522 00042 * WITH MQTR-REC DEFINES THE ACCOUNT TO BE OPERATED ON. DTSBU522 00043 * DTSBU522 00044 * APPLIED MONEY WITH THE GREATEST RECEIVED DATE IS REMOVED DTSBU522 00045 * FIRST. DTSBU522 00046 * DTSBU522 00047 * RIPPING MONEY OUT OF TAX PAID MAY REQUIRE THAT INTEREST DTSBU522 00048 * CHARGED IS REDUCED. THIS LITTLE PROBLEM IS THE CHIEF DTSBU522 00049 * DIFFICULTY ADDRESSED IN THIS MODULE. DTSBU522 00050 * DTSBU522 00051 * DTSBU522 00052 * MASTER FILE RECORDS READ: DTSBU522 00053 * DTSBU522 00054 * MDST DTSBU522 00055 * DTSBU522 00056 * DTSBU522 00057 * MASTER FILE RECORDS UPDATED: DTSBU522 00058 * DTSBU522 00059 * MDST (REWRITE,WRITE) DTSBU522 00060 * DTSBU522 00061 * DTSBU522 00062 * REPORT RECORDS WRITTEN: DTSBU522 00063 * DTSBU522 00064 * R907 ERROR. DTSBU522 00065 * DTSBU522 00066 * DTSBU522 00067 * MODULES CALLED: DTSBU522 00068 * DTSBU522 00069 * DTSBU101 INTEREST COMPUTATION. DTSBU522 00070 * DTSBU541 MODIFY A SPECIFIED CHARGED, WAIVED, TOLERATED, DTSBU522 00071 * OR SUSPENDED AMOUNT. DTSBU522 00072 * DTSBU542 MODIFY A DISTRIBUTION OCCURRENCES IN A DTSBU522 00073 * PAYMENT DISTRIBUTION RECORD. DTSBU522 00074 * DTSBU549 JOURNALING/BATCH DETAIL LISTING. DTSBU522 00075 * DTSBU590 EMPLOYER CLEANUP. DTSBU522 00076 * DTSBU910 MASTER FILE I/O. DTSBU522 00077 * DTSBU946 VARIABLE LENGTH RECORD SEQUENTIAL OUTPUT 1. DTSBU522 00078 * DTSBU522 00079 * DTSBU522 00080 ***** DTSBU522 00081 SKIP3 DTSBU522 00082 ENVIRONMENT DIVISION. DTSBU522 00083 EJECT DTSBU522 00084 DATA DIVISION. DTSBU522 00085 SKIP3 DTSBU522 00086 WORKING-STORAGE SECTION. DTSBU522 000865 77 PAN-VALET PICTURE X(24) VALUE '010DTSBU522 04/30/08'. DTSBU522 00087 SKIP3 DTSBU522 00088 01 WRK-AREA. DTSBU522 00089 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +522.DTSBU522 00090 DTSBU522 00091 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBU522'.DTSBU522 00092 DTSBU522 00093 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBU522 00094 DTSBU522 00095 DTSBU522 00096 05 WRK-NULL-DOC-NO. DTSBU522 00097 10 WRK-NULL-BATCH-NO PIC S9(05) COMP-3. DTSBU522 00098 10 WRK-NULL-ITEM-NO PIC S9(03) COMP-3. DTSBU522 00099 DTSBU522 00100 DTSBU522 00101 05 PROC-AMT PIC S9(09)V9(02) COMP-3. DTSBU522 00102 DTSBU522 00103 05 PROC-ACCT-SUB PIC S9(04) COMP. DTSBU522 00104 DTSBU522 00105 05 PROC-DSTRB-ACCT-IND PIC X(02). DTSBU522 00106 DTSBU522 00107 05 PROC-DSTRB-YRQ PIC S9(05) COMP-3. DTSBU522 00108 DTSBU522 00109 05 WRK-MDST-RECEIVED-DATE PIC S9(09) COMP-3. DTSBU522 00110 DTSBU522 00111 05 WRK-MDST-DOC-NO. DTSBU522 00112 10 WRK-MDST-BATCH-NO PIC S9(05) COMP-3. DTSBU522 00113 10 WRK-MDST-ITEM-NO PIC S9(03) COMP-3. DTSBU522 00114 DTSBU522 00115 05 WRK-DSTRB-SUB PIC S9(04) COMP. DTSBU522 00116 DTSBU522 00117 05 HOLD-TAX-SUB PIC S9(04) COMP. DTSBU522 00118 DTSBU522 00119 05 HOLD-INT-SUB PIC S9(04) COMP. DTSBU522 00120 DTSBU522 00121 *****05 HOLD-PEN-SUB PIC S9(04) COMP. DTSBU522 00122 DTSBU522 00123 05 HOLD-ACCT-SUB PIC S9(04) COMP. DTSBU522 00124 DTSBU522 00125 05 WRK-INT-CHARGED-AMT PIC S9(09)V9(02) COMP-3. DTSBU522 00126 DTSBU522 00127 *****05 WRK-PEN-CHARGED-AMT PIC S9(09)V9(02) COMP-3. DTSBU522 00128 EJECT DTSBU522 00129 01 HOLD-AREA. DTSBU522 00130 05 HOLD-EMP-NO PIC S9(07) COMP-3. DTSBU522 00131 DTSBU522 00132 05 HOLD-YRQ-AREA. DTSBU522 00133 10 HOLD-YRQ-INDS OCCURS 400 TIMES. DTSBU522 00134 15 HOLD-YRQ-MSG1-IND PIC X(01). DTSBU522 00135 88 HOLD-YRQ-MSG1-SENT-88 VALUE 'Y'. DTSBU522 00136 88 HOLD-YRQ-MSG1-NOT-SENT-88 VALUE ' '. DTSBU522 00137 15 HOLD-YRQ-MSG2-IND PIC X(01). DTSBU522 00138 88 HOLD-YRQ-MSG2-SENT-88 VALUE 'Y'. DTSBU522 00139 88 HOLD-YRQ-MSG2-NOT-SENT-88 VALUE ' '. DTSBU522 00140 *************15 HOLD-YRQ-MSG3-IND PIC X(01). DTSBU522 00141 *****************88 HOLD-YRQ-MSG3-SENT-88 VALUE 'Y'. DTSBU522 00142 *****************88 HOLD-YRQ-MSG3-NOT-SENT-88 VALUE ' '. DTSBU522 00143 15 HOLD-YRQ-MSG4-IND PIC X(01). DTSBU522 00144 88 HOLD-YRQ-MSG4-SENT-88 VALUE 'Y'. DTSBU522 00145 88 HOLD-YRQ-MSG4-NOT-SENT-88 VALUE ' '. DTSBU522 00146 15 HOLD-YRQ-MSG5-IND PIC X(01). DTSBU522 00147 88 HOLD-YRQ-MSG5-SENT-88 VALUE 'Y'. DTSBU522 00148 88 HOLD-YRQ-MSG5-NOT-SENT-88 VALUE ' '. DTSBU522 00149 EJECT DTSBU522 00150 01 MSG-TABLE. DTSBU522 00151 05 MSG1-INT-WAIVED. DTSBU522 00152 10 MSG1-ID. DTSBU522 00153 15 MSG1-ID1 PIC X(08) VALUE 'DTSBU522'. DTSBU522 00154 15 MSG1-ID2 PIC X(03) VALUE '362'. DTSBU522 00155 10 MSG1-SHORT-TEXT PIC X(20) VALUE 'AUTO INT WAIVE'. DTSBU522 00156 10 MSG1-LONG-TEXT. DTSBU522 00157 15 FILLER PIC X(30) DTSBU522 00158 VALUE 'INT WAIVED REDUCED DUE TO REDU'. DTSBU522 00159 15 FILLER PIC X(25) DTSBU522 00160 VALUE 'CTION OF TAX PAID. YRQ = '. DTSBU522 00161 15 MSG1-SLASHED-YRQ PIC X(04). DTSBU522 00162 DTSBU522 00163 *****05 MSG2-PEN-WAIVED. DTSBU522 00164 *********10 MSG2-ID. DTSBU522 00165 *************15 MSG2-ID1 PIC X(08) VALUE 'DTSBU522'. DTSBU522 00166 *************15 MSG2-ID2 PIC X(03) VALUE '363'. DTSBU522 00167 *********10 MSG2-SHORT-TEXT PIC X(20) VALUE 'AUTO PEN WAIVE'. DTSBU522 00168 *********10 MSG2-LONG-TEXT. DTSBU522 00169 *************15 FILLER PIC X(30) DTSBU522 00170 *******************VALUE 'PEN WAIVED REDUCED DUE TO REDU'. DTSBU522 00171 *************15 FILLER PIC X(25) DTSBU522 00172 *******************VALUE 'CTION OF TAX PAID. YRQ = '. DTSBU522 00173 *************15 MSG2-SLASHED-YRQ PIC X(04). DTSBU522 00174 DTSBU522 00175 05 MSG3-PAY-DSTRB-NOT-FOUND. DTSBU522 00176 10 MSG3-ID. DTSBU522 00177 15 MSG3-ID1 PIC X(08) VALUE 'DTSBU522'. DTSBU522 00178 15 MSG3-ID2 PIC X(03) VALUE '364'. DTSBU522 00179 10 MSG3-SHORT-TEXT PIC X(20) VALUE 'PAY DSTRB ERR '. DTSBU522 00180 10 MSG3-LONG-TEXT. DTSBU522 00181 15 FILLER PIC X(29) DTSBU522 00182 VALUE 'LOST PAYMENT DISTRIB. YRQ = '. DTSBU522 00183 15 MSG3-SLASHED-YRQ PIC X(04). DTSBU522 00184 15 FILLER PIC X(13) DTSBU522 00185 VALUE ' ACCT IND = '. DTSBU522 00186 15 MSG3-ACCT-IND PIC X(02). DTSBU522 00187 15 MSG3-AMT PIC ZZZ,ZZZ,ZZ9.99-. DTSBU522 00188 DTSBU522 00189 05 MSG4-MANUAL-INT. DTSBU522 00190 10 MSG4-ID. DTSBU522 00191 15 MSG4-ID1 PIC X(08) VALUE 'DTSBU522'. DTSBU522 00192 15 MSG4-ID2 PIC X(03) VALUE '356'. DTSBU522 00193 10 MSG4-SHORT-TEXT PIC X(20) VALUE 'MAN INT QTR PD'. DTSBU522 00194 10 MSG4-LONG-TEXT. DTSBU522 00195 15 FILLER PIC X(30) DTSBU522 00196 VALUE 'TAX PAID MODIFIED IN A MANUAL '. DTSBU522 00197 15 FILLER PIC X(25) DTSBU522 00198 VALUE 'INTEREST QUARTER. YRQ = '. DTSBU522 00199 15 MSG4-SLASHED-YRQ PIC X(04). DTSBU522 00200 DTSBU522 00201 *****05 MSG5-MANUAL-PEN. DTSBU522 00202 *********10 MSG5-ID. DTSBU522 00203 *************15 MSG5-ID1 PIC X(08) VALUE 'DTSBU522'. DTSBU522 00204 *************15 MSG5-ID2 PIC X(03) VALUE '357'. DTSBU522 00205 *********10 MSG5-SHORT-TEXT PIC X(20) VALUE 'MAN PEN QTR PD'. DTSBU522 00206 *********10 MSG5-LONG-TEXT. DTSBU522 00207 *************15 FILLER PIC X(30) DTSBU522 00208 *******************VALUE 'TAX PAID MODIFIED IN A MANUAL '. DTSBU522 00209 *************15 FILLER PIC X(25) DTSBU522 00210 *******************VALUE 'PENALTY QUARTER. YRQ = '. DTSBU522 00211 *************15 MSG5-SLASHED-YRQ PIC X(04). DTSBU522 00212 EJECT DTSBU522 00213 01 R907-REC. DTSBU522 00214 ++INCLUDE DTSIR907 DTSBU522 00215 EJECT DTSBU522 00216 01 L910-LINK-AREA. DTSBU522 00217 ++INCLUDE DTSIL910 DTSBU522 00218 SKIP3 DTSBU522 00219 01 MSKL-REC. DTSBU522 00220 ++INCLUDE DTSIMSKL DTSBU522 00221 SKIP3 DTSBU522 00222 01 MDST-REC. DTSBU522 00223 ++INCLUDE DTSIMDST DTSBU522 00224 SKIP3 DTSBU522 00225 01 L004-LINK-AREA. DTSBU522 00226 ++INCLUDE DTSIL004 DTSBU522 00227 SKIP3 DTSBU522 00228 01 L101-LINK-AREA. DTSBU522 00229 ++INCLUDE DTSIL101 DTSBU522 00230 SKIP3 DTSBU522 00231 01 L109-LINK-AREA. DTSBU522 00232 ++INCLUDE DTSIL109 DTSBU522 00233 SKIP3 DTSBU522 00234 01 L541-LINK-AREA. DTSBU522 00235 ++INCLUDE DTSIL541 DTSBU522 00236 SKIP3 DTSBU522 00237 01 L542-LINK-AREA. DTSBU522 00238 ++INCLUDE DTSIL542 DTSBU522 00239 SKIP3 DTSBU522 00240 01 L549-LINK-AREA. DTSBU522 00241 ++INCLUDE DTSIL549 DTSBU522 00242 SKIP3 DTSBU522 00243 01 L590-LINK-AREA. DTSBU522 00244 ++INCLUDE DTSIL590 DTSBU522 00245 EJECT DTSBU522 00246 01 CACT-LITERALS. DTSBU522 00247 ++INCLUDE DTSICACT DTSBU522 00248 SKIP3 DTSBU522 00249 01 MMAX-LITERALS. DTSBU522 00250 ++INCLUDE DTSIMMAX DTSBU522 00251 EJECT DTSBU522 00252 LINKAGE SECTION. DTSBU522 00253 SKIP3 DTSBU522 00254 01 L522-LINK-AREA. DTSBU522 00255 ++INCLUDE DTSIL522 DTSBU522 00256 EJECT DTSBU522 00257 01 LBCM-LINK-AREA. DTSBU522 00258 ++INCLUDE DTSILBCM DTSBU522 00259 EJECT DTSBU522 00260 01 MPRF-REC. DTSBU522 00261 ++INCLUDE DTSIMPRF DTSBU522 00262 EJECT DTSBU522 00263 01 MQTR-REC. DTSBU522 00264 ++INCLUDE DTSIMQTR DTSBU522 00265 EJECT DTSBU522 00266 PROCEDURE DIVISION USING L522-LINK-AREA DTSBU522 00267 LBCM-LINK-AREA DTSBU522 00268 MPRF-REC DTSBU522 00269 MQTR-REC. DTSBU522 00270 DTSBU522 00271 DTSBU522 00272 IF FIRST-TIME-IND = 'Y' DTSBU522 00273 PERFORM I0000-FIRST-TIME THRU I0000-EXIT DTSBU522 00274 MOVE 'N' TO FIRST-TIME-IND. DTSBU522 00275 DTSBU522 00276 DTSBU522 00277 PERFORM P0000-PROCESS THRU P0000-EXIT. DTSBU522 00278 DTSBU522 00279 DTSBU522 00280 GOBACK. DTSBU522 00281 EJECT DTSBU522 00282 I0000-FIRST-TIME. DTSBU522 00283 MOVE LBCM-TRACE-IND TO L910-TRACE-IND. DTSBU522 00284 DTSBU522 00285 MOVE WRK-MOD-NAME TO L910-MOD-NAME DTSBU522 00286 R907-MODULE-NAME. DTSBU522 00287 DTSBU522 00288 MOVE +0 TO WRK-NULL-BATCH-NO DTSBU522 00289 WRK-NULL-ITEM-NO. DTSBU522 00290 DTSBU522 00291 MOVE LENGTH OF R907-REC TO R907-LENGTH. DTSBU522 00292 DTSBU522 00293 PERFORM P0010-EMP-NO-BREAK THRU P0010-EXIT. DTSBU522 00294 I0000-EXIT. DTSBU522 00295 EXIT. DTSBU522 00296 EJECT DTSBU522 00297 P0000-PROCESS. DTSBU522 00298 IF MPRF-EMP-NO = HOLD-EMP-NO DTSBU522 00299 NEXT SENTENCE DTSBU522 00300 ELSE DTSBU522 00301 PERFORM P0010-EMP-NO-BREAK THRU P0010-EXIT. DTSBU522 00302 DTSBU522 00303 MOVE MPRF-EMP-NO TO R907-EMP-NO. DTSBU522 00304 DTSBU522 00305 IF L522-AMT > +0 DTSBU522 00306 NEXT SENTENCE DTSBU522 00307 ELSE DTSBU522 00308 PERFORM S999-ABEND THRU S999-EXIT. DTSBU522 00309 DTSBU522 00310 IF (L522-ACCT-SUB < +1) DTSBU522 00311 OR DTSBU522 00312 (L522-ACCT-SUB > MQTR-ACCT-CNT) DTSBU522 00313 PERFORM S999-ABEND THRU S999-EXIT. DTSBU522 00314 DTSBU522 00315 DTSBU522 00316 MOVE L522-AMT TO PROC-AMT. DTSBU522 00317 DTSBU522 00318 MOVE L522-ACCT-SUB TO PROC-ACCT-SUB. DTSBU522 00319 DTSBU522 00320 PERFORM S1000-REVERSE-PAYMENT THRU S1000-EXIT. DTSBU522 00321 DTSBU522 00322 PERFORM S109-FIRST-PEN-INT-YRQ THRU S109-EXIT. DTSBU522 00323 DTSBU522 00324 *********************************************************** DTSBU522 00325 * SUR TAX INCLUDED TO CALCULATE INTEREST AS OF 08/01. DTSBU522 00326 *********************************************************** DTSBU522 00327 IF MQTR-ACCT-TAX-88 (L522-ACCT-SUB) DTSBU522 00328 PERFORM P0100-RECOMPUTE-INT THRU P0100-EXIT. DTSBU522 00329 SKIP2 DTSBU522 00330 P0000-EXIT. DTSBU522 00331 EXIT. DTSBU522 00332 SKIP3 DTSBU522 00333 P0010-EMP-NO-BREAK. DTSBU522 00334 MOVE MPRF-EMP-NO TO HOLD-EMP-NO. DTSBU522 00335 DTSBU522 00336 MOVE SPACES TO HOLD-YRQ-AREA. DTSBU522 00337 P0010-EXIT. DTSBU522 00338 EXIT. DTSBU522 00339 EJECT DTSBU522 00340 P0100-RECOMPUTE-INT. DTSBU522 00341 SET L101-WAIVE-INT-NO-88 TO TRUE. DTSBU522 00342 DTSBU522 00343 *****SET L101-WAIVE-PEN-NO-88 TO TRUE. DTSBU522 00344 DTSBU522 00345 MOVE MQTR-TAX-DUE-DATE TO L101-TAX-DUE-DATE. DTSBU522 00346 DTSBU522 00347 *****MOVE +0 TO L101-PEN-CHARGED-AMT. DTSBU522 00348 DTSBU522 00349 MOVE MQTR-INT-AREA TO L101-INT-AREA. DTSBU522 00350 DTSBU522 00351 *****MOVE +0 TO L101-SUBJ10-AMT DTSBU522 00352 *************** L101-SUBJ15-AMT. DTSBU522 00353 DTSBU522 00354 MOVE +0 TO WRK-INT-CHARGED-AMT. DTSBU522 00355 ****************WRK-PEN-CHARGED-AMT. DTSBU522 00356 DTSBU522 00357 DTSBU522 00358 MOVE LOW-VALUES TO MDST-KEY-AREA. DTSBU522 00359 DTSBU522 00360 MOVE MPRF-EMP-NO TO MDST-EMP-NO. DTSBU522 00361 DTSBU522 00362 SET MDST-DST-88 TO TRUE. DTSBU522 00363 DTSBU522 00364 MOVE MQTR-YRQ TO MDST-YRQ. DTSBU522 00365 DTSBU522 00366 MOVE MDST-KEY-AREA TO MSKL-KEY-AREA. DTSBU522 00367 DTSBU522 00368 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBU522 00369 DTSBU522 00370 PERFORM P0131-SCAN-MDST THRU P0131-EXIT DTSBU522 00371 UNTIL L910-NO-REC-88. DTSBU522 00372 DTSBU522 00373 DTSBU522 00374 *****MOVE L101-SUBJ10-AMT TO MQTR-TAX-PAID-SUBJ10-AMT. DTSBU522 00375 DTSBU522 00376 *****MOVE L101-SUBJ15-AMT TO MQTR-TAX-PAID-SUBJ15-AMT. DTSBU522 00377 DTSBU522 00378 IF MQTR-INT-CHARGE-AUTO-88 DTSBU522 00379 PERFORM P1000-CHANGE-INT-CHARGED THRU P1000-EXIT. DTSBU522 00380 DTSBU522 00381 *****IF MQTR-PEN-CHARGE-AUTO-88 DTSBU522 00382 *********PERFORM P2000-CHANGE-PEN-CHARGED THRU P2000-EXIT. DTSBU522 00383 P0100-EXIT. DTSBU522 00384 EXIT. DTSBU522 00385 SKIP3 DTSBU522 00386 P0131-SCAN-MDST. DTSBU522 00387 MOVE MSKL-REC TO MDST-REC. DTSBU522 00388 DTSBU522 00389 IF MDST-YRQ = MQTR-YRQ DTSBU522 00390 NEXT SENTENCE DTSBU522 00391 ELSE DTSBU522 00392 SET L910-NO-REC-88 TO TRUE DTSBU522 00393 GO TO P0131-EXIT. DTSBU522 00394 DTSBU522 00395 PERFORM P0131A-SCAN-ACCT THRU P0131A-EXIT DTSBU522 00396 VARYING MDST-ACCT-IDX FROM 1 BY 1 DTSBU522 00397 UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT. DTSBU522 00398 DTSBU522 00399 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBU522 00400 P0131-EXIT. DTSBU522 00401 EXIT. DTSBU522 00402 SKIP2 DTSBU522 00403 P0131A-SCAN-ACCT. DTSBU522 00404 IF MDST-ACCT-TAX-88 (MDST-ACCT-IDX) DTSBU522 00405 NEXT SENTENCE DTSBU522 00406 ELSE DTSBU522 00407 GO TO P0131A-EXIT. DTSBU522 00408 DTSBU522 00409 IF MDST-ACCT-SUR-88 (MQTR-ACCT-IDX) AND DTSBU522 00410 MDST-YRQ >= L109-FIRST-PEN-INT-YRQ DTSBU522 00411 NEXT SENTENCE DTSBU522 00412 ELSE DTSBU522 00413 GO TO P0131A-EXIT. DTSBU522 00414 DTSBU522 00415 MOVE MDST-AMT (MDST-ACCT-IDX) TO L101-PAID-CHNG. DTSBU522 00416 DTSBU522 00417 MOVE MDST-RECEIVED-DATE TO L101-RECEIVED-DATE. DTSBU522 00418 DTSBU522 00419 IF (L101-TAX-DUE-DATE = +0) DTSBU522 00420 OR DTSBU522 00421 (L101-RECEIVED-DATE = +0) DTSBU522 00422 PERFORM S999-ABEND THRU S999-EXIT. DTSBU522 00423 DTSBU522 00424 PERFORM S101-PER-MONTH-NO THRU S101-EXIT. DTSBU522 00425 DTSBU522 00426 ADD L101-INT-CHARGE-CHNG TO WRK-INT-CHARGED-AMT. DTSBU522 00427 DTSBU522 00428 *****ADD L101-PEN-CHARGE-CHNG TO WRK-PEN-CHARGED-AMT DTSBU522 00429 *********************************L101-PEN-CHARGED-AMT. DTSBU522 00430 DTSBU522 00431 *****ADD L101-SUBJ10-CHNG TO L101-SUBJ10-AMT. DTSBU522 00432 DTSBU522 00433 *****ADD L101-SUBJ15-CHNG TO L101-SUBJ15-AMT. DTSBU522 00434 P0131A-EXIT. DTSBU522 00435 EXIT. DTSBU522 00436 EJECT DTSBU522 00437 P1000-CHANGE-INT-CHARGED. DTSBU522 00438 MOVE +0 TO HOLD-INT-SUB. DTSBU522 00439 DTSBU522 00440 PERFORM DTSBU522 00441 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSBU522 00442 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT DTSBU522 00443 IF MQTR-ACCT-INT-88 (MQTR-ACCT-IDX) DTSBU522 00444 SET HOLD-INT-SUB TO MQTR-ACCT-IDX DTSBU522 00445 END-IF DTSBU522 00446 END-PERFORM. DTSBU522 00447 DTSBU522 00448 IF (HOLD-INT-SUB = +0) DTSBU522 00449 AND DTSBU522 00450 (WRK-INT-CHARGED-AMT = +0) DTSBU522 00451 GO TO P1000-EXIT. DTSBU522 00452 DTSBU522 00453 IF HOLD-INT-SUB = +0 DTSBU522 00454 PERFORM S2200-INIT-ACCT-DATA THRU S2200-EXIT DTSBU522 00455 MOVE MQTR-ACCT-CNT TO HOLD-INT-SUB DTSBU522 00456 SET MQTR-ACCT-INT-88 (HOLD-INT-SUB) TO TRUE. DTSBU522 00457 DTSBU522 00458 COMPUTE L541-AMT DTSBU522 00459 = WRK-INT-CHARGED-AMT - MQTR-CHARGED-AMT (HOLD-INT-SUB). DTSBU522 00460 DTSBU522 00461 IF L541-AMT = +0 DTSBU522 00462 GO TO P1000-EXIT. DTSBU522 00463 DTSBU522 00464 MOVE HOLD-INT-SUB TO L541-ACCT-SUB. DTSBU522 00465 DTSBU522 00466 MOVE CACT-CAT-CHARGED TO L541-CAT-IND. DTSBU522 00467 DTSBU522 00468 PERFORM S541-MODIFY-AMT THRU S541-EXIT. DTSBU522 00469 DTSBU522 00470 MOVE HOLD-INT-SUB TO HOLD-ACCT-SUB. DTSBU522 00471 DTSBU522 00472 PERFORM P3000-NEGATIVE-BALANCE THRU P3000-EXIT. DTSBU522 00473 P1000-EXIT. DTSBU522 00474 EXIT. DTSBU522 00475 EJECT DTSBU522 00476 *P2000-CHANGE-PEN-CHARGED. DTSBU522 00477 *****MOVE +0 TO HOLD-PEN-SUB. DTSBU522 00478 DTSBU522 00479 *****PERFORM DTSBU522 00480 *******VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSBU522 00481 *******UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT DTSBU522 00482 *********IF MQTR-ACCT-PEN-88 (MQTR-ACCT-IDX) DTSBU522 00483 *************SET HOLD-PEN-SUB TO MQTR-ACCT-IDX DTSBU522 00484 *********END-IF DTSBU522 00485 *****END-PERFORM. DTSBU522 00486 DTSBU522 00487 *****IF (HOLD-PEN-SUB = +0) DTSBU522 00488 **********AND DTSBU522 00489 ********(WRK-PEN-CHARGED-AMT = +0) DTSBU522 00490 *********GO TO P2000-EXIT. DTSBU522 00491 DTSBU522 00492 *****IF HOLD-PEN-SUB = +0 DTSBU522 00493 *********PERFORM S2200-INIT-ACCT-DATA THRU S2200-EXIT DTSBU522 00494 *********MOVE MQTR-ACCT-CNT TO HOLD-PEN-SUB DTSBU522 00495 *********SET MQTR-ACCT-PEN-88 (HOLD-PEN-SUB) TO TRUE. DTSBU522 00496 DTSBU522 00497 *****COMPUTE L541-AMT DTSBU522 00498 *******= WRK-PEN-CHARGED-AMT - MQTR-CHARGED-AMT (HOLD-PEN-SUB). DTSBU522 00499 DTSBU522 00500 *****IF L541-AMT = +0 DTSBU522 00501 *********GO TO P2000-EXIT. DTSBU522 00502 DTSBU522 00503 *****MOVE HOLD-PEN-SUB TO L541-ACCT-SUB. DTSBU522 00504 *****MOVE CACT-CAT-CHARGED TO L541-CAT-IND. DTSBU522 00505 *****PERFORM S541-MODIFY-AMT THRU S541-EXIT. DTSBU522 00506 DTSBU522 00507 *****MOVE HOLD-PEN-SUB TO HOLD-ACCT-SUB. DTSBU522 00508 *****PERFORM P3000-NEGATIVE-BALANCE THRU P3000-EXIT. DTSBU522 00509 *P2000-EXIT. DTSBU522 00510 *****EXIT. DTSBU522 00511 EJECT DTSBU522 00512 P3000-NEGATIVE-BALANCE. DTSBU522 00513 IF MQTR-BALANCE-AMT (HOLD-ACCT-SUB) NOT < +0 DTSBU522 00514 GO TO P3000-EXIT. DTSBU522 00515 DTSBU522 00516 IF MQTR-PAID-AMT (HOLD-ACCT-SUB) > +0 DTSBU522 00517 PERFORM P3100-DECR-PAID THRU P3100-EXIT. DTSBU522 00518 DTSBU522 00519 IF MQTR-BALANCE-AMT (HOLD-ACCT-SUB) NOT < +0 DTSBU522 00520 GO TO P3000-EXIT. DTSBU522 00521 DTSBU522 00522 IF MQTR-TOLER-AMT (HOLD-ACCT-SUB) > +0 DTSBU522 00523 PERFORM P3200-DECR-TOLER THRU P3200-EXIT. DTSBU522 00524 DTSBU522 00525 IF MQTR-BALANCE-AMT (HOLD-ACCT-SUB) NOT < +0 DTSBU522 00526 GO TO P3000-EXIT. DTSBU522 00527 DTSBU522 00528 IF MQTR-WAIVED-AMT (HOLD-ACCT-SUB) > +0 DTSBU522 00529 PERFORM P3300-DECR-WAIVED THRU P3300-EXIT. DTSBU522 00530 DTSBU522 00531 IF MQTR-BALANCE-AMT (HOLD-ACCT-SUB) < +0 DTSBU522 00532 PERFORM S999-ABEND THRU S999-EXIT. DTSBU522 00533 P3000-EXIT. DTSBU522 00534 EXIT. DTSBU522 00535 SKIP3 DTSBU522 00536 P3100-DECR-PAID. DTSBU522 00537 COMPUTE PROC-AMT DTSBU522 00538 = MQTR-PAID-AMT (HOLD-ACCT-SUB) * -1. DTSBU522 00539 DTSBU522 00540 IF PROC-AMT < MQTR-BALANCE-AMT (HOLD-ACCT-SUB) DTSBU522 00541 MOVE MQTR-BALANCE-AMT (HOLD-ACCT-SUB) TO PROC-AMT. DTSBU522 00542 DTSBU522 00543 COMPUTE PROC-AMT = PROC-AMT * -1. DTSBU522 00544 DTSBU522 00545 MOVE HOLD-ACCT-SUB TO PROC-ACCT-SUB. DTSBU522 00546 DTSBU522 00547 PERFORM S1000-REVERSE-PAYMENT THRU S1000-EXIT. DTSBU522 00548 P3100-EXIT. DTSBU522 00549 EXIT. DTSBU522 00550 SKIP3 DTSBU522 00551 P3200-DECR-TOLER. DTSBU522 00552 COMPUTE L541-AMT DTSBU522 00553 = MQTR-TOLER-AMT (HOLD-ACCT-SUB) * -1. DTSBU522 00554 DTSBU522 00555 IF L541-AMT < MQTR-BALANCE-AMT (HOLD-ACCT-SUB) DTSBU522 00556 MOVE MQTR-BALANCE-AMT (HOLD-ACCT-SUB) TO L541-AMT. DTSBU522 00557 DTSBU522 00558 MOVE HOLD-ACCT-SUB TO L541-ACCT-SUB. DTSBU522 00559 DTSBU522 00560 MOVE CACT-CAT-TOLER TO L541-CAT-IND. DTSBU522 00561 DTSBU522 00562 PERFORM S541-MODIFY-AMT THRU S541-EXIT. DTSBU522 00563 DTSBU522 00564 *****MOVE MQTR-YRQ TO L004-QTR-5-9. DTSBU522 00565 *****MOVE '1' TO L004-OPTION. DTSBU522 00566 *****PERFORM S004-YRQ THRU S004-EXIT. DTSBU522 00567 *****IF HOLD-YRQ-MSG3-NOT-SENT-88 (L004-ABS-QTR) DTSBU522 00568 *********SET HOLD-YRQ-MSG3-SENT-88 (L004-ABS-QTR) TO TRUE DTSBU522 00569 *********MOVE L004-SLASH-QTR TO MSG3-SLASHED-YRQ DTSBU522 00570 *********MOVE MSG3-ID TO R907-MSG-ID DTSBU522 00571 *********MOVE MSG3-LONG-TEXT TO R907-MSG-TEXT DTSBU522 00572 *********PERFORM S946-R907-WRITE THRU S946-EXIT. DTSBU522 00573 P3200-EXIT. DTSBU522 00574 EXIT. DTSBU522 00575 SKIP3 DTSBU522 00576 P3300-DECR-WAIVED. DTSBU522 00577 COMPUTE L541-AMT DTSBU522 00578 = MQTR-WAIVED-AMT (HOLD-ACCT-SUB) * -1. DTSBU522 00579 DTSBU522 00580 IF L541-AMT < MQTR-BALANCE-AMT (HOLD-ACCT-SUB) DTSBU522 00581 MOVE MQTR-BALANCE-AMT (HOLD-ACCT-SUB) TO L541-AMT. DTSBU522 00582 DTSBU522 00583 MOVE HOLD-ACCT-SUB TO L541-ACCT-SUB. DTSBU522 00584 DTSBU522 00585 MOVE CACT-CAT-WAIVED TO L541-CAT-IND. DTSBU522 00586 DTSBU522 00587 PERFORM S541-MODIFY-AMT THRU S541-EXIT. DTSBU522 00588 DTSBU522 00589 MOVE MQTR-YRQ TO L004-QTR-5-9. DTSBU522 00590 DTSBU522 00591 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBU522 00592 DTSBU522 00593 IF HOLD-YRQ-MSG1-NOT-SENT-88 (L004-ABS-QTR) DTSBU522 00594 SET HOLD-YRQ-MSG1-SENT-88 (L004-ABS-QTR) TO TRUE DTSBU522 00595 MOVE L004-SLASH-QTR TO MSG1-SLASHED-YRQ DTSBU522 00596 MOVE MSG1-ID2 TO R907-MSG-ID DTSBU522 00597 MOVE MSG1-LONG-TEXT TO R907-MSG-TEXT DTSBU522 00598 PERFORM S946-R907-WRITE THRU S946-EXIT. DTSBU522 00599 P3300-EXIT. DTSBU522 00600 EXIT. DTSBU522 00601 EJECT DTSBU522 00602 S1000-REVERSE-PAYMENT. DTSBU522 00603 MOVE MQTR-ACCT-IND (PROC-ACCT-SUB) TO PROC-DSTRB-ACCT-IND. DTSBU522 00604 DTSBU522 00605 MOVE MQTR-YRQ TO PROC-DSTRB-YRQ. DTSBU522 00606 DTSBU522 00607 PERFORM S1100-DSTRB-LOC-PROC THRU S1100-EXIT DTSBU522 00608 UNTIL PROC-AMT NOT > +0. DTSBU522 00609 DTSBU522 00610 IF (MQTR-INT-CHARGE-MANUAL-88) DTSBU522 00611 AND DTSBU522 00612 (MQTR-ACCT-UI-88 (PROC-ACCT-SUB)) DTSBU522 00613 MOVE MQTR-YRQ TO L004-QTR-5-9 DTSBU522 00614 PERFORM S004-FROM-5 THRU S004-EXIT DTSBU522 00615 IF HOLD-YRQ-MSG4-NOT-SENT-88 (L004-ABS-QTR) DTSBU522 00616 SET HOLD-YRQ-MSG4-SENT-88 (L004-ABS-QTR) TO TRUE DTSBU522 00617 MOVE L004-SLASH-QTR TO MSG4-SLASHED-YRQ DTSBU522 00618 MOVE MSG4-ID2 TO R907-MSG-ID DTSBU522 00619 MOVE MSG4-LONG-TEXT TO R907-MSG-TEXT DTSBU522 00620 PERFORM S946-R907-WRITE THRU S946-EXIT. DTSBU522 00621 DTSBU522 00622 *****IF (MQTR-PEN-CHARGE-MANUAL-88) DTSBU522 00623 ************AND DTSBU522 00624 ********(MQTR-ACCT-UI-88 (PROC-ACCT-SUB)) DTSBU522 00625 *********MOVE MQTR-YRQ TO L004-QTR-5-9 DTSBU522 00626 *********PERFORM S004-FROM-5 THRU S004-EXIT DTSBU522 00627 *********IF HOLD-YRQ-MSG5-NOT-SENT-88 (L004-ABS-QTR) DTSBU522 00628 *************SET HOLD-YRQ-MSG5-SENT-88 (L004-ABS-QTR) TO TRUE DTSBU522 00629 *************MOVE L004-SLASH-QTR TO MSG5-SLASHED-YRQ DTSBU522 00630 *************MOVE MSG5-ID2 TO R907-MSG-ID DTSBU522 00631 *************MOVE MSG5-LONG-TEXT TO R907-MSG-TEXT DTSBU522 00632 *************PERFORM S946-R907-WRITE THRU S946-EXIT. DTSBU522 00633 S1000-EXIT. DTSBU522 00634 EXIT. DTSBU522 00635 EJECT DTSBU522 00636 S1100-DSTRB-LOC-PROC. DTSBU522 00637 DTSBU522 00638 *****DISPLAY ' '. DTSBU522 00639 *****DISPLAY 'PROC-DSTRB-YRQ : ' PROC-DSTRB-YRQ. DTSBU522 00640 *****DISPLAY 'PROC-DSTRB-ACCT-IND : ' PROC-DSTRB-ACCT-IND. DTSBU522 00641 DTSBU522 00642 MOVE +0 TO WRK-MDST-RECEIVED-DATE. DTSBU522 00643 DTSBU522 00644 MOVE WRK-NULL-DOC-NO TO WRK-MDST-DOC-NO. DTSBU522 00645 DTSBU522 00646 MOVE +0 TO WRK-DSTRB-SUB. DTSBU522 00647 DTSBU522 00648 DTSBU522 00649 MOVE LOW-VALUES TO MDST-KEY-AREA. DTSBU522 00650 DTSBU522 00651 MOVE MPRF-EMP-NO TO MDST-EMP-NO. DTSBU522 00652 DTSBU522 00653 SET MDST-DST-88 TO TRUE. DTSBU522 00654 DTSBU522 00655 MOVE PROC-DSTRB-YRQ TO MDST-YRQ. DTSBU522 00656 DTSBU522 00657 MOVE MDST-KEY-AREA TO MSKL-KEY-AREA. DTSBU522 00658 DTSBU522 00659 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBU522 00660 DTSBU522 00661 PERFORM S1110-MDST-BROWSE THRU S1110-EXIT DTSBU522 00662 UNTIL L910-NO-REC-88. DTSBU522 00663 DTSBU522 00664 *****DISPLAY 'WRK-MDST-BATCH-NO : ' WRK-MDST-BATCH-NO. DTSBU522 00665 *****DISPLAY 'WRK-MDST-ITEM-NO : ' WRK-MDST-ITEM-NO. DTSBU522 00666 DTSBU522 00667 IF WRK-MDST-DOC-NO = WRK-NULL-DOC-NO DTSBU522 00668 PERFORM S1120-LOST-PAYMENT THRU S1120-EXIT DTSBU522 00669 ELSE DTSBU522 00670 PERFORM S1130-MDST-PROCESS THRU S1130-EXIT. DTSBU522 00671 S1100-EXIT. DTSBU522 00672 EXIT. DTSBU522 00673 EJECT DTSBU522 00674 S1110-MDST-BROWSE. DTSBU522 00675 MOVE MSKL-REC TO MDST-REC. DTSBU522 00676 DTSBU522 00677 *****DISPLAY 'MDST-BATCH-NO : ' MDST-BATCH-NO. DTSBU522 00678 *****DISPLAY 'MDST-ITEM-NO : ' MDST-ITEM-NO. DTSBU522 00679 DTSBU522 00680 IF MDST-YRQ = PROC-DSTRB-YRQ DTSBU522 00681 NEXT SENTENCE DTSBU522 00682 ELSE DTSBU522 00683 SET L910-NO-REC-88 TO TRUE DTSBU522 00684 GO TO S1110-EXIT. DTSBU522 00685 DTSBU522 00686 IF MDST-RECEIVED-DATE NOT < WRK-MDST-RECEIVED-DATE DTSBU522 00687 PERFORM S1111-MDST-SEARCH THRU S1111-EXIT DTSBU522 00688 VARYING MDST-ACCT-IDX FROM 1 BY 1 DTSBU522 00689 UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT. DTSBU522 00690 DTSBU522 00691 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBU522 00692 S1110-EXIT. DTSBU522 00693 EXIT. DTSBU522 00694 SKIP3 DTSBU522 00695 S1111-MDST-SEARCH. DTSBU522 00696 IF MDST-ACCT-IND (MDST-ACCT-IDX) = PROC-DSTRB-ACCT-IND DTSBU522 00697 MOVE MDST-RECEIVED-DATE TO WRK-MDST-RECEIVED-DATE DTSBU522 00698 MOVE MDST-DOC-NO TO WRK-MDST-DOC-NO DTSBU522 00699 SET WRK-DSTRB-SUB TO MDST-ACCT-IDX. DTSBU522 00700 S1111-EXIT. DTSBU522 00701 EXIT. DTSBU522 00702 EJECT DTSBU522 00703 S1120-LOST-PAYMENT. DTSBU522 00704 MOVE PROC-DSTRB-YRQ TO L004-QTR-5-9. DTSBU522 00705 DTSBU522 00706 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBU522 00707 DTSBU522 00708 MOVE L004-SLASH-QTR TO MSG3-SLASHED-YRQ. DTSBU522 00709 DTSBU522 00710 MOVE PROC-DSTRB-ACCT-IND TO MSG3-ACCT-IND. DTSBU522 00711 DTSBU522 00712 MOVE PROC-AMT TO MSG3-AMT. DTSBU522 00713 DTSBU522 00714 MOVE MSG3-ID2 TO R907-MSG-ID. DTSBU522 00715 DTSBU522 00716 MOVE MSG3-LONG-TEXT TO R907-MSG-TEXT. DTSBU522 00717 DTSBU522 00718 PERFORM S946-R907-WRITE THRU S946-EXIT. DTSBU522 00719 DTSBU522 00720 DTSBU522 00721 COMPUTE L549-DELTA-AMT = PROC-AMT * -1. DTSBU522 00722 DTSBU522 00723 PERFORM S2100-UPDATE-MQTR THRU S2100-EXIT. DTSBU522 00724 DTSBU522 00725 MOVE +0 TO PROC-AMT. DTSBU522 00726 S1120-EXIT. DTSBU522 00727 EXIT. DTSBU522 00728 EJECT DTSBU522 00729 S1130-MDST-PROCESS. DTSBU522 00730 MOVE LOW-VALUES TO MDST-KEY-AREA. DTSBU522 00731 DTSBU522 00732 MOVE MPRF-EMP-NO TO MDST-EMP-NO. DTSBU522 00733 DTSBU522 00734 SET MDST-DST-88 TO TRUE. DTSBU522 00735 DTSBU522 00736 MOVE PROC-DSTRB-YRQ TO MDST-YRQ. DTSBU522 00737 DTSBU522 00738 MOVE WRK-MDST-DOC-NO TO MDST-DOC-NO. DTSBU522 00739 DTSBU522 00740 MOVE MDST-KEY-AREA TO MSKL-KEY-AREA. DTSBU522 00741 DTSBU522 00742 PERFORM S910-READ THRU S910-EXIT. DTSBU522 00743 DTSBU522 00744 IF L910-NO-REC-88 DTSBU522 00745 PERFORM S999-ABEND THRU S999-EXIT. DTSBU522 00746 DTSBU522 00747 MOVE MSKL-REC TO MDST-REC. DTSBU522 00748 DTSBU522 00749 PERFORM S1131-MDST-UPDATE THRU S1131-EXIT. DTSBU522 00750 S1130-EXIT. DTSBU522 00751 EXIT. DTSBU522 00752 SKIP3 DTSBU522 00753 S1131-MDST-UPDATE. DTSBU522 00754 IF MDST-AMT (WRK-DSTRB-SUB) > PROC-AMT DTSBU522 00755 MOVE PROC-AMT TO L549-DELTA-AMT DTSBU522 00756 ELSE DTSBU522 00757 MOVE MDST-AMT (WRK-DSTRB-SUB) TO L549-DELTA-AMT. DTSBU522 00758 DTSBU522 00759 COMPUTE PROC-AMT = PROC-AMT - L549-DELTA-AMT. DTSBU522 00760 DTSBU522 00761 COMPUTE L549-DELTA-AMT = L549-DELTA-AMT * -1. DTSBU522 00762 DTSBU522 00763 PERFORM S2100-UPDATE-MQTR THRU S2100-EXIT. DTSBU522 00764 DTSBU522 00765 PERFORM S1132-UPDATE-MDST THRU S1132-EXIT. DTSBU522 00766 DTSBU522 00767 PERFORM S1133-ESTB-CREDIT-DSTRB THRU S1133-EXIT. DTSBU522 00768 S1131-EXIT. DTSBU522 00769 EXIT. DTSBU522 00770 SKIP3 DTSBU522 00771 S1132-UPDATE-MDST. DTSBU522 00772 MOVE L549-DELTA-AMT TO L542-AMT. DTSBU522 00773 DTSBU522 00774 MOVE PROC-DSTRB-ACCT-IND TO L542-ACCT-IND. DTSBU522 00775 DTSBU522 00776 PERFORM S542-MDST-MAINTENANCE THRU S542-EXIT. DTSBU522 00777 DTSBU522 00778 MOVE MDST-REC TO MSKL-REC. DTSBU522 00779 DTSBU522 00780 IF MDST-ACCT-CNT = +0 DTSBU522 00781 PERFORM S910-DELETE THRU S910-EXIT DTSBU522 00782 ELSE DTSBU522 00783 PERFORM S910-REWRITE THRU S910-EXIT. DTSBU522 00784 S1132-EXIT. DTSBU522 00785 EXIT. DTSBU522 00786 SKIP3 DTSBU522 00787 S1133-ESTB-CREDIT-DSTRB. DTSBU522 00788 COMPUTE L542-AMT = L549-DELTA-AMT * -1. DTSBU522 00789 DTSBU522 00790 MOVE CACT-CR-AVAIL TO L542-ACCT-IND. DTSBU522 00791 DTSBU522 00792 SET MDST-CREDIT-REC-88 TO TRUE. DTSBU522 00793 DTSBU522 00794 MOVE MDST-KEY-AREA TO MSKL-KEY-AREA. DTSBU522 00795 DTSBU522 00796 PERFORM S910-READ THRU S910-EXIT. DTSBU522 00797 DTSBU522 00798 IF L910-NO-REC-88 DTSBU522 00799 PERFORM S1134-ADD-MDST THRU S1134-EXIT DTSBU522 00800 ELSE DTSBU522 00801 PERFORM S1135-MODIFY-MDST THRU S1135-EXIT. DTSBU522 00802 S1133-EXIT. DTSBU522 00803 EXIT. DTSBU522 00804 SKIP3 DTSBU522 00805 S1134-ADD-MDST. DTSBU522 00806 MOVE +0 TO MDST-PURGE-DATE. DTSBU522 00807 DTSBU522 00808 MOVE LOW-VALUES TO MDST-DATA-AREA. DTSBU522 00809 DTSBU522 00810 MOVE WRK-MDST-RECEIVED-DATE TO MDST-RECEIVED-DATE. DTSBU522 00811 DTSBU522 00812 SET MDST-NOT-CONVERTED-88 TO TRUE. DTSBU522 00813 DTSBU522 00814 MOVE LBCM-CURR-RUN-DATE TO MDST-ESTB-DATE DTSBU522 00815 MDST-CHNG-DATE. DTSBU522 00816 DTSBU522 00817 MOVE +0 TO MDST-ACCT-CNT. DTSBU522 00818 DTSBU522 00819 PERFORM S542-MDST-MAINTENANCE THRU S542-EXIT. DTSBU522 00820 DTSBU522 00821 *****PERFORM S1136-MDST-TOL-CHECK THRU S1136-EXIT. DTSBU522 00822 DTSBU522 00823 MOVE MDST-REC TO MSKL-REC. DTSBU522 00824 DTSBU522 00825 PERFORM S910-WRITE THRU S910-EXIT. DTSBU522 00826 S1134-EXIT. DTSBU522 00827 EXIT. DTSBU522 00828 SKIP3 DTSBU522 00829 S1135-MODIFY-MDST. DTSBU522 00830 MOVE MSKL-REC TO MDST-REC. DTSBU522 00831 DTSBU522 00832 PERFORM S542-MDST-MAINTENANCE THRU S542-EXIT. DTSBU522 00833 DTSBU522 00834 *****PERFORM S1136-MDST-TOL-CHECK THRU S1136-EXIT. DTSBU522 00835 DTSBU522 00836 MOVE MDST-REC TO MSKL-REC. DTSBU522 00837 DTSBU522 00838 PERFORM S910-REWRITE THRU S910-EXIT. DTSBU522 00839 S1135-EXIT. DTSBU522 00840 EXIT. DTSBU522 00841 SKIP3 DTSBU522 00842 *S1136-MDST-TOL-CHECK. DTSBU522 00843 *****PERFORM S1137-MDST-ACCT THRU S1137-EXIT DTSBU522 00844 *********VARYING MDST-ACCT-IDX FROM 1 BY 1 DTSBU522 00845 *********UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT. DTSBU522 00846 *S1136-EXIT. DTSBU522 00847 *****EXIT. DTSBU522 00848 SKIP3 DTSBU522 00849 *S1137-MDST-ACCT. DTSBU522 00850 *****IF MDST-ACCT-CR-AVAIL-88 (MDST-ACCT-IDX) DTSBU522 00851 *********NEXT SENTENCE DTSBU522 00852 *****ELSE DTSBU522 00853 ******** GO TO S1137-EXIT. DTSBU522 00854 DTSBU522 00855 *****IF (MDST-AMT (MDST-ACCT-IDX) = +0) DTSBU522 00856 ***********OR DTSBU522 00857 ********(MDST-AMT (MDST-ACCT-IDX) > LBCM-CR-TOL-MAX) DTSBU522 00858 *********NEXT SENTENCE DTSBU522 00859 *****ELSE DTSBU522 00860 *********PERFORM S590-CR-TOL THRU S590-EXIT. DTSBU522 00861 *S1137-EXIT. DTSBU522 00862 *****EXIT. DTSBU522 00863 EJECT DTSBU522 00864 S2100-UPDATE-MQTR. DTSBU522 00865 COMPUTE MPRF-TOT-BALANCE-AMT DTSBU522 00866 = MPRF-TOT-BALANCE-AMT - L549-DELTA-AMT. DTSBU522 00867 DTSBU522 00868 COMPUTE MQTR-BALANCE-AMT (PROC-ACCT-SUB) DTSBU522 00869 = MQTR-BALANCE-AMT (PROC-ACCT-SUB) - L549-DELTA-AMT. DTSBU522 00870 DTSBU522 00871 COMPUTE MQTR-PAID-AMT (PROC-ACCT-SUB) DTSBU522 00872 = MQTR-PAID-AMT (PROC-ACCT-SUB) + L549-DELTA-AMT. DTSBU522 00873 DTSBU522 00874 MOVE LBCM-CURR-RUN-DATE TO MQTR-CHNG-DATE. DTSBU522 00875 DTSBU522 00876 DTSBU522 00877 MOVE PROC-DSTRB-YRQ TO L549-DELTA-YRQ. DTSBU522 00878 DTSBU522 00879 MOVE PROC-DSTRB-ACCT-IND TO L549-DELTA-ACCT-IND. DTSBU522 00880 DTSBU522 00881 MOVE CACT-CAT-PAID TO L549-DELTA-CAT-IND. DTSBU522 00882 DTSBU522 00883 PERFORM S549-MJRN-TABLE THRU S549-EXIT. DTSBU522 00884 S2100-EXIT. DTSBU522 00885 EXIT. DTSBU522 00886 EJECT DTSBU522 00887 S2200-INIT-ACCT-DATA. DTSBU522 00888 IF MQTR-ACCT-CNT NOT < MMAX-QTR-ACCT-MAX DTSBU522 00889 PERFORM S999-ABEND THRU S999-EXIT. DTSBU522 00890 DTSBU522 00891 ADD +1 TO MQTR-ACCT-CNT. DTSBU522 00892 DTSBU522 00893 MOVE SPACE TO MQTR-ACCT-IND (MQTR-ACCT-CNT). DTSBU522 00894 DTSBU522 00895 MOVE +0 TO MQTR-CHARGED-AMT (MQTR-ACCT-CNT) DTSBU522 00896 MQTR-PAID-AMT (MQTR-ACCT-CNT) DTSBU522 00897 MQTR-WAIVED-AMT (MQTR-ACCT-CNT) DTSBU522 00898 MQTR-WRITTEN-OFF-AMT (MQTR-ACCT-CNT) DTSBU522 00899 MQTR-TOLER-AMT (MQTR-ACCT-CNT) DTSBU522 00900 MQTR-BALANCE-AMT (MQTR-ACCT-CNT). DTSBU522 00901 S2200-EXIT. DTSBU522 00902 EXIT. DTSBU522 00903 EJECT DTSBU522 00904 S004-FROM-5. DTSBU522 00905 SET L004-FROM-5 TO TRUE. DTSBU522 00906 GO TO S004-QTR. DTSBU522 00907 DTSBU522 00908 S004-QTR. DTSBU522 00909 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBU522 00910 DTSBU522 00911 IF (L004-ABS-QTR < +1) DTSBU522 00912 OR DTSBU522 00913 (L004-ABS-QTR > +400) DTSBU522 00914 MOVE +1 TO L004-ABS-QTR. DTSBU522 00915 S004-EXIT. DTSBU522 00916 EXIT. DTSBU522 00917 SKIP3 DTSBU522 00918 S101-PER-MONTH-NO. DTSBU522 00919 SET L101-PER-MONTH-NO-88 TO TRUE. DTSBU522 00920 GO TO S101-INT-CALC. DTSBU522 00921 DTSBU522 00922 S101-INT-CALC. DTSBU522 00923 CALL 'DTSBU101' USING L101-LINK-AREA. DTSBU522 00924 S101-EXIT. DTSBU522 00925 EXIT. DTSBU522 00926 SKIP3 DTSBU522 00927 S109-FIRST-PEN-INT-YRQ. DTSBU522 00928 SET L109-CMND-PEN-INT-QTR-88 TO TRUE. DTSBU522 00929 CALL 'DTSBU109' USING L109-LINK-AREA. DTSBU522 00930 S109-EXIT. DTSBU522 00931 EXIT. DTSBU522 00932 SKIP3 DTSBU522 00933 S541-MODIFY-AMT. DTSBU522 00934 MOVE LBCM-TRN-DOC-NO TO L541-TRN-DOC-NO. DTSBU522 00935 DTSBU522 00936 CALL 'DTSBU541' USING L541-LINK-AREA DTSBU522 00937 MPRF-REC DTSBU522 00938 MQTR-REC. DTSBU522 00939 S541-EXIT. DTSBU522 00940 EXIT. DTSBU522 00941 SKIP3 DTSBU522 00942 S542-MDST-MAINTENANCE. DTSBU522 00943 MOVE LBCM-TRN-DOC-NO TO L542-TRN-DOC-NO. DTSBU522 00944 DTSBU522 00945 CALL 'DTSBU542' USING L542-LINK-AREA DTSBU522 00946 MPRF-REC DTSBU522 00947 MDST-REC. DTSBU522 00948 S542-EXIT. DTSBU522 00949 EXIT. DTSBU522 00950 SKIP3 DTSBU522 00951 S549-MJRN-TABLE. DTSBU522 00952 MOVE LBCM-TRN-DOC-NO TO L549-TRN-DOC-NO. DTSBU522 00953 DTSBU522 00954 SET L549-DELTA-88 TO TRUE. DTSBU522 00955 DTSBU522 00956 CALL 'DTSBU549' USING L549-LINK-AREA. DTSBU522 00957 S549-EXIT. DTSBU522 00958 EXIT. DTSBU522 00959 SKIP3 DTSBU522 00960 *S590-CR-TOL. DTSBU522 00961 *****SET L590-CR-TOL-88 TO TRUE. DTSBU522 00962 *****MOVE +0 TO L590-YRQ. DTSBU522 00963 *****MOVE MDST-DOC-NO TO L590-PAY-DOC-NO. DTSBU522 00964 *****MOVE LBCM-TRN-DOC-NO TO L590-TOL-DOC-NO. DTSBU522 00965 *****GO TO S590-EMP-CLEANUP. DTSBU522 00966 DTSBU522 00967 *S590-EMP-CLEANUP. DTSBU522 00968 *****CALL 'DTSBU590' USING L590-LINK-AREA DTSBU522 00969 ***************************LBCM-LINK-AREA DTSBU522 00970 ***************************MPRF-REC. DTSBU522 00971 *S590-EXIT. DTSBU522 00972 *****EXIT. DTSBU522 00973 SKIP3 DTSBU522 00974 S910-READ. DTSBU522 00975 SET L910-READ-88 TO TRUE. DTSBU522 00976 GO TO S910-MSTR-IO. DTSBU522 00977 DTSBU522 00978 S910-START-BROWSE. DTSBU522 00979 SET L910-START-BROWSE-88 TO TRUE. DTSBU522 00980 GO TO S910-MSTR-IO. DTSBU522 00981 DTSBU522 00982 S910-READ-NEXT. DTSBU522 00983 SET L910-READ-NEXT-88 TO TRUE. DTSBU522 00984 GO TO S910-MSTR-IO. DTSBU522 00985 DTSBU522 00986 *S910-COUNT. DTSBU522 00987 *****SET L910-COUNT-88 TO TRUE. DTSBU522 00988 *****GO TO S910-MSTR-IO. DTSBU522 00989 DTSBU522 00990 S910-WRITE. DTSBU522 00991 SET LBCM-EMP-UPDATE-YES-88 TO TRUE. DTSBU522 00992 SET L910-WRITE-88 TO TRUE. DTSBU522 00993 GO TO S910-MSTR-IO. DTSBU522 00994 DTSBU522 00995 S910-REWRITE. DTSBU522 00996 SET LBCM-EMP-UPDATE-YES-88 TO TRUE. DTSBU522 00997 SET L910-REWRITE-88 TO TRUE. DTSBU522 00998 GO TO S910-MSTR-IO. DTSBU522 00999 DTSBU522 01000 S910-DELETE. DTSBU522 01001 SET LBCM-EMP-UPDATE-YES-88 TO TRUE. DTSBU522 01002 SET L910-DELETE-88 TO TRUE. DTSBU522 01003 GO TO S910-MSTR-IO. DTSBU522 01004 DTSBU522 01005 S910-MSTR-IO. DTSBU522 01006 CALL 'DTSBU910' USING L910-LINK-AREA DTSBU522 01007 MSKL-REC. DTSBU522 01008 S910-EXIT. DTSBU522 01009 EXIT. DTSBU522 01010 SKIP3 DTSBU522 01011 S946-R907-WRITE. DTSBU522 01012 CALL 'DTSBU946' USING R907-REC. DTSBU522 01013 S946-EXIT. DTSBU522 01014 EXIT. DTSBU522 01015 SKIP3 DTSBU522 01016 S999-ABEND. DTSBU522 01017 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBU522 01018 S999-EXIT. DTSBU522 01019 EXIT. DTSBU522