00001 IDENTIFICATION DIVISION. 08/25/06 00002 PROGRAM-ID. DTSBE420. DTSBE420 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV066 00004 DATE-WRITTEN. AUGUST 1994. DTSBE420 00005 DATE-COMPILED. DTSBE420 00006 SKIP3 DTSBE420 00007 ***** DTSBE420 00008 * DTSBE420 00009 * FUNCTION: FINAL DELINQUENT REPORT EXTRACT. DTSBE420 00010 * DTSBE420 00011 * DTSBE420 00012 * MODIFICATION LOG: DTSBE420 00013 * DTSBE420 00014 * 03/13/95 DON'T PRINT R421 WHEN NO IN-STATE FIELD REP. DTSBE420 00015 * WORK ORDER: CR049 PROGRAMMER: RHC DTSBE420 00016 * DTSBE420 00017 * 04/25/95 ADD R422-SUSPEND-COLL-IND TO REPORT RECORD. DTSBE420 00018 * WORK ORDER: CR082 PROGRAMMER: RHC DTSBE420 00019 * DTSBE420 00020 * 03/13/1999 REVIEWED AND MODIFIED FOR DC. DTSBE420 00021 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH DTSBE420 00022 * DTSBE420 00023 * 11/28/05 ADD MPRF-RETURN-MAIL-IND.IF MPRF-RETURN-MAIL-YES-88DTSBE420 00024 * ON MPRF-EMP-NO, BY PASS THAT ACCOUNT EXTRACT INFO- DTSBE420 00025 * MATION AND SEND NO FINAL DELINQUENT LETTER TO THAT DTSBE420 00026 * EMPLOYER. DTSBE420 00027 * WORK ORDER: PROGRAMMER: RW1 DTSBE420 00028 * DTSBE420 00029 * 08/24/06 MODIFIED P2100 TO CORRECT INTEREST CALCULATION. DTSBE420 00030 * ADMIN ASSESSMENT EXCLUDED FROM CALCULATION. DTSBE420 00031 * WORK ORDER: ADMIN ASSESS PROGRAMMER: GD1 DTSBE420 00032 * DTSBE420 00033 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBE420 00034 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBE420 00035 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBE420 00036 * DTSBE420 00037 * DTSBE420 00038 * DESCRIPTION: DTSBE420 00039 * DTSBE420 00040 * DTSBE420 00041 * INITIATION: DTSBE420 00042 * DTSBE420 00043 * IF LECM-PARM-NOTICE-IND = 'Y' DTSBE420 00044 * SET LECM-MST-OPEN-UPDATE-88 TO TRUE DTSBE420 00045 * SET LECM-REF-OPEN-UPDATE-88 TO TRUE DTSBE420 00046 * ELSE DTSBE420 00047 * SET LECM-MST-OPEN-READ-88 TO TRUE DTSBE420 00048 * SET LECM-REF-OPEN-READ-88 TO TRUE. DTSBE420 00049 * DTSBE420 00050 * EDIT AND DEFAULT PARAMETERS. SEE PRINTED OUTPUTS DTSBE420 00051 * DESCRIPTIONS AND LAYOUTS (421R1, 422R1). DTSBE420 00052 * DTSBE420 00053 * DTSBE420 00054 * PROCESSING: DTSBE420 00055 * DTSBE420 00056 * SEE PRINTED OUTPUTS DESCRIPTION AND LAYOUTS (421R1, DTSBE420 00057 * 422R1). DTSBE420 00058 * DTSBE420 00059 * DTSBE420 00060 * TERMINATION: DTSBE420 00061 * DTSBE420 00062 * IF WRK-PARM-NOTICE-IND = 'Y', THEN DTSBE420 00063 * READ FQTR RECORD FOR WRK-PARM-SUBJECT-YRQ. IF FOUND, DTSBE420 00064 * REWRITE; IF NOT FOUND, CREATE A FQTR RECORD AND WRITE. DTSBE420 00065 * MOVE LECM-CURR-RUN-DATE TO FQTR-UC30-FINAL-DEL-MAIL-DATE. DTSBE420 00066 * DTSBE420 00067 * DTSBE420 00068 * RECORDS READ: DTSBE420 00069 * DTSBE420 00070 * MASTER: DTSBE420 00071 * DTSBE420 00072 * MQTR DTSBE420 00073 * MTAD DTSBE420 00074 * MOPO DTSBE420 00075 * MTAA DTSBE420 00076 * DTSBE420 00077 * DTSBE420 00078 * ALTERNATE INDEX: DTSBE420 00079 * DTSBE420 00080 * NONE. DTSBE420 00081 * DTSBE420 00082 * DTSBE420 00083 * REFERENCE: DTSBE420 00084 * DTSBE420 00085 * FQTR DTSBE420 00086 * DTSBE420 00087 * DTSBE420 00088 * RECORDS UPDATED: DTSBE420 00089 * DTSBE420 00090 * MEVL (WRITE) DTSBE420 00091 * DTSBE420 00092 * DTSBE420 00093 * REPORT RECORDS WRITTEN: DTSBE420 00094 * DTSBE420 00095 * R421 FINAL DELINQUENT REPORT NOTICE. DTSBE420 00096 * R422 FINAL DELINQUENT NOTICE LIST - FIELD CODE DTSBE420 00097 * SEQUENCE. DTSBE420 00098 * R907 UNUSUAL CONDITION ENCOUNTERED. DTSBE420 00099 * DTSBE420 00100 * DTSBE420 00101 * BATCH TRANSACTION COLLECTION RECORDS WRITTEN: DTSBE420 00102 * DTSBE420 00103 * NONE. DTSBE420 00104 * DTSBE420 00105 * DTSBE420 00106 * MODULES CALLED: DTSBE420 00107 * DTSBE420 00108 * DTSBU001 DATE CONVERSION/EDIT. DTSBE420 00109 * DTSBU004 QUARTER CONVERSION/EDIT. DTSBE420 00110 * DTSBU061 FIELD ZIP / FIELD REP ID. DTSBE420 00111 * DTSBU101 INTEREST COMPUTATION. DTSBE420 00112 * DTSBU111 ADDRESS LOOKUP. DTSBE420 00113 * DTSBU112 ADDRESS FORMAT. DTSBE420 00114 * DTSBU910 MASTER FILE I/O DRIVER. DTSBE420 00115 * DTSBU931 REFERENCE FILE I/O DRIVER. DTSBE420 00116 * DTSBU946 VARIABLE LENGTH RECORDS SEQUENTIAL OUTPUT 1. DTSBE420 00117 * DTSBE420 00118 ***** DTSBE420 00119 SKIP3 DTSBE420 00120 ENVIRONMENT DIVISION. DTSBE420 00121 EJECT DTSBE420 00122 DATA DIVISION. DTSBE420 00123 SKIP3 DTSBE420 00124 WORKING-STORAGE SECTION. DTSBE420 001245 77 PAN-VALET PICTURE X(24) VALUE '066DTSBE420 08/25/06'. DTSBE420 00125 SKIP3 DTSBE420 00126 01 WRK-AREA. DTSBE420 00127 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +420.DTSBE420 00128 DTSBE420 00129 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBE420'.DTSBE420 00130 DTSBE420 00131 DTSBE420 00132 05 ABEND-MSG PIC X(60). DTSBE420 00133 DTSBE420 00134 DTSBE420 00135 05 WRK-PARM-SUBJECT-YRQ PIC S9(05) COMP-3. DTSBE420 00136 DTSBE420 00137 05 WRK-SUBJECT-SLASH-QTR PIC X(04). DTSBE420 00138 DTSBE420 00139 05 WRK-PARM-NOTICE-IND PIC X(01). DTSBE420 00140 88 WRK-PARM-NOTICE-YES-88 VALUE 'Y'. DTSBE420 00141 88 WRK-PARM-NOTICE-NO-88 VALUE 'N'. DTSBE420 00142 DTSBE420 00143 05 WRK-PARM-INT-COMP-DATE PIC S9(09) COMP-3. DTSBE420 00144 DTSBE420 00145 05 WRK-PARM-FINAL-ACTION-DATE PIC S9(09) COMP-3. DTSBE420 00146 DTSBE420 00147 DTSBE420 00148 05 WRK-AS-OF-DATE PIC S9(09) COMP-3.DTSBE420 00149 DTSBE420 00150 05 WRK-UC30-FIRST-DEL-MAIL-DATE PIC S9(09) COMP-3.DTSBE420 00151 DTSBE420 00152 05 WRK-UC30-FINAL-DEL-CUTOFF-DATE PIC S9(09) COMP-3.DTSBE420 00153 DTSBE420 00154 05 WRK-UC30-FINAL-DEL-MAIL-DATE PIC S9(09) COMP-3.DTSBE420 00155 DTSBE420 00156 DTSBE420 00157 05 TAD-MISS-RPT-LTRS-IND PIC X(01). DTSBE420 00158 88 TAD-MISS-RPT-LTRS-YES-88 VALUE 'Y'. DTSBE420 00159 88 TAD-MISS-RPT-LTRS-NO-88 VALUE 'N'. DTSBE420 00160 DTSBE420 00161 05 OPO-MISS-RPT-LTRS-IND PIC X(01). DTSBE420 00162 88 OPO-MISS-RPT-LTRS-YES-88 VALUE 'Y'. DTSBE420 00163 88 OPO-MISS-RPT-LTRS-NO-88 VALUE 'N'. DTSBE420 00164 DTSBE420 00165 05 TAA-MISS-RPT-LTRS-IND PIC X(01). DTSBE420 00166 88 TAA-MISS-RPT-LTRS-YES-88 VALUE 'Y'. DTSBE420 00167 88 TAA-MISS-RPT-LTRS-NO-88 VALUE 'N'. DTSBE420 00168 DTSBE420 00169 DTSBE420 00170 05 WRK-TOTAL-RATE PIC S9(01)V9(04) COMP-3.DTSBE420 00171 DTSBE420 00172 05 WRK-RPT-DUE-DATE PIC S9(09) COMP-3.DTSBE420 00173 DTSBE420 00174 05 WRK-ANNUAL-FILER-CNT PIC S9(07) COMP-3 DTSBE420 00175 VALUE +0. DTSBE420 00176 05 WRK-NOTICE-CNT PIC S9(07) COMP-3 DTSBE420 00177 VALUE +0. DTSBE420 00178 05 WRK-CNT-DISP PIC Z(06)9. DTSBE420 00179 DTSBE420 00180 05 EVL-TEXT. DTSBE420 00181 10 FILLER PIC X(29) DTSBE420 00182 VALUE 'FINAL MISSING RPT LETTER FOR '. DTSBE420 00183 10 EVL-SLASH-QTR PIC X(04). DTSBE420 00184 10 FILLER PIC X(09) DTSBE420 00185 VALUE ' SENT TO '. DTSBE420 00186 10 EVL-ADDR-TYPE PIC X(04). DTSBE420 00187 10 FILLER PIC X(01) VALUE SPACES.DTSBE420 00188 10 EVL-ADDR-ID-NO PIC ZZ9. DTSBE420 00189 SKIP3 DTSBE420 00190 01 MSG-AREA. DTSBE420 00191 05 MSG1-AREA. DTSBE420 00192 10 MSG1-ID PIC X(03) VALUE '421'. DTSBE420 00193 10 MSG1-TEXT. DTSBE420 00194 15 FILLER PIC X(40) DTSBE420 00195 VALUE 'RATE MISSING. FINAL DELINQUENT REPORT L'. DTSBE420 00196 15 FILLER PIC X(40) DTSBE420 00197 VALUE 'ETTER PRINTED WITHOUT A RATE. YRQ = '. DTSBE420 00198 15 MSG1-SLASHED-YRQ PIC X(04). DTSBE420 00199 DTSBE420 00200 05 MSG2-AREA. DTSBE420 00201 10 MSG2-ID PIC X(03) VALUE '422'. DTSBE420 00202 10 MSG2-TEXT. DTSBE420 00203 15 FILLER PIC X(40) DTSBE420 00204 VALUE 'FINAL MISSING REPORT LETTER PRINTING SUP'. DTSBE420 00205 15 FILLER PIC X(40) DTSBE420 00206 VALUE 'PRESSED ON ALL MTAD RECORDS. YRQ = '. DTSBE420 00207 15 MSG2-SLASHED-YRQ PIC X(04). DTSBE420 00208 DTSBE420 00209 05 MSG3-AREA. DTSBE420 00210 10 MSG3-ID PIC X(03) VALUE '423'. DTSBE420 00211 10 MSG3-TEXT. DTSBE420 00212 15 FILLER PIC X(40) DTSBE420 00213 VALUE 'MORE THAN 19 ADDITIONAL QUARTERS ARE PUR'. DTSBE420 00214 15 FILLER PIC X(40) DTSBE420 00215 VALUE 'SUED. INCOMPLETE FINAL NOTICE LIST(S) P'. DTSBE420 00216 15 FILLER PIC X(20) DTSBE420 00217 VALUE 'RINTED. '. DTSBE420 00218 DTSBE420 00219 05 MSG4-AREA. DTSBE420 00220 10 MSG4-ID PIC X(03) VALUE '694'. DTSBE420 00221 10 MSG4-TEXT. DTSBE420 00222 15 FILLER PIC X(40) DTSBE420 00223 VALUE 'FINAL DELINQUENT NOTICE NOT PRINTED - NO'. DTSBE420 00224 15 FILLER PIC X(28) DTSBE420 00225 VALUE 'FIELD REP ASSIGNED. '. DTSBE420 00226 DTSBE420 00227 05 MSG5-AREA. DTSBE420 00228 10 MSG5-ID PIC X(03) VALUE '424'. DTSBE420 00229 10 MSG5-TEXT. DTSBE420 00230 15 FILLER PIC X(40) DTSBE420 00231 VALUE 'FINAL MISSING REPORT LETTER PRINTING SUP'. DTSBE420 00232 15 FILLER PIC X(40) DTSBE420 00233 VALUE 'PRESSED ON ALL ADDRESSES. YRQ = '. DTSBE420 00234 15 MSG5-SLASHED-YRQ PIC X(04). DTSBE420 00235 EJECT DTSBE420 00236 01 L001-LINK-AREA. DTSBE420 00237 ++INCLUDE DTSIL001 DTSBE420 00238 SKIP3 DTSBE420 00239 01 L004-LINK-AREA. DTSBE420 00240 ++INCLUDE DTSIL004 DTSBE420 00241 SKIP3 DTSBE420 00242 01 L005-LINK-AREA. DTSBE420 00243 ++INCLUDE DTSIL005 DTSBE420 00244 SKIP3 DTSBE420 00245 01 L061-LINK-AREA. DTSBE420 00246 ++INCLUDE DTSIL061 DTSBE420 00247 SKIP3 DTSBE420 00248 01 L101-LINK-AREA. DTSBE420 00249 ++INCLUDE DTSIL101 DTSBE420 00250 SKIP3 DTSBE420 00251 01 L410-LINK-AREA. DTSBE420 00252 ++INCLUDE DTSIL410 DTSBE420 00253 SKIP3 DTSBE420 00254 01 L109-LINK-AREA. DTSBE420 00255 ++INCLUDE DTSIL109 DTSBE420 00256 SKIP3 DTSBE420 00257 01 L111-LINK-AREA. DTSBE420 00258 ++INCLUDE DTSIL111 DTSBE420 00259 SKIP3 DTSBE420 00260 01 L112-LINK-AREA. DTSBE420 00261 ++INCLUDE DTSIL112 DTSBE420 00262 EJECT DTSBE420 00263 01 L910-LINK-AREA. DTSBE420 00264 ++INCLUDE DTSIL910 DTSBE420 00265 SKIP3 DTSBE420 00266 01 MSKL-REC. DTSBE420 00267 ++INCLUDE DTSIMSKL DTSBE420 00268 SKIP3 DTSBE420 00269 01 MQTR-REC. DTSBE420 00270 ++INCLUDE DTSIMQTR DTSBE420 00271 SKIP3 DTSBE420 00272 01 MTAD-REC. DTSBE420 00273 ++INCLUDE DTSIMTAD DTSBE420 00274 SKIP3 DTSBE420 00275 01 MEVL-REC. DTSBE420 00276 ++INCLUDE DTSIMEVL DTSBE420 00277 SKIP3 DTSBE420 00278 01 MSOL-REC. DTSBE420 00279 ++INCLUDE DTSIMSOL DTSBE420 00280 SKIP3 DTSBE420 00281 01 MOPO-REC. DTSBE420 00282 ++INCLUDE DTSIMOPO DTSBE420 00283 SKIP3 DTSBE420 00284 01 MTAA-REC. DTSBE420 00285 ++INCLUDE DTSIMTAA DTSBE420 00286 EJECT DTSBE420 00287 01 L931-LINK-AREA. DTSBE420 00288 ++INCLUDE DTSIL931 DTSBE420 00289 SKIP3 DTSBE420 00290 01 FSKL-REC. DTSBE420 00291 ++INCLUDE DTSIFSKL DTSBE420 00292 SKIP3 DTSBE420 00293 01 FQTR-REC. DTSBE420 00294 ++INCLUDE DTSIFQTR DTSBE420 00295 EJECT DTSBE420 00296 01 R421-REC. DTSBE420 00297 ++INCLUDE DTSIR421 DTSBE420 00298 SKIP3 DTSBE420 00299 01 R422-REC. DTSBE420 00300 ++INCLUDE DTSIR422 DTSBE420 00301 SKIP3 DTSBE420 00302 01 R907-REC. DTSBE420 00303 ++INCLUDE DTSIR907 DTSBE420 00304 EJECT DTSBE420 00305 LINKAGE SECTION. DTSBE420 00306 SKIP3 DTSBE420 00307 01 LECM-LINK-AREA. DTSBE420 00308 ++INCLUDE DTSILECM DTSBE420 00309 SKIP3 DTSBE420 00310 10 FILLER REDEFINES LECM-EXTRACT-PARMS. DTSBE420 00311 15 LECM-PARM-NOTICE-IND PIC X(01). DTSBE420 00312 15 FILLER PIC X(01). DTSBE420 00313 15 LECM-PARM-SUBJECT-YRQ PIC X(03). DTSBE420 00314 15 FILLER PIC X(01). DTSBE420 00315 15 LECM-PARM-INT-COMP-DATE PIC X(06). DTSBE420 00316 15 FILLER PIC X(01). DTSBE420 00317 15 LECM-PARM-FINAL-ACTION-DATE DTSBE420 00318 PIC X(06). DTSBE420 00319 15 FILLER PIC X(49). DTSBE420 00320 EJECT DTSBE420 00321 01 MPRF-LINK-REC. DTSBE420 00322 ++INCLUDE DTSIMPRF DTSBE420 00323 EJECT DTSBE420 00324 PROCEDURE DIVISION USING LECM-LINK-AREA DTSBE420 00325 MPRF-LINK-REC. DTSBE420 00326 DTSBE420 00327 DTSBE420 00328 IF LECM-PROCESS-88 DTSBE420 00329 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBE420 00330 ELSE DTSBE420 00331 IF LECM-INITIALIZE-88 DTSBE420 00332 PERFORM I0000-INITIALIZE THRU I0000-EXIT DTSBE420 00333 ELSE DTSBE420 00334 IF LECM-TERMINATE-88 DTSBE420 00335 PERFORM T0000-TERMINATE THRU T0000-EXIT DTSBE420 00336 ELSE DTSBE420 00337 MOVE 'INVALID LECM-CALL-TYPE-IND ENCOUNTERED' DTSBE420 00338 TO ABEND-MSG DTSBE420 00339 PERFORM S999-ABEND THRU S999-EXIT. DTSBE420 00340 DTSBE420 00341 DTSBE420 00342 GOBACK. DTSBE420 00343 EJECT DTSBE420 00344 I0000-INITIALIZE. DTSBE420 00345 MOVE LECM-TRACE-IND TO L910-TRACE-IND DTSBE420 00346 L931-TRACE-IND. DTSBE420 00347 DTSBE420 00348 MOVE WRK-MOD-NAME TO L910-MOD-NAME DTSBE420 00349 L931-MOD-NAME DTSBE420 00350 R907-MODULE-NAME. DTSBE420 00351 DTSBE420 00352 DTSBE420 00353 MOVE LENGTH OF R421-REC TO R421-LENGTH. DTSBE420 00354 DTSBE420 00355 MOVE '421' TO R421-REC-TYPE. DTSBE420 00356 DTSBE420 00357 MOVE LENGTH OF R422-REC TO R422-LENGTH. DTSBE420 00358 DTSBE420 00359 MOVE '422' TO R422-REC-TYPE. DTSBE420 00360 DTSBE420 00361 MOVE LENGTH OF R907-REC TO R907-LENGTH. DTSBE420 00362 DTSBE420 00363 MOVE '907' TO R907-REC-TYPE. DTSBE420 00364 DTSBE420 00365 DTSBE420 00366 PERFORM I1000-EDIT-AND-DEFAULT-PARMS THRU I1000-EXIT. DTSBE420 00367 DTSBE420 00368 DTSBE420 00369 IF WRK-PARM-NOTICE-YES-88 DTSBE420 00370 SET LECM-MST-OPEN-UPDATE-88 TO TRUE DTSBE420 00371 SET LECM-REF-OPEN-UPDATE-88 TO TRUE DTSBE420 00372 ELSE DTSBE420 00373 SET LECM-MST-OPEN-READ-88 TO TRUE DTSBE420 00374 SET LECM-REF-OPEN-READ-88 TO TRUE. DTSBE420 00375 SKIP2 DTSBE420 00376 I0000-EXIT. DTSBE420 00377 EXIT. DTSBE420 00378 SKIP3 DTSBE420 00379 I1000-EDIT-AND-DEFAULT-PARMS. DTSBE420 00380 PERFORM I1100-NOTICE-IND THRU I1100-EXIT. DTSBE420 00381 DTSBE420 00382 DTSBE420 00383 PERFORM I1300-SUBJECT-YRQ THRU I1300-EXIT. DTSBE420 00384 DTSBE420 00385 DTSBE420 00386 PERFORM I1400-INT-COMP-DATE THRU I1400-EXIT. DTSBE420 00387 DTSBE420 00388 DTSBE420 00389 MOVE +0 TO WRK-PARM-FINAL-ACTION-DATE DTSBE420 00390 WRK-AS-OF-DATE DTSBE420 00391 WRK-UC30-FIRST-DEL-MAIL-DATE DTSBE420 00392 WRK-UC30-FINAL-DEL-CUTOFF-DATE DTSBE420 00393 WRK-UC30-FINAL-DEL-MAIL-DATE. DTSBE420 00394 DTSBE420 00395 DTSBE420 00396 IF WRK-PARM-NOTICE-YES-88 DTSBE420 00397 PERFORM I2000-NOTICE-PARAMETERS THRU I2000-EXIT. DTSBE420 00398 I1000-EXIT. DTSBE420 00399 EXIT. DTSBE420 00400 SKIP3 DTSBE420 00401 I1100-NOTICE-IND. DTSBE420 00402 IF LECM-PARM-NOTICE-IND = SPACES DTSBE420 00403 SET WRK-PARM-NOTICE-NO-88 TO TRUE DTSBE420 00404 ELSE DTSBE420 00405 IF LECM-PARM-NOTICE-IND = 'N' OR 'Y' DTSBE420 00406 MOVE LECM-PARM-NOTICE-IND TO WRK-PARM-NOTICE-IND DTSBE420 00407 ELSE DTSBE420 00408 MOVE 'PARM-NOTICE-IND NOT VALID' DTSBE420 00409 TO ABEND-MSG DTSBE420 00410 PERFORM S999-ABEND THRU S999-EXIT. DTSBE420 00411 I1100-EXIT. DTSBE420 00412 EXIT. DTSBE420 00413 SKIP3 DTSBE420 00414 I1300-SUBJECT-YRQ. DTSBE420 00415 IF LECM-PARM-SUBJECT-YRQ = SPACES DTSBE420 00416 MOVE LECM-LAST-UC30-DEL-MAIL-YRQ TO WRK-PARM-SUBJECT-YRQ DTSBE420 00417 ELSE DTSBE420 00418 MOVE LECM-PARM-SUBJECT-YRQ TO L004-QTR-3-X DTSBE420 00419 PERFORM S004-FROM-3 THRU S004-EXIT DTSBE420 00420 IF L004-VALID-QTR DTSBE420 00421 MOVE L004-QTR-5-9 TO WRK-PARM-SUBJECT-YRQ DTSBE420 00422 ELSE DTSBE420 00423 MOVE 'PARM-SUBJECT-YRQ NOT VALID' DTSBE420 00424 TO ABEND-MSG DTSBE420 00425 PERFORM S999-ABEND THRU S999-EXIT. DTSBE420 00426 DTSBE420 00427 DTSBE420 00428 IF WRK-PARM-SUBJECT-YRQ > LECM-LAST-UC30-DEL-MAIL-YRQ DTSBE420 00429 MOVE DTSBE420 00430 'PARM-SUBJECT-YRQ NOT COMPATIBLE WITH LAST-UC30-DEL-MAIL-YRQ'DTSBE420 00431 TO ABEND-MSG DTSBE420 00432 PERFORM S999-ABEND THRU S999-EXIT. DTSBE420 00433 DTSBE420 00434 DTSBE420 00435 MOVE WRK-PARM-SUBJECT-YRQ TO L004-QTR-5-9. DTSBE420 00436 DTSBE420 00437 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBE420 00438 DTSBE420 00439 MOVE L004-SLASH-QTR TO WRK-SUBJECT-SLASH-QTR. DTSBE420 00440 I1300-EXIT. DTSBE420 00441 EXIT. DTSBE420 00442 SKIP3 DTSBE420 00443 I1400-INT-COMP-DATE. DTSBE420 00444 IF LECM-PARM-INT-COMP-DATE = SPACES DTSBE420 00445 MOVE LECM-CURR-RUN-DATE TO WRK-PARM-INT-COMP-DATE DTSBE420 00446 ELSE DTSBE420 00447 MOVE LECM-PARM-INT-COMP-DATE TO L001-CAL-6-DATE-X DTSBE420 00448 PERFORM S001-FROM-CAL-6 THRU S001-EXIT DTSBE420 00449 IF L001-VALID-DATE DTSBE420 00450 MOVE L001-FED-8-DATE-9 TO WRK-PARM-INT-COMP-DATE DTSBE420 00451 ELSE DTSBE420 00452 MOVE 'PARM-INT-COMP-DATE NOT VALID' DTSBE420 00453 TO ABEND-MSG DTSBE420 00454 PERFORM S999-ABEND THRU S999-EXIT. DTSBE420 00455 I1400-EXIT. DTSBE420 00456 EXIT. DTSBE420 00457 EJECT DTSBE420 00458 I2000-NOTICE-PARAMETERS. DTSBE420 00459 MOVE LOW-VALUES TO FQTR-KEY-AREA. DTSBE420 00460 DTSBE420 00461 SET FQTR-QTR-88 TO TRUE. DTSBE420 00462 DTSBE420 00463 MOVE WRK-PARM-SUBJECT-YRQ TO FQTR-YRQ. DTSBE420 00464 DTSBE420 00465 MOVE FQTR-KEY-AREA TO FSKL-KEY-AREA. DTSBE420 00466 DTSBE420 00467 PERFORM S931-READ THRU S931-EXIT. DTSBE420 00468 DTSBE420 00469 IF L931-NO-REC-88 DTSBE420 00470 MOVE 'FQTR RECORD FOR SUBJECT YRQ NOT FOUND' DTSBE420 00471 TO ABEND-MSG DTSBE420 00472 PERFORM S999-ABEND THRU S999-EXIT. DTSBE420 00473 DTSBE420 00474 DTSBE420 00475 MOVE FSKL-REC TO FQTR-REC. DTSBE420 00476 DTSBE420 00477 DTSBE420 00478 PERFORM I2100-FINAL-ACTION-DATE THRU I2100-EXIT. DTSBE420 00479 DTSBE420 00480 DTSBE420 00481 MOVE LECM-PRIOR-RUN-DATE TO WRK-AS-OF-DATE. DTSBE420 00482 DTSBE420 00483 DTSBE420 00484 IF FQTR-UC30-FIRST-DEL-DATE = +0 DTSBE420 00485 MOVE 'FQTR-UC30-FIRST-DEL-DATE NOT FOUND' DTSBE420 00486 TO ABEND-MSG DTSBE420 00487 PERFORM S999-ABEND THRU S999-EXIT DTSBE420 00488 ELSE DTSBE420 00489 MOVE FQTR-UC30-FIRST-DEL-DATE DTSBE420 00490 TO WRK-UC30-FIRST-DEL-MAIL-DATE. DTSBE420 00491 DTSBE420 00492 DTSBE420 00493 MOVE LECM-CURR-RUN-DATE TO WRK-UC30-FINAL-DEL-CUTOFF-DATE DTSBE420 00494 WRK-UC30-FINAL-DEL-MAIL-DATE. DTSBE420 00495 DTSBE420 00496 DTSBE420 00497 IF (WRK-UC30-FIRST-DEL-MAIL-DATE DTSBE420 00498 < WRK-UC30-FINAL-DEL-MAIL-DATE) DTSBE420 00499 AND DTSBE420 00500 (WRK-UC30-FINAL-DEL-MAIL-DATE DTSBE420 00501 < WRK-PARM-FINAL-ACTION-DATE) DTSBE420 00502 NEXT SENTENCE DTSBE420 00503 ELSE DTSBE420 00504 MOVE 'INCONSISTENT DATES ENCOUNTERED' DTSBE420 00505 TO ABEND-MSG DTSBE420 00506 PERFORM S999-ABEND THRU S999-EXIT. DTSBE420 00507 I2000-EXIT. DTSBE420 00508 EXIT. DTSBE420 00509 SKIP3 DTSBE420 00510 I2100-FINAL-ACTION-DATE. DTSBE420 00511 IF LECM-PARM-FINAL-ACTION-DATE = SPACES DTSBE420 00512 IF FQTR-UC30-FINAL-ACTION-DATE = +0 DTSBE420 00513 MOVE LECM-CURR-RUN-DATE TO L001-FED-8-DATE-9 DTSBE420 00514 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBE420 00515 ADD +14 TO L001-JUL-ABS-DAY DTSBE420 00516 PERFORM S001-FROM-ABS-DAY THRU S001-EXIT DTSBE420 00517 MOVE L001-FED-8-DATE-9 DTSBE420 00518 TO WRK-PARM-FINAL-ACTION-DATE DTSBE420 00519 ELSE DTSBE420 00520 MOVE FQTR-UC30-FINAL-ACTION-DATE DTSBE420 00521 TO WRK-PARM-FINAL-ACTION-DATE DTSBE420 00522 ELSE DTSBE420 00523 MOVE LECM-PARM-FINAL-ACTION-DATE DTSBE420 00524 TO L001-CAL-6-DATE-X DTSBE420 00525 PERFORM S001-FROM-CAL-6 THRU S001-EXIT DTSBE420 00526 IF L001-VALID-DATE DTSBE420 00527 MOVE L001-FED-8-DATE-9 DTSBE420 00528 TO WRK-PARM-FINAL-ACTION-DATE DTSBE420 00529 ELSE DTSBE420 00530 MOVE 'INVALID PARM-FINAL-ACTION-DATE ENCOUNTERED' DTSBE420 00531 TO ABEND-MSG DTSBE420 00532 PERFORM S999-ABEND THRU S999-EXIT. DTSBE420 00533 I2100-EXIT. DTSBE420 00534 EXIT. DTSBE420 00535 EJECT DTSBE420 00536 P0000-PROCESS. DTSBE420 00537 *****IF (MPRF-EMP-NO < 360094) DTSBE420 00538 ***************OR DTSBE420 00539 ********(MPRF-EMP-NO > 360098) DTSBE420 00540 *********GO TO P0000-EXIT. DTSBE420 00541 DTSBE420 00542 DTSBE420 00543 MOVE MPRF-EMP-NO TO R907-EMP-NO. DTSBE420 00544 DTSBE420 00545 IF MPRF-CLASS-SUB-88 DTSBE420 00546 SET L410-MODE-INPUT-YRQ-88 TO TRUE DTSBE420 00547 MOVE MPRF-EMP-NO TO L410-EMP-NO DTSBE420 00548 MOVE WRK-PARM-SUBJECT-YRQ TO L410-YRQ DTSBE420 00549 PERFORM S410-FILE-SCHED THRU S410-EXIT DTSBE420 00550 IF L410-ANN-SCHED-88 DTSBE420 00551 ADD +1 TO WRK-ANNUAL-FILER-CNT DTSBE420 00552 GO TO P0000-EXIT. DTSBE420 00553 DTSBE420 00554 IF MPRF-PURSUED-RPT-CNT > +0 DTSBE420 00555 NEXT SENTENCE DTSBE420 00556 ELSE DTSBE420 00557 GO TO P0000-EXIT. DTSBE420 00558 *RW DTSBE420 00559 IF MPRF-RETURN-MAIL-YES-88 DTSBE420 00560 GO TO P0000-EXIT. DTSBE420 00561 *RW DTSBE420 00562 DTSBE420 00563 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSBE420 00564 DTSBE420 00565 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBE420 00566 DTSBE420 00567 SET MQTR-QTR-88 TO TRUE. DTSBE420 00568 DTSBE420 00569 MOVE WRK-PARM-SUBJECT-YRQ TO MQTR-YRQ. DTSBE420 00570 DTSBE420 00571 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBE420 00572 DTSBE420 00573 PERFORM S910-READ THRU S910-EXIT. DTSBE420 00574 DTSBE420 00575 IF L910-NO-REC-88 DTSBE420 00576 GO TO P0000-EXIT. DTSBE420 00577 DTSBE420 00578 DTSBE420 00579 MOVE MSKL-REC TO MQTR-REC. DTSBE420 00580 DTSBE420 00581 DTSBE420 00582 IF MQTR-RPT-NOT-PURSUED-88 DTSBE420 00583 GO TO P0000-EXIT. DTSBE420 00584 DTSBE420 00585 DTSBE420 00586 IF MQTR-MISS-LETTER-SENT-88 DTSBE420 00587 NEXT SENTENCE DTSBE420 00588 ELSE DTSBE420 00589 GO TO P0000-EXIT. DTSBE420 00590 DTSBE420 00591 DTSBE420 00592 SET TAD-MISS-RPT-LTRS-NO-88 TO TRUE. DTSBE420 00593 DTSBE420 00594 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBE420 00595 DTSBE420 00596 MOVE MPRF-EMP-NO TO MSKL-EMP-NO. DTSBE420 00597 DTSBE420 00598 SET MSKL-TAD-88 TO TRUE. DTSBE420 00599 DTSBE420 00600 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE420 00601 DTSBE420 00602 PERFORM DTSBE420 00603 UNTIL L910-NO-REC-88 DTSBE420 00604 MOVE MSKL-REC TO MTAD-REC DTSBE420 00605 IF MTAD-MISSING-RPT-LTRS-YES-88 DTSBE420 00606 SET TAD-MISS-RPT-LTRS-YES-88 TO TRUE DTSBE420 00607 END-IF DTSBE420 00608 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBE420 00609 END-PERFORM. DTSBE420 00610 DTSBE420 00611 DTSBE420 00612 SET OPO-MISS-RPT-LTRS-NO-88 TO TRUE. DTSBE420 00613 DTSBE420 00614 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBE420 00615 DTSBE420 00616 MOVE MPRF-EMP-NO TO MSKL-EMP-NO. DTSBE420 00617 DTSBE420 00618 SET MSKL-OPO-88 TO TRUE. DTSBE420 00619 DTSBE420 00620 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE420 00621 DTSBE420 00622 PERFORM DTSBE420 00623 UNTIL L910-NO-REC-88 DTSBE420 00624 MOVE MSKL-REC TO MOPO-REC DTSBE420 00625 IF MOPO-MISSING-RPT-LTRS-YES-88 DTSBE420 00626 SET OPO-MISS-RPT-LTRS-YES-88 TO TRUE DTSBE420 00627 END-IF DTSBE420 00628 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBE420 00629 END-PERFORM. DTSBE420 00630 DTSBE420 00631 DTSBE420 00632 SET TAA-MISS-RPT-LTRS-NO-88 TO TRUE. DTSBE420 00633 DTSBE420 00634 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBE420 00635 DTSBE420 00636 MOVE MPRF-EMP-NO TO MSKL-EMP-NO. DTSBE420 00637 DTSBE420 00638 SET MSKL-TAA-88 TO TRUE. DTSBE420 00639 DTSBE420 00640 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE420 00641 DTSBE420 00642 PERFORM DTSBE420 00643 UNTIL L910-NO-REC-88 DTSBE420 00644 MOVE MSKL-REC TO MTAA-REC DTSBE420 00645 IF MTAA-MISSING-RPT-LTRS-YES-88 DTSBE420 00646 SET TAA-MISS-RPT-LTRS-YES-88 TO TRUE DTSBE420 00647 END-IF DTSBE420 00648 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBE420 00649 END-PERFORM. DTSBE420 00650 DTSBE420 00651 DTSBE420 00652 IF TAD-MISS-RPT-LTRS-NO-88 DTSBE420 00653 MOVE MSG2-ID TO R907-MSG-ID DTSBE420 00654 MOVE WRK-SUBJECT-SLASH-QTR TO MSG2-SLASHED-YRQ DTSBE420 00655 MOVE MSG2-TEXT TO R907-MSG-TEXT DTSBE420 00656 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBE420 00657 DTSBE420 00658 DTSBE420 00659 IF (TAD-MISS-RPT-LTRS-NO-88) DTSBE420 00660 AND DTSBE420 00661 (OPO-MISS-RPT-LTRS-NO-88) DTSBE420 00662 AND DTSBE420 00663 (TAA-MISS-RPT-LTRS-NO-88) DTSBE420 00664 MOVE MSG5-ID TO R907-MSG-ID DTSBE420 00665 MOVE WRK-SUBJECT-SLASH-QTR TO MSG5-SLASHED-YRQ DTSBE420 00666 MOVE MSG5-TEXT TO R907-MSG-TEXT DTSBE420 00667 PERFORM S946-WRITE-R907 THRU S946-EXIT DTSBE420 00668 GO TO P0000-EXIT. DTSBE420 00669 DTSBE420 00670 DTSBE420 00671 PERFORM P1000-TOTAL-RATE THRU P1000-EXIT. DTSBE420 00672 DTSBE420 00673 DTSBE420 00674 MOVE MQTR-RPT-DUE-DATE TO WRK-RPT-DUE-DATE. DTSBE420 00675 DTSBE420 00676 DTSBE420 00677 PERFORM P2000-FIELD-LIST THRU P2000-EXIT. DTSBE420 00678 DTSBE420 00679 DTSBE420 00680 IF WRK-PARM-NOTICE-YES-88 DTSBE420 00681 ADD +1 TO WRK-NOTICE-CNT DTSBE420 00682 PERFORM P3000-FINAL-NOTICE THRU P3000-EXIT. DTSBE420 00683 P0000-EXIT. DTSBE420 00684 EXIT. DTSBE420 00685 EJECT DTSBE420 00686 P1000-TOTAL-RATE. DTSBE420 00687 IF MPRF-CLASS-SELF-INS-88 DTSBE420 00688 PERFORM S109-LOOKUP-SUR-RATE THRU S109-EXIT DTSBE420 00689 MOVE L109-SUR-RATE TO WRK-TOTAL-RATE DTSBE420 00690 ELSE DTSBE420 00691 IF MQTR-NO-UI-RATE-88 DTSBE420 00692 MOVE MQTR-UI-RATE TO WRK-TOTAL-RATE DTSBE420 00693 ELSE DTSBE420 00694 PERFORM S109-LOOKUP-SUR-RATE THRU S109-EXIT DTSBE420 00695 ADD MQTR-UI-RATE DTSBE420 00696 L109-SUR-RATE GIVING WRK-TOTAL-RATE. DTSBE420 00697 P1000-EXIT. DTSBE420 00698 EXIT. DTSBE420 00699 EJECT DTSBE420 00700 P2000-FIELD-LIST. DTSBE420 00701 PERFORM S061-DETERMINE-FLD-REP THRU S061-EXIT. DTSBE420 00702 DTSBE420 00703 DTSBE420 00704 MOVE L061-FLD-REP-ID TO R422-FIELD-REP-ID. DTSBE420 00705 DTSBE420 00706 MOVE MPRF-FLD-ZIP TO R422-FIELD-ZIP. DTSBE420 00707 DTSBE420 00708 MOVE MPRF-EMP-NO TO R422-EMP-NO. DTSBE420 00709 DTSBE420 00710 DTSBE420 00711 MOVE LOW-VALUES TO R422-DATA-AREA. DTSBE420 00712 DTSBE420 00713 DTSBE420 00714 MOVE WRK-PARM-SUBJECT-YRQ TO R422-YRQ. DTSBE420 00715 DTSBE420 00716 MOVE WRK-PARM-INT-COMP-DATE TO R422-COMPUTATION-DATE. DTSBE420 00717 DTSBE420 00718 MOVE MPRF-SUSPEND-COLL-IND TO R422-SUSPEND-COLL-IND. DTSBE420 00719 DTSBE420 00720 MOVE MPRF-PRIMARY-NAME TO R422-PRIMARY-NAME. DTSBE420 00721 DTSBE420 00722 DTSBE420 00723 MOVE LOW-VALUES TO MTAD-KEY-AREA. DTSBE420 00724 DTSBE420 00725 MOVE MPRF-EMP-NO TO MTAD-EMP-NO. DTSBE420 00726 DTSBE420 00727 SET MTAD-TAD-88 TO TRUE. DTSBE420 00728 DTSBE420 00729 MOVE +1 TO MTAD-ID-NO. DTSBE420 00730 DTSBE420 00731 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. DTSBE420 00732 DTSBE420 00733 PERFORM S910-READ THRU S910-EXIT. DTSBE420 00734 DTSBE420 00735 IF L910-OK-88 DTSBE420 00736 MOVE MSKL-REC TO MTAD-REC DTSBE420 00737 MOVE MTAD-ATTN-LINE TO R422-ADDR1-ATTN-LINE DTSBE420 00738 MOVE MTAD-DELIV-LINE-1 TO R422-ADDR1-DELIV-LINE-1 DTSBE420 00739 MOVE MTAD-DELIV-LINE-2 TO R422-ADDR1-DELIV-LINE-2 DTSBE420 00740 MOVE MTAD-CITY TO R422-ADDR1-CITY DTSBE420 00741 MOVE MTAD-ST TO R422-ADDR1-STATE DTSBE420 00742 MOVE MTAD-ZIP TO R422-ADDR1-ZIP DTSBE420 00743 MOVE MTAD-VOICE-1 TO R422-EMPLOYER-VOICE (1) DTSBE420 00744 MOVE MTAD-VOICE-2 TO R422-EMPLOYER-VOICE (2) DTSBE420 00745 ELSE DTSBE420 00746 MOVE SPACE TO R422-ADDR1-ATTN-LINE DTSBE420 00747 R422-ADDR1-DELIV-LINE-1 DTSBE420 00748 R422-ADDR1-DELIV-LINE-2 DTSBE420 00749 R422-ADDR1-CITY DTSBE420 00750 R422-ADDR1-STATE DTSBE420 00751 R422-ADDR1-ZIP DTSBE420 00752 R422-EMPLOYER-VOICE (1) DTSBE420 00753 R422-EMPLOYER-VOICE (2). DTSBE420 00754 DTSBE420 00755 DTSBE420 00756 MOVE +2 TO MTAD-ID-NO. DTSBE420 00757 DTSBE420 00758 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. DTSBE420 00759 DTSBE420 00760 PERFORM S910-READ THRU S910-EXIT. DTSBE420 00761 DTSBE420 00762 IF L910-OK-88 DTSBE420 00763 MOVE MSKL-REC TO MTAD-REC DTSBE420 00764 MOVE MTAD-ATTN-LINE TO R422-ADDR2-ATTN-LINE DTSBE420 00765 MOVE MTAD-DELIV-LINE-1 TO R422-ADDR2-DELIV-LINE-1 DTSBE420 00766 MOVE MTAD-DELIV-LINE-2 TO R422-ADDR2-DELIV-LINE-2 DTSBE420 00767 MOVE MTAD-CITY TO R422-ADDR2-CITY DTSBE420 00768 MOVE MTAD-ST TO R422-ADDR2-STATE DTSBE420 00769 MOVE MTAD-ZIP TO R422-ADDR2-ZIP DTSBE420 00770 MOVE MTAD-VOICE-1 TO R422-EMPLOYER-VOICE (3) DTSBE420 00771 MOVE MTAD-VOICE-2 TO R422-EMPLOYER-VOICE (4) DTSBE420 00772 ELSE DTSBE420 00773 MOVE SPACE TO R422-ADDR2-ATTN-LINE DTSBE420 00774 R422-ADDR2-DELIV-LINE-1 DTSBE420 00775 R422-ADDR2-DELIV-LINE-2 DTSBE420 00776 R422-ADDR2-CITY DTSBE420 00777 R422-ADDR2-STATE DTSBE420 00778 R422-ADDR2-ZIP DTSBE420 00779 R422-EMPLOYER-VOICE (3) DTSBE420 00780 R422-EMPLOYER-VOICE (4). DTSBE420 00781 DTSBE420 00782 DTSBE420 00783 MOVE +0 TO R422-INACT-DATE. DTSBE420 00784 DTSBE420 00785 IF MPRF-STATUS-INACT-88 DTSBE420 00786 MOVE LOW-VALUES TO MSKL-KEY-AREA DTSBE420 00787 MOVE MPRF-EMP-NO TO MSKL-EMP-NO DTSBE420 00788 SET MSKL-SOL-88 TO TRUE DTSBE420 00789 PERFORM S910-START-BROWSE THRU S910-EXIT DTSBE420 00790 PERFORM DTSBE420 00791 UNTIL L910-NO-REC-88 DTSBE420 00792 MOVE MSKL-REC TO MSOL-REC DTSBE420 00793 MOVE MSOL-INACT-DATE TO R422-INACT-DATE DTSBE420 00794 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBE420 00795 END-PERFORM. DTSBE420 00796 DTSBE420 00797 DTSBE420 00798 MOVE WRK-TOTAL-RATE TO R422-TOTAL-RATE. DTSBE420 00799 DTSBE420 00800 DTSBE420 00801 MOVE +0 TO R422-BALANCE-AMT. DTSBE420 00802 DTSBE420 00803 IF MPRF-TOT-BALANCE-AMT > +0 DTSBE420 00804 MOVE LOW-VALUES TO MSKL-KEY-AREA DTSBE420 00805 MOVE MPRF-EMP-NO TO MSKL-EMP-NO DTSBE420 00806 SET MSKL-QTR-88 TO TRUE DTSBE420 00807 PERFORM S910-START-BROWSE THRU S910-EXIT DTSBE420 00808 PERFORM P2100-SCAN-MQTR THRU P2100-EXIT DTSBE420 00809 UNTIL L910-NO-REC-88. DTSBE420 00810 DTSBE420 00811 DTSBE420 00812 MOVE MPRF-TOT-CREDIT-AMT TO R422-CREDIT-AMT. DTSBE420 00813 DTSBE420 00814 DTSBE420 00815 MOVE +0 TO R422-ADDITIONAL-RPT-CNT. DTSBE420 00816 DTSBE420 00817 IF MPRF-PURSUED-RPT-CNT > +1 DTSBE420 00818 MOVE LOW-VALUES TO MSKL-KEY-AREA DTSBE420 00819 MOVE MPRF-EMP-NO TO MSKL-EMP-NO DTSBE420 00820 SET MSKL-QTR-88 TO TRUE DTSBE420 00821 PERFORM S910-START-BROWSE THRU S910-EXIT DTSBE420 00822 PERFORM P2200-SCAN-MQTR THRU P2200-EXIT DTSBE420 00823 UNTIL L910-NO-REC-88. DTSBE420 00824 DTSBE420 00825 DTSBE420 00826 MOVE +0 TO R422-OPO-NAME-CNT. DTSBE420 00827 DTSBE420 00828 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBE420 00829 DTSBE420 00830 MOVE MPRF-EMP-NO TO MSKL-EMP-NO. DTSBE420 00831 DTSBE420 00832 SET MSKL-OPO-88 TO TRUE. DTSBE420 00833 DTSBE420 00834 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE420 00835 DTSBE420 00836 PERFORM P2300-SCAN-MOPO THRU P2300-EXIT DTSBE420 00837 UNTIL L910-NO-REC-88. DTSBE420 00838 DTSBE420 00839 DTSBE420 00840 PERFORM S946-WRITE-R422 THRU S946-EXIT. DTSBE420 00841 P2000-EXIT. DTSBE420 00842 EXIT. DTSBE420 00843 SKIP3 DTSBE420 00844 P2100-SCAN-MQTR. DTSBE420 00845 *********************************************** DTSBE420 00846 * INCLUDE ONLY UI TAX IN INTEREST CALCULATION DTSBE420 00847 *********************************************** DTSBE420 00848 MOVE MSKL-REC TO MQTR-REC. DTSBE420 00849 DTSBE420 00850 DTSBE420 00851 MOVE +0 TO L101-PAID-CHNG. DTSBE420 00852 DTSBE420 00853 PERFORM DTSBE420 00854 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSBE420 00855 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT DTSBE420 00856 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSBE420 00857 TO R422-BALANCE-AMT DTSBE420 00858 IF MQTR-ACCT-UI-88 (MQTR-ACCT-IDX) DTSBE420 00859 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSBE420 00860 TO L101-PAID-CHNG DTSBE420 00861 END-IF DTSBE420 00862 END-PERFORM. DTSBE420 00863 DTSBE420 00864 IF L101-PAID-CHNG > +0 DTSBE420 00865 PERFORM P2110-PROJECT-PEN-INT THRU P2110-EXIT. DTSBE420 00866 DTSBE420 00867 DTSBE420 00868 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE420 00869 P2100-EXIT. DTSBE420 00870 EXIT. DTSBE420 00871 SKIP3 DTSBE420 00872 P2110-PROJECT-PEN-INT. DTSBE420 00873 MOVE WRK-PARM-INT-COMP-DATE TO L101-RECEIVED-DATE. DTSBE420 00874 DTSBE420 00875 SET L101-WAIVE-INT-NO-88 TO TRUE. DTSBE420 00876 DTSBE420 00877 MOVE MQTR-TAX-DUE-DATE TO L101-TAX-DUE-DATE. DTSBE420 00878 DTSBE420 00879 MOVE MQTR-INT-AREA TO L101-INT-AREA. DTSBE420 00880 DTSBE420 00881 PERFORM S101-PER-MONTH-NO THRU S101-EXIT. DTSBE420 00882 DTSBE420 00883 ADD L101-INT-CHARGE-CHNG TO R422-BALANCE-AMT. DTSBE420 00884 DTSBE420 00885 SUBTRACT L101-INT-WAIVE-CHNG FROM R422-BALANCE-AMT. DTSBE420 00886 P2110-EXIT. DTSBE420 00887 EXIT. DTSBE420 00888 SKIP3 DTSBE420 00889 P2200-SCAN-MQTR. DTSBE420 00890 MOVE MSKL-REC TO MQTR-REC. DTSBE420 00891 DTSBE420 00892 IF MQTR-YRQ = WRK-PARM-SUBJECT-YRQ DTSBE420 00893 NEXT SENTENCE DTSBE420 00894 ELSE DTSBE420 00895 IF MQTR-RPT-IS-PURSUED-88 DTSBE420 00896 IF R422-ADDITIONAL-RPT-CNT < +19 DTSBE420 00897 ADD +1 TO R422-ADDITIONAL-RPT-CNT DTSBE420 00898 MOVE MQTR-YRQ DTSBE420 00899 TO R422-ADDITIONAL-RPT-YRQ DTSBE420 00900 (R422-ADDITIONAL-RPT-CNT) DTSBE420 00901 ELSE DTSBE420 00902 MOVE MSG3-ID TO R907-MSG-ID DTSBE420 00903 MOVE MSG3-TEXT TO R907-MSG-TEXT DTSBE420 00904 PERFORM S946-WRITE-R907 THRU S946-EXIT DTSBE420 00905 SET L910-NO-REC-88 TO TRUE DTSBE420 00906 GO TO P2200-EXIT. DTSBE420 00907 DTSBE420 00908 DTSBE420 00909 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE420 00910 P2200-EXIT. DTSBE420 00911 EXIT. DTSBE420 00912 SKIP3 DTSBE420 00913 P2300-SCAN-MOPO. DTSBE420 00914 MOVE MSKL-REC TO MOPO-REC. DTSBE420 00915 DTSBE420 00916 ADD +1 TO R422-OPO-NAME-CNT. DTSBE420 00917 DTSBE420 00918 MOVE MOPO-NAME TO R422-OPO-NAME (R422-OPO-NAME-CNT). DTSBE420 00919 DTSBE420 00920 IF R422-OPO-NAME-CNT < +6 DTSBE420 00921 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBE420 00922 ELSE DTSBE420 00923 SET L910-NO-REC-88 TO TRUE. DTSBE420 00924 P2300-EXIT. DTSBE420 00925 EXIT. DTSBE420 00926 EJECT DTSBE420 00927 P3000-FINAL-NOTICE. DTSBE420 00928 IF L061-FLD-REP-ID = '??' DTSBE420 00929 MOVE MSG4-ID TO R907-MSG-ID DTSBE420 00930 MOVE MSG4-TEXT TO R907-MSG-TEXT DTSBE420 00931 PERFORM S946-WRITE-R907 THRU S946-EXIT DTSBE420 00932 GO TO P3000-EXIT DTSBE420 00933 ELSE DTSBE420 00934 IF L061-FLD-DESK-88 DTSBE420 00935 SET R421-FLD-DESK-YES-88 TO TRUE DTSBE420 00936 ELSE DTSBE420 00937 SET R421-FLD-DESK-NO-88 TO TRUE. DTSBE420 00938 DTSBE420 00939 DTSBE420 00940 MOVE SPACES TO R421-SORT-ZIP. DTSBE420 00941 DTSBE420 00942 MOVE MPRF-EMP-NO TO R421-EMP-NO. DTSBE420 00943 DTSBE420 00944 MOVE LOW-VALUES TO R421-DATA-AREA. DTSBE420 00945 DTSBE420 00946 MOVE L061-FLD-REP-ID TO R421-FIELD-REP-ID. DTSBE420 00947 DTSBE420 00948 MOVE WRK-UC30-FINAL-DEL-MAIL-DATE TO R421-MAIL-DATE. DTSBE420 00949 DTSBE420 00950 MOVE WRK-AS-OF-DATE TO R421-AS-OF-DATE. DTSBE420 00951 DTSBE420 00952 MOVE WRK-UC30-FIRST-DEL-MAIL-DATE DTSBE420 00953 TO R421-UC30-FIRST-DEL-MAIL-DATE. DTSBE420 00954 DTSBE420 00955 MOVE WRK-PARM-FINAL-ACTION-DATE DTSBE420 00956 TO R421-FINAL-ACTION-DATE. DTSBE420 00957 DTSBE420 00958 MOVE SPACES TO R421-FMT-ADDR DTSBE420 00959 R421-ZIP DTSBE420 00960 R421-ADVANCED-BARCODE. DTSBE420 00961 DTSBE420 00962 MOVE WRK-TOTAL-RATE TO R421-TOTAL-RATE. DTSBE420 00963 DTSBE420 00964 IF R421-NO-UI-RATE-88 DTSBE420 00965 MOVE MSG1-ID TO R907-MSG-ID DTSBE420 00966 MOVE WRK-SUBJECT-SLASH-QTR TO MSG1-SLASHED-YRQ DTSBE420 00967 MOVE MSG1-TEXT TO R907-MSG-TEXT DTSBE420 00968 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBE420 00969 DTSBE420 00970 MOVE WRK-PARM-SUBJECT-YRQ TO R421-YRQ. DTSBE420 00971 DTSBE420 00972 MOVE WRK-RPT-DUE-DATE TO R421-DUE-DATE. DTSBE420 00973 DTSBE420 00974 DTSBE420 00975 MOVE R422-ADDITIONAL-RPT-CNT TO R421-ADDITIONAL-RPT-CNT. DTSBE420 00976 DTSBE420 00977 PERFORM DTSBE420 00978 VARYING R422-YRQ-IDX FROM 1 BY 1 DTSBE420 00979 UNTIL R422-YRQ-IDX > R422-ADDITIONAL-RPT-CNT DTSBE420 00980 SET R421-YRQ-IDX TO R422-YRQ-IDX DTSBE420 00981 MOVE R422-ADDITIONAL-RPT-YRQ (R422-YRQ-IDX) DTSBE420 00982 TO R421-ADDITIONAL-RPT-YRQ (R421-YRQ-IDX) DTSBE420 00983 END-PERFORM. DTSBE420 00984 DTSBE420 00985 DTSBE420 00986 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBE420 00987 DTSBE420 00988 MOVE MPRF-EMP-NO TO MSKL-EMP-NO. DTSBE420 00989 DTSBE420 00990 SET MSKL-TAD-88 TO TRUE. DTSBE420 00991 DTSBE420 00992 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE420 00993 DTSBE420 00994 PERFORM DTSBE420 00995 UNTIL L910-NO-REC-88 DTSBE420 00996 MOVE MSKL-REC TO MTAD-REC DTSBE420 00997 IF MTAD-MISSING-RPT-LTRS-YES-88 DTSBE420 00998 PERFORM P3100-TAD-PROCESS THRU P3100-EXIT DTSBE420 00999 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA DTSBE420 01000 PERFORM S910-READ THRU S910-EXIT DTSBE420 01001 END-IF DTSBE420 01002 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBE420 01003 END-PERFORM. DTSBE420 01004 DTSBE420 01005 DTSBE420 01006 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBE420 01007 DTSBE420 01008 MOVE MPRF-EMP-NO TO MSKL-EMP-NO. DTSBE420 01009 DTSBE420 01010 SET MSKL-OPO-88 TO TRUE. DTSBE420 01011 DTSBE420 01012 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE420 01013 DTSBE420 01014 PERFORM DTSBE420 01015 UNTIL L910-NO-REC-88 DTSBE420 01016 MOVE MSKL-REC TO MOPO-REC DTSBE420 01017 IF MOPO-MISSING-RPT-LTRS-YES-88 DTSBE420 01018 PERFORM P3200-OPO-PROCESS THRU P3200-EXIT DTSBE420 01019 MOVE MOPO-KEY-AREA TO MSKL-KEY-AREA DTSBE420 01020 PERFORM S910-READ THRU S910-EXIT DTSBE420 01021 END-IF DTSBE420 01022 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBE420 01023 END-PERFORM. DTSBE420 01024 DTSBE420 01025 DTSBE420 01026 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBE420 01027 DTSBE420 01028 MOVE MPRF-EMP-NO TO MSKL-EMP-NO. DTSBE420 01029 DTSBE420 01030 SET MSKL-TAA-88 TO TRUE. DTSBE420 01031 DTSBE420 01032 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE420 01033 DTSBE420 01034 PERFORM DTSBE420 01035 UNTIL L910-NO-REC-88 DTSBE420 01036 MOVE MSKL-REC TO MTAA-REC DTSBE420 01037 IF MTAA-MISSING-RPT-LTRS-YES-88 DTSBE420 01038 PERFORM P3300-TAA-PROCESS THRU P3300-EXIT DTSBE420 01039 MOVE MTAA-KEY-AREA TO MSKL-KEY-AREA DTSBE420 01040 PERFORM S910-READ THRU S910-EXIT DTSBE420 01041 END-IF DTSBE420 01042 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBE420 01043 END-PERFORM. DTSBE420 01044 P3000-EXIT. DTSBE420 01045 EXIT. DTSBE420 01046 SKIP3 DTSBE420 01047 P3100-TAD-PROCESS. DTSBE420 01048 MOVE MTAD-ID-NO TO L111-ID-NO. DTSBE420 01049 DTSBE420 01050 PERFORM S111-LOOKUP-TAD THRU S111-EXIT. DTSBE420 01051 DTSBE420 01052 IF L111-ADDR-NOT-FOUND-88 DTSBE420 01053 GO TO P3100-EXIT. DTSBE420 01054 DTSBE420 01055 DTSBE420 01056 MOVE L111-RETURN-AREA TO L112-NAME-ADDRESS-AREA. DTSBE420 01057 DTSBE420 01058 PERFORM S112-FORMAT-TAD THRU S112-EXIT. DTSBE420 01059 DTSBE420 01060 DTSBE420 01061 MOVE L112-ZIP TO R421-SORT-ZIP. DTSBE420 01062 DTSBE420 01063 MOVE L112-MAILING-ADDRESS TO R421-FMT-ADDR. DTSBE420 01064 DTSBE420 01065 MOVE L112-ZIP TO R421-ZIP. DTSBE420 01066 DTSBE420 01067 MOVE L112-ADVANCED-BARCODE TO R421-ADVANCED-BARCODE. DTSBE420 01068 DTSBE420 01069 DTSBE420 01070 PERFORM S946-WRITE-R421 THRU S946-EXIT. DTSBE420 01071 DTSBE420 01072 DTSBE420 01073 MOVE 'MTAD' TO EVL-ADDR-TYPE. DTSBE420 01074 DTSBE420 01075 MOVE L111-ID-NO TO EVL-ADDR-ID-NO. DTSBE420 01076 DTSBE420 01077 MOVE WRK-SUBJECT-SLASH-QTR TO EVL-SLASH-QTR. DTSBE420 01078 DTSBE420 01079 PERFORM S1000-WRITE-MEVL THRU S1000-EXIT. DTSBE420 01080 P3100-EXIT. DTSBE420 01081 EXIT. DTSBE420 01082 SKIP3 DTSBE420 01083 P3200-OPO-PROCESS. DTSBE420 01084 MOVE MOPO-ID-NO TO L111-ID-NO. DTSBE420 01085 DTSBE420 01086 PERFORM S111-LOOKUP-OPO THRU S111-EXIT. DTSBE420 01087 DTSBE420 01088 IF L111-ADDR-NOT-FOUND-88 DTSBE420 01089 GO TO P3200-EXIT. DTSBE420 01090 DTSBE420 01091 DTSBE420 01092 MOVE L111-RETURN-AREA TO L112-NAME-ADDRESS-AREA. DTSBE420 01093 DTSBE420 01094 PERFORM S112-FORMAT-OPO THRU S112-EXIT. DTSBE420 01095 DTSBE420 01096 DTSBE420 01097 MOVE L112-ZIP TO R421-SORT-ZIP. DTSBE420 01098 DTSBE420 01099 MOVE L112-MAILING-ADDRESS TO R421-FMT-ADDR. DTSBE420 01100 DTSBE420 01101 MOVE L112-ZIP TO R421-ZIP. DTSBE420 01102 DTSBE420 01103 MOVE L112-ADVANCED-BARCODE TO R421-ADVANCED-BARCODE. DTSBE420 01104 DTSBE420 01105 DTSBE420 01106 PERFORM S946-WRITE-R421 THRU S946-EXIT. DTSBE420 01107 DTSBE420 01108 DTSBE420 01109 MOVE 'MOPO' TO EVL-ADDR-TYPE. DTSBE420 01110 DTSBE420 01111 MOVE L111-ID-NO TO EVL-ADDR-ID-NO. DTSBE420 01112 DTSBE420 01113 MOVE WRK-SUBJECT-SLASH-QTR TO EVL-SLASH-QTR. DTSBE420 01114 DTSBE420 01115 PERFORM S1000-WRITE-MEVL THRU S1000-EXIT. DTSBE420 01116 P3200-EXIT. DTSBE420 01117 EXIT. DTSBE420 01118 SKIP3 DTSBE420 01119 P3300-TAA-PROCESS. DTSBE420 01120 MOVE MTAA-ID-NO TO L111-ID-NO. DTSBE420 01121 DTSBE420 01122 PERFORM S111-LOOKUP-TAA THRU S111-EXIT. DTSBE420 01123 DTSBE420 01124 IF L111-ADDR-NOT-FOUND-88 DTSBE420 01125 GO TO P3300-EXIT. DTSBE420 01126 DTSBE420 01127 DTSBE420 01128 MOVE L111-RETURN-AREA TO L112-NAME-ADDRESS-AREA. DTSBE420 01129 DTSBE420 01130 PERFORM S112-FORMAT-TAA THRU S112-EXIT. DTSBE420 01131 DTSBE420 01132 DTSBE420 01133 MOVE L112-ZIP TO R421-SORT-ZIP. DTSBE420 01134 DTSBE420 01135 MOVE L112-MAILING-ADDRESS TO R421-FMT-ADDR. DTSBE420 01136 DTSBE420 01137 MOVE L112-ZIP TO R421-ZIP. DTSBE420 01138 DTSBE420 01139 MOVE L112-ADVANCED-BARCODE TO R421-ADVANCED-BARCODE. DTSBE420 01140 DTSBE420 01141 DTSBE420 01142 PERFORM S946-WRITE-R421 THRU S946-EXIT. DTSBE420 01143 DTSBE420 01144 DTSBE420 01145 MOVE 'MTAA' TO EVL-ADDR-TYPE. DTSBE420 01146 DTSBE420 01147 MOVE L111-ID-NO TO EVL-ADDR-ID-NO. DTSBE420 01148 DTSBE420 01149 MOVE WRK-SUBJECT-SLASH-QTR TO EVL-SLASH-QTR. DTSBE420 01150 DTSBE420 01151 PERFORM S1000-WRITE-MEVL THRU S1000-EXIT. DTSBE420 01152 P3300-EXIT. DTSBE420 01153 EXIT. DTSBE420 01154 EJECT DTSBE420 01155 T0000-TERMINATE. DTSBE420 01156 MOVE WRK-NOTICE-CNT TO WRK-CNT-DISP. DTSBE420 01157 DISPLAY SPACE. DTSBE420 01158 DISPLAY '*****************************************'. DTSBE420 01159 DISPLAY '** DTSBE420 COUNTS **'. DTSBE420 01160 DISPLAY '** **'. DTSBE420 01161 DISPLAY '** NOTICES SENT: ' WRK-CNT-DISP DTSBE420 01162 ' **'. DTSBE420 01163 DISPLAY '** **'. DTSBE420 01164 MOVE WRK-ANNUAL-FILER-CNT TO WRK-CNT-DISP. DTSBE420 01165 DISPLAY '** ANNUAL FILERS BYPASSED: ' WRK-CNT-DISP DTSBE420 01166 ' **'. DTSBE420 01167 DISPLAY '** **'. DTSBE420 01168 DISPLAY '*****************************************'. DTSBE420 01169 IF WRK-PARM-NOTICE-YES-88 DTSBE420 01170 MOVE LOW-VALUES TO FQTR-KEY-AREA DTSBE420 01171 SET FQTR-QTR-88 TO TRUE DTSBE420 01172 MOVE WRK-PARM-SUBJECT-YRQ TO FQTR-YRQ DTSBE420 01173 MOVE FQTR-KEY-AREA TO FSKL-KEY-AREA DTSBE420 01174 PERFORM S931-READ THRU S931-EXIT DTSBE420 01175 IF L931-NO-REC-88 DTSBE420 01176 MOVE 'LOGIC ERROR T0000-1' TO ABEND-MSG DTSBE420 01177 PERFORM S999-ABEND THRU S999-EXIT DTSBE420 01178 ELSE DTSBE420 01179 MOVE FSKL-REC TO FQTR-REC DTSBE420 01180 MOVE WRK-UC30-FINAL-DEL-CUTOFF-DATE DTSBE420 01181 TO FQTR-UC30-FINAL-DEL-DATE DTSBE420 01182 MOVE WRK-PARM-FINAL-ACTION-DATE DTSBE420 01183 TO FQTR-UC30-FINAL-ACTION-DATE DTSBE420 01184 MOVE LECM-CURR-RUN-DATE TO FQTR-CHNG-DATE DTSBE420 01185 MOVE FQTR-REC TO FSKL-REC DTSBE420 01186 PERFORM S931-REWRITE THRU S931-EXIT. DTSBE420 01187 T0000-EXIT. DTSBE420 01188 EXIT. DTSBE420 01189 EJECT DTSBE420 01190 S1000-WRITE-MEVL. DTSBE420 01191 ADD +1000 TO LECM-EMP-ABSTIME. DTSBE420 01192 DTSBE420 01193 MOVE LECM-EMP-ABSTIME TO L005-ABSTIME. DTSBE420 01194 DTSBE420 01195 PERFORM S005-FROM-ABSTIME THRU S005-EXIT. DTSBE420 01196 DTSBE420 01197 DTSBE420 01198 MOVE LOW-VALUES TO MEVL-REC. DTSBE420 01199 DTSBE420 01200 MOVE MPRF-EMP-NO TO MEVL-EMP-NO. DTSBE420 01201 DTSBE420 01202 SET MEVL-EVL-88 TO TRUE. DTSBE420 01203 DTSBE420 01204 MOVE L005-DATE TO MEVL-DATE. DTSBE420 01205 DTSBE420 01206 MOVE L005-TIME TO MEVL-TIME. DTSBE420 01207 DTSBE420 01208 DTSBE420 01209 MOVE ZEROS TO MEVL-PURGE-DATE. DTSBE420 01210 DTSBE420 01211 DTSBE420 01212 MOVE EVL-TEXT TO MEVL-TEXT. DTSBE420 01213 DTSBE420 01214 SET MEVL-SOURCE-SYSTEM-88 TO TRUE. DTSBE420 01215 DTSBE420 01216 SET MEVL-NOT-CONVERTED-88 TO TRUE. DTSBE420 01217 DTSBE420 01218 MOVE LECM-CURR-RUN-DATE TO MEVL-ESTB-DATE DTSBE420 01219 MEVL-CHNG-DATE. DTSBE420 01220 DTSBE420 01221 DTSBE420 01222 MOVE MEVL-REC TO MSKL-REC. DTSBE420 01223 DTSBE420 01224 PERFORM S910-WRITE THRU S910-EXIT. DTSBE420 01225 S1000-EXIT. DTSBE420 01226 EXIT. DTSBE420 01227 EJECT DTSBE420 01228 S001-FROM-FED-8. DTSBE420 01229 SET L001-FROM-FED-8 TO TRUE. DTSBE420 01230 GO TO S001-DATE. DTSBE420 01231 DTSBE420 01232 S001-FROM-CAL-6. DTSBE420 01233 SET L001-FROM-CAL-6 TO TRUE. DTSBE420 01234 GO TO S001-DATE. DTSBE420 01235 DTSBE420 01236 S001-FROM-ABS-DAY. DTSBE420 01237 SET L001-FROM-ABS-DAY TO TRUE. DTSBE420 01238 GO TO S001-DATE. DTSBE420 01239 DTSBE420 01240 S001-DATE. DTSBE420 01241 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBE420 01242 S001-EXIT. DTSBE420 01243 EXIT. DTSBE420 01244 SKIP3 DTSBE420 01245 S004-FROM-5. DTSBE420 01246 SET L004-FROM-5 TO TRUE. DTSBE420 01247 GO TO S004-QTR. DTSBE420 01248 DTSBE420 01249 S004-FROM-3. DTSBE420 01250 SET L004-FROM-3 TO TRUE. DTSBE420 01251 GO TO S004-QTR. DTSBE420 01252 DTSBE420 01253 S004-QTR. DTSBE420 01254 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBE420 01255 S004-EXIT. DTSBE420 01256 EXIT. DTSBE420 01257 SKIP3 DTSBE420 01258 S005-FROM-ABSTIME. DTSBE420 01259 SET L005-FROM-ABSTIME TO TRUE. DTSBE420 01260 GO TO S005-ABSTIME. DTSBE420 01261 DTSBE420 01262 S005-ABSTIME. DTSBE420 01263 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBE420 01264 S005-EXIT. DTSBE420 01265 EXIT. DTSBE420 01266 SKIP3 DTSBE420 01267 S061-DETERMINE-FLD-REP. DTSBE420 01268 MOVE MPRF-FLD-ZIP-ST TO L061-FLD-ZIP-ST. DTSBE420 01269 DTSBE420 01270 MOVE MPRF-EMP-NO TO L061-EMP-NO. DTSBE420 01271 DTSBE420 01272 CALL 'DTSBU061' USING L061-LINK-AREA. DTSBE420 01273 S061-EXIT. DTSBE420 01274 EXIT. DTSBE420 01275 SKIP3 DTSBE420 01276 S101-PER-MONTH-NO. DTSBE420 01277 SET L101-PER-MONTH-NO-88 TO TRUE. DTSBE420 01278 GO TO S101-INT-COMP. DTSBE420 01279 DTSBE420 01280 S101-INT-COMP. DTSBE420 01281 CALL 'DTSBU101' USING L101-LINK-AREA. DTSBE420 01282 S101-EXIT. DTSBE420 01283 EXIT. DTSBE420 01284 SKIP3 DTSBE420 01285 S109-LOOKUP-SUR-RATE. DTSBE420 01286 MOVE MPRF-EMP-CLASS TO L109-EMP-CLASS. DTSBE420 01287 MOVE MQTR-YRQ TO L109-YRQ. DTSBE420 01288 SET L109-CMND-INPUT-QTR-88 TO TRUE. DTSBE420 01289 DTSBE420 01290 CALL 'DTSBU109' USING L109-LINK-AREA. DTSBE420 01291 S109-EXIT. DTSBE420 01292 EXIT. DTSBE420 01293 SKIP3 DTSBE420 01294 S111-LOOKUP-TAD. DTSBE420 01295 SET L111-LOOKUP-TAD-88 TO TRUE. DTSBE420 01296 GO TO S111-LOOKUP-ADDR. DTSBE420 01297 DTSBE420 01298 S111-LOOKUP-TAA. DTSBE420 01299 SET L111-LOOKUP-TAA-88 TO TRUE. DTSBE420 01300 GO TO S111-LOOKUP-ADDR. DTSBE420 01301 DTSBE420 01302 S111-LOOKUP-OPO. DTSBE420 01303 SET L111-LOOKUP-OPO-88 TO TRUE. DTSBE420 01304 GO TO S111-LOOKUP-ADDR. DTSBE420 01305 DTSBE420 01306 S111-LOOKUP-ADDR. DTSBE420 01307 MOVE MPRF-EMP-NO TO L111-EMP-NO. DTSBE420 01308 DTSBE420 01309 CALL 'DTSBU111' USING L111-LINK-AREA. DTSBE420 01310 S111-EXIT. DTSBE420 01311 EXIT. DTSBE420 01312 SKIP3 DTSBE420 01313 S112-FORMAT-TAD. DTSBE420 01314 SET L112-TAD-ADDR-88 TO TRUE. DTSBE420 01315 GO TO S112-FORMAT-ADDR. DTSBE420 01316 DTSBE420 01317 S112-FORMAT-TAA. DTSBE420 01318 SET L112-TAA-ADDR-88 TO TRUE. DTSBE420 01319 GO TO S112-FORMAT-ADDR. DTSBE420 01320 DTSBE420 01321 S112-FORMAT-OPO. DTSBE420 01322 SET L112-OPO-ADDR-88 TO TRUE. DTSBE420 01323 GO TO S112-FORMAT-ADDR. DTSBE420 01324 DTSBE420 01325 S112-FORMAT-ADDR. DTSBE420 01326 SET L112-ANCHOR-LAST-88 TO TRUE. DTSBE420 01327 DTSBE420 01328 MOVE MPRF-PRIMARY-NAME TO L112-PRIMARY-NAME. DTSBE420 01329 DTSBE420 01330 CALL 'DTSBU112' USING L112-LINK-AREA. DTSBE420 01331 S112-EXIT. DTSBE420 01332 EXIT. DTSBE420 01333 SKIP3 DTSBE420 01334 S410-FILE-SCHED. DTSBE420 01335 CALL 'DTSBU410' USING L410-LINK-AREA. DTSBE420 01336 S410-EXIT. DTSBE420 01337 EXIT. DTSBE420 01338 SKIP3 DTSBE420 01339 S910-READ. DTSBE420 01340 SET L910-READ-88 TO TRUE. DTSBE420 01341 GO TO S910-MSTR-IO. DTSBE420 01342 DTSBE420 01343 S910-START-BROWSE. DTSBE420 01344 SET L910-START-BROWSE-88 TO TRUE. DTSBE420 01345 GO TO S910-MSTR-IO. DTSBE420 01346 DTSBE420 01347 S910-READ-NEXT. DTSBE420 01348 SET L910-READ-NEXT-88 TO TRUE. DTSBE420 01349 GO TO S910-MSTR-IO. DTSBE420 01350 DTSBE420 01351 *S910-COUNT. DTSBE420 01352 *****SET L910-COUNT-88 TO TRUE. DTSBE420 01353 *****GO TO S910-MSTR-IO. DTSBE420 01354 DTSBE420 01355 S910-WRITE. DTSBE420 01356 SET L910-WRITE-88 TO TRUE. DTSBE420 01357 SET LECM-EMP-UPDATED-YES-88 TO TRUE. DTSBE420 01358 GO TO S910-MSTR-IO. DTSBE420 01359 DTSBE420 01360 *S910-REWRITE. DTSBE420 01361 *****SET L910-REWRITE-88 TO TRUE. DTSBE420 01362 *****SET LECM-EMP-UPDATED-YES-88 TO TRUE. DTSBE420 01363 *****GO TO S910-MSTR-IO. DTSBE420 01364 DTSBE420 01365 *S910-DELETE. DTSBE420 01366 *****SET L910-DELETE-88 TO TRUE. DTSBE420 01367 *****SET LECM-EMP-UPDATED-YES-88 TO TRUE. DTSBE420 01368 *****GO TO S910-MSTR-IO. DTSBE420 01369 DTSBE420 01370 S910-MSTR-IO. DTSBE420 01371 CALL 'DTSBU910' USING L910-LINK-AREA DTSBE420 01372 MSKL-REC. DTSBE420 01373 S910-EXIT. DTSBE420 01374 EXIT. DTSBE420 01375 SKIP3 DTSBE420 01376 S931-READ. DTSBE420 01377 SET L931-READ-88 TO TRUE. DTSBE420 01378 GO TO S931-REF-I. DTSBE420 01379 DTSBE420 01380 *S931-START-BROWSE. DTSBE420 01381 *****SET L931-START-BROWSE-88 TO TRUE. DTSBE420 01382 *****GO TO S931-REF-I. DTSBE420 01383 DTSBE420 01384 *S931-READ-NEXT. DTSBE420 01385 *****SET L931-READ-NEXT-88 TO TRUE. DTSBE420 01386 *****GO TO S931-REF-I. DTSBE420 01387 DTSBE420 01388 *S931-WRITE. DTSBE420 01389 *****SET L931-WRITE-88 TO TRUE. DTSBE420 01390 *****GO TO S931-REF-I. DTSBE420 01391 DTSBE420 01392 S931-REWRITE. DTSBE420 01393 SET L931-REWRITE-88 TO TRUE. DTSBE420 01394 GO TO S931-REF-I. DTSBE420 01395 DTSBE420 01396 *S931-DELETE. DTSBE420 01397 *****SET L931-DELETE-88 TO TRUE. DTSBE420 01398 *****GO TO S931-REF-I. DTSBE420 01399 DTSBE420 01400 S931-REF-I. DTSBE420 01401 CALL 'DTSBU931' USING L931-LINK-AREA DTSBE420 01402 FSKL-REC. DTSBE420 01403 S931-EXIT. DTSBE420 01404 EXIT. DTSBE420 01405 SKIP3 DTSBE420 01406 S946-WRITE-R421. DTSBE420 01407 CALL 'DTSBU946' USING R421-REC. DTSBE420 01408 GO TO S946-EXIT. DTSBE420 01409 DTSBE420 01410 S946-WRITE-R422. DTSBE420 01411 CALL 'DTSBU946' USING R422-REC. DTSBE420 01412 GO TO S946-EXIT. DTSBE420 01413 DTSBE420 01414 S946-WRITE-R907. DTSBE420 01415 CALL 'DTSBU946' USING R907-REC. DTSBE420 01416 GO TO S946-EXIT. DTSBE420 01417 DTSBE420 01418 S946-EXIT. DTSBE420 01419 EXIT. DTSBE420 01420 SKIP3 DTSBE420 01421 S999-ABEND. DTSBE420 01422 DISPLAY '*** DTSBE420 ABENDING. ' DTSBE420 01423 ABEND-MSG. DTSBE420 01424 DTSBE420 01425 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBE420 01426 S999-EXIT. DTSBE420 01427 EXIT. DTSBE420