00001 IDENTIFICATION DIVISION. 04/01/99 00002 PROGRAM-ID. DTSBE717. DTSBE717 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV012 00004 MODIFIED BY TRW/BDM OCT. 1998. CL**3 00005 DATE-WRITTEN. SEPTEMBER 1994. DTSBE717 00006 DATE-COMPILED. DTSBE717 00007 SKIP3 DTSBE717 00008 ***** DTSBE717 00009 * DTSBE717 00010 * CALLING SEQUENCE: DTSBD400 CALLS CL**2 00011 * DTSBE717 WHICH UPDATES DTSIR717 CL**2 00012 * DTSBR717 READS DTSIR715 RECORDS. CL**2 00013 * CL**2 00014 * FUNCTION: RQC COLLECTIONS UNIVERSE RECORDS EXTRACT. DTSBE717 00015 * DTSBE717 00016 * DTSBE717 00017 * MODIFICATION LOG: DTSBE717 00018 * DTSBE717 00019 * XX/XX/XX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBE717 00020 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBE717 00021 * WORK ORDER: PROGRAMMER: XXX DTSBE717 00022 * DTSBE717 00023 * DTSBE717 00024 * DESCRIPTION: DTSBE717 00025 * DTSBE717 00026 * DTSBE717 00027 * INITIATION: DTSBE717 00028 * DTSBE717 00029 * SET LECM-MST-OPEN-READ-88 TO TRUE. DTSBE717 00030 * SET LECM-REF-OPEN-READ-88 TO TRUE. DTSBE717 00031 * DTSBE717 00032 * EDIT AND DEFAULT PARAMETERS. DTSBE717 00033 * DTSBE717 00034 * DTSBE717 00035 * PROCESSING: DTSBE717 00036 * DTSBE717 00037 * SEE PRINTED OUTPUTS DESCRIPTION AND LAYOUTS (717R1). DTSBE717 00038 * DTSBE717 00039 * DTSBE717 00040 * TERMINATION: DTSBE717 00041 * DTSBE717 00042 * NONE. DTSBE717 00043 * DTSBE717 00044 * DTSBE717 00045 * RECORDS READ: DTSBE717 00046 * DTSBE717 00047 * MASTER: DTSBE717 00048 * DTSBE717 00049 * MQTR DTSBE717 00050 * MJRN DTSBE717 00051 * DTSBE717 00052 * DTSBE717 00053 * ALTERNATE INDEX: DTSBE717 00054 * DTSBE717 00055 * NONE. DTSBE717 00056 * DTSBE717 00057 * DTSBE717 00058 * REFERENCE: DTSBE717 00059 * DTSBE717 00060 * NONE. DTSBE717 00061 * DTSBE717 00062 * DTSBE717 00063 * RECORDS UPDATED: DTSBE717 00064 * DTSBE717 00065 * NONE. DTSBE717 00066 * DTSBE717 00067 * DTSBE717 00068 * REPORT RECORDS WRITTEN: DTSBE717 00069 * DTSBE717 00070 * R717 RQC COLLECTIONS UNIVERSE EXTRACT. DTSBE717 00071 * DTSBE717 00072 * DTSBE717 00073 * BATCH TRANSACTION COLLECTION RECORDS WRITTEN: DTSBE717 00074 * DTSBE717 00075 * NONE. DTSBE717 00076 * DTSBE717 00077 * DTSBE717 00078 * MODULES CALLED: DTSBE717 00079 * DTSBE717 00080 * DTSBU001 DATE EDIT/CONVERSION. CL**3 00081 * DTSBU910 MASTER FILE I/O. CL**3 00082 * DTSBU946 VARIABLE LENGTH RECORDS SEQUENTIAL OUTPUT 1. CL**3 00083 * DTSBE717 00084 * DTSBE717 00085 * VERMONT REFERENCE: DTSBE717 00086 * DTSBE717 00087 * NONE. DTSBE717 00088 * DTSBE717 00089 ***** DTSBE717 00090 SKIP3 DTSBE717 00091 ENVIRONMENT DIVISION. DTSBE717 00092 EJECT DTSBE717 00093 DATA DIVISION. DTSBE717 00094 SKIP3 DTSBE717 00095 WORKING-STORAGE SECTION. DTSBE717 000955 77 PAN-VALET PICTURE X(24) VALUE '012DTSBE717 04/01/99'. DTSBE717 00096 SKIP3 DTSBE717 00097 01 WRK-AREA. DTSBE717 00098 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +717.DTSBE717 00099 SKIP1 DTSBE717 00100 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBE717'. CL**3 00101 SKIP3 DTSBE717 00102 05 ABEND-MSG PIC X(60). DTSBE717 00103 SKIP3 DTSBE717 00104 05 WRK-PARM-MIN-AMT PIC S9(09)V9(02) COMP-3. DTSBE717 00105 DTSBE717 00106 05 WRK-PARM-PERIOD-START-DATE PIC S9(09) COMP-3. DTSBE717 00107 SKIP3 DTSBE717 00108 05 WRK-CURRENT-UI-TAX-PAST-DUE PIC S9(09)V9(02) COMP-3. DTSBE717 00109 DTSBE717 00110 05 WRK-START-UI-TAX-PAST-DUE PIC S9(09)V9(02) COMP-3. DTSBE717 00111 DTSBE717 00112 05 WRK-YRQ PIC S9(05) COMP-3. DTSBE717 00113 DTSBE717 00114 05 QTR-CNT-MAX PIC S9(04) COMP VALUE +400.DTSBE717 00115 DTSBE717 00116 05 QTR-SUB PIC S9(04) COMP. DTSBE717 00117 DTSBE717 00118 05 QTR-CNT PIC S9(04) COMP. DTSBE717 00119 DTSBE717 00120 05 QTR-START-PAST-DUE-YRQ OCCURS 400 TIMES DTSBE717 00121 INDEXED BY QTR-IDX DTSBE717 00122 PIC S9(05) COMP-3. DTSBE717 00123 EJECT DTSBE717 00124 01 L001-LINK-AREA. DTSBE717 00125 ++INCLUDE DTSIL001 CL**3 00126 EJECT DTSBE717 00127 01 L910-LINK-AREA. DTSBE717 00128 ++INCLUDE DTSIL910 CL**3 00129 SKIP3 DTSBE717 00130 01 MSKL-REC. DTSBE717 00131 ++INCLUDE DTSIMSKL CL**3 00132 SKIP3 DTSBE717 00133 01 MQTR-REC. DTSBE717 00134 ++INCLUDE DTSIMQTR CL**3 00135 SKIP3 DTSBE717 00136 01 MJRN-REC. DTSBE717 00137 ++INCLUDE DTSIMJRN CL**3 00138 EJECT DTSBE717 00139 01 R717-REC. DTSBE717 00140 ++INCLUDE DTSIR717 CL**3 00141 EJECT DTSBE717 00142 LINKAGE SECTION. DTSBE717 00143 SKIP3 DTSBE717 00144 01 LECM-LINK-AREA. DTSBE717 00145 ++INCLUDE DTSILECM CL**3 00146 SKIP3 DTSBE717 00147 10 FILLER REDEFINES LECM-EXTRACT-PARMS. DTSBE717 00148 15 LECM-PARM-MIN-AMT PIC X(03). DTSBE717 00149 15 LECM-PARM-MIN-AMT-9 DTSBE717 00150 REDEFINES LECM-PARM-MIN-AMT PIC 9(03). DTSBE717 00151 15 FILLER PIC X(01). DTSBE717 00152 15 LECM-PARM-PERIOD-START-DATE PIC X(06). DTSBE717 00153 15 FILLER PIC X(58). DTSBE717 00154 EJECT DTSBE717 00155 01 MPRF-LINK-REC. DTSBE717 00156 ++INCLUDE DTSIMPRF CL**5 00157 EJECT DTSBE717 00158 PROCEDURE DIVISION USING LECM-LINK-AREA DTSBE717 00159 MPRF-LINK-REC. DTSBE717 00160 SKIP2 DTSBE717 00161 SKIP2 CL**4 00162 IF LECM-PROCESS-88 DTSBE717 00163 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBE717 00164 ELSE DTSBE717 00165 IF LECM-INITIALIZE-88 DTSBE717 00166 PERFORM I0000-INITIALIZE THRU I0000-EXIT DTSBE717 00167 ELSE DTSBE717 00168 IF LECM-TERMINATE-88 DTSBE717 00169 PERFORM T0000-TERMINATE THRU T0000-EXIT DTSBE717 00170 ELSE DTSBE717 00171 MOVE 'INVALID LECM-CALL-TYPE-IND ENCOUNTERED' DTSBE717 00172 TO ABEND-MSG DTSBE717 00173 PERFORM S999-ABEND THRU S999-EXIT. DTSBE717 00174 SKIP2 DTSBE717 00175 GOBACK. DTSBE717 00176 EJECT DTSBE717 00177 I0000-INITIALIZE. DTSBE717 00178 SKIP2 DTSBE717 00179 MOVE LENGTH OF R717-REC TO R717-LENGTH. CL*11 00180 MOVE '717' TO R717-REC-TYPE. CL*11 00181 MOVE LECM-TRACE-IND TO L910-TRACE-IND. DTSBE717 00182 MOVE WRK-MOD-NAME TO L910-MOD-NAME. DTSBE717 00183 PERFORM I1000-EDIT-AND-DEFAULT-PARMS THRU I1000-EXIT. DTSBE717 00184 DTSBE717 00185 SET LECM-MST-OPEN-READ-88 TO TRUE. DTSBE717 00186 SET LECM-REF-OPEN-READ-88 TO TRUE. DTSBE717 00187 SKIP2 DTSBE717 00188 I0000-EXIT. DTSBE717 00189 EXIT. DTSBE717 00190 SKIP3 DTSBE717 00191 I1000-EDIT-AND-DEFAULT-PARMS. DTSBE717 00192 PERFORM I1100-MIN-AMT THRU I1100-EXIT. DTSBE717 00193 DTSBE717 00194 PERFORM I1200-PERIOD-START-DATE THRU I1200-EXIT. DTSBE717 00195 I1000-EXIT. DTSBE717 00196 EXIT. DTSBE717 00197 SKIP3 DTSBE717 00198 I1100-MIN-AMT. DTSBE717 00199 IF LECM-PARM-MIN-AMT = SPACES DTSBE717 00200 MOVE +100 TO WRK-PARM-MIN-AMT DTSBE717 00201 ELSE DTSBE717 00202 IF LECM-PARM-MIN-AMT NUMERIC DTSBE717 00203 MOVE LECM-PARM-MIN-AMT-9 TO WRK-PARM-MIN-AMT DTSBE717 00204 ELSE DTSBE717 00205 MOVE 'LECM-PARM-MIN-AMT NOT VALID' DTSBE717 00206 TO ABEND-MSG DTSBE717 00207 PERFORM S999-ABEND THRU S999-EXIT. DTSBE717 00208 I1100-EXIT. DTSBE717 00209 EXIT. DTSBE717 00210 SKIP3 DTSBE717 00211 I1200-PERIOD-START-DATE. DTSBE717 00212 IF LECM-PARM-PERIOD-START-DATE = SPACES DTSBE717 00213 MOVE LECM-PRIOR-RUN-DATE TO L001-FED-8-DATE-9 DTSBE717 00214 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBE717 00215 SUBTRACT 30 FROM L001-JUL-ABS-DAY DTSBE717 00216 PERFORM S001-FROM-ABS-DAY THRU S001-EXIT DTSBE717 00217 MOVE L001-FED-8-DATE-9 TO WRK-PARM-PERIOD-START-DATE DTSBE717 00218 ELSE DTSBE717 00219 MOVE LECM-PARM-PERIOD-START-DATE TO L001-CAL-6-DATE-X DTSBE717 00220 PERFORM S001-FROM-CAL-6 THRU S001-EXIT DTSBE717 00221 IF L001-VALID-DATE DTSBE717 00222 MOVE L001-FED-8-DATE-9 TO WRK-PARM-PERIOD-START-DATE DTSBE717 00223 ELSE DTSBE717 00224 MOVE 'LECM-PARM-PERIOD-START-DATE NOT VALID' DTSBE717 00225 TO ABEND-MSG DTSBE717 00226 PERFORM S999-ABEND THRU S999-EXIT. DTSBE717 00227 DTSBE717 00228 IF WRK-PARM-PERIOD-START-DATE > LECM-PRIOR-RUN-DATE DTSBE717 00229 MOVE DTSBE717 00230 'WRK-PARM-PERIOD-START-DATE GREATER THAN PRIOR RUN DATE' DTSBE717 00231 TO ABEND-MSG DTSBE717 00232 PERFORM S999-ABEND THRU S999-EXIT. DTSBE717 00233 DTSBE717 00234 IF WRK-PARM-PERIOD-START-DATE > LECM-LAST-MJRN-PURGE-DATE DTSBE717 00235 NEXT SENTENCE DTSBE717 00236 ELSE DTSBE717 00237 MOVE DTSBE717 00238 'PERIOD-START-DATE NOT GREATER THAN LAST-MJRN-PURGE-DATE' DTSBE717 00239 TO ABEND-MSG DTSBE717 00240 PERFORM S999-ABEND THRU S999-EXIT. DTSBE717 00241 I1200-EXIT. DTSBE717 00242 EXIT. DTSBE717 00243 EJECT DTSBE717 00244 P0000-PROCESS. DTSBE717 00245 IF MPRF-TOT-BALANCE-AMT < WRK-PARM-MIN-AMT DTSBE717 00246 GO TO P0000-EXIT. DTSBE717 00247 DTSBE717 00248 MOVE +0 TO WRK-CURRENT-UI-TAX-PAST-DUE DTSBE717 00249 WRK-START-UI-TAX-PAST-DUE. DTSBE717 00250 DTSBE717 00251 MOVE +0 TO QTR-CNT. DTSBE717 00252 DTSBE717 00253 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSBE717 00254 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBE717 00255 SET MQTR-QTR-88 TO TRUE. DTSBE717 00256 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBE717 00257 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE717 00258 PERFORM P1000-SCAN-MQTR THRU P1000-EXIT DTSBE717 00259 UNTIL L910-NO-REC-88. DTSBE717 00260 DTSBE717 00261 IF WRK-CURRENT-UI-TAX-PAST-DUE < WRK-PARM-MIN-AMT DTSBE717 00262 GO TO P0000-EXIT. DTSBE717 00263 DTSBE717 00264 MOVE LOW-VALUES TO MJRN-KEY-AREA. DTSBE717 00265 MOVE MPRF-EMP-NO TO MJRN-EMP-NO. DTSBE717 00266 SET MJRN-JRN-88 TO TRUE. DTSBE717 00267 MOVE MJRN-KEY-AREA TO MSKL-KEY-AREA. DTSBE717 00268 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE717 00269 PERFORM P2000-SCAN-MJRN THRU P2000-EXIT DTSBE717 00270 UNTIL L910-NO-REC-88. DTSBE717 00271 DTSBE717 00272 IF WRK-START-UI-TAX-PAST-DUE < WRK-PARM-MIN-AMT DTSBE717 00273 GO TO P0000-EXIT. DTSBE717 00274 DTSBE717 00275 MOVE WRK-CURRENT-UI-TAX-PAST-DUE TO R717-AMT-DUE. DTSBE717 00276 MOVE MPRF-EMP-NO TO R717-EMP-NO. DTSBE717 00277 * MOVE MPRF-PRIMARY-NAME TO R717-PRIMARY-NAME. CL*12 00278 MOVE LECM-PRIOR-RUN-DATE TO R717-RUN-DATE. DTSBE717 00279 DTSBE717 00280 PERFORM S946-WRITE-R717 THRU S946-EXIT. DTSBE717 00281 P0000-EXIT. DTSBE717 00282 EXIT. DTSBE717 00283 EJECT DTSBE717 00284 P1000-SCAN-MQTR. DTSBE717 00285 MOVE MSKL-REC TO MQTR-REC. DTSBE717 00286 DTSBE717 00287 PERFORM DTSBE717 00288 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSBE717 00289 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT DTSBE717 00290 IF MQTR-ACCT-UI-88 (MQTR-ACCT-IDX) DTSBE717 00291 PERFORM P1100-PAST-DUE THRU P1100-EXIT DTSBE717 00292 END-IF DTSBE717 00293 END-PERFORM. DTSBE717 00294 DTSBE717 00295 IF MQTR-TAX-DUE-DATE <= WRK-PARM-PERIOD-START-DATE DTSBE717 00296 IF QTR-CNT < QTR-CNT-MAX DTSBE717 00297 ADD +1 TO QTR-CNT DTSBE717 00298 MOVE MQTR-YRQ TO QTR-START-PAST-DUE-YRQ (QTR-CNT) DTSBE717 00299 ELSE DTSBE717 00300 MOVE 'LOGIC ERROR P1000-1' TO ABEND-MSG DTSBE717 00301 PERFORM S999-ABEND THRU S999-EXIT. DTSBE717 00302 DTSBE717 00303 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE717 00304 P1000-EXIT. DTSBE717 00305 EXIT. DTSBE717 00306 SKIP3 DTSBE717 00307 P1100-PAST-DUE. DTSBE717 00308 IF MQTR-TAX-DUE-DATE <= LECM-PRIOR-RUN-DATE DTSBE717 00309 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSBE717 00310 TO WRK-CURRENT-UI-TAX-PAST-DUE. DTSBE717 00311 DTSBE717 00312 IF MQTR-TAX-DUE-DATE <= WRK-PARM-PERIOD-START-DATE DTSBE717 00313 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSBE717 00314 TO WRK-START-UI-TAX-PAST-DUE. DTSBE717 00315 P1100-EXIT. DTSBE717 00316 EXIT. DTSBE717 00317 EJECT DTSBE717 00318 P2000-SCAN-MJRN. DTSBE717 00319 MOVE MSKL-REC TO MJRN-REC. DTSBE717 00320 DTSBE717 00321 IF MJRN-TRAN-CNVR-88 DTSBE717 00322 NEXT SENTENCE DTSBE717 00323 ELSE DTSBE717 00324 IF MJRN-ESTB-DATE > WRK-PARM-PERIOD-START-DATE DTSBE717 00325 PERFORM P2100-ACCT-GROUP-SCAN THRU P2100-EXIT DTSBE717 00326 VARYING MJRN-OCC-IDX FROM 1 BY 1 DTSBE717 00327 UNTIL MJRN-OCC-IDX > MJRN-OCC-CNT. DTSBE717 00328 DTSBE717 00329 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE717 00330 P2000-EXIT. DTSBE717 00331 EXIT. DTSBE717 00332 SKIP3 DTSBE717 00333 P2100-ACCT-GROUP-SCAN. DTSBE717 00334 IF MJRN-ROW-UI-88 (MJRN-OCC-IDX) DTSBE717 00335 NEXT SENTENCE DTSBE717 00336 ELSE DTSBE717 00337 GO TO P2100-EXIT. DTSBE717 00338 DTSBE717 00339 MOVE MJRN-YRQ (MJRN-OCC-IDX) TO WRK-YRQ. DTSBE717 00340 DTSBE717 00341 MOVE +0 TO QTR-SUB. DTSBE717 00342 DTSBE717 00343 PERFORM DTSBE717 00344 VARYING QTR-IDX FROM 1 BY 1 DTSBE717 00345 UNTIL (QTR-IDX > QTR-CNT) DTSBE717 00346 OR DTSBE717 00347 (QTR-SUB NOT = +0) DTSBE717 00348 IF QTR-START-PAST-DUE-YRQ (QTR-IDX) = WRK-YRQ DTSBE717 00349 SET QTR-SUB TO QTR-IDX DTSBE717 00350 END-IF DTSBE717 00351 END-PERFORM. DTSBE717 00352 DTSBE717 00353 IF QTR-SUB = +0 DTSBE717 00354 GO TO P2100-EXIT. DTSBE717 00355 DTSBE717 00356 IF MJRN-COL-CHARGED-88 (MJRN-OCC-IDX) DTSBE717 00357 SUBTRACT MJRN-AMT (MJRN-OCC-IDX) DTSBE717 00358 FROM WRK-START-UI-TAX-PAST-DUE DTSBE717 00359 ELSE DTSBE717 00360 ADD MJRN-AMT (MJRN-OCC-IDX) DTSBE717 00361 TO WRK-START-UI-TAX-PAST-DUE. DTSBE717 00362 P2100-EXIT. DTSBE717 00363 EXIT. DTSBE717 00364 EJECT DTSBE717 00365 T0000-TERMINATE. DTSBE717 00366 SKIP2 DTSBE717 00367 SKIP2 DTSBE717 00368 T0000-EXIT. DTSBE717 00369 EXIT. DTSBE717 00370 EJECT DTSBE717 00371 S001-FROM-FED-8. DTSBE717 00372 SET L001-FROM-FED-8 TO TRUE. DTSBE717 00373 GO TO S001-DATE. DTSBE717 00374 SKIP1 DTSBE717 00375 S001-FROM-ABS-DAY. DTSBE717 00376 SET L001-FROM-ABS-DAY TO TRUE. DTSBE717 00377 GO TO S001-DATE. DTSBE717 00378 SKIP1 DTSBE717 00379 S001-FROM-CAL-6. DTSBE717 00380 SET L001-FROM-CAL-6 TO TRUE. DTSBE717 00381 GO TO S001-DATE. DTSBE717 00382 SKIP1 DTSBE717 00383 S001-DATE. DTSBE717 00384 CALL 'DTSBU001' USING L001-LINK-AREA. CL**3 00385 S001-EXIT. DTSBE717 00386 EXIT. DTSBE717 00387 SKIP3 DTSBE717 00388 S910-READ. DTSBE717 00389 SET L910-READ-88 TO TRUE. DTSBE717 00390 GO TO S910-MSTR-IO. DTSBE717 00391 SKIP1 DTSBE717 00392 S910-START-BROWSE. DTSBE717 00393 SET L910-START-BROWSE-88 TO TRUE. DTSBE717 00394 GO TO S910-MSTR-IO. DTSBE717 00395 SKIP1 DTSBE717 00396 S910-READ-NEXT. DTSBE717 00397 SET L910-READ-NEXT-88 TO TRUE. DTSBE717 00398 GO TO S910-MSTR-IO. DTSBE717 00399 SKIP1 DTSBE717 00400 S910-COUNT. DTSBE717 00401 SET L910-COUNT-88 TO TRUE. DTSBE717 00402 GO TO S910-MSTR-IO. DTSBE717 00403 SKIP1 DTSBE717 00404 S910-MSTR-IO. DTSBE717 00405 CALL 'DTSBU910' USING L910-LINK-AREA CL**3 00406 MSKL-REC. DTSBE717 00407 S910-EXIT. DTSBE717 00408 EXIT. DTSBE717 00409 SKIP3 DTSBE717 00410 S946-WRITE-R717. DTSBE717 00411 CALL 'DTSBU946' USING R717-REC. CL**3 00412 GO TO S946-EXIT. DTSBE717 00413 SKIP1 DTSBE717 00414 S946-EXIT. DTSBE717 00415 EXIT. DTSBE717 00416 SKIP3 DTSBE717 00417 S999-ABEND. DTSBE717 00418 DISPLAY '*** DTSBE717 ABENDING. ' CL**3 00419 ABEND-MSG. DTSBE717 00420 SKIP1 DTSBE717 00421 CALL 'DTSBU999' USING WRK-ABEND-CD. CL**3 00422 S999-EXIT. DTSBE717 00423 EXIT. DTSBE717