Files
DUTAS/Batch/DTSBU522.cob
2025-07-21 11:20:11 -04:00

1021 lines
81 KiB
COBOL

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