00001 IDENTIFICATION DIVISION. 10/01/15 00002 PROGRAM-ID. DTSBU590. DTSBU590 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV016 00004 DATE-WRITTEN. JULY 1994. DTSBU590 00005 DATE-COMPILED. DTSBU590 00006 SKIP3 DTSBU590 00007 ***** DTSBU590 00008 * DTSBU590 00009 * FUNCTION: EMPLOYER UPDATE CLEANUP PROCESSING. DTSBU590 00010 * DTSBU590 00011 * DTSBU590 00012 * MODIFICATION LOG: DTSBU590 00013 * DTSBU590 00014 * 07/12/94 INITIAL DEVELOPMENT. DTSBU590 00015 * WORK ORDER: PROGRAMMER: TCL DTSBU590 00016 * DTSBU590 00017 * 04/25/95 BYPASS R425R2 WHEN MPRF-FLD-LIST-REMOVE-88. DTSBU590 00018 * WORK ORDER: CR082 PROGRAMMER: RHC DTSBU590 00019 * DTSBU590 00020 * 05/13/95 FOR REIMBURSING EMPLOYERS, INCLUDE ONLY AFT DTSBU590 00021 * BALANCES DUE ON THE INCREASES IN TOTAL BALANCES DTSBU590 00022 * DUE LIST. DTSBU590 00023 * WORK ORDER: CR084 PROGRAMMER: EHH DTSBU590 00024 * DTSBU590 00025 * 06/12/95 ADD BATCH NUMBERS TO R424R1. DTSBU590 00026 * WORK ORDER: CR095 PROGRAMMER: RHC DTSBU590 00027 * DTSBU590 00028 * 06/13/95 ACCUMULATE CREDIT TOLERANCE BY EMPLOYER. DTSBU590 00029 * WORK ORDER: CR094 PROGRAMMER: RHC DTSBU590 00030 * DTSBU590 00031 * 10/14/1998 REVIEWED AND MODIFIED FOR DC. DTSBU590 00032 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH DTSBU590 00033 * DTSBU590 00034 * 02/14/2006 MODIFIED P9110 AND P9120 TO EXCLUDE DTSBU590 00035 * ADMINISTRATIVE ASSESSMENT FROM TOLERANCE, WITH DTSBU590 00036 * ONE EXCEPTION - TOLERATE A ROUNDING ERROR OF DTSBU590 00037 * ONE PENNY. DTSBU590 00038 * REFERENCE: 2006 SUR-TAX PROGRAMMER: GD DTSBU590 00039 * DTSBU590 00040 * 10/29/2008 MODIFIED P9110 AND P9120 TO TOLERATE DTSBU590 00041 * ADMINISTRATIVE ASSESSMENT AMOUNTS OF LESS DTSBU590 00042 * THAN $1.00. DTSBU590 00043 * REFERENCE: DIR 119 PROGRAMMER: GD DTSBU590 00044 * DTSBU590 00045 * DTSBU590 00046 * 09/24/2015 MODIFIED P9110 AND P9120 TO NOT TOLERATE ANY DTSBU590 00047 * ADMINISTRATIVE ASSESSMENT AMOUNTS. DTSBU590 00048 * REFERENCE: TOLERANCE PROGRAMMER: ZL1 DTSBU590 00049 * DTSBU590 00050 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU590 00051 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU590 00052 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBU590 00053 * DTSBU590 00054 * DTSBU590 00055 * DESCRIPTION: DTSBU590 00056 * DTSBU590 00057 * AFTER ALL TRANSACTIONS FOR A GIVEN EMPLOYER HAVE BEEN DTSBU590 00058 * PROCESSED DTSBU590 IS CALLED. DTSBU590 00059 * DTSBU590 00060 * DTSBU590 PERFORMS ANY EMPLOYER CLEANUP PROCESSING DTSBU590 00061 * NECESSARY. DTSBU590 00062 * DTSBU590 00063 * DTSBU590 00064 * MASTER FILE RECORDS READ: DTSBU590 00065 * DTSBU590 00066 * MQTR DTSBU590 00067 * MRPT DTSBU590 00068 * MPAY DTSBU590 00069 * MADJ DTSBU590 00070 * MDST DTSBU590 00071 * DTSBU590 00072 * DTSBU590 00073 * MASTER FILE RECORDS UPDATED: DTSBU590 00074 * DTSBU590 00075 * MQTR (REWRITE) DTSBU590 00076 * MDST (WRITE, REWRITE) DTSBU590 00077 * DTSBU590 00078 * DTSBU590 00079 * REPORT RECORDS WRITTEN: DTSBU590 00080 * DTSBU590 00081 * NONE DTSBU590 00082 * DTSBU590 00083 * DTSBU590 00084 * MODULES CALLED: DTSBU590 00085 * DTSBU590 00086 * DTSBU910 MASTER FILE I/O DRIVER. DTSBU590 00087 * DTSBU590 00088 * DTSBU590 00089 ***** DTSBU590 00090 SKIP3 DTSBU590 00091 ENVIRONMENT DIVISION. DTSBU590 00092 EJECT DTSBU590 00093 DATA DIVISION. DTSBU590 00094 SKIP3 DTSBU590 00095 WORKING-STORAGE SECTION. DTSBU590 000955 77 PAN-VALET PICTURE X(24) VALUE '016DTSBU590 10/01/15'. DTSBU590 00096 77 PAN-VALET PICTURE X(24) VALUE '003DTSBU590 10/01/15'. DTSBU590 00097 77 PAN-VALET PICTURE X(24) VALUE '014DTSBU590 10/29/08'. DTSBU590 00098 SKIP3 DTSBU590 00099 01 WRK-AREA. DTSBU590 00100 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +590.DTSBU590 00101 DTSBU590 00102 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBU590'.DTSBU590 00103 DTSBU590 00104 05 ENTRY-FOUND-IND PIC X(01). DTSBU590 00105 DTSBU590 00106 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBU590 00107 DTSBU590 00108 05 WRK-NULL-DOC-NO. DTSBU590 00109 10 WRK-NULL-BATCH-NO PIC S9(05) COMP-3. DTSBU590 00110 10 WRK-NULL-ITEM-NO PIC S9(03) COMP-3. DTSBU590 00111 DTSBU590 00112 05 WRK-TOL-DOC-NO PIC X(05). DTSBU590 00113 DTSBU590 00114 05 WRK-BALANCE-AMT PIC S9(09)V9(02) COMP-3. DTSBU590 00115 DTSBU590 00116 05 WRK-SUR-BAL-AMT PIC S9(09)V9(02) COMP-3. DTSBU590 00117 DTSBU590 00118 05 WRK-AVAILABLE-AMT PIC S9(09)V9(02) COMP-3. DTSBU590 00119 DTSBU590 00120 05 RPT-FOUND-IND PIC X(01). DTSBU590 00121 DTSBU590 00122 05 R424-BALANCE-AMT PIC S9(09)V9(02) COMP-3. DTSBU590 00123 DTSBU590 00124 05 WRK-COLLECT-SUR-IND PIC X(01). DTSBU590 00125 88 WRK-COLLECT-SUR-YES-88 VALUE 'Y'. DTSBU590 00126 88 WRK-COLLECT-SUR-NO-88 VALUE 'N'. DTSBU590 00127 DTSBU590 00128 05 AMT-DISP1 PIC ---,---,--9.99. DTSBU590 00129 05 AMT-DISP2 PIC ---,---,--9.99. DTSBU590 00130 EJECT DTSBU590 00131 01 QTR-TOL-AREA. DTSBU590 00132 05 QTR-TOL-CNT PIC S9(04) COMP. DTSBU590 00133 05 QTR-TOL-ENTRY OCCURS 400 TIMES DTSBU590 00134 INDEXED BY QTR-TOL-IDX. DTSBU590 00135 10 QTR-TOL-YRQ PIC S9(05) COMP-3. DTSBU590 00136 10 QTR-TOL-DOC-NO PIC X(05). DTSBU590 00137 SKIP3 DTSBU590 00138 01 ORIG-RPT-AREA. DTSBU590 00139 05 ORIG-RPT-CNT PIC S9(04) COMP. DTSBU590 00140 05 ORIG-RPT-ENTRY OCCURS 400 TIMES DTSBU590 00141 INDEXED BY ORIG-RPT-IDX. DTSBU590 00142 10 ORIG-RPT-YRQ PIC S9(05) COMP-3. DTSBU590 00143 SKIP3 DTSBU590 00144 01 TOT-BALANCE-AREA. DTSBU590 00145 05 INIT-TOT-BALANCE-AMT PIC S9(09)V9(02) COMP-3. DTSBU590 00146 SKIP3 DTSBU590 00147 01 PURSUED-AREA. DTSBU590 00148 05 PURSUED-CNT PIC S9(04) COMP. DTSBU590 00149 05 PURSUED-ENTRY OCCURS 400 TIMES DTSBU590 00150 INDEXED BY PURSUED-IDX. DTSBU590 00151 10 PURSUED-YRQ PIC S9(05) COMP-3. DTSBU590 00152 EJECT DTSBU590 00153 01 L061-LINK-AREA. DTSBU590 00154 ++INCLUDE DTSIL061 DTSBU590 00155 EJECT DTSBU590 00156 01 L541-LINK-AREA. DTSBU590 00157 ++INCLUDE DTSIL541 DTSBU590 00158 EJECT DTSBU590 00159 01 L542-LINK-AREA. DTSBU590 00160 ++INCLUDE DTSIL542 DTSBU590 00161 EJECT DTSBU590 00162 01 L549-LINK-AREA. DTSBU590 00163 ++INCLUDE DTSIL549 DTSBU590 00164 EJECT DTSBU590 00165 01 L910-LINK-AREA. DTSBU590 00166 ++INCLUDE DTSIL910 DTSBU590 00167 SKIP3 DTSBU590 00168 01 MSKL-REC. DTSBU590 00169 ++INCLUDE DTSIMSKL DTSBU590 00170 SKIP3 DTSBU590 00171 01 MQTR-REC. DTSBU590 00172 ++INCLUDE DTSIMQTR DTSBU590 00173 EJECT DTSBU590 00174 01 MRPT-REC. DTSBU590 00175 ++INCLUDE DTSIMRPT DTSBU590 00176 EJECT DTSBU590 00177 01 MPAY-REC. DTSBU590 00178 ++INCLUDE DTSIMPAY DTSBU590 00179 EJECT DTSBU590 00180 01 MADJ-REC. DTSBU590 00181 ++INCLUDE DTSIMADJ DTSBU590 00182 EJECT DTSBU590 00183 01 MDST-REC. DTSBU590 00184 ++INCLUDE DTSIMDST DTSBU590 00185 EJECT DTSBU590 00186 01 RSKL-REC. DTSBU590 00187 ++INCLUDE DTSIRSK1 DTSBU590 00188 EJECT DTSBU590 00189 01 R424-REC. DTSBU590 00190 ++INCLUDE DTSIR424 DTSBU590 00191 EJECT DTSBU590 00192 01 R425-REC. DTSBU590 00193 ++INCLUDE DTSIR425 DTSBU590 00194 EJECT DTSBU590 00195 01 R907-REC. DTSBU590 00196 ++INCLUDE DTSIR907 DTSBU590 00197 EJECT DTSBU590 00198 01 CACT-LITERALS. DTSBU590 00199 ++INCLUDE DTSICACT DTSBU590 00200 EJECT DTSBU590 00201 LINKAGE SECTION. DTSBU590 00202 SKIP3 DTSBU590 00203 01 L590-LINK-AREA. DTSBU590 00204 ++INCLUDE DTSIL590 DTSBU590 00205 EJECT DTSBU590 00206 01 LBCM-LINK-AREA. DTSBU590 00207 ++INCLUDE DTSILBCM DTSBU590 00208 EJECT DTSBU590 00209 01 MPRF-REC. DTSBU590 00210 ++INCLUDE DTSIMPRF DTSBU590 00211 EJECT DTSBU590 00212 PROCEDURE DIVISION USING L590-LINK-AREA DTSBU590 00213 LBCM-LINK-AREA DTSBU590 00214 MPRF-REC. DTSBU590 00215 DTSBU590 00216 DTSBU590 00217 IF FIRST-TIME-IND = 'Y' DTSBU590 00218 PERFORM I0000-FIRST-TIME THRU I0000-EXIT DTSBU590 00219 MOVE 'N' TO FIRST-TIME-IND. DTSBU590 00220 DTSBU590 00221 IF L590-INITIATE-88 DTSBU590 00222 PERFORM P1000-INITIATE THRU P1000-EXIT DTSBU590 00223 ELSE DTSBU590 00224 IF L590-QTR-TOL-88 DTSBU590 00225 PERFORM P2000-QTR-TOL THRU P2000-EXIT DTSBU590 00226 ELSE DTSBU590 00227 IF L590-ORIG-RPT-88 DTSBU590 00228 PERFORM P4000-ORIG-RPT THRU P4000-EXIT DTSBU590 00229 ELSE DTSBU590 00230 IF L590-QTR-PURSUED-88 DTSBU590 00231 PERFORM P5000-QTR-PURSUED THRU P5000-EXIT DTSBU590 00232 ELSE DTSBU590 00233 IF L590-TERMINATE-88 DTSBU590 00234 PERFORM P9000-TERMINATE THRU P9000-EXIT DTSBU590 00235 ELSE DTSBU590 00236 PERFORM S999-ABEND THRU S999-EXIT. DTSBU590 00237 DTSBU590 00238 DTSBU590 00239 GOBACK. DTSBU590 00240 EJECT DTSBU590 00241 I0000-FIRST-TIME. DTSBU590 00242 MOVE +0 TO WRK-NULL-BATCH-NO DTSBU590 00243 WRK-NULL-ITEM-NO. DTSBU590 00244 DTSBU590 00245 MOVE WRK-MOD-NAME TO L910-MOD-NAME DTSBU590 00246 R907-MODULE-NAME. DTSBU590 00247 DTSBU590 00248 MOVE LBCM-TRACE-IND TO L910-TRACE-IND. DTSBU590 00249 DTSBU590 00250 MOVE LENGTH OF R424-REC TO R424-LENGTH. DTSBU590 00251 DTSBU590 00252 MOVE LENGTH OF R425-REC TO R425-LENGTH. DTSBU590 00253 DTSBU590 00254 MOVE LENGTH OF R907-REC TO R907-LENGTH. DTSBU590 00255 I0000-EXIT. DTSBU590 00256 EXIT. DTSBU590 00257 EJECT DTSBU590 00258 P1000-INITIATE. DTSBU590 00259 MOVE +0 TO QTR-TOL-CNT DTSBU590 00260 ORIG-RPT-CNT DTSBU590 00261 PURSUED-CNT. DTSBU590 00262 DTSBU590 00263 IF MPRF-CLASS-SELF-INS-88 DTSBU590 00264 MOVE +0 TO R424-BALANCE-AMT DTSBU590 00265 PERFORM S2100-SELF-INS-BALANCE-AMT THRU S2100-EXIT DTSBU590 00266 MOVE R424-BALANCE-AMT TO INIT-TOT-BALANCE-AMT DTSBU590 00267 ELSE DTSBU590 00268 MOVE MPRF-TOT-BALANCE-AMT TO INIT-TOT-BALANCE-AMT. DTSBU590 00269 P1000-EXIT. DTSBU590 00270 EXIT. DTSBU590 00271 EJECT DTSBU590 00272 P2000-QTR-TOL. DTSBU590 00273 MOVE 'N' TO ENTRY-FOUND-IND. DTSBU590 00274 DTSBU590 00275 PERFORM P2100-QTR-TOL-LOOP THRU P2100-EXIT DTSBU590 00276 VARYING QTR-TOL-IDX FROM 1 BY 1 DTSBU590 00277 UNTIL (QTR-TOL-IDX > QTR-TOL-CNT) DTSBU590 00278 OR DTSBU590 00279 (ENTRY-FOUND-IND = 'Y'). DTSBU590 00280 DTSBU590 00281 IF ENTRY-FOUND-IND = 'Y' DTSBU590 00282 GO TO P2000-EXIT. DTSBU590 00283 DTSBU590 00284 IF QTR-TOL-CNT < +400 DTSBU590 00285 ADD +1 TO QTR-TOL-CNT DTSBU590 00286 MOVE L590-YRQ TO QTR-TOL-YRQ (QTR-TOL-CNT) DTSBU590 00287 MOVE L590-TOL-DOC-NO TO QTR-TOL-DOC-NO (QTR-TOL-CNT) DTSBU590 00288 ELSE DTSBU590 00289 PERFORM S999-ABEND THRU S999-EXIT. DTSBU590 00290 P2000-EXIT. DTSBU590 00291 EXIT. DTSBU590 00292 SKIP3 DTSBU590 00293 P2100-QTR-TOL-LOOP. DTSBU590 00294 IF L590-YRQ = QTR-TOL-YRQ (QTR-TOL-IDX) DTSBU590 00295 MOVE 'Y' TO ENTRY-FOUND-IND. DTSBU590 00296 P2100-EXIT. DTSBU590 00297 EXIT. DTSBU590 00298 EJECT DTSBU590 00299 P4000-ORIG-RPT. DTSBU590 00300 MOVE 'N' TO ENTRY-FOUND-IND. DTSBU590 00301 DTSBU590 00302 PERFORM P4100-ORIG-RPT-LOOP THRU P4100-EXIT DTSBU590 00303 VARYING ORIG-RPT-IDX FROM 1 BY 1 DTSBU590 00304 UNTIL (ORIG-RPT-IDX > ORIG-RPT-CNT) DTSBU590 00305 OR DTSBU590 00306 (ENTRY-FOUND-IND = 'Y'). DTSBU590 00307 DTSBU590 00308 IF ENTRY-FOUND-IND = 'Y' DTSBU590 00309 GO TO P4000-EXIT. DTSBU590 00310 DTSBU590 00311 IF ORIG-RPT-CNT < +400 DTSBU590 00312 ADD +1 TO ORIG-RPT-CNT DTSBU590 00313 MOVE L590-YRQ TO ORIG-RPT-YRQ (ORIG-RPT-CNT) DTSBU590 00314 ELSE DTSBU590 00315 PERFORM S999-ABEND THRU S999-EXIT. DTSBU590 00316 P4000-EXIT. DTSBU590 00317 EXIT. DTSBU590 00318 SKIP3 DTSBU590 00319 P4100-ORIG-RPT-LOOP. DTSBU590 00320 IF L590-YRQ = ORIG-RPT-YRQ (ORIG-RPT-IDX) DTSBU590 00321 MOVE 'Y' TO ENTRY-FOUND-IND. DTSBU590 00322 P4100-EXIT. DTSBU590 00323 EXIT. DTSBU590 00324 EJECT DTSBU590 00325 P5000-QTR-PURSUED. DTSBU590 00326 MOVE 'N' TO ENTRY-FOUND-IND. DTSBU590 00327 DTSBU590 00328 PERFORM P5100-PURSUED-LOOP THRU P5100-EXIT DTSBU590 00329 VARYING PURSUED-IDX FROM 1 BY 1 DTSBU590 00330 UNTIL (PURSUED-IDX > PURSUED-CNT) DTSBU590 00331 OR DTSBU590 00332 (ENTRY-FOUND-IND = 'Y'). DTSBU590 00333 DTSBU590 00334 IF ENTRY-FOUND-IND = 'Y' DTSBU590 00335 GO TO P5000-EXIT. DTSBU590 00336 DTSBU590 00337 IF PURSUED-CNT < +400 DTSBU590 00338 ADD +1 TO PURSUED-CNT DTSBU590 00339 MOVE L590-YRQ TO PURSUED-YRQ (PURSUED-CNT) DTSBU590 00340 ELSE DTSBU590 00341 PERFORM S999-ABEND THRU S999-EXIT. DTSBU590 00342 P5000-EXIT. DTSBU590 00343 EXIT. DTSBU590 00344 SKIP3 DTSBU590 00345 P5100-PURSUED-LOOP. DTSBU590 00346 IF L590-YRQ = PURSUED-YRQ (PURSUED-IDX) DTSBU590 00347 MOVE 'Y' TO ENTRY-FOUND-IND. DTSBU590 00348 P5100-EXIT. DTSBU590 00349 EXIT. DTSBU590 00350 EJECT DTSBU590 00351 P9000-TERMINATE. DTSBU590 00352 PERFORM P9100-QTR-TOL THRU P9100-EXIT DTSBU590 00353 VARYING QTR-TOL-IDX FROM 1 BY 1 DTSBU590 00354 UNTIL QTR-TOL-IDX > QTR-TOL-CNT. DTSBU590 00355 DTSBU590 00356 PERFORM P9200-CREDIT-TOL THRU P9200-EXIT. DTSBU590 00357 DTSBU590 00358 PERFORM P9300-ORIG-RPT THRU P9300-EXIT DTSBU590 00359 VARYING ORIG-RPT-IDX FROM 1 BY 1 DTSBU590 00360 UNTIL ORIG-RPT-IDX > ORIG-RPT-CNT. DTSBU590 00361 DTSBU590 00362 PERFORM P9400-TOT-BALANCE-AMT THRU P9400-EXIT. DTSBU590 00363 DTSBU590 00364 PERFORM P9500-PURSUED-YRQ THRU P9500-EXIT DTSBU590 00365 VARYING PURSUED-IDX FROM 1 BY 1 DTSBU590 00366 UNTIL PURSUED-IDX > PURSUED-CNT. DTSBU590 00367 DTSBU590 00368 IF LBCM-EMP-UPDATE-YES-88 DTSBU590 00369 PERFORM P9900-MPRF-UPDATE-DATA THRU P9900-EXIT. DTSBU590 00370 P9000-EXIT. DTSBU590 00371 EXIT. DTSBU590 00372 EJECT DTSBU590 00373 P9100-QTR-TOL. DTSBU590 00374 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSBU590 00375 DTSBU590 00376 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBU590 00377 DTSBU590 00378 SET MQTR-QTR-88 TO TRUE. DTSBU590 00379 DTSBU590 00380 MOVE QTR-TOL-YRQ (QTR-TOL-IDX) TO MQTR-YRQ. DTSBU590 00381 DTSBU590 00382 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBU590 00383 DTSBU590 00384 PERFORM S910-READ THRU S910-EXIT. DTSBU590 00385 DTSBU590 00386 IF L910-NO-REC-88 DTSBU590 00387 GO TO P9100-EXIT. DTSBU590 00388 DTSBU590 00389 DTSBU590 00390 MOVE MSKL-REC TO MQTR-REC. DTSBU590 00391 DTSBU590 00392 DTSBU590 00393 MOVE +0 TO WRK-BALANCE-AMT DTSBU590 00394 WRK-SUR-BAL-AMT. DTSBU590 00395 DTSBU590 00396 PERFORM P9110-ACCT-SCAN THRU P9110-EXIT DTSBU590 00397 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSBU590 00398 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT. DTSBU590 00399 DTSBU590 00400 MOVE WRK-BALANCE-AMT TO AMT-DISP1. DTSBU590 00401 MOVE WRK-SUR-BAL-AMT TO AMT-DISP2. DTSBU590 00402 DISPLAY 'BU590 ' MPRF-EMP-NO DTSBU590 00403 ' TOT ' AMT-DISP1 DTSBU590 00404 ' SUR ' AMT-DISP2. DTSBU590 00405 DTSBU590 00406 IF (WRK-BALANCE-AMT NOT > +0) DTSBU590 00407 OR DTSBU590 00408 (WRK-BALANCE-AMT > LBCM-QTR-TOL-MAX) DTSBU590 00409 GO TO P9100-EXIT DTSBU590 00410 END-IF. DTSBU590 00411 DTSBU590 00412 ******************************************************* DTSBU590 00413 * IF THE TOTAL BALANCE DUE IS LESS THAN THE THRESHOLD, DTSBU590 00414 * BUT THE BALANCE DUE IN ADMIN ASSESSMENT IS ABOVE DTSBU590 00415 * THE .99 THRESHOLD, TOLERATE ALL BUT THE ADMIN ASSESS. DTSBU590 00416 ******************************************************* DTSBU590 00417 IF WRK-SUR-BAL-AMT >= +0.01 DTSBU590 00418 SET WRK-COLLECT-SUR-YES-88 TO TRUE DTSBU590 00419 ELSE DTSBU590 00420 SET WRK-COLLECT-SUR-NO-88 TO TRUE DTSBU590 00421 END-IF. DTSBU590 00422 DTSBU590 00423 MOVE QTR-TOL-DOC-NO (QTR-TOL-IDX) TO WRK-TOL-DOC-NO. DTSBU590 00424 DTSBU590 00425 PERFORM S1000-L549-INIT-AREA THRU S1000-EXIT. DTSBU590 00426 DTSBU590 00427 PERFORM S549-INIT-TRAN THRU S549-EXIT. DTSBU590 00428 DTSBU590 00429 PERFORM P9120-ZERO-BALANCE THRU P9120-EXIT DTSBU590 00430 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSBU590 00431 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT. DTSBU590 00432 DTSBU590 00433 MOVE LBCM-CURR-RUN-DATE TO MQTR-CHNG-DATE. DTSBU590 00434 DTSBU590 00435 MOVE MQTR-REC TO MSKL-REC. DTSBU590 00436 DTSBU590 00437 PERFORM S910-REWRITE THRU S910-EXIT. DTSBU590 00438 DTSBU590 00439 PERFORM S549-TERM-TRAN-SEC THRU S549-EXIT. DTSBU590 00440 P9100-EXIT. DTSBU590 00441 EXIT. DTSBU590 00442 SKIP3 DTSBU590 00443 P9110-ACCT-SCAN. DTSBU590 00444 IF MQTR-ACCT-SUR-88 (MQTR-ACCT-IDX) DTSBU590 00445 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSBU590 00446 TO WRK-BALANCE-AMT DTSBU590 00447 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSBU590 00448 TO WRK-SUR-BAL-AMT DTSBU590 00449 ELSE DTSBU590 00450 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSBU590 00451 TO WRK-BALANCE-AMT DTSBU590 00452 END-IF. DTSBU590 00453 DTSBU590 00454 P9110-EXIT. DTSBU590 00455 EXIT. DTSBU590 00456 SKIP3 DTSBU590 00457 P9120-ZERO-BALANCE. DTSBU590 00458 IF MQTR-ACCT-SUR-88 (MQTR-ACCT-IDX) DTSBU590 00459 IF WRK-COLLECT-SUR-YES-88 DTSBU590 00460 GO TO P9120-EXIT DTSBU590 00461 END-IF DTSBU590 00462 ELSE DTSBU590 00463 IF MQTR-BALANCE-AMT (MQTR-ACCT-IDX) > +0 DTSBU590 00464 NEXT SENTENCE DTSBU590 00465 ELSE DTSBU590 00466 GO TO P9120-EXIT DTSBU590 00467 END-IF DTSBU590 00468 END-IF. DTSBU590 00469 DTSBU590 00470 MOVE MQTR-BALANCE-AMT (MQTR-ACCT-IDX) TO L541-AMT. DTSBU590 00471 DTSBU590 00472 SET L541-ACCT-SUB TO MQTR-ACCT-IDX. DTSBU590 00473 DTSBU590 00474 MOVE CACT-CAT-TOLER TO L541-CAT-IND. DTSBU590 00475 DTSBU590 00476 MOVE WRK-TOL-DOC-NO TO L541-TRN-DOC-NO. DTSBU590 00477 DTSBU590 00478 PERFORM S541-MQTR-AMT THRU S541-EXIT. DTSBU590 00479 P9120-EXIT. DTSBU590 00480 EXIT. DTSBU590 00481 EJECT DTSBU590 00482 P9200-CREDIT-TOL. DTSBU590 00483 IF (MPRF-TOT-CREDIT-AMT <= +0) DTSBU590 00484 OR DTSBU590 00485 (MPRF-TOT-CREDIT-AMT > LBCM-CR-TOL-MAX) DTSBU590 00486 GO TO P9200-EXIT. DTSBU590 00487 DTSBU590 00488 DTSBU590 00489 IF LBCM-EMP-CR-TOL-DOC-NO = WRK-NULL-DOC-NO DTSBU590 00490 MOVE '354' TO R907-MSG-ID DTSBU590 00491 MOVE MPRF-EMP-NO TO R907-EMP-NO DTSBU590 00492 MOVE DTSBU590 00493 'CREDIT TOLERANCE WITHIN RANGE BEFORE ACCT TRN. NO ACTION.'DTSBU590 00494 TO R907-MSG-TEXT DTSBU590 00495 MOVE R907-REC TO RSKL-REC DTSBU590 00496 PERFORM S946-RSKL-WRITE THRU S946-EXIT DTSBU590 00497 GO TO P9200-EXIT. DTSBU590 00498 DTSBU590 00499 DTSBU590 00500 MOVE LBCM-EMP-CR-TOL-DOC-NO TO WRK-TOL-DOC-NO. DTSBU590 00501 DTSBU590 00502 PERFORM S1000-L549-INIT-AREA THRU S1000-EXIT. DTSBU590 00503 DTSBU590 00504 PERFORM S549-INIT-TRAN THRU S549-EXIT. DTSBU590 00505 DTSBU590 00506 DTSBU590 00507 MOVE LOW-VALUES TO MDST-KEY-AREA. DTSBU590 00508 DTSBU590 00509 MOVE MPRF-EMP-NO TO MDST-EMP-NO. DTSBU590 00510 DTSBU590 00511 SET MDST-DST-88 TO TRUE. DTSBU590 00512 DTSBU590 00513 SET MDST-CREDIT-REC-88 TO TRUE. DTSBU590 00514 DTSBU590 00515 MOVE MDST-KEY-AREA TO MSKL-KEY-AREA. DTSBU590 00516 DTSBU590 00517 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBU590 00518 DTSBU590 00519 PERFORM UNTIL L910-NO-REC-88 DTSBU590 00520 MOVE MSKL-REC TO MDST-REC DTSBU590 00521 PERFORM P9210-MDST-PROCESS THRU P9210-EXIT DTSBU590 00522 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBU590 00523 END-PERFORM. DTSBU590 00524 DTSBU590 00525 PERFORM S549-TERM-TRAN-SEC THRU S549-EXIT. DTSBU590 00526 P9200-EXIT. DTSBU590 00527 EXIT. DTSBU590 00528 SKIP3 DTSBU590 00529 P9210-MDST-PROCESS. DTSBU590 00530 MOVE +0 TO WRK-AVAILABLE-AMT. DTSBU590 00531 DTSBU590 00532 PERFORM DTSBU590 00533 VARYING MDST-ACCT-IDX FROM 1 BY 1 DTSBU590 00534 UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT DTSBU590 00535 IF MDST-ACCT-CR-AVAIL-88 (MDST-ACCT-IDX) DTSBU590 00536 MOVE MDST-AMT (MDST-ACCT-IDX) TO WRK-AVAILABLE-AMT DTSBU590 00537 END-IF DTSBU590 00538 END-PERFORM. DTSBU590 00539 DTSBU590 00540 IF WRK-AVAILABLE-AMT <= +0 DTSBU590 00541 GO TO P9210-EXIT. DTSBU590 00542 DTSBU590 00543 DTSBU590 00544 COMPUTE L542-AMT = WRK-AVAILABLE-AMT * -1. DTSBU590 00545 DTSBU590 00546 MOVE CACT-CR-AVAIL TO L542-ACCT-IND. DTSBU590 00547 DTSBU590 00548 MOVE WRK-TOL-DOC-NO TO L542-TRN-DOC-NO. DTSBU590 00549 DTSBU590 00550 PERFORM S542-MDST-AMT THRU S542-EXIT. DTSBU590 00551 DTSBU590 00552 DTSBU590 00553 MOVE WRK-AVAILABLE-AMT TO L542-AMT. DTSBU590 00554 DTSBU590 00555 MOVE CACT-CR-TOLER TO L542-ACCT-IND. DTSBU590 00556 DTSBU590 00557 MOVE WRK-TOL-DOC-NO TO L542-TRN-DOC-NO. DTSBU590 00558 DTSBU590 00559 PERFORM S542-MDST-AMT THRU S542-EXIT. DTSBU590 00560 DTSBU590 00561 DTSBU590 00562 MOVE LBCM-CURR-RUN-DATE TO MDST-CHNG-DATE. DTSBU590 00563 DTSBU590 00564 MOVE MDST-REC TO MSKL-REC. DTSBU590 00565 DTSBU590 00566 PERFORM S910-REWRITE THRU S910-EXIT. DTSBU590 00567 P9210-EXIT. DTSBU590 00568 EXIT. DTSBU590 00569 EJECT DTSBU590 00570 P9300-ORIG-RPT. DTSBU590 00571 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSBU590 00572 DTSBU590 00573 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBU590 00574 DTSBU590 00575 SET MQTR-QTR-88 TO TRUE. DTSBU590 00576 DTSBU590 00577 MOVE ORIG-RPT-YRQ (ORIG-RPT-IDX) TO MQTR-YRQ. DTSBU590 00578 DTSBU590 00579 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBU590 00580 DTSBU590 00581 PERFORM S910-READ THRU S910-EXIT. DTSBU590 00582 DTSBU590 00583 IF L910-NO-REC-88 DTSBU590 00584 GO TO P9300-EXIT. DTSBU590 00585 DTSBU590 00586 DTSBU590 00587 MOVE MSKL-REC TO MQTR-REC. DTSBU590 00588 DTSBU590 00589 DTSBU590 00590 IF MQTR-COLL-PROMPT-DUE-AMT < +0 DTSBU590 00591 NEXT SENTENCE DTSBU590 00592 ELSE DTSBU590 00593 GO TO P9300-EXIT. DTSBU590 00594 DTSBU590 00595 DTSBU590 00596 MOVE +0 TO MQTR-COLL-PROMPT-DUE-AMT. DTSBU590 00597 DTSBU590 00598 PERFORM P9310-ACCT-DATA-LOOP THRU P9310-EXIT DTSBU590 00599 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSBU590 00600 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT. DTSBU590 00601 DTSBU590 00602 MOVE LBCM-CURR-RUN-DATE TO MQTR-CHNG-DATE. DTSBU590 00603 DTSBU590 00604 MOVE MQTR-REC TO MSKL-REC. DTSBU590 00605 DTSBU590 00606 PERFORM S910-REWRITE THRU S910-EXIT. DTSBU590 00607 P9300-EXIT. DTSBU590 00608 EXIT. DTSBU590 00609 SKIP3 DTSBU590 00610 P9310-ACCT-DATA-LOOP. DTSBU590 00611 IF MQTR-ACCT-UI-88 (MQTR-ACCT-IDX) DTSBU590 00612 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSBU590 00613 TO MQTR-COLL-PROMPT-DUE-AMT. DTSBU590 00614 P9310-EXIT. DTSBU590 00615 EXIT. DTSBU590 00616 EJECT DTSBU590 00617 P9400-TOT-BALANCE-AMT. DTSBU590 00618 IF MPRF-CLASS-SELF-INS-88 DTSBU590 00619 MOVE +0 TO R424-BALANCE-AMT DTSBU590 00620 PERFORM S2100-SELF-INS-BALANCE-AMT THRU S2100-EXIT DTSBU590 00621 ELSE DTSBU590 00622 MOVE MPRF-TOT-BALANCE-AMT TO R424-BALANCE-AMT. DTSBU590 00623 DTSBU590 00624 DTSBU590 00625 ***** DTSBU590 00626 * DTSBU590 00627 * PER DC SPECIFICATION RPT424R1.DSC, DO NOT REPORT SELF DTSBU590 00628 * INSURED EMPLOYERS ON RPT424R1. DTSBU590 00629 * DTSBU590 00630 ***** DTSBU590 00631 DTSBU590 00632 IF MPRF-CLASS-SELF-INS-88 DTSBU590 00633 GO TO P9400-EXIT. DTSBU590 00634 DTSBU590 00635 DTSBU590 00636 IF R424-BALANCE-AMT > INIT-TOT-BALANCE-AMT DTSBU590 00637 NEXT SENTENCE DTSBU590 00638 ELSE DTSBU590 00639 GO TO P9400-EXIT. DTSBU590 00640 DTSBU590 00641 DTSBU590 00642 ***** DTSBU590 00643 * DTSBU590 00644 * THE DC SPECIFICATION FOR RPT424R1 DOES NOT EXPLICITLY STATE DTSBU590 00645 * TO BYPASS RPT424R1 WHEN COLLECTIONS ARE SUSPENDED. HOWEVER, DTSBU590 00646 * TO MAKE RPT424R1 CONSISTENT WITH RPT425R1 AND BECAUSE IN DC DTSBU590 00647 * RPT424R1 IS ORGANIZED BY FIELD REP CODE, THE FOLLOWING DTSBU590 00648 * SENTENCE BYPASSES RPT424R1 WHEN COLLECTIONS ARE SUSPENDED. DTSBU590 00649 * DTSBU590 00650 ***** DTSBU590 00651 DTSBU590 00652 IF MPRF-SUSPEND-COLL-YES-88 DTSBU590 00653 GO TO P9400-EXIT. DTSBU590 00654 DTSBU590 00655 DTSBU590 00656 MOVE MPRF-FLD-ZIP-ST TO L061-FLD-ZIP-ST. DTSBU590 00657 DTSBU590 00658 MOVE MPRF-EMP-NO TO L061-EMP-NO. DTSBU590 00659 DTSBU590 00660 PERFORM S061-FLD-REP-LOOKUP THRU S061-EXIT. DTSBU590 00661 DTSBU590 00662 MOVE L061-FLD-REP-ID TO R424-FLD-REP-ID. DTSBU590 00663 DTSBU590 00664 MOVE MPRF-EMP-NO TO R424-EMP-NO. DTSBU590 00665 DTSBU590 00666 MOVE MPRF-PRIMARY-NAME TO R424-PRIMARY-NAME. DTSBU590 00667 DTSBU590 00668 COMPUTE R424-INCREASED-AMT DTSBU590 00669 = R424-BALANCE-AMT - INIT-TOT-BALANCE-AMT. DTSBU590 00670 DTSBU590 00671 DTSBU590 00672 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSBU590 00673 DTSBU590 00674 MOVE MPRF-EMP-NO TO MSKL-EMP-NO. DTSBU590 00675 DTSBU590 00676 SET MSKL-RPT-88 TO TRUE DTSBU590 00677 DTSBU590 00678 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBU590 00679 DTSBU590 00680 PERFORM UNTIL L910-NO-REC-88 DTSBU590 00681 PERFORM P9410-WRITE-R424 THRU P9410-EXIT DTSBU590 00682 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBU590 00683 END-PERFORM. DTSBU590 00684 DTSBU590 00685 DTSBU590 00686 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSBU590 00687 DTSBU590 00688 MOVE MPRF-EMP-NO TO MSKL-EMP-NO. DTSBU590 00689 DTSBU590 00690 SET MSKL-PAY-88 TO TRUE DTSBU590 00691 DTSBU590 00692 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBU590 00693 DTSBU590 00694 PERFORM UNTIL L910-NO-REC-88 DTSBU590 00695 PERFORM P9410-WRITE-R424 THRU P9410-EXIT DTSBU590 00696 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBU590 00697 END-PERFORM. DTSBU590 00698 DTSBU590 00699 DTSBU590 00700 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSBU590 00701 DTSBU590 00702 MOVE MPRF-EMP-NO TO MSKL-EMP-NO. DTSBU590 00703 DTSBU590 00704 SET MSKL-ADJ-88 TO TRUE DTSBU590 00705 DTSBU590 00706 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBU590 00707 DTSBU590 00708 PERFORM UNTIL L910-NO-REC-88 DTSBU590 00709 PERFORM P9410-WRITE-R424 THRU P9410-EXIT DTSBU590 00710 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBU590 00711 END-PERFORM. DTSBU590 00712 P9400-EXIT. DTSBU590 00713 EXIT. DTSBU590 00714 SKIP3 DTSBU590 00715 P9410-WRITE-R424. DTSBU590 00716 IF MSKL-RPT-88 DTSBU590 00717 MOVE MSKL-REC TO MRPT-REC DTSBU590 00718 IF MRPT-ESTB-DATE = LBCM-CURR-RUN-DATE DTSBU590 00719 MOVE MRPT-BATCH-NO TO R424-BATCH-NO DTSBU590 00720 ELSE DTSBU590 00721 GO TO P9410-EXIT DTSBU590 00722 ELSE DTSBU590 00723 IF MSKL-PAY-88 DTSBU590 00724 MOVE MSKL-REC TO MPAY-REC DTSBU590 00725 IF MPAY-ESTB-DATE = LBCM-CURR-RUN-DATE DTSBU590 00726 MOVE MPAY-BATCH-NO TO R424-BATCH-NO DTSBU590 00727 ELSE DTSBU590 00728 GO TO P9410-EXIT DTSBU590 00729 ELSE DTSBU590 00730 IF MSKL-ADJ-88 DTSBU590 00731 MOVE MSKL-REC TO MADJ-REC DTSBU590 00732 IF MADJ-ESTB-DATE = LBCM-CURR-RUN-DATE DTSBU590 00733 MOVE MADJ-BATCH-NO TO R424-BATCH-NO DTSBU590 00734 ELSE DTSBU590 00735 GO TO P9410-EXIT DTSBU590 00736 ELSE DTSBU590 00737 GO TO P9410-EXIT. DTSBU590 00738 DTSBU590 00739 MOVE R424-REC TO RSKL-REC. DTSBU590 00740 DTSBU590 00741 PERFORM S946-RSKL-WRITE THRU S946-EXIT. DTSBU590 00742 P9410-EXIT. DTSBU590 00743 EXIT. DTSBU590 00744 EJECT DTSBU590 00745 P9500-PURSUED-YRQ. DTSBU590 00746 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSBU590 00747 DTSBU590 00748 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBU590 00749 DTSBU590 00750 SET MQTR-QTR-88 TO TRUE. DTSBU590 00751 DTSBU590 00752 MOVE PURSUED-YRQ (PURSUED-IDX) TO MQTR-YRQ. DTSBU590 00753 DTSBU590 00754 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBU590 00755 DTSBU590 00756 PERFORM S910-READ THRU S910-EXIT. DTSBU590 00757 DTSBU590 00758 IF L910-NO-REC-88 DTSBU590 00759 GO TO P9500-EXIT. DTSBU590 00760 DTSBU590 00761 DTSBU590 00762 MOVE MSKL-REC TO MQTR-REC. DTSBU590 00763 DTSBU590 00764 DTSBU590 00765 IF MQTR-RPT-NOT-PURSUED-88 DTSBU590 00766 GO TO P9500-EXIT. DTSBU590 00767 DTSBU590 00768 DTSBU590 00769 IF MPRF-SUSPEND-COLL-YES-88 DTSBU590 00770 GO TO P9500-EXIT. DTSBU590 00771 DTSBU590 00772 DTSBU590 00773 MOVE MPRF-FLD-ZIP-ST TO L061-FLD-ZIP-ST. DTSBU590 00774 DTSBU590 00775 MOVE MPRF-EMP-NO TO L061-EMP-NO. DTSBU590 00776 DTSBU590 00777 PERFORM S061-FLD-REP-LOOKUP THRU S061-EXIT. DTSBU590 00778 DTSBU590 00779 MOVE L061-FLD-REP-ID TO R425-FLD-REP-ID. DTSBU590 00780 DTSBU590 00781 MOVE MPRF-EMP-NO TO R425-EMP-NO. DTSBU590 00782 DTSBU590 00783 MOVE MQTR-YRQ TO R425-YRQ. DTSBU590 00784 DTSBU590 00785 MOVE MPRF-PRIMARY-NAME TO R425-PRIMARY-NAME. DTSBU590 00786 DTSBU590 00787 MOVE MQTR-RPT-DUE-DATE TO R425-RPT-DUE-DATE. DTSBU590 00788 DTSBU590 00789 MOVE R425-REC TO RSKL-REC. DTSBU590 00790 DTSBU590 00791 PERFORM S946-RSKL-WRITE THRU S946-EXIT. DTSBU590 00792 P9500-EXIT. DTSBU590 00793 EXIT. DTSBU590 00794 EJECT DTSBU590 00795 P9900-MPRF-UPDATE-DATA. DTSBU590 00796 MOVE LBCM-ABSTIME TO MPRF-UPDATE-END-ABSTIME. DTSBU590 00797 DTSBU590 00798 MOVE +0 TO MPRF-UPDATE-TASK-ID. DTSBU590 00799 DTSBU590 00800 MOVE 'BATCH' TO MPRF-UPDATE-OP-ID. DTSBU590 00801 DTSBU590 00802 MOVE SPACES TO MPRF-UPDATE-TERMID. DTSBU590 00803 DTSBU590 00804 MOVE SPACES TO MPRF-UPDATE-NETNAME. DTSBU590 00805 DTSBU590 00806 MOVE LBCM-SYS-DATE TO MPRF-UPDATE-START-DATE. DTSBU590 00807 DTSBU590 00808 MOVE LBCM-SYS-TIME TO MPRF-UPDATE-START-TIME. DTSBU590 00809 DTSBU590 00810 MOVE SPACE TO MPRF-UPDATE-SCR-ID DTSBU590 00811 MPRF-UPDATE-FUNCTION. DTSBU590 00812 DTSBU590 00813 MOVE LBCM-CURR-RUN-DATE TO MPRF-CHNG-DATE. DTSBU590 00814 P9900-EXIT. DTSBU590 00815 EXIT. DTSBU590 00816 EJECT DTSBU590 00817 S1000-L549-INIT-AREA. DTSBU590 00818 MOVE WRK-TOL-DOC-NO TO L549-TRN-DOC-NO. DTSBU590 00819 DTSBU590 00820 MOVE LBCM-TRACE-IND TO L549-INIT-TRACE-IND. DTSBU590 00821 DTSBU590 00822 MOVE LBCM-CURR-RUN-DATE TO L549-INIT-CURR-RUN-DATE. DTSBU590 00823 DTSBU590 00824 MOVE LBCM-EMP-ABSTIME TO L549-INIT-ABSTIME. DTSBU590 00825 DTSBU590 00826 MOVE MPRF-EMP-NO TO L549-INIT-EMP-NO. DTSBU590 00827 DTSBU590 00828 MOVE MPRF-EMP-CLASS TO L549-INIT-EMP-CLASS. DTSBU590 00829 DTSBU590 00830 MOVE MPRF-ELIGIBLE-CD TO L549-INIT-ELIGIBLE-CD. DTSBU590 00831 DTSBU590 00832 DTSBU590 00833 MOVE LOW-VALUES TO MPAY-KEY-AREA. DTSBU590 00834 DTSBU590 00835 MOVE MPRF-EMP-NO TO MPAY-EMP-NO. DTSBU590 00836 DTSBU590 00837 SET MPAY-PAY-88 TO TRUE. DTSBU590 00838 DTSBU590 00839 MOVE WRK-TOL-DOC-NO TO MPAY-DOC-NO. DTSBU590 00840 DTSBU590 00841 MOVE MPAY-KEY-AREA TO MSKL-KEY-AREA. DTSBU590 00842 DTSBU590 00843 PERFORM S910-READ THRU S910-EXIT. DTSBU590 00844 DTSBU590 00845 IF L910-OK-88 DTSBU590 00846 MOVE MSKL-REC TO MPAY-REC DTSBU590 00847 PERFORM S1100-FROM-MPAY THRU S1100-EXIT DTSBU590 00848 GO TO S1000-EXIT. DTSBU590 00849 DTSBU590 00850 DTSBU590 00851 MOVE LOW-VALUES TO MADJ-KEY-AREA. DTSBU590 00852 DTSBU590 00853 MOVE MPRF-EMP-NO TO MADJ-EMP-NO. DTSBU590 00854 DTSBU590 00855 SET MADJ-ADJ-88 TO TRUE. DTSBU590 00856 DTSBU590 00857 MOVE WRK-TOL-DOC-NO TO MADJ-DOC-NO. DTSBU590 00858 DTSBU590 00859 MOVE MADJ-KEY-AREA TO MSKL-KEY-AREA. DTSBU590 00860 DTSBU590 00861 PERFORM S910-READ THRU S910-EXIT. DTSBU590 00862 DTSBU590 00863 IF L910-OK-88 DTSBU590 00864 MOVE MSKL-REC TO MADJ-REC DTSBU590 00865 PERFORM S1200-FROM-MADJ THRU S1200-EXIT DTSBU590 00866 GO TO S1000-EXIT. DTSBU590 00867 DTSBU590 00868 DTSBU590 00869 MOVE LOW-VALUES TO MRPT-KEY-AREA. DTSBU590 00870 DTSBU590 00871 MOVE MPRF-EMP-NO TO MRPT-EMP-NO. DTSBU590 00872 DTSBU590 00873 SET MRPT-RPT-88 TO TRUE. DTSBU590 00874 DTSBU590 00875 MOVE MRPT-KEY-AREA TO MSKL-KEY-AREA. DTSBU590 00876 DTSBU590 00877 MOVE 'N' TO RPT-FOUND-IND. DTSBU590 00878 DTSBU590 00879 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBU590 00880 DTSBU590 00881 PERFORM S1010-MRPT-SCAN THRU S1010-EXIT DTSBU590 00882 UNTIL (L910-NO-REC-88) DTSBU590 00883 OR DTSBU590 00884 (RPT-FOUND-IND = 'Y'). DTSBU590 00885 DTSBU590 00886 DTSBU590 00887 IF RPT-FOUND-IND = 'Y' DTSBU590 00888 PERFORM S1300-FROM-MRPT THRU S1300-EXIT DTSBU590 00889 ELSE DTSBU590 00890 PERFORM S999-ABEND THRU S999-EXIT. DTSBU590 00891 S1000-EXIT. DTSBU590 00892 EXIT. DTSBU590 00893 SKIP3 DTSBU590 00894 S1010-MRPT-SCAN. DTSBU590 00895 MOVE MSKL-REC TO MRPT-REC. DTSBU590 00896 DTSBU590 00897 IF MRPT-DOC-NO = WRK-TOL-DOC-NO DTSBU590 00898 MOVE 'Y' TO RPT-FOUND-IND DTSBU590 00899 ELSE DTSBU590 00900 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBU590 00901 S1010-EXIT. DTSBU590 00902 EXIT. DTSBU590 00903 SKIP3 DTSBU590 00904 S1100-FROM-MPAY. DTSBU590 00905 MOVE 'N' TO RPT-FOUND-IND. DTSBU590 00906 DTSBU590 00907 IF MPAY-APPLIC-YRQ > +0 DTSBU590 00908 MOVE LOW-VALUES TO MRPT-KEY-AREA DTSBU590 00909 MOVE MPRF-EMP-NO TO MRPT-EMP-NO DTSBU590 00910 SET MRPT-RPT-88 TO TRUE DTSBU590 00911 MOVE MPAY-APPLIC-YRQ TO MRPT-YRQ DTSBU590 00912 MOVE MPAY-DOC-NO TO MRPT-DOC-NO DTSBU590 00913 MOVE MRPT-KEY-AREA TO MSKL-KEY-AREA DTSBU590 00914 PERFORM S910-READ THRU S910-EXIT DTSBU590 00915 IF L910-OK-88 DTSBU590 00916 MOVE MSKL-REC TO MRPT-REC DTSBU590 00917 MOVE 'Y' TO RPT-FOUND-IND. DTSBU590 00918 DTSBU590 00919 IF RPT-FOUND-IND = 'Y' DTSBU590 00920 MOVE 'R' TO L549-INIT-REC-TYPE DTSBU590 00921 MOVE MRPT-RPT-TYPE TO L549-INIT-TRANS-TYPE DTSBU590 00922 ELSE DTSBU590 00923 MOVE 'P' TO L549-INIT-REC-TYPE DTSBU590 00924 MOVE MPAY-PAY-TYPE TO L549-INIT-TRANS-TYPE. DTSBU590 00925 DTSBU590 00926 MOVE MPAY-RECEIVED-DATE TO L549-INIT-RECEIVED-DATE. DTSBU590 00927 DTSBU590 00928 MOVE MPAY-DEPOSIT-DATE TO L549-INIT-DEPOSIT-DATE. DTSBU590 00929 DTSBU590 00930 MOVE MPAY-REMIT-AMT TO L549-INIT-REMIT-AMT. DTSBU590 00931 DTSBU590 00932 MOVE MPAY-WAIVE-INT-IND TO L549-INIT-WAIVE-INT-IND. DTSBU590 00933 DTSBU590 00934 MOVE MPAY-WAIVE-LATE-PEN-IND DTSBU590 00935 TO L549-INIT-WAIVE-LATE-PEN-IND. DTSBU590 00936 DTSBU590 00937 MOVE MPAY-APPLIC-YRQ TO L549-INIT-APPLIC-YRQ. DTSBU590 00938 DTSBU590 00939 MOVE MPAY-APPLIC-IND TO L549-INIT-APPLIC-ACCT-IND. DTSBU590 00940 DTSBU590 00941 MOVE MPAY-APPLIC-DOC-NO TO L549-INIT-APPLIC-DOC-NO. DTSBU590 00942 DTSBU590 00943 MOVE MPAY-RESPONSIBLE-ACTIVITY TO L549-INIT-RESP-ACTIVITY. DTSBU590 00944 DTSBU590 00945 MOVE MPAY-RESPONSIBLE-OP-ID TO L549-INIT-RESP-OP-ID. DTSBU590 00946 S1100-EXIT. DTSBU590 00947 EXIT. DTSBU590 00948 SKIP3 DTSBU590 00949 S1200-FROM-MADJ. DTSBU590 00950 MOVE 'A' TO L549-INIT-REC-TYPE. DTSBU590 00951 DTSBU590 00952 MOVE MADJ-ADJ-TYPE TO L549-INIT-TRANS-TYPE. DTSBU590 00953 DTSBU590 00954 MOVE MADJ-RECEIVED-DATE TO L549-INIT-RECEIVED-DATE. DTSBU590 00955 DTSBU590 00956 MOVE MADJ-DEPOSIT-DATE TO L549-INIT-DEPOSIT-DATE. DTSBU590 00957 DTSBU590 00958 MOVE +0 TO L549-INIT-REMIT-AMT. DTSBU590 00959 DTSBU590 00960 MOVE SPACE TO L549-INIT-WAIVE-INT-IND DTSBU590 00961 L549-INIT-WAIVE-LATE-PEN-IND. DTSBU590 00962 DTSBU590 00963 MOVE MADJ-APPLIC-YRQ TO L549-INIT-APPLIC-YRQ. DTSBU590 00964 DTSBU590 00965 MOVE MADJ-APPLIC-IND TO L549-INIT-APPLIC-ACCT-IND. DTSBU590 00966 DTSBU590 00967 MOVE MADJ-APPLIC-DOC-NO TO L549-INIT-APPLIC-DOC-NO. DTSBU590 00968 DTSBU590 00969 MOVE MADJ-RESPONSIBLE-ACTIVITY TO L549-INIT-RESP-ACTIVITY. DTSBU590 00970 DTSBU590 00971 MOVE MADJ-RESPONSIBLE-OP-ID TO L549-INIT-RESP-OP-ID. DTSBU590 00972 S1200-EXIT. DTSBU590 00973 EXIT. DTSBU590 00974 SKIP3 DTSBU590 00975 S1300-FROM-MRPT. DTSBU590 00976 MOVE 'R' TO L549-INIT-REC-TYPE. DTSBU590 00977 DTSBU590 00978 MOVE MRPT-RPT-TYPE TO L549-INIT-TRANS-TYPE. DTSBU590 00979 DTSBU590 00980 MOVE MRPT-RECEIVED-DATE TO L549-INIT-RECEIVED-DATE. DTSBU590 00981 DTSBU590 00982 MOVE MRPT-DEPOSIT-DATE TO L549-INIT-DEPOSIT-DATE. DTSBU590 00983 DTSBU590 00984 MOVE +0 TO L549-INIT-REMIT-AMT. DTSBU590 00985 DTSBU590 00986 MOVE 'N' TO L549-INIT-WAIVE-INT-IND DTSBU590 00987 L549-INIT-WAIVE-LATE-PEN-IND. DTSBU590 00988 DTSBU590 00989 MOVE MRPT-YRQ TO L549-INIT-APPLIC-YRQ. DTSBU590 00990 DTSBU590 00991 MOVE SPACE TO L549-INIT-APPLIC-ACCT-IND. DTSBU590 00992 DTSBU590 00993 MOVE WRK-NULL-DOC-NO TO L549-INIT-APPLIC-DOC-NO. DTSBU590 00994 DTSBU590 00995 MOVE MRPT-RESPONSIBLE-ACTIVITY TO L549-INIT-RESP-ACTIVITY. DTSBU590 00996 DTSBU590 00997 MOVE MRPT-RESPONSIBLE-OP-ID TO L549-INIT-RESP-OP-ID. DTSBU590 00998 S1300-EXIT. DTSBU590 00999 EXIT. DTSBU590 01000 EJECT DTSBU590 01001 S2100-SELF-INS-BALANCE-AMT. DTSBU590 01002 MOVE +0 TO R424-BALANCE-AMT. DTSBU590 01003 DTSBU590 01004 IF MPRF-TOT-BALANCE-AMT = +0 DTSBU590 01005 GO TO S2100-EXIT. DTSBU590 01006 DTSBU590 01007 DTSBU590 01008 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBU590 01009 DTSBU590 01010 MOVE MPRF-EMP-NO TO MSKL-EMP-NO. DTSBU590 01011 DTSBU590 01012 SET MSKL-QTR-88 TO TRUE. DTSBU590 01013 DTSBU590 01014 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBU590 01015 DTSBU590 01016 PERFORM DTSBU590 01017 UNTIL L910-NO-REC-88 DTSBU590 01018 MOVE MSKL-REC TO MQTR-REC DTSBU590 01019 PERFORM S2110-PROCESS-MQTR THRU S2110-EXIT DTSBU590 01020 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBU590 01021 END-PERFORM. DTSBU590 01022 S2100-EXIT. DTSBU590 01023 EXIT. DTSBU590 01024 SKIP3 DTSBU590 01025 S2110-PROCESS-MQTR. DTSBU590 01026 PERFORM DTSBU590 01027 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSBU590 01028 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT DTSBU590 01029 IF MQTR-ACCT-SUR-88 (MQTR-ACCT-IDX) DTSBU590 01030 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSBU590 01031 TO R424-BALANCE-AMT DTSBU590 01032 END-IF DTSBU590 01033 END-PERFORM. DTSBU590 01034 S2110-EXIT. DTSBU590 01035 EXIT. DTSBU590 01036 EJECT DTSBU590 01037 S061-FLD-REP-LOOKUP. DTSBU590 01038 CALL 'DTSBU061' USING L061-LINK-AREA. DTSBU590 01039 S061-EXIT. DTSBU590 01040 EXIT. DTSBU590 01041 SKIP3 DTSBU590 01042 S541-MQTR-AMT. DTSBU590 01043 CALL 'DTSBU541' USING L541-LINK-AREA DTSBU590 01044 MPRF-REC DTSBU590 01045 MQTR-REC. DTSBU590 01046 S541-EXIT. DTSBU590 01047 EXIT. DTSBU590 01048 SKIP3 DTSBU590 01049 S542-MDST-AMT. DTSBU590 01050 CALL 'DTSBU542' USING L542-LINK-AREA DTSBU590 01051 MPRF-REC DTSBU590 01052 MDST-REC. DTSBU590 01053 S542-EXIT. DTSBU590 01054 EXIT. DTSBU590 01055 SKIP3 DTSBU590 01056 S549-INIT-TRAN. DTSBU590 01057 SET L549-INIT-TRAN-88 TO TRUE. DTSBU590 01058 GO TO S549-MJRN-TABLE. DTSBU590 01059 DTSBU590 01060 S549-TERM-TRAN-SEC. DTSBU590 01061 SET L549-TERM-TRAN-SEC-88 TO TRUE. DTSBU590 01062 GO TO S549-MJRN-TABLE. DTSBU590 01063 DTSBU590 01064 S549-MJRN-TABLE. DTSBU590 01065 CALL 'DTSBU549' USING L549-LINK-AREA. DTSBU590 01066 S549-EXIT. DTSBU590 01067 EXIT. DTSBU590 01068 SKIP3 DTSBU590 01069 S910-READ. DTSBU590 01070 SET L910-READ-88 TO TRUE. DTSBU590 01071 GO TO S910-MSTR-IO. DTSBU590 01072 DTSBU590 01073 S910-START-BROWSE. DTSBU590 01074 SET L910-START-BROWSE-88 TO TRUE. DTSBU590 01075 GO TO S910-MSTR-IO. DTSBU590 01076 DTSBU590 01077 S910-READ-NEXT. DTSBU590 01078 SET L910-READ-NEXT-88 TO TRUE. DTSBU590 01079 GO TO S910-MSTR-IO. DTSBU590 01080 DTSBU590 01081 *S910-COUNT. DTSBU590 01082 *****SET L910-COUNT-88 TO TRUE. DTSBU590 01083 *****GO TO S910-MSTR-IO. DTSBU590 01084 DTSBU590 01085 *S910-WRITE. DTSBU590 01086 *****SET LBCM-EMP-UPDATE-YES-88 TO TRUE. DTSBU590 01087 *****SET L910-WRITE-88 TO TRUE. DTSBU590 01088 *****GO TO S910-MSTR-IO. DTSBU590 01089 DTSBU590 01090 S910-REWRITE. DTSBU590 01091 SET LBCM-EMP-UPDATE-YES-88 TO TRUE. DTSBU590 01092 SET L910-REWRITE-88 TO TRUE. DTSBU590 01093 GO TO S910-MSTR-IO. DTSBU590 01094 DTSBU590 01095 *S910-DELETE. DTSBU590 01096 *****SET LBCM-EMP-UPDATE-YES-88 TO TRUE. DTSBU590 01097 *****SET L910-DELETE-88 TO TRUE. DTSBU590 01098 *****GO TO S910-MSTR-IO. DTSBU590 01099 DTSBU590 01100 S910-MSTR-IO. DTSBU590 01101 CALL 'DTSBU910' USING L910-LINK-AREA DTSBU590 01102 MSKL-REC. DTSBU590 01103 S910-EXIT. DTSBU590 01104 EXIT. DTSBU590 01105 SKIP3 DTSBU590 01106 S946-RSKL-WRITE. DTSBU590 01107 CALL 'DTSBU946' USING RSKL-REC. DTSBU590 01108 S946-EXIT. DTSBU590 01109 EXIT. DTSBU590 01110 SKIP3 DTSBU590 01111 S999-ABEND. DTSBU590 01112 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBU590 01113 S999-EXIT. DTSBU590 01114 EXIT. DTSBU590