00001 IDENTIFICATION DIVISION. 04/30/08 00002 PROGRAM-ID. DTSBE429. DTSBE429 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV027 00004 DATE-WRITTEN. AUGUST 1994. DTSBE429 00005 DATE-COMPILED. DTSBE429 00006 SKIP3 DTSBE429 00007 ***** DTSBE429 00008 * DTSBE429 00009 * FUNCTION: FIELD REPRESENTATIVE'S LIST EXTRACT. DTSBE429 00010 * DTSBE429 00011 * CALLING SEQUENCE: DTSBD400 CALLS DTSBE429 DTSBE429 00012 * WHICH CREATES DTSIR429 RECORDS. DTSBE429 00013 * DTSBD800 CALLS DTSBR429 DTSBE429 00014 * WHICH PRODUCES THE LIST EXTRACTS.DTSBE429 00015 * DTSBE429 00016 * DTSBE429 00017 * MODIFICATION LOG: DTSBE429 00018 * DTSBE429 00019 * 03/06/95 DROP THE FIELD REP FROM THE EXTRACT. DTSBE429 00020 * WORK ORDER: CR046 PROGRAMMER: RHC DTSBE429 00021 * DTSBE429 00022 * 05/15/95 ADD TAX DUE CUTOFF DATE. IF ONE OR MORE BALANCES DTSBE429 00023 * ARE DUE ON OR BEFORE THE CUTOFF DATE, PRINT THE DTSBE429 00024 * TOTAL OF ALL BALANCES DUE FOR THE EMPLOYER. DTSBE429 00025 * WORK ORDER: CR087 PROGRAMMER: RHC DTSBE429 00026 * DTSBE429 00027 * 02/23/99 MODIFIED TO MEET DUTAS PROGRAM SPECIFICATIONS. DTSBE429 00028 * WORK ORDER: PROGRAMMER: DVS DTSBE429 00029 * DTSBE429 00030 * 01/31/2008 MODIFIED ADMINISTRATIVE ASSESSMENT PROCESS DTSBE429 00031 * TO INCLUDE PENALTY AND INTEREST CALCULATION DTSBE429 00032 * STARTING WITH 2008/1. DTSBE429 00033 * REFERENCE: ADMIN ASSESS PROGRAMMER: RW1 DTSBE429 00034 * DTSBE429 00035 * XX/XX/XX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBE429 00036 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBE429 00037 * WORK ORDER: PROGRAMMER: XXX DTSBE429 00038 * DTSBE429 00039 * DTSBE429 00040 * DESCRIPTION: DTSBE429 00041 * DTSBE429 00042 * DTSBE429 00043 * INITIATION: DTSBE429 00044 * DTSBE429 00045 * SET LECM-MST-OPEN-READ-88 TO TRUE. DTSBE429 00046 * SET LECM-REF-OPEN-READ-88 TO TRUE. DTSBE429 00047 * DTSBE429 00048 * EDIT AND DEFAULT PARAMETERS. SEE PRINTED OUTPUTS DTSBE429 00049 * DESCRIPTIONS AND LAYOUTS (429R1). DTSBE429 00050 * DTSBE429 00051 * DTSBE429 00052 * PROCESSING: DTSBE429 00053 * DTSBE429 00054 * SEE PRINTED OUTPUTS DESCRIPTION AND LAYOUTS (429R1). DTSBE429 00055 * DTSBE429 00056 * DTSBE429 00057 * TERMINATION: DTSBE429 00058 * DTSBE429 00059 * NONE. DTSBE429 00060 * DTSBE429 00061 * DTSBE429 00062 * RECORDS READ: DTSBE429 00063 * DTSBE429 00064 * MASTER: DTSBE429 00065 * DTSBE429 00066 * MQTR DTSBE429 00067 * MFAS DTSBE429 00068 * MLIN DTSBE429 00069 * MDPC DTSBE429 00070 * MJRN DTSBE429 00071 * MSOL DTSBE429 00072 * DTSBE429 00073 * DTSBE429 00074 * ALTERNATE INDEX: DTSBE429 00075 * DTSBE429 00076 * NONE. DTSBE429 00077 * DTSBE429 00078 * DTSBE429 00079 * REFERENCE: DTSBE429 00080 * DTSBE429 00081 * NONE. DTSBE429 00082 * DTSBE429 00083 * DTSBE429 00084 * RECORDS UPDATED: DTSBE429 00085 * DTSBE429 00086 * NONE. DTSBE429 00087 * DTSBE429 00088 * DTSBE429 00089 * REPORT RECORDS WRITTEN: DTSBE429 00090 * DTSBE429 00091 * R429 COLLECTIONS SPECIALIST'S REPORT. DTSBE429 00092 * DTSBE429 00093 * DTSBE429 00094 * BATCH TRANSACTION COLLECTION RECORDS WRITTEN: DTSBE429 00095 * DTSBE429 00096 * NONE. DTSBE429 00097 * DTSBE429 00098 * DTSBE429 00099 * MODULES CALLED: DTSBE429 00100 * DTSBE429 00101 * DTSBU001 DATE CONVERSION/EDIT. DTSBE429 00102 * DTSBU004 QUARTER CONVERSION/EDIT. DTSBE429 00103 * DTSBU061 FIELD ZIP / FIELD REP ID. DTSBE429 00104 * DTSBU062 FIELD REP ID DESCRIPTION. DTSBE429 00105 * DTSBU101 INTEREST AND PENALTY COMPUTATION. DTSBE429 00106 * DTSBU910 MASTER FILE I/O DRIVER. DTSBE429 00107 * DTSBU946 VARIABLE LENGTH RECORDS SEQUENTIAL OUTPUT 1. DTSBE429 00108 * DTSBE429 00109 * DTSBE429 00110 * VERMONT REFERENCE: DTSBE429 00111 * DTSBE429 00112 * NONE. DTSBE429 00113 * DTSBE429 00114 ***** DTSBE429 00115 SKIP3 DTSBE429 00116 ENVIRONMENT DIVISION. DTSBE429 00117 EJECT DTSBE429 00118 DATA DIVISION. DTSBE429 00119 SKIP3 DTSBE429 00120 WORKING-STORAGE SECTION. DTSBE429 001205 77 PAN-VALET PICTURE X(24) VALUE '027DTSBE429 04/30/08'. DTSBE429 00121 SKIP3 DTSBE429 00122 01 WRK-AREA. DTSBE429 00123 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +429.DTSBE429 00124 SKIP1 DTSBE429 00125 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBE429'.DTSBE429 00126 SKIP1 DTSBE429 00127 05 ALL-NINES-AMT PIC S9(09)V9(02) COMP-3 DTSBE429 00128 VALUE +999999999.99. DTSBE429 00129 SKIP3 DTSBE429 00130 05 ABEND-MSG PIC X(60). DTSBE429 00131 SKIP3 DTSBE429 00132 05 WRK-INT-PEN-COMP-DATE PIC S9(09) COMP-3. DTSBE429 00133 DTSBE429 00134 05 WRK-FIRST-PAYMENT-DATE PIC S9(09) COMP-3. DTSBE429 00135 DTSBE429 00136 05 WRK-FLD-REP-SELECT-IND PIC X(01). DTSBE429 00137 DTSBE429 00138 05 WRK-TAX-DUE-DATE-FOUND-IND PIC X(01). DTSBE429 00139 88 WRK-TAX-DUE-DATE-FOUND-YES-88 VALUE 'Y'. DTSBE429 00140 88 WRK-TAX-DUE-DATE-FOUND-NO-88 VALUE 'N'. DTSBE429 00141 DTSBE429 00142 05 WRK-ACTIVE-AR-FAS-IND PIC X(01). DTSBE429 00143 88 WRK-ACTIVE-AR-FAS-YES-88 VALUE 'Y'. DTSBE429 00144 88 WRK-ACTIVE-AR-FAS-NO-88 VALUE 'N'. DTSBE429 00145 DTSBE429 00146 05 WRK-ACTIVE-YRQ-DPC-IND PIC X(01). DTSBE429 00147 88 WRK-ACTIVE-YRQ-DPC-88 VALUE 'Y'. DTSBE429 00148 88 WRK-NO-ACTIVE-YRQ-DPC-88 VALUE 'N'. DTSBE429 00149 DTSBE429 00150 05 WRK-ACTIVE-YRQ-LIEN-IND PIC X(01). DTSBE429 00151 88 WRK-ACTIVE-YRQ-LIEN-88 VALUE 'Y'. DTSBE429 00152 88 WRK-NO-ACTIVE-YRQ-LIEN-88 VALUE 'N'. DTSBE429 00153 DTSBE429 00154 05 DPC-ACTIVE-YRQ-CNT PIC S9(04) COMP. DTSBE429 00155 05 DPC-ACTIVE-YRQ OCCURS 400 TIMES DTSBE429 00156 INDEXED BY DPC-ACTIVE-IDX DTSBE429 00157 PIC S9(05) COMP-3. DTSBE429 00158 DTSBE429 00159 05 HOLD-DPC-YRQ PIC S9(05) COMP-3. DTSBE429 00160 DTSBE429 00161 05 NET-ACTIVE-DPC-YRQ-PAID-AMT PIC S9(09)V9(02) COMP-3. DTSBE429 00162 DTSBE429 00163 05 LIN-ACTIVE-YRQ-CNT PIC S9(04) COMP. DTSBE429 00164 05 LIN-ACTIVE-YRQ OCCURS 400 TIMES DTSBE429 00165 INDEXED BY LIN-ACTIVE-IDX DTSBE429 00166 PIC S9(05) COMP-3. DTSBE429 00167 DTSBE429 00168 05 HOLD-LIN-YRQ PIC S9(05) COMP-3. DTSBE429 00169 DTSBE429 00170 05 CATEGORY2-QTR-CNT PIC S9(04) COMP. DTSBE429 00171 DTSBE429 00172 05 WRK-QTR-BALANCE-AMT PIC S9(09)V9(02) COMP-3. DTSBE429 00173 DTSBE429 00174 05 WRK-TOT-BALANCE-AMT PIC S9(09)V9(02) COMP-3. DTSBE429 00175 *RW1 DTSBE429 00176 05 WRK-FIRST-PEN-INT-YRQ PIC S9(05) COMP-3. DTSBE429 00177 *RW2 DTSBE429 00178 DTSBE429 00179 01 MSG-AREA. DTSBE429 00180 05 MSG1-AREA. DTSBE429 00181 10 MSG1-ID PIC X(03) VALUE ' '. DTSBE429 00182 10 MSG1-TEXT. DTSBE429 00183 15 FILLER PIC X(40) DTSBE429 00184 VALUE ' '. DTSBE429 00185 15 FILLER PIC X(40) DTSBE429 00186 VALUE ' '. DTSBE429 00187 DTSBE429 00188 01 WRK-END-AREA PIC X(20) VALUE SPACE. DTSBE429 00189 EJECT DTSBE429 00190 01 L001-LINK-AREA. DTSBE429 00191 ++INCLUDE DTSIL001 DTSBE429 00192 EJECT DTSBE429 00193 01 L004-LINK-AREA. DTSBE429 00194 ++INCLUDE DTSIL004 DTSBE429 00195 EJECT DTSBE429 00196 01 L061-LINK-AREA. DTSBE429 00197 ++INCLUDE DTSIL061 DTSBE429 00198 EJECT DTSBE429 00199 01 L062-LINK-AREA. DTSBE429 00200 ++INCLUDE DTSIL062 DTSBE429 00201 EJECT DTSBE429 00202 01 L101-LINK-AREA. DTSBE429 00203 ++INCLUDE DTSIL101 DTSBE429 00204 EJECT DTSBE429 00205 01 L109-LINK-AREA. DTSBE429 00206 ++INCLUDE DTSIL109 DTSBE429 00207 EJECT DTSBE429 00208 01 L910-LINK-AREA. DTSBE429 00209 ++INCLUDE DTSIL910 DTSBE429 00210 SKIP3 DTSBE429 00211 01 MSKL-REC. DTSBE429 00212 ++INCLUDE DTSIMSKL DTSBE429 00213 SKIP3 DTSBE429 00214 01 MQTR-REC. DTSBE429 00215 ++INCLUDE DTSIMQTR DTSBE429 00216 SKIP3 DTSBE429 00217 01 MFAS-REC. DTSBE429 00218 ++INCLUDE DTSIMFAS DTSBE429 00219 SKIP3 DTSBE429 00220 01 MLIN-REC. DTSBE429 00221 ++INCLUDE DTSIMLIN DTSBE429 00222 SKIP3 DTSBE429 00223 01 MDPC-REC. DTSBE429 00224 ++INCLUDE DTSIMDPC DTSBE429 00225 SKIP3 DTSBE429 00226 01 MJRN-REC. DTSBE429 00227 ++INCLUDE DTSIMJRN DTSBE429 00228 SKIP3 DTSBE429 00229 01 MSOL-REC. DTSBE429 00230 ++INCLUDE DTSIMSOL DTSBE429 00231 EJECT DTSBE429 00232 01 R429-REC. DTSBE429 00233 ++INCLUDE DTSIR429 DTSBE429 00234 EJECT DTSBE429 00235 ++INCLUDE OJRWE429 DTSBE429 00236 EJECT DTSBE429 00237 LINKAGE SECTION. DTSBE429 00238 SKIP3 DTSBE429 00239 01 LECM-LINK-AREA. DTSBE429 00240 ++INCLUDE DTSILECM DTSBE429 00241 SKIP3 DTSBE429 00242 10 FILLER REDEFINES LECM-EXTRACT-PARMS. DTSBE429 00243 15 LECM-PARM-MIN-DUE-AMT PIC X(04). DTSBE429 00244 15 LECM-PARM-MIN-DUE-AMT-9 DTSBE429 00245 REDEFINES LECM-PARM-MIN-DUE-AMT DTSBE429 00246 PIC 9(04). DTSBE429 00247 15 FILLER PIC X(01). DTSBE429 00248 15 LECM-PARM-AR-ASSIGN-TYPE-1 PIC X(02). DTSBE429 00249 15 FILLER PIC X(01). DTSBE429 00250 15 LECM-PARM-AR-ASSIGN-TYPE-2 PIC X(02). DTSBE429 00251 15 FILLER PIC X(01). DTSBE429 00252 15 LECM-PARM-AR-ASSIGN-TYPE-3 PIC X(02). DTSBE429 00253 15 FILLER PIC X(01). DTSBE429 00254 15 LECM-PARM-FLD-REP-ID-1 PIC X(02). DTSBE429 00255 15 FILLER PIC X(01). DTSBE429 00256 15 LECM-PARM-FLD-REP-ID-2 PIC X(02). DTSBE429 00257 15 FILLER PIC X(01). DTSBE429 00258 15 LECM-PARM-TAX-DUE-CUTOFF-DT PIC X(06). DTSBE429 00259 15 FILLER PIC X(42). DTSBE429 00260 EJECT DTSBE429 00261 01 MPRF-LINK-REC. DTSBE429 00262 ++INCLUDE DTSIMPRF DTSBE429 00263 EJECT DTSBE429 00264 PROCEDURE DIVISION USING LECM-LINK-AREA DTSBE429 00265 MPRF-LINK-REC. DTSBE429 00266 MOVE LENGTH OF R429-REC TO R429-LENGTH. DTSBE429 00267 MOVE '429' TO R429-REC-TYPE. DTSBE429 00268 SKIP2 DTSBE429 00269 EVALUATE TRUE DTSBE429 00270 WHEN LECM-PROCESS-88 DTSBE429 00271 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBE429 00272 DTSBE429 00273 WHEN LECM-INITIALIZE-88 DTSBE429 00274 SET WRK-EDIT-PASSED-88 TO TRUE DTSBE429 00275 PERFORM I0000-INITIALIZE THRU I0000-EXIT DTSBE429 00276 IF WRK-EDIT-FAILED-88 DTSBE429 00277 PERFORM S999-ABEND THRU S999-EXIT DTSBE429 00278 END-IF DTSBE429 00279 DTSBE429 00280 WHEN LECM-TERMINATE-88 DTSBE429 00281 PERFORM T0000-TERMINATE THRU T0000-EXIT DTSBE429 00282 DTSBE429 00283 WHEN OTHER DTSBE429 00284 MOVE 'INVALID LECM-CALL-TYPE-IND ENCOUNTERED' DTSBE429 00285 TO ABEND-MSG DTSBE429 00286 PERFORM S999-ABEND THRU S999-EXIT DTSBE429 00287 DTSBE429 00288 END-EVALUATE. DTSBE429 00289 DTSBE429 00290 SKIP2 DTSBE429 00291 GOBACK. DTSBE429 00292 EJECT DTSBE429 00293 I0000-INITIALIZE. DTSBE429 00294 SKIP2 DTSBE429 00295 MOVE LECM-TRACE-IND TO L910-TRACE-IND. DTSBE429 00296 MOVE WRK-MOD-NAME TO L910-MOD-NAME. DTSBE429 00297 *OJR DTSBE429 00298 MOVE LECM-PARM-MIN-DUE-AMT TO OJR-PARM-MIN-DUE-AMT. DTSBE429 00299 MOVE LECM-PARM-AR-ASSIGN-TYPE-1 DTSBE429 00300 TO OJR-PARM-AR-ASSIGN-TYPE-1. DTSBE429 00301 MOVE LECM-PARM-AR-ASSIGN-TYPE-2 DTSBE429 00302 TO OJR-PARM-AR-ASSIGN-TYPE-2. DTSBE429 00303 MOVE LECM-PARM-AR-ASSIGN-TYPE-3 DTSBE429 00304 TO OJR-PARM-AR-ASSIGN-TYPE-3. DTSBE429 00305 MOVE LECM-PARM-FLD-REP-ID-1 TO OJR-PARM-FLD-REP-ID-1. DTSBE429 00306 MOVE LECM-PARM-FLD-REP-ID-2 TO OJR-PARM-FLD-REP-ID-2. DTSBE429 00307 MOVE LECM-PARM-TAX-DUE-CUTOFF-DT DTSBE429 00308 TO OJR-PARM-TAX-DUE-CUTOFF-DT. DTSBE429 00309 MOVE LECM-PRIOR-RUN-DATE TO OJR-PRIOR-RUN-DATE. DTSBE429 00310 DTSBE429 00311 PERFORM I1000-EDIT-AND-DEFAULT-PARMS THRU I1000-EXIT. DTSBE429 00312 DTSBE429 00313 MOVE LECM-CURR-RUN-DATE TO WRK-INT-PEN-COMP-DATE. DTSBE429 00314 DTSBE429 00315 MOVE LECM-PRIOR-RUN-DATE TO L001-FED-8-DATE-9. DTSBE429 00316 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBE429 00317 SUBTRACT 29 FROM L001-JUL-ABS-DAY. DTSBE429 00318 PERFORM S001-FROM-ABS-DAY THRU S001-EXIT. DTSBE429 00319 MOVE L001-FED-8-DATE-9 TO WRK-FIRST-PAYMENT-DATE. DTSBE429 00320 DTSBE429 00321 SET LECM-MST-OPEN-READ-88 TO TRUE. DTSBE429 00322 SET LECM-REF-OPEN-READ-88 TO TRUE. DTSBE429 00323 SKIP2 DTSBE429 00324 *RW1 DTSBE429 00325 PERFORM S109-FIRST-PEN-INT-YRQ THRU S109-EXIT. DTSBE429 00326 MOVE L109-FIRST-PEN-INT-YRQ TO WRK-FIRST-PEN-INT-YRQ. DTSBE429 00327 *RW2 DTSBE429 00328 I0000-EXIT. DTSBE429 00329 EXIT. DTSBE429 00330 ++INCLUDE OJRPE429 DTSBE429 00331 EJECT DTSBE429 00332 DTSBE429 00333 *************************************************************** DTSBE429 00334 * THIS IS THE PROCESS PARAGRAPH FOR DTSBE429. DTSBE429 00335 *************************************************************** DTSBE429 00336 DTSBE429 00337 P0000-PROCESS. DTSBE429 00338 DTSBE429 00339 IF MPRF-TOT-BALANCE-AMT > +0 DTSBE429 00340 NEXT SENTENCE DTSBE429 00341 ELSE DTSBE429 00342 GO TO P0000-EXIT. DTSBE429 00343 DTSBE429 00344 * IF MPRF-NOT-SUSPENDED-88 DTSBE429 00345 * NEXT SENTENCE DTSBE429 00346 * ELSE DTSBE429 00347 * GO TO P0000-EXIT. DTSBE429 00348 DTSBE429 00349 IF MPRF-BANKRP-OPEN-88 DTSBE429 00350 GO TO P0000-EXIT. DTSBE429 00351 DTSBE429 00352 PERFORM S061-DETERMINE-FLD-REP THRU S061-EXIT. DTSBE429 00353 MOVE L061-FLD-REP-ID TO L062-FLD-REP-ID. DTSBE429 00354 PERFORM S062-LOOKUP-FLD-REP THRU S062-EXIT. DTSBE429 00355 DTSBE429 00356 MOVE 'N' TO WRK-FLD-REP-SELECT-IND. DTSBE429 00357 PERFORM P0100-FLD-REP-SELECT THRU P0100-EXIT. DTSBE429 00358 IF WRK-FLD-REP-SELECT-IND = 'N' DTSBE429 00359 GO TO P0000-EXIT. DTSBE429 00360 DTSBE429 00361 SET WRK-ACTIVE-AR-FAS-NO-88 TO TRUE. DTSBE429 00362 DTSBE429 00363 IF MPRF-MFAS-EXISTS-88 DTSBE429 00364 PERFORM P1000-CHECK-FOR-ACTIVE-AR-FAS THRU P1000-EXIT. DTSBE429 00365 DTSBE429 00366 IF WRK-ACTIVE-AR-FAS-YES-88 DTSBE429 00367 GO TO P0000-EXIT. DTSBE429 00368 DTSBE429 00369 MOVE +0 TO DPC-ACTIVE-YRQ-CNT. DTSBE429 00370 IF MPRF-MDPC-EXISTS-88 DTSBE429 00371 PERFORM P2000-TABLE-ACTIVE-DPC-YRQ THRU P2000-EXIT. DTSBE429 00372 DTSBE429 00373 MOVE +0 TO LIN-ACTIVE-YRQ-CNT. DTSBE429 00374 IF MPRF-MLIN-EXISTS-88 DTSBE429 00375 PERFORM P3000-TABLE-ACTIVE-LIN-YRQ THRU P3000-EXIT. DTSBE429 00376 DTSBE429 00377 MOVE +0 TO CATEGORY2-QTR-CNT DTSBE429 00378 WRK-TOT-BALANCE-AMT. DTSBE429 00379 DTSBE429 00380 SET WRK-TAX-DUE-DATE-FOUND-NO-88 TO TRUE. DTSBE429 00381 PERFORM P4000-SCAN-QUARTERS THRU P4000-EXIT. DTSBE429 00382 IF WRK-TAX-DUE-DATE-FOUND-NO-88 DTSBE429 00383 GO TO P0000-EXIT. DTSBE429 00384 DTSBE429 00385 IF WRK-TOT-BALANCE-AMT > WRK-PARM-MIN-DUE-AMT DTSBE429 00386 NEXT SENTENCE DTSBE429 00387 ELSE DTSBE429 00388 GO TO P0000-EXIT. DTSBE429 00389 DTSBE429 00390 MOVE +0 TO NET-ACTIVE-DPC-YRQ-PAID-AMT. DTSBE429 00391 IF DPC-ACTIVE-YRQ-CNT > +0 DTSBE429 00392 PERFORM P5000-SCAN-JOURNAL THRU P5000-EXIT. DTSBE429 00393 DTSBE429 00394 PERFORM P6000-DETERMINE-CATEGORY THRU P6000-EXIT. DTSBE429 00395 DTSBE429 00396 PERFORM P7000-SETUP-R429 THRU P7000-EXIT. DTSBE429 00397 DTSBE429 00398 PERFORM S946-WRITE-R429 THRU S946-EXIT. DTSBE429 00399 DTSBE429 00400 P0000-EXIT. DTSBE429 00401 EXIT. DTSBE429 00402 SKIP3 DTSBE429 00403 P0100-FLD-REP-SELECT. DTSBE429 00404 IF (WRK-PARM-FLD-REP-ID-1 = SPACES) DTSBE429 00405 AND DTSBE429 00406 (WRK-PARM-FLD-REP-ID-2 = SPACES) DTSBE429 00407 MOVE 'Y' TO WRK-FLD-REP-SELECT-IND DTSBE429 00408 GO TO P0100-EXIT. DTSBE429 00409 DTSBE429 00410 IF WRK-PARM-FLD-REP-ID-1 = SPACES DTSBE429 00411 NEXT SENTENCE DTSBE429 00412 ELSE DTSBE429 00413 IF WRK-PARM-FLD-REP-ID-1 = L062-FLD-REP-ID DTSBE429 00414 MOVE 'Y' TO WRK-FLD-REP-SELECT-IND DTSBE429 00415 ELSE DTSBE429 00416 NEXT SENTENCE. DTSBE429 00417 DTSBE429 00418 IF WRK-PARM-FLD-REP-ID-2 = SPACES DTSBE429 00419 NEXT SENTENCE DTSBE429 00420 ELSE DTSBE429 00421 IF WRK-PARM-FLD-REP-ID-2 = L062-FLD-REP-ID DTSBE429 00422 MOVE 'Y' TO WRK-FLD-REP-SELECT-IND DTSBE429 00423 ELSE DTSBE429 00424 NEXT SENTENCE. DTSBE429 00425 P0100-EXIT. DTSBE429 00426 EXIT. DTSBE429 00427 EJECT DTSBE429 00428 P1000-CHECK-FOR-ACTIVE-AR-FAS. DTSBE429 00429 MOVE LOW-VALUES TO MFAS-KEY-AREA. DTSBE429 00430 MOVE MPRF-EMP-NO TO MFAS-EMP-NO. DTSBE429 00431 SET MFAS-FAS-88 TO TRUE. DTSBE429 00432 MOVE MFAS-KEY-AREA TO MSKL-KEY-AREA. DTSBE429 00433 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE429 00434 PERFORM P1100-SCAN-MFAS THRU P1100-EXIT DTSBE429 00435 UNTIL L910-NO-REC-88. DTSBE429 00436 P1000-EXIT. DTSBE429 00437 EXIT. DTSBE429 00438 SKIP3 DTSBE429 00439 P1100-SCAN-MFAS. DTSBE429 00440 MOVE MSKL-REC TO MFAS-REC. DTSBE429 00441 DTSBE429 00442 IF MFAS-STATUS-ACTIVE-88 DTSBE429 00443 IF MFAS-ASSIGN-TYPE = WRK-PARM-AR-ASSIGN-TYPE-1 DTSBE429 00444 OR WRK-PARM-AR-ASSIGN-TYPE-2 DTSBE429 00445 OR WRK-PARM-AR-ASSIGN-TYPE-3 DTSBE429 00446 SET WRK-ACTIVE-AR-FAS-YES-88 TO TRUE DTSBE429 00447 SET L910-NO-REC-88 TO TRUE DTSBE429 00448 GO TO P1100-EXIT. DTSBE429 00449 DTSBE429 00450 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE429 00451 P1100-EXIT. DTSBE429 00452 EXIT. DTSBE429 00453 EJECT DTSBE429 00454 P2000-TABLE-ACTIVE-DPC-YRQ. DTSBE429 00455 MOVE LOW-VALUES TO MDPC-KEY-AREA. DTSBE429 00456 MOVE MPRF-EMP-NO TO MDPC-EMP-NO. DTSBE429 00457 SET MDPC-DPC-88 TO TRUE. DTSBE429 00458 MOVE MDPC-KEY-AREA TO MSKL-KEY-AREA. DTSBE429 00459 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE429 00460 PERFORM P2100-SCAN-MDPC THRU P2100-EXIT DTSBE429 00461 UNTIL L910-NO-REC-88. DTSBE429 00462 P2000-EXIT. DTSBE429 00463 EXIT. DTSBE429 00464 SKIP2 DTSBE429 00465 P2100-SCAN-MDPC. DTSBE429 00466 MOVE MSKL-REC TO MDPC-REC. DTSBE429 00467 DTSBE429 00468 IF MDPC-STATUS-ACTIVE-88 DTSBE429 00469 PERFORM P2110-SCAN-COVERED-YRQ THRU P2110-EXIT DTSBE429 00470 VARYING MDPC-COV-IDX FROM 1 BY 1 DTSBE429 00471 UNTIL MDPC-COV-IDX > MDPC-COV-CNT. DTSBE429 00472 DTSBE429 00473 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE429 00474 P2100-EXIT. DTSBE429 00475 EXIT. DTSBE429 00476 SKIP2 DTSBE429 00477 P2110-SCAN-COVERED-YRQ. DTSBE429 00478 MOVE MDPC-COVERED-YRQ (MDPC-COV-IDX) TO HOLD-DPC-YRQ. DTSBE429 00479 DTSBE429 00480 PERFORM P2111-WRK-MDPC-YRQ-LOOP THRU P2111-EXIT DTSBE429 00481 VARYING DPC-ACTIVE-IDX FROM 1 BY 1 DTSBE429 00482 UNTIL (DPC-ACTIVE-IDX > DPC-ACTIVE-YRQ-CNT) DTSBE429 00483 OR DTSBE429 00484 (HOLD-DPC-YRQ = +0). DTSBE429 00485 DTSBE429 00486 IF HOLD-DPC-YRQ = +0 DTSBE429 00487 NEXT SENTENCE DTSBE429 00488 ELSE DTSBE429 00489 IF DPC-ACTIVE-YRQ-CNT < +400 DTSBE429 00490 ADD +1 TO DPC-ACTIVE-YRQ-CNT DTSBE429 00491 MOVE HOLD-DPC-YRQ DTSBE429 00492 TO DPC-ACTIVE-YRQ (DPC-ACTIVE-YRQ-CNT). DTSBE429 00493 P2110-EXIT. DTSBE429 00494 EXIT. DTSBE429 00495 SKIP2 DTSBE429 00496 P2111-WRK-MDPC-YRQ-LOOP. DTSBE429 00497 IF HOLD-DPC-YRQ = DPC-ACTIVE-YRQ (DPC-ACTIVE-IDX) DTSBE429 00498 MOVE +0 TO HOLD-DPC-YRQ. DTSBE429 00499 P2111-EXIT. DTSBE429 00500 EXIT. DTSBE429 00501 EJECT DTSBE429 00502 P3000-TABLE-ACTIVE-LIN-YRQ. DTSBE429 00503 MOVE LOW-VALUES TO MLIN-KEY-AREA. DTSBE429 00504 MOVE MPRF-EMP-NO TO MLIN-EMP-NO. DTSBE429 00505 SET MLIN-LIN-88 TO TRUE. DTSBE429 00506 MOVE MLIN-KEY-AREA TO MSKL-KEY-AREA. DTSBE429 00507 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE429 00508 PERFORM P3100-SCAN-MLIN THRU P3100-EXIT DTSBE429 00509 UNTIL L910-NO-REC-88. DTSBE429 00510 P3000-EXIT. DTSBE429 00511 EXIT. DTSBE429 00512 SKIP3 DTSBE429 00513 P3100-SCAN-MLIN. DTSBE429 00514 MOVE MSKL-REC TO MLIN-REC. DTSBE429 00515 DTSBE429 00516 IF MLIN-STATUS-ACTIVE-88 DTSBE429 00517 PERFORM P3110-SCAN-COVERED-YRQ THRU P3110-EXIT DTSBE429 00518 VARYING MLIN-COV-IDX FROM 1 BY 1 DTSBE429 00519 UNTIL MLIN-COV-IDX > MLIN-COV-CNT. DTSBE429 00520 DTSBE429 00521 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE429 00522 P3100-EXIT. DTSBE429 00523 EXIT. DTSBE429 00524 SKIP3 DTSBE429 00525 P3110-SCAN-COVERED-YRQ. DTSBE429 00526 MOVE MLIN-COVERED-YRQ (MLIN-COV-IDX) TO HOLD-LIN-YRQ. DTSBE429 00527 DTSBE429 00528 PERFORM P3111-WRK-MLIN-YRQ-LOOP THRU P3111-EXIT DTSBE429 00529 VARYING LIN-ACTIVE-IDX FROM 1 BY 1 DTSBE429 00530 UNTIL (LIN-ACTIVE-IDX > LIN-ACTIVE-YRQ-CNT) DTSBE429 00531 OR DTSBE429 00532 (HOLD-LIN-YRQ = +0). DTSBE429 00533 DTSBE429 00534 IF HOLD-LIN-YRQ = +0 DTSBE429 00535 NEXT SENTENCE DTSBE429 00536 ELSE DTSBE429 00537 IF LIN-ACTIVE-YRQ-CNT < +400 DTSBE429 00538 ADD +1 TO LIN-ACTIVE-YRQ-CNT DTSBE429 00539 MOVE HOLD-LIN-YRQ DTSBE429 00540 TO LIN-ACTIVE-YRQ (LIN-ACTIVE-YRQ-CNT). DTSBE429 00541 P3110-EXIT. DTSBE429 00542 EXIT. DTSBE429 00543 SKIP3 DTSBE429 00544 P3111-WRK-MLIN-YRQ-LOOP. DTSBE429 00545 IF HOLD-LIN-YRQ = LIN-ACTIVE-YRQ (LIN-ACTIVE-IDX) DTSBE429 00546 MOVE +0 TO HOLD-LIN-YRQ. DTSBE429 00547 P3111-EXIT. DTSBE429 00548 EXIT. DTSBE429 00549 EJECT DTSBE429 00550 *************************************************************** DTSBE429 00551 * THIS PARAGRAPH CAUSES THE MQTR RECORDS TO BE PROCESSED. DTSBE429 00552 *************************************************************** DTSBE429 00553 DTSBE429 00554 P4000-SCAN-QUARTERS. DTSBE429 00555 DTSBE429 00556 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSBE429 00557 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBE429 00558 SET MQTR-QTR-88 TO TRUE. DTSBE429 00559 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBE429 00560 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE429 00561 DTSBE429 00562 PERFORM P4100-PROCESS-MQTR-RECS THRU P4100-EXIT DTSBE429 00563 UNTIL L910-NO-REC-88. DTSBE429 00564 DTSBE429 00565 P4000-EXIT. DTSBE429 00566 EXIT. DTSBE429 00567 EJECT DTSBE429 00568 *************************************************************** DTSBE429 00569 * THIS PARAGRAPH PROCESSES THE MQTR RECORDS. DTSBE429 00570 *************************************************************** DTSBE429 00571 DTSBE429 00572 P4100-PROCESS-MQTR-RECS. DTSBE429 00573 DTSBE429 00574 MOVE MSKL-REC TO MQTR-REC. DTSBE429 00575 DTSBE429 00576 MOVE +0 TO WRK-QTR-BALANCE-AMT. DTSBE429 00577 PERFORM P4110-PROJECT-PEN-AND-INT THRU P4110-EXIT. DTSBE429 00578 DTSBE429 00579 IF WRK-QTR-BALANCE-AMT = +0 DTSBE429 00580 OR MQTR-TAX-DUE-DATE > WRK-PARM-TAX-DUE-CUTOFF-DT DTSBE429 00581 NEXT SENTENCE DTSBE429 00582 ELSE DTSBE429 00583 SET WRK-TAX-DUE-DATE-FOUND-YES-88 TO TRUE. DTSBE429 00584 DTSBE429 00585 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE429 00586 DTSBE429 00587 P4100-EXIT. DTSBE429 00588 EXIT. DTSBE429 00589 EJECT DTSBE429 00590 *************************************************************** DTSBE429 00591 * THIS PARAGRAPH PROJECTS PENALTY AND INTEREST AND INCREMENTS DTSBE429 00592 * THE CATEGORY 2 COUNT AS APPROPRIATE. DTSBE429 00593 *************************************************************** DTSBE429 00594 DTSBE429 00595 P4110-PROJECT-PEN-AND-INT. DTSBE429 00596 ***************************************************** DTSBE429 00597 * INCLUDE ONLY UI TAX IN CALCULATION OF INTEREST DTSBE429 00598 ***************************************************** DTSBE429 00599 DTSBE429 00600 MOVE ZERO TO L101-PAID-CHNG. DTSBE429 00601 DTSBE429 00602 PERFORM DTSBE429 00603 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSBE429 00604 UNTIL MQTR-ACCT-IDX GREATER THAN MQTR-ACCT-CNT DTSBE429 00605 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSBE429 00606 TO WRK-QTR-BALANCE-AMT DTSBE429 00607 IF MQTR-ACCT-UI-88 (MQTR-ACCT-IDX) DTSBE429 00608 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSBE429 00609 TO L101-PAID-CHNG DTSBE429 00610 END-IF DTSBE429 00611 *RW1 DTSBE429 00612 IF MQTR-ACCT-SUR-88 (MQTR-ACCT-IDX) DTSBE429 00613 IF MQTR-YRQ >= WRK-FIRST-PEN-INT-YRQ DTSBE429 00614 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSBE429 00615 TO L101-PAID-CHNG DTSBE429 00616 END-IF DTSBE429 00617 END-IF DTSBE429 00618 *RW2 DTSBE429 00619 * IF MQTR-ACCT-PEN-88 (MQTR-ACCT-IDX) DTSBE429 00620 * ADD MQTR-CHARGED-AMT (MQTR-ACCT-IDX) DTSBE429 00621 * TO L101-PEN-CHARGED-AMT DTSBE429 00622 * END-IF DTSBE429 00623 END-PERFORM. DTSBE429 00624 DTSBE429 00625 IF WRK-QTR-BALANCE-AMT > +0 DTSBE429 00626 NEXT SENTENCE DTSBE429 00627 ELSE DTSBE429 00628 GO TO P4110-EXIT. DTSBE429 00629 DTSBE429 00630 ADD WRK-QTR-BALANCE-AMT TO WRK-TOT-BALANCE-AMT. DTSBE429 00631 DTSBE429 00632 SET WRK-NO-ACTIVE-YRQ-DPC-88 TO TRUE. DTSBE429 00633 SET WRK-NO-ACTIVE-YRQ-LIEN-88 TO TRUE. DTSBE429 00634 DTSBE429 00635 PERFORM P4111-CHECK-ACTIVE-DPC THRU P4111-EXIT DTSBE429 00636 VARYING DPC-ACTIVE-IDX FROM 1 BY 1 DTSBE429 00637 UNTIL DPC-ACTIVE-IDX GREATER THAN DTSBE429 00638 DPC-ACTIVE-YRQ-CNT OR DTSBE429 00639 WRK-ACTIVE-YRQ-DPC-88. DTSBE429 00640 DTSBE429 00641 IF WRK-ACTIVE-YRQ-DPC-88 DTSBE429 00642 NEXT SENTENCE DTSBE429 00643 ELSE DTSBE429 00644 PERFORM P4112-CHECK-ACTIVE-LIEN THRU P4112-EXIT DTSBE429 00645 VARYING LIN-ACTIVE-IDX FROM 1 BY 1 DTSBE429 00646 UNTIL LIN-ACTIVE-IDX GREATER THAN DTSBE429 00647 LIN-ACTIVE-YRQ-CNT OR DTSBE429 00648 WRK-ACTIVE-YRQ-LIEN-88 DTSBE429 00649 IF WRK-ACTIVE-YRQ-LIEN-88 DTSBE429 00650 NEXT SENTENCE DTSBE429 00651 ELSE DTSBE429 00652 ADD +1 TO CATEGORY2-QTR-CNT. DTSBE429 00653 DTSBE429 00654 IF L101-PAID-CHNG GREATER THAN ZERO DTSBE429 00655 NEXT SENTENCE DTSBE429 00656 ELSE DTSBE429 00657 GO TO P4110-EXIT. DTSBE429 00658 DTSBE429 00659 MOVE WRK-INT-PEN-COMP-DATE TO L101-RECEIVED-DATE. DTSBE429 00660 SET L101-WAIVE-INT-NO-88 TO TRUE. DTSBE429 00661 MOVE MQTR-TAX-DUE-DATE TO L101-TAX-DUE-DATE. DTSBE429 00662 MOVE MQTR-INT-AREA TO L101-INT-AREA. DTSBE429 00663 DTSBE429 00664 PERFORM S101-PER-DIEM-NO THRU S101-EXIT. DTSBE429 00665 DTSBE429 00666 ADD L101-INT-CHARGE-CHNG TO WRK-TOT-BALANCE-AMT. DTSBE429 00667 ADD L101-INT-PER-MONTH TO WRK-TOT-BALANCE-AMT. DTSBE429 00668 SUBTRACT L101-INT-WAIVE-CHNG FROM WRK-TOT-BALANCE-AMT. DTSBE429 00669 * SUBTRACT L101-PEN-WAIVE-CHNG FROM WRK-TOT-BALANCE-AMT. DTSBE429 00670 DTSBE429 00671 P4110-EXIT. DTSBE429 00672 EXIT. DTSBE429 00673 EJECT DTSBE429 00674 *************************************************************** DTSBE429 00675 * THIS PARAGRAPH CHECKS FOR AN ACTIVE DPC FOR THE QUARTER DTSBE429 00676 * IN THE WORKING STORAGE TABLE. DTSBE429 00677 *************************************************************** DTSBE429 00678 DTSBE429 00679 P4111-CHECK-ACTIVE-DPC. DTSBE429 00680 DTSBE429 00681 IF MQTR-YRQ EQUAL DPC-ACTIVE-YRQ (DPC-ACTIVE-IDX) DTSBE429 00682 SET WRK-ACTIVE-YRQ-DPC-88 TO TRUE. DTSBE429 00683 DTSBE429 00684 P4111-EXIT. DTSBE429 00685 EXIT. DTSBE429 00686 EJECT DTSBE429 00687 *************************************************************** DTSBE429 00688 * THIS PARAGRAPH CHECKS FOR AN ACTIVE LIEN FOR THE QUARTER DTSBE429 00689 * IN THE WORKING STORAGE TABLE. DTSBE429 00690 *************************************************************** DTSBE429 00691 DTSBE429 00692 P4112-CHECK-ACTIVE-LIEN. DTSBE429 00693 DTSBE429 00694 IF MQTR-YRQ EQUAL LIN-ACTIVE-YRQ (LIN-ACTIVE-IDX) DTSBE429 00695 SET WRK-ACTIVE-YRQ-LIEN-88 TO TRUE. DTSBE429 00696 DTSBE429 00697 P4112-EXIT. DTSBE429 00698 EXIT. DTSBE429 00699 EJECT DTSBE429 00700 *************************************************************** DTSBE429 00701 * THIS PARAGRAPH CAUSES THE MJRNL RECORDS TO BE SCANNED. DTSBE429 00702 *************************************************************** DTSBE429 00703 DTSBE429 00704 P5000-SCAN-JOURNAL. DTSBE429 00705 DTSBE429 00706 MOVE LOW-VALUES TO MJRN-KEY-AREA. DTSBE429 00707 MOVE MPRF-EMP-NO TO MJRN-EMP-NO. DTSBE429 00708 SET MJRN-JRN-88 TO TRUE. DTSBE429 00709 MOVE MJRN-KEY-AREA TO MSKL-KEY-AREA. DTSBE429 00710 DTSBE429 00711 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE429 00712 DTSBE429 00713 PERFORM P5100-PROCESS-MJRN-RECS THRU P5100-EXIT DTSBE429 00714 UNTIL L910-NO-REC-88. DTSBE429 00715 DTSBE429 00716 P5000-EXIT. DTSBE429 00717 EXIT. DTSBE429 00718 EJECT DTSBE429 00719 *************************************************************** DTSBE429 00720 * THIS PARAGRAPH PROCESSES THE MJRN RECORDS. DTSBE429 00721 *************************************************************** DTSBE429 00722 DTSBE429 00723 P5100-PROCESS-MJRN-RECS. DTSBE429 00724 DTSBE429 00725 MOVE MSKL-REC TO MJRN-REC. DTSBE429 00726 DTSBE429 00727 IF MJRN-TRAN-CNVR-88 DTSBE429 00728 NEXT SENTENCE DTSBE429 00729 ELSE DTSBE429 00730 IF MJRN-ESTB-DATE LESS THAN WRK-FIRST-PAYMENT-DATE DTSBE429 00731 NEXT SENTENCE DTSBE429 00732 ELSE DTSBE429 00733 PERFORM P5110-ACCUM-MJRN-AMTS THRU P5110-EXIT DTSBE429 00734 VARYING MJRN-OCC-IDX FROM 1 BY 1 DTSBE429 00735 UNTIL MJRN-OCC-IDX GREATER THAN MJRN-OCC-CNT. DTSBE429 00736 DTSBE429 00737 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE429 00738 DTSBE429 00739 P5100-EXIT. DTSBE429 00740 EXIT. DTSBE429 00741 EJECT DTSBE429 00742 *************************************************************** DTSBE429 00743 * THIS PARAGRAPH CHECKS THE TYPE OF PAYMENT. DTSBE429 00744 *************************************************************** DTSBE429 00745 DTSBE429 00746 P5110-ACCUM-MJRN-AMTS. DTSBE429 00747 DTSBE429 00748 DTSBE429 00749 IF MJRN-COL-PAID-88 (MJRN-OCC-IDX) DTSBE429 00750 MOVE MJRN-YRQ (MJRN-OCC-IDX) TO HOLD-DPC-YRQ DTSBE429 00751 SET WRK-NO-ACTIVE-YRQ-DPC-88 TO TRUE DTSBE429 00752 PERFORM P5111-CHECK-ACTIVE-YRQ-DPC THRU P5111-EXIT DTSBE429 00753 VARYING DPC-ACTIVE-IDX FROM 1 BY 1 DTSBE429 00754 UNTIL DPC-ACTIVE-IDX GREATER THAN DTSBE429 00755 DPC-ACTIVE-YRQ-CNT OR DTSBE429 00756 WRK-ACTIVE-YRQ-DPC-88. DTSBE429 00757 DTSBE429 00758 P5110-EXIT. DTSBE429 00759 EXIT. DTSBE429 00760 EJECT DTSBE429 00761 *************************************************************** DTSBE429 00762 * THIS PARAGRAPH CHECKS FOR AN ACTIVE DPC. DTSBE429 00763 *************************************************************** DTSBE429 00764 DTSBE429 00765 P5111-CHECK-ACTIVE-YRQ-DPC. DTSBE429 00766 DTSBE429 00767 IF HOLD-DPC-YRQ EQUAL DPC-ACTIVE-YRQ (DPC-ACTIVE-IDX) DTSBE429 00768 SET WRK-ACTIVE-YRQ-DPC-88 TO TRUE DTSBE429 00769 ADD MJRN-AMT (MJRN-OCC-IDX) DTSBE429 00770 TO NET-ACTIVE-DPC-YRQ-PAID-AMT. DTSBE429 00771 DTSBE429 00772 P5111-EXIT. DTSBE429 00773 EXIT. DTSBE429 00774 EJECT DTSBE429 00775 *************************************************************** DTSBE429 00776 * THIS PARAGRAPH DETERMINES THE CATEGORY. DTSBE429 00777 *************************************************************** DTSBE429 00778 DTSBE429 00779 P6000-DETERMINE-CATEGORY. DTSBE429 00780 DTSBE429 00781 IF (DPC-ACTIVE-YRQ-CNT > +0) DTSBE429 00782 AND DTSBE429 00783 (NET-ACTIVE-DPC-YRQ-PAID-AMT NOT > +0) DTSBE429 00784 SET R429-CATEGORY-DEF-PAYMNT-88 TO TRUE DTSBE429 00785 GO TO P6000-EXIT. DTSBE429 00786 DTSBE429 00787 IF CATEGORY2-QTR-CNT > +0 DTSBE429 00788 IF (MPRF-STATUS-INACT-88 OR MPRF-MLIN-EXISTS-88) DTSBE429 00789 SET R429-CATEGORY-LIEN-CAND-88 TO TRUE DTSBE429 00790 GO TO P6000-EXIT. DTSBE429 00791 DTSBE429 00792 IF CATEGORY2-QTR-CNT > +1 DTSBE429 00793 SET R429-CATEGORY-LIEN-CAND-88 TO TRUE DTSBE429 00794 GO TO P6000-EXIT. DTSBE429 00795 DTSBE429 00796 IF MPRF-STATUS-ACT-88 DTSBE429 00797 SET R429-CATEGORY-ALL-ELSE-A-88 TO TRUE DTSBE429 00798 ELSE DTSBE429 00799 SET R429-CATEGORY-ALL-ELSE-I-88 TO TRUE. DTSBE429 00800 DTSBE429 00801 P6000-EXIT. DTSBE429 00802 EXIT. DTSBE429 00803 EJECT DTSBE429 00804 ************************************************************** DTSBE429 00805 * THIS PARAGRAPH SETS UP THE R429 REPORT EXTRACT RECORD. DTSBE429 00806 ************************************************************** DTSBE429 00807 DTSBE429 00808 P7000-SETUP-R429. DTSBE429 00809 DTSBE429 00810 MOVE L062-FLD-REP-ID TO R429-FLD-REP-ID. DTSBE429 00811 COMPUTE R429-TOT-BAL-AMT-INV = DTSBE429 00812 ALL-NINES-AMT - DTSBE429 00813 WRK-TOT-BALANCE-AMT. DTSBE429 00814 MOVE MPRF-EMP-NO TO R429-EMP-NO. DTSBE429 00815 DTSBE429 00816 MOVE WRK-PARM-MIN-DUE-AMT TO R429-PARM-BAL-AMT. DTSBE429 00817 DTSBE429 00818 MOVE +0 TO R429-FLD-REP-CNT. DTSBE429 00819 IF WRK-PARM-FLD-REP-ID-1 NOT = SPACES DTSBE429 00820 ADD +1 TO R429-FLD-REP-CNT DTSBE429 00821 MOVE WRK-PARM-FLD-REP-ID-1 DTSBE429 00822 TO R429-FLD-REP-PARM (R429-FLD-REP-CNT). DTSBE429 00823 IF WRK-PARM-FLD-REP-ID-2 NOT = SPACES DTSBE429 00824 ADD +1 TO R429-FLD-REP-CNT DTSBE429 00825 MOVE WRK-PARM-FLD-REP-ID-2 DTSBE429 00826 TO R429-FLD-REP-PARM (R429-FLD-REP-CNT). DTSBE429 00827 DTSBE429 00828 MOVE WRK-PARM-TAX-DUE-CUTOFF-DT TO R429-TAX-DUE-CUTOFF-DT. DTSBE429 00829 DTSBE429 00830 MOVE +0 TO R429-FIELD-TYPE-CNT. DTSBE429 00831 IF WRK-PARM-AR-ASSIGN-TYPE-1 NOT = SPACES DTSBE429 00832 ADD +1 TO R429-FIELD-TYPE-CNT DTSBE429 00833 MOVE WRK-PARM-AR-ASSIGN-TYPE-1 DTSBE429 00834 TO R429-FIELD-TYPE-PARM (R429-FIELD-TYPE-CNT). DTSBE429 00835 IF WRK-PARM-AR-ASSIGN-TYPE-2 NOT = SPACES DTSBE429 00836 ADD +1 TO R429-FIELD-TYPE-CNT DTSBE429 00837 MOVE WRK-PARM-AR-ASSIGN-TYPE-2 DTSBE429 00838 TO R429-FIELD-TYPE-PARM (R429-FIELD-TYPE-CNT). DTSBE429 00839 IF WRK-PARM-AR-ASSIGN-TYPE-3 NOT = SPACES DTSBE429 00840 ADD +1 TO R429-FIELD-TYPE-CNT DTSBE429 00841 MOVE WRK-PARM-AR-ASSIGN-TYPE-3 DTSBE429 00842 TO R429-FIELD-TYPE-PARM (R429-FIELD-TYPE-CNT). DTSBE429 00843 DTSBE429 00844 MOVE WRK-INT-PEN-COMP-DATE TO R429-INT-PEN-COMP-DATE. DTSBE429 00845 MOVE MPRF-PRIMARY-NAME TO R429-PRIMARY-NAME. DTSBE429 00846 DTSBE429 00847 MOVE +0 TO R429-INAC-DATE. DTSBE429 00848 IF MPRF-STATUS-INACT-88 DTSBE429 00849 PERFORM P7100-GREATEST-INACT-DATE THRU P7100-EXIT. DTSBE429 00850 DTSBE429 00851 MOVE WRK-TOT-BALANCE-AMT TO R429-TOT-BAL-AMT. DTSBE429 00852 DTSBE429 00853 P7000-EXIT. DTSBE429 00854 EXIT. DTSBE429 00855 EJECT DTSBE429 00856 ************************************************************** DTSBE429 00857 * THIS PARAGRAPH FINDS THE LATEST INACTIVE DATE. DTSBE429 00858 ************************************************************** DTSBE429 00859 DTSBE429 00860 P7100-GREATEST-INACT-DATE. DTSBE429 00861 DTSBE429 00862 MOVE LOW-VALUES TO MSOL-KEY-AREA. DTSBE429 00863 MOVE MPRF-EMP-NO TO MSOL-EMP-NO. DTSBE429 00864 SET MSOL-SOL-88 TO TRUE. DTSBE429 00865 MOVE MSOL-KEY-AREA TO MSKL-KEY-AREA. DTSBE429 00866 DTSBE429 00867 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE429 00868 DTSBE429 00869 PERFORM P7110-SCAN-MSOL THRU P7110-EXIT DTSBE429 00870 UNTIL L910-NO-REC-88. DTSBE429 00871 DTSBE429 00872 P7100-EXIT. DTSBE429 00873 EXIT. DTSBE429 00874 SKIP3 DTSBE429 00875 ************************************************************** DTSBE429 00876 * THIS PARAGRAPH SCANS THE MSOL RECORDS FOR INACTIVE DATE. DTSBE429 00877 ************************************************************** DTSBE429 00878 DTSBE429 00879 P7110-SCAN-MSOL. DTSBE429 00880 DTSBE429 00881 MOVE MSKL-REC TO MSOL-REC. DTSBE429 00882 DTSBE429 00883 IF MSOL-INACT-ACTIVE-88 DTSBE429 00884 NEXT SENTENCE DTSBE429 00885 ELSE DTSBE429 00886 IF MSOL-INACT-DATE > R429-INAC-DATE DTSBE429 00887 MOVE MSOL-INACT-DATE TO R429-INAC-DATE. DTSBE429 00888 DTSBE429 00889 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE429 00890 DTSBE429 00891 P7110-EXIT. DTSBE429 00892 EXIT. DTSBE429 00893 EJECT DTSBE429 00894 T0000-TERMINATE. DTSBE429 00895 DTSBE429 00896 MOVE SPACE TO WRK-END-AREA. DTSBE429 00897 DTSBE429 00898 T0000-EXIT. DTSBE429 00899 EXIT. DTSBE429 00900 EJECT DTSBE429 00901 S001-FROM-FED-8. DTSBE429 00902 SET L001-FROM-FED-8 TO TRUE. DTSBE429 00903 GO TO S001-DATE. DTSBE429 00904 SKIP1 DTSBE429 00905 S001-FROM-CAL-6. DTSBE429 00906 SET L001-FROM-CAL-6 TO TRUE. DTSBE429 00907 GO TO S001-DATE. DTSBE429 00908 SKIP1 DTSBE429 00909 S001-FROM-ABS-DAY. DTSBE429 00910 SET L001-FROM-ABS-DAY TO TRUE. DTSBE429 00911 GO TO S001-DATE. DTSBE429 00912 SKIP1 DTSBE429 00913 S001-DATE. DTSBE429 00914 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBE429 00915 S001-EXIT. DTSBE429 00916 EXIT. DTSBE429 00917 SKIP3 DTSBE429 00918 *S004-FROM-5. DTSBE429 00919 ** SET L004-FROM-5 TO TRUE. DTSBE429 00920 ** GO TO S004-QTR. DTSBE429 00921 ** DTSBE429 00922 *S004-FROM-ABS. DTSBE429 00923 ** SET L004-FROM-ABS TO TRUE. DTSBE429 00924 ** GO TO S004-QTR. DTSBE429 00925 ** DTSBE429 00926 *S004-FROM-3. DTSBE429 00927 ** SET L004-FROM-3 TO TRUE. DTSBE429 00928 ** GO TO S004-QTR. DTSBE429 00929 ** DTSBE429 00930 *S004-QTR. DTSBE429 00931 ** SKIP1 DTSBE429 00932 ** CALL 'DTSBU004' USING L004-LINK-AREA. DTSBE429 00933 ** DTSBE429 00934 *S004-EXIT. DTSBE429 00935 ** EXIT. DTSBE429 00936 DTSBE429 00937 S061-DETERMINE-FLD-REP. DTSBE429 00938 MOVE MPRF-FLD-ZIP TO L061-FLD-ZIP. DTSBE429 00939 MOVE MPRF-FLD-ST TO L061-FLD-ST. DTSBE429 00940 MOVE MPRF-EMP-NO TO L061-EMP-NO. DTSBE429 00941 DTSBE429 00942 CALL 'DTSBU061' USING L061-LINK-AREA. DTSBE429 00943 S061-EXIT. DTSBE429 00944 EXIT. DTSBE429 00945 SKIP3 DTSBE429 00946 S062-LOOKUP-FLD-REP. DTSBE429 00947 CALL 'DTSBU062' USING L062-LINK-AREA. DTSBE429 00948 S062-EXIT. DTSBE429 00949 EXIT. DTSBE429 00950 SKIP3 DTSBE429 00951 S101-PER-DIEM-NO. DTSBE429 00952 SET L101-PER-MONTH-NO-88 TO TRUE. DTSBE429 00953 GO TO S101-INT-PEN-COMP. DTSBE429 00954 DTSBE429 00955 S101-INT-PEN-COMP. DTSBE429 00956 CALL 'DTSBU101' USING L101-LINK-AREA. DTSBE429 00957 S101-EXIT. DTSBE429 00958 EXIT. DTSBE429 00959 SKIP3 DTSBE429 00960 S109-FIRST-PEN-INT-YRQ. DTSBE429 00961 SET L109-CMND-PEN-INT-QTR-88 TO TRUE. DTSBE429 00962 GO TO S109-SUR-RATE. DTSBE429 00963 DTSBE429 00964 S109-SUR-RATE. DTSBE429 00965 CALL 'DTSBU109' USING L109-LINK-AREA. DTSBE429 00966 S109-EXIT. DTSBE429 00967 EXIT. DTSBE429 00968 SKIP3 DTSBE429 00969 *S910-READ. DTSBE429 00970 ** SET L910-READ-88 TO TRUE. DTSBE429 00971 ** GO TO S910-MSTR-IO. DTSBE429 00972 ** DTSBE429 00973 S910-START-BROWSE. DTSBE429 00974 SET L910-START-BROWSE-88 TO TRUE. DTSBE429 00975 GO TO S910-MSTR-IO. DTSBE429 00976 DTSBE429 00977 S910-READ-NEXT. DTSBE429 00978 SET L910-READ-NEXT-88 TO TRUE. DTSBE429 00979 GO TO S910-MSTR-IO. DTSBE429 00980 DTSBE429 00981 *S910-COUNT. DTSBE429 00982 ** SET L910-COUNT-88 TO TRUE. DTSBE429 00983 ** GO TO S910-MSTR-IO. DTSBE429 00984 DTSBE429 00985 S910-MSTR-IO. DTSBE429 00986 CALL 'DTSBU910' USING L910-LINK-AREA DTSBE429 00987 MSKL-REC. DTSBE429 00988 S910-EXIT. DTSBE429 00989 EXIT. DTSBE429 00990 SKIP3 DTSBE429 00991 S946-WRITE-R429. DTSBE429 00992 CALL 'DTSBU946' USING R429-REC. DTSBE429 00993 GO TO S946-EXIT. DTSBE429 00994 SKIP1 DTSBE429 00995 S946-EXIT. DTSBE429 00996 EXIT. DTSBE429 00997 SKIP3 DTSBE429 00998 S999-ABEND. DTSBE429 00999 DISPLAY '*** DTSBE429 ABENDING. ' DTSBE429 01000 ABEND-MSG. DTSBE429 01001 SKIP1 DTSBE429 01002 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBE429 01003 S999-EXIT. DTSBE429 01004 EXIT. DTSBE429