00001 IDENTIFICATION DIVISION. 06/01/18 00002 PROGRAM-ID. DTSBE451. DTSBE451 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV002 00004 DATE-WRITTEN. AUGUST 2002. DTSBE451 00005 DATE-COMPILED. DTSBE451 00006 SKIP3 DTSBE451 00007 ***** DTSBE451 00008 * DTSBE451 00009 * FUNCTION: THIS PROGRAM WILL SEND THE FIRST DELINQUENCY DTSBE451 00010 * NOTICES TO HOUSEHOLD EMPLOYERS FILING ANNUALLY. DTSBE451 00011 * DTSBE451 00012 * MODIFICATION LOG: DTSBE451 00013 * DTSBE451 00014 * 08/20/2002 CREATED FROM DTSBE417 ZL1. DTSBE451 00015 * DTSBE451 00016 * 06/08/2005 MODIFIED FOR NEW PENALTY PROCESS. PENALTY DTSBE451 00017 * IS NOW ASSESSED FOR MISSING REPORTS. GD DTSBE451 00018 * DTSBE451 00019 * 11/28/05 ADD MPRF-RETURN-MAIL-IND. IF MPRF-RETURN-MAIL-YES-8DTSBE451 00020 * ON MPRF-EMP-NO, BY PASS THAT ACCOUNT EXTRACT INFO- DTSBE451 00021 * MATION AND SEND NO HOUSEHOLD DELINQUENT LETTER TO DTSBE451 00022 * THAT EMPLOYER. DTSBE451 00023 * WORK ORDER: PROGRAMMER: RW1 DTSBE451 00024 * DTSBE451 00025 * 08/25/2006 MODIFIED FOR ADMINISTRATIVE ASSESSMENT. PENALTY DTSBE451 00026 * AND INTEREST CALCULATED ON UI TAX BALANCE ONLY - DTSBE451 00027 * ADMIN ASSESSMENT NOT USED. DTSBE451 00028 * WORK ORDER: PROGRAMMER: GD DTSBE451 00029 * DTSBE451 00030 * 04/27/07 ADDED PROCESSING TO CHECK FOR UNPROCESSED REPORTS IDTSBE451 00031 * THE TRANSACTION FILE (ATC). DO NOT COUNT AS DTSBE451 00032 * DELINQUENT IF A REPORT EXISTS IN THE TRANSACTION DTSBE451 00033 * FILE FOR THE EMPLOYER. DTSBE451 00034 * WORK ORDER: ANNUAL FILERS PROGRAMMER: ZL1 DTSBE451 00035 * DTSBE451 00036 * 09/10/2007 MODIFIED P4100 TO MOVE LECM-CURR-RUN-DATE TO DTSBE451 00037 * NEW FIELD L102-CURR-RUN-DATE. DTSBE451 00038 * WORK ORDER: PROGRAMMER: ZL1 DTSBE451 00039 * DTSBE451 00040 * 03/04/2008 MODIFIED FOR ADMINISTRATIVE ASSESSMENT. PENALTY DTSBE451 00041 * AND INTEREST CALCULATED ON UI AND SUR TAX BALANCEDTSBE451 00042 * WORK ORDER: PROGRAMMER: ZL1 DTSBE451 00043 * DTSBE451 00044 * 03/22/2013 MODIFIED FOR TIMLEY PAYMENTS. PENALTY DTSBE451 00045 * AND INTEREST CALCULATED ON UI AND SUR TAX BALANCEDTSBE451 00046 * WORK ORDER: PROGRAMMER: ZL1 DTSBE451 00047 * DTSBE451 00048 * DTSBE451 00049 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBE451 00050 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBE451 00051 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBE451 00052 * DTSBE451 00053 * DTSBE451 00054 * DESCRIPTION: DTSBE451 00055 * DTSBE451 00056 * DTSBE451 00057 * INITIATION: DTSBE451 00058 * DTSBE451 00059 * SET LECM-MST-OPEN-UPDATE-88 TO TRUE. DTSBE451 00060 * SET LECM-REF-OPEN-UPDATE-88 TO TRUE. DTSBE451 00061 * DTSBE451 00062 * EDIT AND DEFAULT PARAMETERS. SEE PRINTED OUTPUTS DTSBE451 00063 * DESCRIPTIONS AND LAYOUTS (451R1, 452R1, 716R1). DTSBE451 00064 * DTSBE451 00065 * IF WRK-PARM-SUBJECT-YRQ IS GREATER THAN DTSBE451 00066 * LECM-LAST-UC30-DEL-MAIL-YRQ THEN MOVE DTSBE451 00067 * WRK-PARM-SUBJECT-YRQ TO LECM-LAST-UC30-DEL-MAIL-YRQ. DTSBE451 00068 * DTSBE451 00069 * REFIGURE LECM-FIRST-PURSUED-RPT-YRQ. DTSBE451 00070 * DTSBE451 00071 * DTSBE451 00072 * PROCESSING: DTSBE451 00073 * DTSBE451 00074 * NOTE: ANNUAL PENALTY IS APPLIED ONLY TO THE LAST DTSBE451 00075 * LIABLE QUARTER OF THE CALENDAR YEAR. DTSBE451 00076 * DTSBE451 00077 * SEE PRINTED OUTPUTS DESCRIPTION AND LAYOUTS (451R1, DTSBE451 00078 * 452R1, 716R1). DTSBE451 00079 * DTSBE451 00080 * INCLUDES EXTENSIVE MASTER FILE UPDATING. DTSBE451 00081 * DTSBE451 00082 * MAINTAIN MPRF-PURSUED-RPT-CNT. DTSBE451 00083 * DTSBE451 00084 * DTSBE451 00085 * TERMINATION: DTSBE451 00086 * DTSBE451 00087 * READ THE MHDR RECORD. IF WRK-PARM-SUBJECT-YRQ IS DTSBE451 00088 * GREATER THAN MHDR-LAST-UC30-DEL-MAIL-YRQ THEN MOVE DTSBE451 00089 * WRK-PARM-SUBJECT-YRQ TO MHDR-LAST-UC30-DEL-MAIL-YRQ. DTSBE451 00090 * REFIGURE MHDR-FIRST-PURSUED-RPT-YRQ. DTSBE451 00091 * REWRITE THE MHDR-RECORD. DTSBE451 00092 * DTSBE451 00093 * READ FQTR RECORD FOR WRK-PARM-SUBJECT-YRQ. IF FOUND, DTSBE451 00094 * REWRITE; IF NOT FOUND, CREATE A FQTR RECORD AND WRITE. DTSBE451 00095 * MOVE LECM-CURR-RUN-DATE TO FQTR-UC30-DEL-MAIL-DATE. DTSBE451 00096 * DTSBE451 00097 * DTSBE451 00098 * RECORDS READ: DTSBE451 00099 * DTSBE451 00100 * MASTER: DTSBE451 00101 * DTSBE451 00102 * MHDR DTSBE451 00103 * MQTR DTSBE451 00104 * MRPT DTSBE451 00105 * MTAD DTSBE451 00106 * MOPO DTSBE451 00107 * MTAA DTSBE451 00108 * DTSBE451 00109 * DTSBE451 00110 * ALTERNATE INDEX: DTSBE451 00111 * DTSBE451 00112 * NONE. DTSBE451 00113 * DTSBE451 00114 * DTSBE451 00115 * REFERENCE: DTSBE451 00116 * DTSBE451 00117 * FQTR DTSBE451 00118 * DTSBE451 00119 * DTSBE451 00120 * RECORDS UPDATED: DTSBE451 00121 * DTSBE451 00122 * MHDR (REWRITE) DTSBE451 00123 * MTCK (WRITE) DTSBE451 00124 * MEVL (WRITE) DTSBE451 00125 * FQTR (WRITE, REWRITE) DTSBE451 00126 * DTSBE451 00127 * DTSBE451 00128 * REPORT RECORDS WRITTEN: DTSBE451 00129 * DTSBE451 00130 * R716 RQC REPORT DELINQUENCY UNIVERSE. DTSBE451 00131 * R451 DELINQUENT REPORT NOTICE LETTER. DTSBE451 00132 * R452 DELINQUENT EMPLOYER ACCOUNT NUMBER LIST. DTSBE451 00133 * R907 UNUSUAL CONDITION ENCOUNTERED. DTSBE451 00134 * DTSBE451 00135 * DTSBE451 00136 * BATCH TRANSACTION COLLECTION RECORDS WRITTEN: DTSBE451 00137 * DTSBE451 00138 * NONE. DTSBE451 00139 * DTSBE451 00140 * DTSBE451 00141 * MODULES CALLED: DTSBE451 00142 * DTSBE451 00143 * DTSBU001 DATE CONVERSION/EDIT. DTSBE451 00144 * DTSBU004 QUARTER CONVERSION/EDIT. DTSBE451 00145 * DTSBU061 FIELD ZIP / FIELD REP ID. DTSBE451 00146 * DTSBU111 ADDRESS LOOKUP. DTSBE451 00147 * DTSBU112 ADDRESS FORMAT. DTSBE451 00148 * DTSBU415 HOUSEHOLD DELINQUENT YEAR DTSBE451 00149 * DTSBU511 INITIALIZE MQTR. DTSBE451 00150 * DTSBU516 DETERMINE LIABILITY, DUE DATE, AND RATE DTSBE451 00151 * FOR A GIVEN QUARTER. DTSBE451 00152 * DTSBU910 MASTER FILE I/O DRIVER. DTSBE451 00153 * DTSBU931 REFERENCE FILE I/O DRIVER. DTSBE451 00154 * DTSBU946 VARIABLE LENGTH RECORDS SEQUENTIAL OUTPUT 1. DTSBE451 00155 * DTSBE451 00156 ***** DTSBE451 00157 DTSBE451 00158 DTSBE451 00159 ENVIRONMENT DIVISION. DTSBE451 00160 DTSBE451 00161 DTSBE451 00162 DATA DIVISION. DTSBE451 00163 DTSBE451 00164 DTSBE451 00165 WORKING-STORAGE SECTION. DTSBE451 001655 77 PAN-VALET PICTURE X(24) VALUE '002DTSBE451 06/01/18'. DTSBE451 00166 77 PAN-VALET PICTURE X(24) VALUE '007DTSBE451 05/17/13'. DTSBE451 00167 77 PAN-VALET PICTURE X(24) VALUE '005DTSBE451 05/08/13'. DTSBE451 00168 77 PAN-VALET PICTURE X(24) VALUE '004DTSBE451 03/22/13'. DTSBE451 00169 DTSBE451 00170 01 WRK-AREA. DTSBE451 00171 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +451.DTSBE451 00172 05 ABEND-MSG PIC X(50). DTSBE451 00173 DTSBE451 00174 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBE451'.DTSBE451 00175 DTSBE451 00176 05 ALL-NINES-DATE PIC S9(09) COMP-3 DTSBE451 00177 VALUE +999999999. DTSBE451 00178 DTSBE451 00179 05 WRK-QTR1 PIC S9(05) COMP-3. DTSBE451 00180 05 WRK-QTR2 PIC S9(05) COMP-3. DTSBE451 00181 05 WRK-QTR3 PIC S9(05) COMP-3. DTSBE451 00182 05 WRK-QTR4 PIC S9(05) COMP-3. DTSBE451 00183 05 WRK-QTR1-LIABLE-IND PIC X(01). DTSBE451 00184 88 WRK-QTR1-LIABLE-YES-88 VALUE 'Y'. DTSBE451 00185 88 WRK-QTR1-LIABLE-NO-88 VALUE 'N'. DTSBE451 00186 05 WRK-QTR2-LIABLE-IND PIC X(01). DTSBE451 00187 88 WRK-QTR2-LIABLE-YES-88 VALUE 'Y'. DTSBE451 00188 88 WRK-QTR2-LIABLE-NO-88 VALUE 'N'. DTSBE451 00189 05 WRK-QTR3-LIABLE-IND PIC X(01). DTSBE451 00190 88 WRK-QTR3-LIABLE-YES-88 VALUE 'Y'. DTSBE451 00191 88 WRK-QTR3-LIABLE-NO-88 VALUE 'N'. DTSBE451 00192 05 WRK-QTR4-LIABLE-IND PIC X(01). DTSBE451 00193 88 WRK-QTR4-LIABLE-YES-88 VALUE 'Y'. DTSBE451 00194 88 WRK-QTR4-LIABLE-NO-88 VALUE 'N'. DTSBE451 00195 DTSBE451 00196 05 WRK-ANN-YEAR PIC 9(04). DTSBE451 00197 DTSBE451 00198 05 WRK-RETURN-MAIL-CNT PIC 9(05) VALUE ZEROS. CL**2 00199 05 WRK-PENALTY-YRQ PIC S9(05) COMP-3. DTSBE451 00200 DTSBE451 00201 05 WRK-TIMELY-PAYMENTS PIC S9(09)V99 COMP-3 DTSBE451 00202 VALUE +0. DTSBE451 00203 05 WRK-TF-TABLE-CNT PIC S9(07) COMP-3 DTSBE451 00204 VALUE +0. DTSBE451 00205 05 WRK-BYPASS-CNT PIC S9(07) COMP-3 DTSBE451 00206 VALUE +0. DTSBE451 00207 DTSBE451 00208 05 TF-SUB PIC S9(07) COMP-3. DTSBE451 00209 05 TF-MAX PIC S9(07) COMP-3 DTSBE451 00210 VALUE +999999. DTSBE451 00211 05 TRANS-FILE-RPTS OCCURS 999999 TIMES. DTSBE451 00212 10 TRANS-FILE-RPT-IND PIC X(01). DTSBE451 00213 88 TF-RPT-FOUND-YES-88 VALUE 'Y'. DTSBE451 00214 88 TF-RPT-FOUND-NO-88 VALUE 'N'. DTSBE451 00215 10 TRANS-BYPASSED-IND PIC X(01). DTSBE451 00216 88 TF-BYPASSED-YES-88 VALUE 'Y'. DTSBE451 00217 88 TF-BYPASSED-NO-88 VALUE 'N'. DTSBE451 00218 05 WRK-DELINQUENT-CNT PIC S9(07) COMP-3 DTSBE451 00219 VALUE +0. DTSBE451 00220 05 WRK-SI-DEL-CNT PIC S9(07) COMP-3 DTSBE451 00221 VALUE +0. DTSBE451 00222 05 WRK-PEN-CNT PIC S9(07) COMP-3 DTSBE451 00223 VALUE +0. DTSBE451 00224 05 WRK-SI-PEN-CNT PIC S9(07) COMP-3 DTSBE451 00225 VALUE +0. DTSBE451 00226 DTSBE451 00227 05 AMT-DISP1 PIC --------9.99. DTSBE451 00228 DTSBE451 00229 05 INCONSISTENCY-ENCOUNTERED-IND PIC X(01). DTSBE451 00230 DTSBE451 00231 05 WRK-TRIGGER-DATE PIC S9(09) COMP-3. DTSBE451 00232 DTSBE451 00233 05 WRK-ORIG-RECEIVED-DATE PIC S9(09) COMP-3. DTSBE451 00234 DTSBE451 00235 05 WRK-DROP-PURSUIT-IND PIC X(01). DTSBE451 00236 88 WRK-DROP-PURSUIT-YES-88 VALUE 'Y'. DTSBE451 00237 88 WRK-DROP-PURSUIT-NO-88 VALUE 'N'. DTSBE451 00238 DTSBE451 00239 DTSBE451 00240 05 WRK-PRE-UPD-IND PIC X(01). DTSBE451 00241 88 PRE-UPD-RPT-PURSUED-YES-88 VALUE 'Y'. DTSBE451 00242 88 PRE-UPD-RPT-PURSUED-NO-88 VALUE 'N'. DTSBE451 00243 DTSBE451 00244 05 WRK-POST-UPD-IND PIC X(01). DTSBE451 00245 88 POST-UPD-RPT-PURSUED-YES-88 VALUE 'Y'. DTSBE451 00246 88 POST-UPD-RPT-PURSUED-NO-88 VALUE 'N'. DTSBE451 00247 DTSBE451 00248 05 EVL-TEXT. DTSBE451 00249 10 FILLER PIC X(26) DTSBE451 00250 VALUE 'MISSING REPORT LETTER FOR '. DTSBE451 00251 10 EVL-SLASH-QTR PIC X(4). DTSBE451 00252 10 FILLER PIC X(9) DTSBE451 00253 VALUE ' SENT TO '. DTSBE451 00254 10 EVL-ADDR-TYPE PIC X(04). DTSBE451 00255 10 EVL-ADDR-ID-NO PIC ZZ9. DTSBE451 00256 EJECT DTSBE451 00257 01 MSG-AREA. DTSBE451 00258 05 MSG1-AREA. DTSBE451 00259 10 MSG1-ID PIC X(03) VALUE '421'. DTSBE451 00260 10 MSG1-TEXT. DTSBE451 00261 15 FILLER PIC X(40) DTSBE451 00262 VALUE 'RATE MISSING. DELINQUENT REPORT LETTER '. DTSBE451 00263 15 FILLER PIC X(40) DTSBE451 00264 VALUE 'PRINTED WITHOUT A RATE. YRQ = '. DTSBE451 00265 15 MSG1-SLASHED-YRQ PIC X(04). DTSBE451 00266 DTSBE451 00267 05 MSG2-AREA. DTSBE451 00268 10 MSG2-ID PIC X(03) VALUE '422'. DTSBE451 00269 10 MSG2-TEXT. DTSBE451 00270 15 FILLER PIC X(40) DTSBE451 00271 VALUE 'DELINQUENT REPORT LETTER PRINTING SUPPRE'. DTSBE451 00272 15 FILLER PIC X(40) DTSBE451 00273 VALUE 'SSED ON ALL MTAD RECORDS. YRQ = '. DTSBE451 00274 15 MSG2-SLASHED-YRQ PIC X(04). DTSBE451 00275 DTSBE451 00276 05 MSG3-AREA. DTSBE451 00277 10 MSG3-ID PIC X(03) VALUE '423'. DTSBE451 00278 10 MSG3-TEXT. DTSBE451 00279 15 FILLER PIC X(40) DTSBE451 00280 VALUE 'MORE THAN 19 ADDITIONAL REPORTS ARE MISS'. DTSBE451 00281 15 FILLER PIC X(40) DTSBE451 00282 VALUE 'ING. INCOMPLETE LETTER PRINTED. YRQ = '. DTSBE451 00283 15 MSG3-SLASHED-YRQ PIC X(04). DTSBE451 00284 DTSBE451 00285 05 MSG4-AREA. DTSBE451 00286 10 MSG4-ID PIC X(03) VALUE '424'. DTSBE451 00287 10 MSG4-TEXT. DTSBE451 00288 15 FILLER PIC X(40) DTSBE451 00289 VALUE 'INCONSISTENT MQR-CURR-RPT-TYPE ENCOUNTER'. DTSBE451 00290 15 FILLER PIC X(40) DTSBE451 00291 VALUE 'ED. SCREAM AT PROGRAMMING. YRQ = '. DTSBE451 00292 15 MSG4-SLASHED-YRQ PIC X(04). DTSBE451 00293 DTSBE451 00294 05 MSG5-AREA. DTSBE451 00295 10 MSG5-ID PIC X(03) VALUE '425'. DTSBE451 00296 10 MSG5-TEXT. DTSBE451 00297 15 FILLER PIC X(40) DTSBE451 00298 VALUE 'DELINQUENT REPORT LETTER PRINTING SUPPRE'. DTSBE451 00299 15 FILLER PIC X(40) DTSBE451 00300 VALUE 'SSED FOR ALL ADDRESSES. YRQ = '. DTSBE451 00301 15 MSG5-SLASHED-YRQ PIC X(04). DTSBE451 00302 DTSBE451 00303 05 MSG6-AREA. DTSBE451 00304 10 MSG6-ID PIC X(03) VALUE '426'. DTSBE451 00305 10 MSG6-TEXT. DTSBE451 00306 15 FILLER PIC X(40) DTSBE451 00307 VALUE 'DELINQUENT QUARTER ADDED BUT RATE IS EST'. DTSBE451 00308 15 FILLER PIC X(40) DTSBE451 00309 VALUE 'IMATED. YRQ = '. DTSBE451 00310 15 MSG6-SLASHED-YRQ PIC X(04). DTSBE451 00311 EJECT DTSBE451 00312 01 L001-LINK-AREA. DTSBE451 00313 ++INCLUDE DTSIL001 DTSBE451 00314 EJECT DTSBE451 00315 01 L004-LINK-AREA. DTSBE451 00316 ++INCLUDE DTSIL004 DTSBE451 00317 EJECT DTSBE451 00318 01 L005-LINK-AREA. DTSBE451 00319 ++INCLUDE DTSIL005 DTSBE451 00320 EJECT DTSBE451 00321 01 L061-LINK-AREA. DTSBE451 00322 ++INCLUDE DTSIL061 DTSBE451 00323 EJECT DTSBE451 00324 01 L064-LINK-AREA. DTSBE451 00325 ++INCLUDE DTSIL064 DTSBE451 00326 EJECT DTSBE451 00327 01 L102-LINK-AREA. DTSBE451 00328 ++INCLUDE DTSIL102 DTSBE451 00329 EJECT DTSBE451 00330 01 L109-LINK-AREA. DTSBE451 00331 ++INCLUDE DTSIL109 DTSBE451 00332 EJECT DTSBE451 00333 01 L111-LINK-AREA. DTSBE451 00334 ++INCLUDE DTSIL111 DTSBE451 00335 EJECT DTSBE451 00336 01 L112-LINK-AREA. DTSBE451 00337 ++INCLUDE DTSIL112 DTSBE451 00338 EJECT DTSBE451 00339 01 L410-LINK-AREA. DTSBE451 00340 ++INCLUDE DTSIL410 DTSBE451 00341 EJECT DTSBE451 00342 01 L415-LINK-AREA. DTSBE451 00343 ++INCLUDE DTSIL415 DTSBE451 00344 EJECT DTSBE451 00345 01 L516-LINK-AREA. DTSBE451 00346 ++INCLUDE DTSIL516 DTSBE451 00347 EJECT DTSBE451 00348 01 L910-LINK-AREA. DTSBE451 00349 ++INCLUDE DTSIL910 DTSBE451 00350 EJECT DTSBE451 00351 01 L923-LINK-AREA. DTSBE451 00352 ++INCLUDE DTSIL923 DTSBE451 00353 SKIP3 DTSBE451 00354 01 MSKL-REC. DTSBE451 00355 ++INCLUDE DTSIMSKL DTSBE451 00356 SKIP3 DTSBE451 00357 01 MHDR-REC. DTSBE451 00358 ++INCLUDE DTSIMHDR DTSBE451 00359 SKIP3 DTSBE451 00360 01 MQTR-REC. DTSBE451 00361 ++INCLUDE DTSIMQTR DTSBE451 00362 SKIP3 DTSBE451 00363 01 MRPT-REC. DTSBE451 00364 ++INCLUDE DTSIMRPT DTSBE451 00365 SKIP3 DTSBE451 00366 01 MDST-REC. DTSBE451 00367 ++INCLUDE DTSIMDST DTSBE451 00368 SKIP3 DTSBE451 00369 01 ARPT-REC. DTSBE451 00370 ++INCLUDE DTSIARPT DTSBE451 00371 SKIP3 DTSBE451 00372 01 ASKL-REC. DTSBE451 00373 ++INCLUDE DTSIASKL DTSBE451 00374 SKIP3 DTSBE451 00375 01 MTAD-REC. DTSBE451 00376 ++INCLUDE DTSIMTAD DTSBE451 00377 SKIP3 DTSBE451 00378 01 MOPO-REC. DTSBE451 00379 ++INCLUDE DTSIMOPO DTSBE451 00380 SKIP3 DTSBE451 00381 01 MTAA-REC. DTSBE451 00382 ++INCLUDE DTSIMTAA DTSBE451 00383 SKIP3 DTSBE451 00384 01 MEVL-REC. DTSBE451 00385 ++INCLUDE DTSIMEVL DTSBE451 00386 SKIP3 DTSBE451 00387 01 MTCK-REC. DTSBE451 00388 ++INCLUDE DTSIMTCK DTSBE451 00389 EJECT DTSBE451 00390 01 L927-LINK-AREA. DTSBE451 00391 ++INCLUDE DTSIL927 DTSBE451 00392 DTSBE451 00393 01 T026-REC. DTSBE451 00394 ++INCLUDE DTSIT026 DTSBE451 00395 DTSBE451 00396 01 L931-LINK-AREA. DTSBE451 00397 ++INCLUDE DTSIL931 DTSBE451 00398 SKIP3 DTSBE451 00399 01 FSKL-REC. DTSBE451 00400 ++INCLUDE DTSIFSKL DTSBE451 00401 SKIP3 DTSBE451 00402 01 FAFD-REC. DTSBE451 00403 ++INCLUDE DTSIFAFD DTSBE451 00404 EJECT DTSBE451 00405 01 R451-REC. DTSBE451 00406 ++INCLUDE DTSIR451 DTSBE451 00407 SKIP3 DTSBE451 00408 01 R452-REC. DTSBE451 00409 ++INCLUDE DTSIR452 DTSBE451 00410 SKIP3 DTSBE451 00411 01 R716-REC. DTSBE451 00412 ++INCLUDE DTSIR716 DTSBE451 00413 SKIP3 DTSBE451 00414 01 R907-REC. DTSBE451 00415 ++INCLUDE DTSIR907 DTSBE451 00416 EJECT DTSBE451 00417 01 CACT-LITERALS. DTSBE451 00418 ++INCLUDE DTSICACT DTSBE451 00419 DTSBE451 00420 ++INCLUDE OJRWE451 DTSBE451 00421 EJECT DTSBE451 00422 LINKAGE SECTION. DTSBE451 00423 SKIP3 DTSBE451 00424 01 LECM-LINK-AREA. DTSBE451 00425 ++INCLUDE DTSILECM DTSBE451 00426 SKIP3 DTSBE451 00427 10 FILLER REDEFINES LECM-EXTRACT-PARMS. DTSBE451 00428 15 LECM-PARM-SUBJECT-YRQ PIC X(03). DTSBE451 00429 15 FILLER PIC X(01). DTSBE451 00430 15 LECM-PARM-RETURN-BY-DATE DTSBE451 00431 PIC X(06). DTSBE451 00432 15 FILLER PIC X(58). DTSBE451 00433 EJECT DTSBE451 00434 01 MPRF-LINK-REC. DTSBE451 00435 ++INCLUDE DTSIMPRF DTSBE451 00436 EJECT DTSBE451 00437 PROCEDURE DIVISION USING LECM-LINK-AREA DTSBE451 00438 MPRF-LINK-REC. DTSBE451 00439 DTSBE451 00440 EVALUATE TRUE DTSBE451 00441 WHEN LECM-PROCESS-88 DTSBE451 00442 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBE451 00443 DTSBE451 00444 WHEN LECM-INITIALIZE-88 DTSBE451 00445 SET WRK-EDIT-PASSED-88 TO TRUE DTSBE451 00446 PERFORM I0000-INITIALIZE THRU I0000-EXIT DTSBE451 00447 IF WRK-EDIT-FAILED-88 DTSBE451 00448 PERFORM S999-ABEND THRU S999-EXIT DTSBE451 00449 END-IF DTSBE451 00450 DTSBE451 00451 WHEN LECM-TERMINATE-88 DTSBE451 00452 PERFORM T0000-TERMINATE THRU T0000-EXIT DTSBE451 00453 DTSBE451 00454 WHEN OTHER DTSBE451 00455 MOVE 'INVALID LECM-CALL-TYPE-IND ENCOUNTERED' DTSBE451 00456 TO ABEND-MSG DTSBE451 00457 PERFORM S999-ABEND THRU S999-EXIT. DTSBE451 00458 DTSBE451 00459 DTSBE451 00460 GOBACK. DTSBE451 00461 EJECT DTSBE451 00462 I0000-INITIALIZE. DTSBE451 00463 MOVE LECM-TRACE-IND TO L910-TRACE-IND DTSBE451 00464 L931-TRACE-IND DTSBE451 00465 L516-TRACE-IND. DTSBE451 00466 DTSBE451 00467 MOVE WRK-MOD-NAME TO L910-MOD-NAME DTSBE451 00468 L931-MOD-NAME DTSBE451 00469 R907-MODULE-NAME. DTSBE451 00470 DTSBE451 00471 MOVE LECM-PARM-SUBJECT-YRQ TO DTSBE451 00472 OJR-PARM-SUBJECT-YRQ. DTSBE451 00473 DTSBE451 00474 MOVE LECM-PARM-RETURN-BY-DATE TO DTSBE451 00475 OJR-PARM-RETURN-BY-DATE. DTSBE451 00476 DTSBE451 00477 MOVE LENGTH OF R451-REC TO R451-LENGTH. DTSBE451 00478 DTSBE451 00479 MOVE '451' TO R451-REC-TYPE. DTSBE451 00480 DTSBE451 00481 MOVE LENGTH OF R452-REC TO R452-LENGTH. DTSBE451 00482 DTSBE451 00483 MOVE '452' TO R452-REC-TYPE. DTSBE451 00484 DTSBE451 00485 MOVE LENGTH OF R716-REC TO R716-LENGTH. DTSBE451 00486 DTSBE451 00487 MOVE '716' TO R716-REC-TYPE. DTSBE451 00488 DTSBE451 00489 MOVE LENGTH OF R907-REC TO R907-LENGTH. DTSBE451 00490 DTSBE451 00491 MOVE '907' TO R907-REC-TYPE. DTSBE451 00492 DTSBE451 00493 SET L415-MODE-MOST-RECENT-88 TO TRUE. DTSBE451 00494 PERFORM S415-HOUSEHOLD-DATES THRU S415-EXIT. DTSBE451 00495 MOVE L415-UC30H-FIRST-DEL-STRT-YRQ TO L004-QTR-5-9. DTSBE451 00496 DTSBE451 00497 PERFORM I1000-EDIT-AND-DEFAULT-PARMS THRU I1000-EXIT. DTSBE451 00498 DTSBE451 00499 DISPLAY 'BE451 SUBJECT QTR ' WRK-PARM-SUBJECT-YRQ. DTSBE451 00500 DTSBE451 00501 PERFORM I3000-TRANS-FILE-RPT THRU I3000-EXIT. DTSBE451 00502 DTSBE451 00503 SET LECM-MST-OPEN-UPDATE-88 TO TRUE. DTSBE451 00504 DTSBE451 00505 SET LECM-REF-OPEN-UPDATE-88 TO TRUE. DTSBE451 00506 I0000-EXIT. DTSBE451 00507 EXIT. DTSBE451 00508 ++INCLUDE OJRPE451 DTSBE451 00509 DTSBE451 00510 I3000-TRANS-FILE-RPT. DTSBE451 00511 PERFORM DTSBE451 00512 VARYING TF-SUB FROM +1 BY +1 DTSBE451 00513 UNTIL TF-SUB > TF-MAX DTSBE451 00514 SET TF-RPT-FOUND-NO-88 (TF-SUB) TO TRUE DTSBE451 00515 SET TF-BYPASSED-NO-88 (TF-SUB) TO TRUE DTSBE451 00516 END-PERFORM. DTSBE451 00517 PERFORM S923-OPEN-READ THRU S923-EXIT. DTSBE451 00518 MOVE ZERO TO ASKL-BATCH-NO DTSBE451 00519 ASKL-ITEM-NO. DTSBE451 00520 PERFORM S923-START-BROWSE THRU S923-EXIT. DTSBE451 00521 PERFORM UNTIL L923-NO-REC-88 DTSBE451 00522 IF ASKL-ATX-88 DTSBE451 00523 MOVE ASKL-REC TO ARPT-REC DTSBE451 00524 IF (ARPT-ORIG-88 DTSBE451 00525 AND ARPT-YRQ = WRK-PARM-SUBJECT-YRQ DTSBE451 00526 AND ARPT-NOT-PROCESSED-88) DTSBE451 00527 IF NOT ARPT-EMP-NO-NO-ENTRY-88 DTSBE451 00528 SET TF-RPT-FOUND-YES-88 (ARPT-EMP-NO) TO TRUE DTSBE451 00529 ADD +1 TO WRK-TF-TABLE-CNT DTSBE451 00530 DISPLAY 'I3 ' ARPT-EMP-NO ' ' ARPT-BATCH-NO DTSBE451 00531 ' ' ARPT-ITEM-NO DTSBE451 00532 END-IF DTSBE451 00533 END-IF DTSBE451 00534 END-IF DTSBE451 00535 PERFORM S923-READ-NEXT THRU S923-EXIT DTSBE451 00536 END-PERFORM. DTSBE451 00537 PERFORM S923-CLOSE THRU S923-EXIT. DTSBE451 00538 I3000-EXIT. DTSBE451 00539 EXIT. DTSBE451 00540 P0000-PROCESS. DTSBE451 00541 *****IF (MPRF-EMP-NO < 360094) DTSBE451 00542 *************OR DTSBE451 00543 ********(MPRF-EMP-NO > 360098) DTSBE451 00544 *********GO TO P0000-EXIT. DTSBE451 00545 DTSBE451 00546 MOVE ZEROS TO WRK-CURR-YEAR. DTSBE451 00547 MOVE MPRF-EMP-NO TO R907-EMP-NO. DTSBE451 00548 DTSBE451 00549 IF MPRF-CLASS-SUB-88 DTSBE451 00550 NEXT SENTENCE DTSBE451 00551 ELSE DTSBE451 00552 GO TO P0000-EXIT. DTSBE451 00553 *RW DTSBE451 00554 *RW DTSBE451 00555 SET L410-MODE-INPUT-YRQ-88 TO TRUE. DTSBE451 00556 MOVE MPRF-EMP-NO TO L410-EMP-NO. DTSBE451 00557 MOVE WRK-PARM-SUBJECT-YRQ TO L410-YRQ. DTSBE451 00558 PERFORM S410-FILE-SCHED THRU S410-EXIT. DTSBE451 00559 IF NOT L410-ANN-SCHED-88 DTSBE451 00560 GO TO P0000-EXIT. DTSBE451 00561 DTSBE451 00562 *& DTSBE451 00563 IF TF-RPT-FOUND-YES-88 (MPRF-EMP-NO) DTSBE451 00564 SET TF-BYPASSED-YES-88 (MPRF-EMP-NO) TO TRUE DTSBE451 00565 ADD +1 TO WRK-BYPASS-CNT DTSBE451 00566 DISPLAY 'BE451 TRAN FOUND ' MPRF-EMP-NO DTSBE451 00567 GO TO P0000-EXIT DTSBE451 00568 END-IF. DTSBE451 00569 *& DTSBE451 00570 IF WRK-DROP-PURSUIT-YES-88 DTSBE451 00571 IF MPRF-PURSUED-RPT-CNT > +0 DTSBE451 00572 PERFORM P1000-DROP-PURSUIT THRU P1000-EXIT. DTSBE451 00573 DTSBE451 00574 MOVE 'N' TO WRK-SUBJECT-YRQ-PURSUED-IND. DTSBE451 00575 DTSBE451 00576 MOVE +0 TO WRK-SUBJECT-YRQ-RPT-DUE-DATE. DTSBE451 00577 DTSBE451 00578 SET WRK-SUBJECT-YRQ-NO-UI-RATE-88 TO TRUE. DTSBE451 00579 DTSBE451 00580 SET PRE-UPD-RPT-PURSUED-NO-88 TO TRUE DTSBE451 00581 SET POST-UPD-RPT-PURSUED-NO-88 TO TRUE DTSBE451 00582 DTSBE451 00583 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSBE451 00584 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBE451 00585 SET MQTR-QTR-88 TO TRUE. DTSBE451 00586 DTSBE451 00587 MOVE WRK-PARM-SUBJECT-YRQ TO L004-QTR-5-9 DTSBE451 00588 MOVE 1 TO L004-QTR-5-Q DTSBE451 00589 MOVE L004-QTR-5-9 TO WRK-QTR1. DTSBE451 00590 MOVE WRK-QTR1 TO MQTR-YRQ. DTSBE451 00591 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBE451 00592 PERFORM S910-READ THRU S910-EXIT. DTSBE451 00593 PERFORM P2000-SUBJECT-YRQ THRU P2000-EXIT. DTSBE451 00594 IF L516-LIABLE-88 DTSBE451 00595 SET WRK-QTR1-LIABLE-YES-88 TO TRUE DTSBE451 00596 ELSE DTSBE451 00597 SET WRK-QTR1-LIABLE-NO-88 TO TRUE DTSBE451 00598 END-IF. DTSBE451 00599 DTSBE451 00600 MOVE WRK-PARM-SUBJECT-YRQ TO L004-QTR-5-9 DTSBE451 00601 MOVE 2 TO L004-QTR-5-Q DTSBE451 00602 MOVE L004-QTR-5-9 TO WRK-QTR2. DTSBE451 00603 DTSBE451 00604 MOVE WRK-QTR2 TO MQTR-YRQ. DTSBE451 00605 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBE451 00606 PERFORM S910-READ THRU S910-EXIT. DTSBE451 00607 PERFORM P2000-SUBJECT-YRQ THRU P2000-EXIT. DTSBE451 00608 IF L516-LIABLE-88 DTSBE451 00609 SET WRK-QTR2-LIABLE-YES-88 TO TRUE DTSBE451 00610 ELSE DTSBE451 00611 SET WRK-QTR2-LIABLE-NO-88 TO TRUE DTSBE451 00612 END-IF. DTSBE451 00613 DTSBE451 00614 MOVE WRK-PARM-SUBJECT-YRQ TO L004-QTR-5-9 DTSBE451 00615 MOVE 3 TO L004-QTR-5-Q DTSBE451 00616 MOVE L004-QTR-5-9 TO WRK-QTR3. DTSBE451 00617 DTSBE451 00618 MOVE WRK-QTR3 TO MQTR-YRQ. DTSBE451 00619 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBE451 00620 PERFORM S910-READ THRU S910-EXIT. DTSBE451 00621 PERFORM P2000-SUBJECT-YRQ THRU P2000-EXIT. DTSBE451 00622 IF L516-LIABLE-88 DTSBE451 00623 SET WRK-QTR3-LIABLE-YES-88 TO TRUE DTSBE451 00624 ELSE DTSBE451 00625 SET WRK-QTR3-LIABLE-NO-88 TO TRUE DTSBE451 00626 END-IF. DTSBE451 00627 DTSBE451 00628 MOVE WRK-PARM-SUBJECT-YRQ TO L004-QTR-5-9 DTSBE451 00629 MOVE 4 TO L004-QTR-5-Q DTSBE451 00630 MOVE L004-QTR-5-9 TO WRK-QTR4. DTSBE451 00631 DTSBE451 00632 MOVE WRK-QTR4 TO MQTR-YRQ. DTSBE451 00633 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBE451 00634 PERFORM S910-READ THRU S910-EXIT. DTSBE451 00635 PERFORM P2000-SUBJECT-YRQ THRU P2000-EXIT. DTSBE451 00636 IF L516-LIABLE-88 DTSBE451 00637 SET WRK-QTR4-LIABLE-YES-88 TO TRUE DTSBE451 00638 ELSE DTSBE451 00639 SET WRK-QTR4-LIABLE-NO-88 TO TRUE DTSBE451 00640 END-IF. DTSBE451 00641 DTSBE451 00642 *& DTSBE451 00643 * DISPLAY 'EMP NO ' MPRF-EMP-NO DTSBE451 00644 *& DTSBE451 00645 IF PRE-UPD-RPT-PURSUED-NO-88 DTSBE451 00646 IF POST-UPD-RPT-PURSUED-YES-88 DTSBE451 00647 ADD 1 TO MPRF-PURSUED-RPT-CNT DTSBE451 00648 END-IF DTSBE451 00649 ELSE DTSBE451 00650 IF POST-UPD-RPT-PURSUED-NO-88 DTSBE451 00651 SUBTRACT 1 FROM MPRF-PURSUED-RPT-CNT DTSBE451 00652 END-IF DTSBE451 00653 END-IF. DTSBE451 00654 DTSBE451 00655 *& DTSBE451 00656 * IF PRE-UPD-RPT-PURSUED-YES-88 DTSBE451 00657 * OR POST-UPD-RPT-PURSUED-YES-88 DTSBE451 00658 * DISPLAY 'P0000 2 ' MPRF-EMP-NO DTSBE451 00659 * ' PRE ' WRK-PRE-UPD-IND DTSBE451 00660 * ' POST ' WRK-POST-UPD-IND DTSBE451 00661 * ' ' MPRF-PURSUED-RPT-CNT. DTSBE451 00662 * DTSBE451 00663 *& DISPLAY 'EMP ' MPRF-EMP-NO ' ' WRK-SUBJECT-YRQ-PURSUED-IND. DTSBE451 00664 IF WRK-SUBJECT-YRQ-PURSUED-IND = 'Y' DTSBE451 00665 ADD +1 TO WRK-DELINQUENT-CNT DTSBE451 00666 IF MPRF-CLASS-SELF-INS-88 DTSBE451 00667 ADD +1 TO WRK-SI-DEL-CNT DTSBE451 00668 END-IF DTSBE451 00669 PERFORM P3000-CONSTRUCT-RPT-RECS THRU P3000-EXIT DTSBE451 00670 PERFORM P4000-PENALTY THRU P4000-EXIT DTSBE451 00671 END-IF. DTSBE451 00672 DTSBE451 00673 P0000-EXIT. DTSBE451 00674 EXIT. DTSBE451 00675 EJECT DTSBE451 00676 P1000-DROP-PURSUIT. DTSBE451 00677 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSBE451 00678 DTSBE451 00679 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBE451 00680 DTSBE451 00681 SET MQTR-QTR-88 TO TRUE. DTSBE451 00682 DTSBE451 00683 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBE451 00684 DTSBE451 00685 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE451 00686 DTSBE451 00687 PERFORM P1100-SCAN-MQTR THRU P1100-EXIT DTSBE451 00688 UNTIL L910-NO-REC-88. DTSBE451 00689 P1000-EXIT. DTSBE451 00690 EXIT. DTSBE451 00691 SKIP3 DTSBE451 00692 P1100-SCAN-MQTR. DTSBE451 00693 MOVE MSKL-REC TO MQTR-REC. DTSBE451 00694 DTSBE451 00695 IF MQTR-YRQ < WRK-FIRST-PURSUED-RPT-YRQ DTSBE451 00696 NEXT SENTENCE DTSBE451 00697 ELSE DTSBE451 00698 SET L910-NO-REC-88 TO TRUE DTSBE451 00699 GO TO P1100-EXIT. DTSBE451 00700 DTSBE451 00701 IF MQTR-ANNUAL-YES-88 DTSBE451 00702 MOVE MQTR-YRQ TO L004-QTR-5-9 DTSBE451 00703 IF WRK-CURR-YEAR NOT = L004-QTR-5-YR DTSBE451 00704 IF MPRF-PURSUED-RPT-CNT > +0 DTSBE451 00705 MOVE L004-QTR-5-YR TO WRK-CURR-YEAR DTSBE451 00706 SUBTRACT 1 FROM MPRF-PURSUED-RPT-CNT DTSBE451 00707 END-IF DTSBE451 00708 END-IF DTSBE451 00709 END-IF. DTSBE451 00710 DTSBE451 00711 IF MQTR-ANNUAL-YES-88 DTSBE451 00712 IF MQTR-RPT-IS-PURSUED-88 DTSBE451 00713 SET MQTR-RPT-NOT-PURSUED-88 TO TRUE DTSBE451 00714 MOVE MQTR-REC TO MSKL-REC DTSBE451 00715 PERFORM S910-REWRITE THRU S910-EXIT DTSBE451 00716 END-IF DTSBE451 00717 END-IF. DTSBE451 00718 DTSBE451 00719 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE451 00720 P1100-EXIT. DTSBE451 00721 EXIT. DTSBE451 00722 EJECT DTSBE451 00723 P2000-SUBJECT-YRQ. DTSBE451 00724 IF L910-OK-88 DTSBE451 00725 SET WRK-MQTR-FOUND-YES-88 TO TRUE DTSBE451 00726 MOVE MSKL-REC TO MQTR-REC DTSBE451 00727 ELSE DTSBE451 00728 SET WRK-MQTR-FOUND-NO-88 TO TRUE. DTSBE451 00729 DTSBE451 00730 MOVE MQTR-YRQ TO L516-YRQ. DTSBE451 00731 PERFORM S516-LIABILITY THRU S516-EXIT. DTSBE451 00732 DTSBE451 00733 IF WRK-MQTR-FOUND-YES-88 DTSBE451 00734 PERFORM P2100-MQTR-EXISTS THRU P2100-EXIT DTSBE451 00735 ELSE DTSBE451 00736 PERFORM P2200-NO-MQTR-EXISTS THRU P2200-EXIT. DTSBE451 00737 DTSBE451 00738 P2000-EXIT. DTSBE451 00739 EXIT. DTSBE451 00740 SKIP3 DTSBE451 00741 P2100-MQTR-EXISTS. DTSBE451 00742 MOVE MSKL-REC TO MQTR-REC. DTSBE451 00743 DTSBE451 00744 DTSBE451 00745 MOVE 'N' TO INCONSISTENCY-ENCOUNTERED-IND. DTSBE451 00746 DTSBE451 00747 DTSBE451 00748 IF L516-LIABLE-88 DTSBE451 00749 PERFORM P2110-LIABLE THRU P2110-EXIT DTSBE451 00750 ELSE DTSBE451 00751 PERFORM P2120-NOT-LIABLE THRU P2120-EXIT. DTSBE451 00752 DTSBE451 00753 DTSBE451 00754 IF INCONSISTENCY-ENCOUNTERED-IND = 'Y' DTSBE451 00755 NEXT SENTENCE DTSBE451 00756 ELSE DTSBE451 00757 IF MQTR-RPT-IS-PURSUED-88 DTSBE451 00758 MOVE 'Y' TO WRK-SUBJECT-YRQ-PURSUED-IND DTSBE451 00759 MOVE MQTR-RPT-DUE-DATE DTSBE451 00760 TO WRK-SUBJECT-YRQ-RPT-DUE-DATE DTSBE451 00761 MOVE MQTR-UI-RATE TO WRK-SUBJECT-YRQ-UI-RATE. DTSBE451 00762 DTSBE451 00763 DTSBE451 00764 MOVE LECM-CURR-RUN-DATE TO MQTR-CHNG-DATE. DTSBE451 00765 DTSBE451 00766 MOVE MQTR-REC TO MSKL-REC. DTSBE451 00767 DTSBE451 00768 PERFORM S910-REWRITE THRU S910-EXIT. DTSBE451 00769 P2100-EXIT. DTSBE451 00770 EXIT. DTSBE451 00771 SKIP3 DTSBE451 00772 P2110-LIABLE. DTSBE451 00773 *& DTSBE451 00774 * IF MPRF-EMP-NO = 136190 DTSBE451 00775 * DISPLAY 'P2110 ' MPRF-EMP-NO DTSBE451 00776 * ' PRE UPD ' WRK-PRE-UPD-IND DTSBE451 00777 * ' MQTR ' MQTR-CURR-RPT-TYPE. DTSBE451 00778 *& DTSBE451 00779 DTSBE451 00780 SET MQTR-ANNUAL-YES-88 TO TRUE. DTSBE451 00781 DTSBE451 00782 IF MQTR-CURR-NOT-LIABLE-88 DTSBE451 00783 ** DISPLAY 'P2110 NOT LIABLE ' MPRF-EMP-NO DTSBE451 00784 PERFORM S9100-INCONSISTENT-RPT-TYPE THRU S9100-EXIT DTSBE451 00785 ELSE DTSBE451 00786 IF MQTR-RPT-IS-PURSUED-88 DTSBE451 00787 SET PRE-UPD-RPT-PURSUED-YES-88 TO TRUE DTSBE451 00788 END-IF DTSBE451 00789 IF MQTR-CURR-RCVD-88 OR MQTR-CURR-ESTIM-88 DTSBE451 00790 NEXT SENTENCE DTSBE451 00791 ELSE DTSBE451 00792 IF MQTR-RPT-DUE-DATE = WRK-SUBJECT-YRQ-DEF-DUE-DATE DTSBE451 00793 SET MQTR-CURR-DELINQ-88 TO TRUE DTSBE451 00794 ELSE DTSBE451 00795 IF MQTR-RPT-DUE-DATE <= LECM-PRIOR-RUN-DATE DTSBE451 00796 ** DISPLAY ' DUE DATE ' MQTR-RPT-DUE-DATE DTSBE451 00797 ** DISPLAY ' LECM PROR RN DATE ' LECM-PRIOR-RUN-DATE DTSBE451 00798 IF MQTR-CURR-NOT-DUE-88 DTSBE451 00799 ** DISPLAY 'P2110 CURR NOT DUE ' MPRF-EMP-NO DTSBE451 00800 PERFORM S9100-INCONSISTENT-RPT-TYPE DTSBE451 00801 THRU S9100-EXIT DTSBE451 00802 ELSE DTSBE451 00803 NEXT SENTENCE DTSBE451 00804 ELSE DTSBE451 00805 IF MQTR-CURR-NOT-DUE-88 DTSBE451 00806 MOVE MQTR-RPT-DUE-DATE TO WRK-TRIGGER-DATE DTSBE451 00807 ** DISPLAY 'P2110 TICKLER ' MPRF-EMP-NO DTSBE451 00808 ** ' ' MQTR-RPT-DUE-DATE DTSBE451 00809 PERFORM S3000-ESTB-MTCK THRU S3000-EXIT DTSBE451 00810 ELSE DTSBE451 00811 ** DISPLAY 'P2110 CURR QTR DUE ' MPRF-EMP-NO DTSBE451 00812 PERFORM S9100-INCONSISTENT-RPT-TYPE DTSBE451 00813 THRU S9100-EXIT. DTSBE451 00814 DTSBE451 00815 DTSBE451 00816 PERFORM S1000-PURSUED-RPT-IND THRU S1000-EXIT. DTSBE451 00817 DTSBE451 00818 DTSBE451 00819 PERFORM S2000-MISS-RPT-CUTOFF-CD THRU S2000-EXIT. DTSBE451 00820 P2110-EXIT. DTSBE451 00821 EXIT. DTSBE451 00822 SKIP3 DTSBE451 00823 P2120-NOT-LIABLE. DTSBE451 00824 *& DTSBE451 00825 * IF MPRF-EMP-NO = 016306 DTSBE451 00826 * DISPLAY 'P2120 ' MPRF-EMP-NO DTSBE451 00827 * ' ' WRK-PRE-UPD-IND. DTSBE451 00828 *& DTSBE451 00829 IF MQTR-CURR-NOT-LIABLE-88 DTSBE451 00830 NEXT SENTENCE DTSBE451 00831 ELSE DTSBE451 00832 ** DISPLAY 'P2120 QTR LIABLE ' MPRF-EMP-NO DTSBE451 00833 PERFORM S9100-INCONSISTENT-RPT-TYPE THRU S9100-EXIT. DTSBE451 00834 DTSBE451 00835 DTSBE451 00836 PERFORM S2000-MISS-RPT-CUTOFF-CD THRU S2000-EXIT. DTSBE451 00837 P2120-EXIT. DTSBE451 00838 EXIT. DTSBE451 00839 SKIP3 DTSBE451 00840 P2200-NO-MQTR-EXISTS. DTSBE451 00841 IF L516-NOT-LIABLE-88 DTSBE451 00842 ** DISPLAY 'P2200 NOT LIABLE ' MPRF-EMP-NO DTSBE451 00843 GO TO P2200-EXIT. DTSBE451 00844 DTSBE451 00845 *& DTSBE451 00846 * IF MPRF-EMP-NO = 016306 DTSBE451 00847 * DISPLAY 'P2120 ' MPRF-EMP-NO DTSBE451 00848 * ' ' WRK-PRE-UPD-IND. DTSBE451 00849 *& DTSBE451 00850 IF TF-RPT-FOUND-YES-88 (MPRF-EMP-NO) DTSBE451 00851 SET TF-BYPASSED-YES-88 (MPRF-EMP-NO) TO TRUE DTSBE451 00852 ADD +1 TO WRK-BYPASS-CNT DTSBE451 00853 DISPLAY 'BE451 TRAN FOUND ' MPRF-EMP-NO DTSBE451 00854 GO TO P2200-EXIT DTSBE451 00855 END-IF. DTSBE451 00856 *& DTSBE451 00857 DTSBE451 00858 PERFORM S511-INITIALIZE-MQTR THRU S511-EXIT. DTSBE451 00859 DTSBE451 00860 SET MQTR-ANNUAL-YES-88 TO TRUE. DTSBE451 00861 DTSBE451 00862 IF L516-DEFAULT-RPT-DUE-DATE = WRK-SUBJECT-YRQ-DEF-DUE-DATE DTSBE451 00863 SET MQTR-CURR-DELINQ-88 TO TRUE DTSBE451 00864 ELSE DTSBE451 00865 IF L516-DEFAULT-RPT-DUE-DATE < LECM-CURR-RUN-DATE DTSBE451 00866 SET MQTR-CURR-DELINQ-88 TO TRUE DTSBE451 00867 ELSE DTSBE451 00868 SET MQTR-CURR-NOT-DUE-88 TO TRUE DTSBE451 00869 MOVE L516-DEFAULT-RPT-DUE-DATE TO WRK-TRIGGER-DATE DTSBE451 00870 PERFORM S3000-ESTB-MTCK THRU S3000-EXIT. DTSBE451 00871 DTSBE451 00872 DTSBE451 00873 PERFORM S1000-PURSUED-RPT-IND THRU S1000-EXIT DTSBE451 00874 DTSBE451 00875 DTSBE451 00876 PERFORM S2000-MISS-RPT-CUTOFF-CD THRU S2000-EXIT. DTSBE451 00877 DTSBE451 00878 IF L516-ESTIMATED-RATE-88 DTSBE451 00879 MOVE MSG6-ID TO R907-MSG-ID DTSBE451 00880 MOVE WRK-SUBJECT-SLASH-QTR TO MSG6-SLASHED-YRQ DTSBE451 00881 MOVE MSG6-TEXT TO R907-MSG-TEXT DTSBE451 00882 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBE451 00883 DTSBE451 00884 MOVE L516-UI-RATE TO MQTR-UI-RATE. DTSBE451 00885 DTSBE451 00886 MOVE L516-DEFAULT-TAX-DUE-DATE TO MQTR-TAX-DUE-DATE DTSBE451 00887 DTSBE451 00888 MOVE L516-DEFAULT-RPT-DUE-DATE TO MQTR-RPT-DUE-DATE. DTSBE451 00889 DTSBE451 00890 MOVE LECM-CURR-RUN-DATE TO MQTR-ESTB-DATE DTSBE451 00891 MQTR-CHNG-DATE. DTSBE451 00892 DTSBE451 00893 IF MQTR-RPT-IS-PURSUED-88 DTSBE451 00894 MOVE 'Y' TO WRK-SUBJECT-YRQ-PURSUED-IND DTSBE451 00895 MOVE MQTR-RPT-DUE-DATE DTSBE451 00896 TO WRK-SUBJECT-YRQ-RPT-DUE-DATE DTSBE451 00897 MOVE MQTR-UI-RATE TO WRK-SUBJECT-YRQ-UI-RATE. DTSBE451 00898 DTSBE451 00899 DTSBE451 00900 MOVE MQTR-REC TO MSKL-REC. DTSBE451 00901 DTSBE451 00902 PERFORM S910-WRITE THRU S910-EXIT. DTSBE451 00903 P2200-EXIT. DTSBE451 00904 EXIT. DTSBE451 00905 EJECT DTSBE451 00906 P3000-CONSTRUCT-RPT-RECS. DTSBE451 00907 IF MPRF-RETURN-MAIL-YES-88 DTSBE451 00908 ADD 1 TO WRK-RETURN-MAIL-CNT CL**2 00909 DISPLAY ' RETURN MAIL SET - NO LETTER SENT ' MPRF-EMP-NO. CL**2 00910 * GO TO P3000-EXIT. CL**2 00911 DTSBE451 00912 MOVE MPRF-EMP-NO TO R451-EMP-NO DTSBE451 00913 R452-EMP-NO. DTSBE451 00914 DTSBE451 00915 MOVE WRK-UC30H-FIRST-DEL-MAIL-DATE DTSBE451 00916 TO R451-MAIL-DATE. DTSBE451 00917 DTSBE451 00918 MOVE WRK-PARM-RETURN-BY-DATE TO R451-RETURN-BY-DATE. DTSBE451 00919 DTSBE451 00920 MOVE WRK-PARM-SUBJECT-YRQ TO R451-YRQ DTSBE451 00921 R452-YRQ. DTSBE451 00922 DTSBE451 00923 MOVE WRK-SUBJECT-YRQ-RPT-DUE-DATE DTSBE451 00924 TO R451-DUE-DATE. DTSBE451 00925 DTSBE451 00926 MOVE MPRF-PRIMARY-NAME TO R452-PRIMARY-NAME. DTSBE451 00927 DTSBE451 00928 MOVE ZEROS TO R451-ADDITIONAL-RPT-CNT DTSBE451 00929 R452-ADDITIONAL-RPT-CNT. DTSBE451 00930 DTSBE451 00931 DTSBE451 00932 PERFORM DTSBE451 00933 VARYING WRK-SUB FROM 1 BY 1 DTSBE451 00934 UNTIL WRK-SUB > +19 DTSBE451 00935 MOVE +0 TO R451-ADDITIONAL-RPT-YRQ (WRK-SUB) DTSBE451 00936 R452-ADDITIONAL-RPT-YRQ (WRK-SUB) DTSBE451 00937 END-PERFORM. DTSBE451 00938 DTSBE451 00939 MOVE ZERO TO WRK-ANN-YEAR. DTSBE451 00940 DTSBE451 00941 IF MPRF-PURSUED-RPT-CNT LESS THAN 2 DTSBE451 00942 NEXT SENTENCE DTSBE451 00943 ELSE DTSBE451 00944 MOVE LOW-VALUES TO MQTR-KEY-AREA DTSBE451 00945 MOVE MPRF-EMP-NO TO MQTR-EMP-NO DTSBE451 00946 SET MQTR-QTR-88 TO TRUE DTSBE451 00947 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA DTSBE451 00948 PERFORM S910-START-BROWSE THRU S910-EXIT DTSBE451 00949 PERFORM P3010-SCAN-MQTR THRU P3010-EXIT DTSBE451 00950 UNTIL L910-NO-REC-88. DTSBE451 00951 DTSBE451 00952 DTSBE451 00953 PERFORM S061-DETERMINE-FLD-REP THRU S061-EXIT. DTSBE451 00954 DTSBE451 00955 DTSBE451 00956 MOVE L061-FLD-REP-ID TO R452-FIELD-REP-ID. DTSBE451 00957 DTSBE451 00958 DTSBE451 00959 PERFORM P3020-CALC-RATE THRU P3020-EXIT. DTSBE451 00960 DTSBE451 00961 DTSBE451 00962 SET WRK-MTAD-NO-LETTER-SENT-88 TO TRUE. DTSBE451 00963 DTSBE451 00964 MOVE LOW-VALUES TO MTAD-KEY-AREA. DTSBE451 00965 DTSBE451 00966 MOVE MPRF-EMP-NO TO MTAD-EMP-NO. DTSBE451 00967 DTSBE451 00968 SET MTAD-TAD-88 TO TRUE. DTSBE451 00969 DTSBE451 00970 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. DTSBE451 00971 DTSBE451 00972 MOVE SPACES TO R452-ADDRESS1-SENT-IND DTSBE451 00973 R452-ADDRESS2-SENT-IND DTSBE451 00974 R452-ADDRESS3-SENT-IND. DTSBE451 00975 DTSBE451 00976 DTSBE451 00977 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE451 00978 DTSBE451 00979 DTSBE451 00980 PERFORM P3030-SCAN-MTAD THRU P3030-EXIT DTSBE451 00981 UNTIL L910-NO-REC-88. DTSBE451 00982 DTSBE451 00983 DTSBE451 00984 IF WRK-MTAD-NO-LETTER-SENT-88 DTSBE451 00985 MOVE MSG2-ID TO R907-MSG-ID DTSBE451 00986 MOVE WRK-SUBJECT-SLASH-QTR TO MSG2-SLASHED-YRQ DTSBE451 00987 MOVE MSG2-TEXT TO R907-MSG-TEXT DTSBE451 00988 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBE451 00989 DTSBE451 00990 DTSBE451 00991 SET WRK-MOPO-NO-LETTER-SENT-88 TO TRUE. DTSBE451 00992 DTSBE451 00993 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBE451 00994 DTSBE451 00995 MOVE MPRF-EMP-NO TO MSKL-EMP-NO. DTSBE451 00996 DTSBE451 00997 SET MSKL-OPO-88 TO TRUE. DTSBE451 00998 DTSBE451 00999 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE451 01000 DTSBE451 01001 PERFORM P3040-SCAN-MOPO THRU P3040-EXIT DTSBE451 01002 UNTIL L910-NO-REC-88. DTSBE451 01003 DTSBE451 01004 DTSBE451 01005 SET WRK-MTAA-NO-LETTER-SENT-88 TO TRUE. DTSBE451 01006 DTSBE451 01007 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBE451 01008 DTSBE451 01009 MOVE MPRF-EMP-NO TO MSKL-EMP-NO. DTSBE451 01010 DTSBE451 01011 SET MSKL-TAA-88 TO TRUE. DTSBE451 01012 DTSBE451 01013 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE451 01014 DTSBE451 01015 PERFORM P3050-SCAN-MTAA THRU P3050-EXIT DTSBE451 01016 UNTIL L910-NO-REC-88. DTSBE451 01017 DTSBE451 01018 DTSBE451 01019 IF (WRK-MTAD-NO-LETTER-SENT-88) DTSBE451 01020 AND DTSBE451 01021 (WRK-MOPO-NO-LETTER-SENT-88) DTSBE451 01022 AND DTSBE451 01023 (WRK-MTAA-NO-LETTER-SENT-88) DTSBE451 01024 MOVE MSG5-ID TO R907-MSG-ID DTSBE451 01025 MOVE WRK-SUBJECT-SLASH-QTR TO MSG5-SLASHED-YRQ DTSBE451 01026 MOVE MSG5-TEXT TO R907-MSG-TEXT DTSBE451 01027 PERFORM S946-WRITE-R907 THRU S946-EXIT DTSBE451 01028 ELSE DTSBE451 01029 PERFORM S064-LOOKUP-FLD-ZIP-ADDR THRU S064-EXIT DTSBE451 01030 MOVE L064-CITY TO R452-CITY DTSBE451 01031 MOVE L064-ST TO R452-STATE DTSBE451 01032 MOVE L064-ZIP TO R452-ZIP DTSBE451 01033 PERFORM S946-WRITE-R452 THRU S946-EXIT. DTSBE451 01034 DTSBE451 01035 DTSBE451 01036 MOVE MPRF-EMP-NO TO R716-EMP-NO. DTSBE451 01037 DTSBE451 01038 MOVE LECM-CURR-RUN-DATE TO R716-RUN-DATE. DTSBE451 01039 DTSBE451 01040 MOVE MPRF-PRIMARY-NAME TO R716-PRIMARY-NAME. DTSBE451 01041 DTSBE451 01042 PERFORM S946-WRITE-R716 THRU S946-EXIT. DTSBE451 01043 P3000-EXIT. DTSBE451 01044 EXIT. DTSBE451 01045 EJECT DTSBE451 01046 P3010-SCAN-MQTR. DTSBE451 01047 MOVE MSKL-REC TO MQTR-REC. DTSBE451 01048 DTSBE451 01049 MOVE MQTR-YRQ TO L004-QTR-5-9. DTSBE451 01050 IF L004-QTR-5-YR = WRK-PARM-SUBJECT-YR DTSBE451 01051 NEXT SENTENCE DTSBE451 01052 ELSE DTSBE451 01053 IF MQTR-RPT-IS-PURSUED-88 DTSBE451 01054 IF R451-ADDITIONAL-RPT-CNT > 19 DTSBE451 01055 SET L910-NO-REC-88 TO TRUE DTSBE451 01056 PERFORM P3011-WRITE-R907 THRU P3011-EXIT DTSBE451 01057 GO TO P3010-EXIT DTSBE451 01058 ELSE DTSBE451 01059 MOVE MQTR-YRQ TO L410-YRQ DTSBE451 01060 SET L410-MODE-INPUT-YRQ-88 TO TRUE DTSBE451 01061 MOVE MPRF-EMP-NO TO L410-EMP-NO DTSBE451 01062 PERFORM S410-FILE-SCHED THRU S410-EXIT DTSBE451 01063 IF NOT L410-ANN-SCHED-88 DTSBE451 01064 PERFORM P3012-NOT-ANNUAL THRU P3012-EXIT DTSBE451 01065 ELSE DTSBE451 01066 PERFORM P3013-ANNUAL THRU P3013-EXIT DTSBE451 01067 END-IF DTSBE451 01068 END-IF DTSBE451 01069 END-IF DTSBE451 01070 END-IF. DTSBE451 01071 DTSBE451 01072 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA DTSBE451 01073 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE451 01074 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE451 01075 P3010-EXIT. DTSBE451 01076 EXIT. DTSBE451 01077 EJECT DTSBE451 01078 P3011-WRITE-R907. DTSBE451 01079 MOVE MSG3-ID TO R907-MSG-ID. DTSBE451 01080 DTSBE451 01081 MOVE MQTR-YRQ TO L004-QTR-5-9 DTSBE451 01082 DTSBE451 01083 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBE451 01084 DTSBE451 01085 MOVE L004-SLASH-QTR TO MSG3-SLASHED-YRQ. DTSBE451 01086 DTSBE451 01087 MOVE MSG3-TEXT TO R907-MSG-TEXT. DTSBE451 01088 DTSBE451 01089 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBE451 01090 P3011-EXIT. DTSBE451 01091 EXIT. DTSBE451 01092 DTSBE451 01093 P3012-NOT-ANNUAL. DTSBE451 01094 ADD +1 TO R451-ADDITIONAL-RPT-CNT DTSBE451 01095 R452-ADDITIONAL-RPT-CNT. DTSBE451 01096 MOVE MQTR-YRQ TO DTSBE451 01097 R451-ADDITIONAL-RPT-YRQ (R451-ADDITIONAL-RPT-CNT) DTSBE451 01098 R452-ADDITIONAL-RPT-YRQ (R452-ADDITIONAL-RPT-CNT). DTSBE451 01099 DTSBE451 01100 P3012-EXIT. DTSBE451 01101 EXIT. DTSBE451 01102 DTSBE451 01103 P3013-ANNUAL. DTSBE451 01104 MOVE 0 TO L004-QTR-5-Q. DTSBE451 01105 IF L004-QTR-5-YR NOT = WRK-ANN-YEAR DTSBE451 01106 MOVE L004-QTR-5-YR TO WRK-ANN-YEAR DTSBE451 01107 ADD +1 TO R451-ADDITIONAL-RPT-CNT DTSBE451 01108 R452-ADDITIONAL-RPT-CNT DTSBE451 01109 MOVE L004-QTR-5-9 TO DTSBE451 01110 R451-ADDITIONAL-RPT-YRQ (R451-ADDITIONAL-RPT-CNT) DTSBE451 01111 R452-ADDITIONAL-RPT-YRQ (R452-ADDITIONAL-RPT-CNT) DTSBE451 01112 END-IF. DTSBE451 01113 P3013-EXIT. DTSBE451 01114 EXIT. DTSBE451 01115 DTSBE451 01116 P3020-CALC-RATE. DTSBE451 01117 IF WRK-SUBJECT-YRQ-NO-UI-RATE-88 DTSBE451 01118 IF MPRF-CLASS-SELF-INS-88 DTSBE451 01119 PERFORM P3021-GET-L109 THRU P3021-EXIT DTSBE451 01120 COMPUTE DTSBE451 01121 R451-TOTAL-RATE = L109-SUR-RATE DTSBE451 01122 ELSE DTSBE451 01123 SET R451-NO-UI-RATE-88 TO TRUE DTSBE451 01124 PERFORM P3022-NO-RATE-R907 THRU P3022-EXIT DTSBE451 01125 ELSE DTSBE451 01126 PERFORM P3021-GET-L109 THRU P3021-EXIT DTSBE451 01127 COMPUTE DTSBE451 01128 R451-TOTAL-RATE = DTSBE451 01129 WRK-SUBJECT-YRQ-UI-RATE + DTSBE451 01130 L109-SUR-RATE. DTSBE451 01131 DTSBE451 01132 MOVE R451-TOTAL-RATE TO R452-TOTAL-RATE. DTSBE451 01133 P3020-EXIT. DTSBE451 01134 EXIT. DTSBE451 01135 EJECT DTSBE451 01136 P3021-GET-L109. DTSBE451 01137 MOVE MPRF-EMP-CLASS TO L109-EMP-CLASS. DTSBE451 01138 DTSBE451 01139 MOVE MQTR-YRQ TO L109-YRQ. DTSBE451 01140 DTSBE451 01141 PERFORM S109-LOOKUP-SUR-RATE THRU S109-EXIT. DTSBE451 01142 P3021-EXIT. DTSBE451 01143 EXIT. DTSBE451 01144 EJECT DTSBE451 01145 P3022-NO-RATE-R907. DTSBE451 01146 MOVE MSG1-ID TO R907-MSG-ID. DTSBE451 01147 DTSBE451 01148 MOVE WRK-SUBJECT-SLASH-QTR TO MSG1-SLASHED-YRQ. DTSBE451 01149 DTSBE451 01150 MOVE MSG1-TEXT TO R907-MSG-TEXT. DTSBE451 01151 DTSBE451 01152 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBE451 01153 P3022-EXIT. DTSBE451 01154 EXIT. DTSBE451 01155 EJECT DTSBE451 01156 P3030-SCAN-MTAD. DTSBE451 01157 MOVE MSKL-REC TO MTAD-REC. DTSBE451 01158 DTSBE451 01159 IF MTAD-MISSING-RPT-LTRS-YES-88 DTSBE451 01160 SET WRK-MTAD-LETTER-SENT-88 TO TRUE DTSBE451 01161 PERFORM P3031-LOOKUP-ADDR THRU P3031-EXIT DTSBE451 01162 PERFORM P3032-SET-ADDRESS-SENT-IND THRU P3032-EXIT DTSBE451 01163 PERFORM S946-WRITE-R451 THRU S946-EXIT DTSBE451 01164 MOVE WRK-SUBJECT-SLASH-QTR TO EVL-SLASH-QTR DTSBE451 01165 MOVE 'MTAD' TO EVL-ADDR-TYPE DTSBE451 01166 MOVE MTAD-ID-NO TO EVL-ADDR-ID-NO DTSBE451 01167 PERFORM S4000-WRITE-MEVL THRU S4000-EXIT DTSBE451 01168 MOVE MTAD-REC TO MSKL-REC DTSBE451 01169 PERFORM S910-READ THRU S910-EXIT DTSBE451 01170 IF L910-NO-REC-88 DTSBE451 01171 MOVE 'LOGIC ERROR IN P3030' TO ABEND-MSG DTSBE451 01172 PERFORM S999-ABEND THRU S999-EXIT. DTSBE451 01173 DTSBE451 01174 DTSBE451 01175 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE451 01176 P3030-EXIT. DTSBE451 01177 EXIT. DTSBE451 01178 SKIP3 DTSBE451 01179 P3031-LOOKUP-ADDR. DTSBE451 01180 MOVE MTAD-ID-NO TO L111-ID-NO. DTSBE451 01181 DTSBE451 01182 DTSBE451 01183 PERFORM S111-LOOKUP-TAD THRU S111-EXIT. DTSBE451 01184 DTSBE451 01185 DTSBE451 01186 IF L111-ADDR-FOUND-88 DTSBE451 01187 MOVE L111-RETURN-AREA TO L112-NAME-ADDRESS-AREA DTSBE451 01188 PERFORM S112-TAD-ADDR THRU S112-EXIT DTSBE451 01189 MOVE L112-MAILING-ADDRESS TO R451-FMT-ADDR DTSBE451 01190 MOVE L112-ZIP TO R451-ZIP DTSBE451 01191 R451-SORT-ZIP DTSBE451 01192 MOVE L112-ADVANCED-BARCODE TO R451-ADVANCED-BARCODE DTSBE451 01193 ELSE DTSBE451 01194 MOVE ALL '?' TO R451-FMT-ADDR DTSBE451 01195 R451-ZIP DTSBE451 01196 R451-SORT-ZIP DTSBE451 01197 R451-ADVANCED-BARCODE. DTSBE451 01198 P3031-EXIT. DTSBE451 01199 EXIT. DTSBE451 01200 SKIP3 DTSBE451 01201 P3032-SET-ADDRESS-SENT-IND. DTSBE451 01202 IF MTAD-ID-NO = 001 DTSBE451 01203 SET R452-ADDRESS1-SENT-YES TO TRUE DTSBE451 01204 ELSE DTSBE451 01205 IF MTAD-ID-NO = 002 DTSBE451 01206 SET R452-ADDRESS2-SENT-YES TO TRUE. DTSBE451 01207 P3032-EXIT. DTSBE451 01208 EXIT. DTSBE451 01209 EJECT DTSBE451 01210 P3040-SCAN-MOPO. DTSBE451 01211 MOVE MSKL-REC TO MOPO-REC. DTSBE451 01212 DTSBE451 01213 IF MOPO-MISSING-RPT-LTRS-YES-88 DTSBE451 01214 SET WRK-MOPO-LETTER-SENT-88 TO TRUE DTSBE451 01215 PERFORM P3041-LOOKUP-ADDR THRU P3041-EXIT DTSBE451 01216 PERFORM S946-WRITE-R451 THRU S946-EXIT DTSBE451 01217 MOVE WRK-SUBJECT-SLASH-QTR TO EVL-SLASH-QTR DTSBE451 01218 MOVE 'MOPO' TO EVL-ADDR-TYPE DTSBE451 01219 MOVE MOPO-ID-NO TO EVL-ADDR-ID-NO DTSBE451 01220 PERFORM S4000-WRITE-MEVL THRU S4000-EXIT DTSBE451 01221 MOVE MOPO-REC TO MSKL-REC DTSBE451 01222 PERFORM S910-READ THRU S910-EXIT DTSBE451 01223 IF L910-NO-REC-88 DTSBE451 01224 MOVE 'LOGIC ERROR IN P3040' TO ABEND-MSG DTSBE451 01225 PERFORM S999-ABEND THRU S999-EXIT. DTSBE451 01226 DTSBE451 01227 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE451 01228 P3040-EXIT. DTSBE451 01229 EXIT. DTSBE451 01230 SKIP3 DTSBE451 01231 P3041-LOOKUP-ADDR. DTSBE451 01232 MOVE MOPO-ID-NO TO L111-ID-NO. DTSBE451 01233 DTSBE451 01234 PERFORM S111-LOOKUP-OPO THRU S111-EXIT. DTSBE451 01235 DTSBE451 01236 IF L111-ADDR-FOUND-88 DTSBE451 01237 MOVE L111-RETURN-AREA TO L112-NAME-ADDRESS-AREA DTSBE451 01238 PERFORM S112-OPO-ADDR THRU S112-EXIT DTSBE451 01239 MOVE L112-MAILING-ADDRESS TO R451-FMT-ADDR DTSBE451 01240 MOVE L112-ZIP TO R451-ZIP DTSBE451 01241 R451-SORT-ZIP DTSBE451 01242 MOVE L112-ADVANCED-BARCODE TO R451-ADVANCED-BARCODE DTSBE451 01243 ELSE DTSBE451 01244 MOVE ALL '?' TO R451-FMT-ADDR DTSBE451 01245 R451-ZIP DTSBE451 01246 R451-SORT-ZIP DTSBE451 01247 R451-ADVANCED-BARCODE. DTSBE451 01248 P3041-EXIT. DTSBE451 01249 EXIT. DTSBE451 01250 EJECT DTSBE451 01251 P3050-SCAN-MTAA. DTSBE451 01252 MOVE MSKL-REC TO MTAA-REC. DTSBE451 01253 DTSBE451 01254 IF MTAA-MISSING-RPT-LTRS-YES-88 DTSBE451 01255 SET WRK-MTAA-LETTER-SENT-88 TO TRUE DTSBE451 01256 PERFORM P3051-LOOKUP-ADDR THRU P3051-EXIT DTSBE451 01257 PERFORM S946-WRITE-R451 THRU S946-EXIT DTSBE451 01258 MOVE WRK-SUBJECT-SLASH-QTR TO EVL-SLASH-QTR DTSBE451 01259 MOVE 'MTAA' TO EVL-ADDR-TYPE DTSBE451 01260 MOVE MTAA-ID-NO TO EVL-ADDR-ID-NO DTSBE451 01261 PERFORM S4000-WRITE-MEVL THRU S4000-EXIT DTSBE451 01262 MOVE MTAA-REC TO MSKL-REC DTSBE451 01263 PERFORM S910-READ THRU S910-EXIT DTSBE451 01264 IF L910-NO-REC-88 DTSBE451 01265 MOVE 'LOGIC ERROR IN P3050' TO ABEND-MSG DTSBE451 01266 PERFORM S999-ABEND THRU S999-EXIT. DTSBE451 01267 DTSBE451 01268 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE451 01269 P3050-EXIT. DTSBE451 01270 EXIT. DTSBE451 01271 SKIP3 DTSBE451 01272 P3051-LOOKUP-ADDR. DTSBE451 01273 MOVE MTAA-ID-NO TO L111-ID-NO. DTSBE451 01274 DTSBE451 01275 PERFORM S111-LOOKUP-TAA THRU S111-EXIT. DTSBE451 01276 DTSBE451 01277 IF L111-ADDR-FOUND-88 DTSBE451 01278 MOVE L111-RETURN-AREA TO L112-NAME-ADDRESS-AREA DTSBE451 01279 PERFORM S112-TAA-ADDR THRU S112-EXIT DTSBE451 01280 MOVE L112-MAILING-ADDRESS TO R451-FMT-ADDR DTSBE451 01281 MOVE L112-ZIP TO R451-ZIP DTSBE451 01282 R451-SORT-ZIP DTSBE451 01283 MOVE L112-ADVANCED-BARCODE TO R451-ADVANCED-BARCODE DTSBE451 01284 ELSE DTSBE451 01285 MOVE ALL '?' TO R451-FMT-ADDR DTSBE451 01286 R451-ZIP DTSBE451 01287 R451-SORT-ZIP DTSBE451 01288 R451-ADVANCED-BARCODE. DTSBE451 01289 P3051-EXIT. DTSBE451 01290 EXIT. DTSBE451 01291 EJECT DTSBE451 01292 P4000-PENALTY. DTSBE451 01293 IF WRK-QTR4-LIABLE-YES-88 DTSBE451 01294 MOVE WRK-QTR4 TO WRK-PENALTY-YRQ DTSBE451 01295 ELSE DTSBE451 01296 IF WRK-QTR3-LIABLE-YES-88 DTSBE451 01297 MOVE WRK-QTR3 TO WRK-PENALTY-YRQ DTSBE451 01298 ELSE DTSBE451 01299 IF WRK-QTR2-LIABLE-YES-88 DTSBE451 01300 MOVE WRK-QTR2 TO WRK-PENALTY-YRQ DTSBE451 01301 ELSE DTSBE451 01302 IF WRK-QTR1-LIABLE-YES-88 DTSBE451 01303 MOVE WRK-QTR1 TO WRK-PENALTY-YRQ DTSBE451 01304 ELSE DTSBE451 01305 GO TO P4000-EXIT DTSBE451 01306 END-IF DTSBE451 01307 END-IF DTSBE451 01308 END-IF DTSBE451 01309 END-IF. DTSBE451 01310 DISPLAY ' WRK PENALTY YRQ ' WRK-PENALTY-YRQ. DTSBE451 01311 MOVE WRK-PENALTY-YRQ TO MQTR-YRQ. DTSBE451 01312 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBE451 01313 PERFORM S910-READ THRU S910-EXIT. DTSBE451 01314 IF NOT L910-OK-88 DTSBE451 01315 MOVE 'P4000 - CANNOT FIND PENALTY QTR ' TO ABEND-MSG DTSBE451 01316 DISPLAY 'EMP ' MPRF-EMP-NO ' PQTR ' WRK-PENALTY-YRQ DTSBE451 01317 PERFORM S999-ABEND THRU S999-EXIT DTSBE451 01318 END-IF. DTSBE451 01319 DTSBE451 01320 PERFORM S109-FIRST-PEN-INT-YRQ THRU S109-EXIT. DTSBE451 01321 PERFORM P4100-INIT-L102 THRU P4100-EXIT. DTSBE451 01322 DTSBE451 01323 PERFORM S102-DELINQUENCY-RUN THRU S102-EXIT. DTSBE451 01324 IF L102-LATE-PEN-CHARGE-CHNG > +0 DTSBE451 01325 ADD +1 TO WRK-PEN-CNT DTSBE451 01326 IF MPRF-CLASS-SELF-INS-88 DTSBE451 01327 ADD +1 TO WRK-SI-PEN-CNT DTSBE451 01328 END-IF DTSBE451 01329 MOVE L102-LATE-PEN-CHARGE-CHNG TO AMT-DISP1 DTSBE451 01330 ** DISPLAY 'BE417 ' MPRF-EMP-CLASS ' ' MPRF-EMP-NO DTSBE451 01331 ** ' AMT ' AMT-DISP1 DTSBE451 01332 PERFORM P4200-GENERATE-T026 THRU P4200-EXIT DTSBE451 01333 END-IF. DTSBE451 01334 DTSBE451 01335 P4000-EXIT. DTSBE451 01336 EXIT. DTSBE451 01337 DTSBE451 01338 P4100-INIT-L102. DTSBE451 01339 MOVE MPRF-EMP-CLASS TO L102-EMP-CLASS. DTSBE451 01340 MOVE +0 TO L102-TRAN-RECEIVED-DATE. DTSBE451 01341 SET L102-WAIVE-LATE-PEN-NO-88 TO TRUE. DTSBE451 01342 MOVE WRK-PENALTY-YRQ TO L102-LAST-PEN-ASSESSED-YRQ. DTSBE451 01343 MOVE +0 TO L102-OR-RECEIVED-DATE. DTSBE451 01344 DTSBE451 01345 MOVE WRK-PENALTY-YRQ TO L102-MQTR-YRQ. DTSBE451 01346 MOVE MQTR-TAX-DUE-DATE TO L102-TAX-DUE-DATE. DTSBE451 01347 MOVE MQTR-RPT-DUE-DATE TO L102-RPT-DUE-DATE. DTSBE451 01348 DTSBE451 01349 MOVE LECM-CURR-RUN-DATE TO L102-CURR-RUN-DATE. DTSBE451 01350 DTSBE451 01351 MOVE +0 TO L102-LATE-PEN-CHARGED-AMT DTSBE451 01352 L102-TAX-CHARGED-AMT DTSBE451 01353 L102-TAX-BALANCE-AMT DTSBE451 01354 WRK-TIMELY-PAYMENTS. DTSBE451 01355 DTSBE451 01356 ********************************************************* DTSBE451 01357 * PENALTY CALCULATED ON UI AND SUR TAX BALANCE DTSBE451 01358 ********************************************************* DTSBE451 01359 PERFORM DTSBE451 01360 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSBE451 01361 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT DTSBE451 01362 IF MQTR-ACCT-LATE-PEN-88 (MQTR-ACCT-IDX) DTSBE451 01363 ADD MQTR-CHARGED-AMT (MQTR-ACCT-IDX) DTSBE451 01364 TO L102-LATE-PEN-CHARGED-AMT DTSBE451 01365 END-IF DTSBE451 01366 IF MQTR-ACCT-UI-88 (MQTR-ACCT-IDX) DTSBE451 01367 ADD MQTR-CHARGED-AMT (MQTR-ACCT-IDX) DTSBE451 01368 TO L102-TAX-CHARGED-AMT DTSBE451 01369 * ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSBE451 01370 * TO L102-TAX-BALANCE-AMT DTSBE451 01371 END-IF DTSBE451 01372 IF MQTR-ACCT-SUR-88 (MQTR-ACCT-IDX) AND DTSBE451 01373 MQTR-YRQ >= L109-FIRST-PEN-INT-YRQ DTSBE451 01374 ADD MQTR-CHARGED-AMT (MQTR-ACCT-IDX) DTSBE451 01375 TO L102-TAX-CHARGED-AMT DTSBE451 01376 * ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSBE451 01377 * TO L102-TAX-BALANCE-AMT DTSBE451 01378 END-IF DTSBE451 01379 END-PERFORM. DTSBE451 01380 DTSBE451 01381 MOVE MQTR-PEN-AREA TO L102-PEN-AREA. DTSBE451 01382 DTSBE451 01383 * MOVE ZERO TO WRK-TIMELY-SI-PAY-AMT. DTSBE451 01384 * IF MPRF-CLASS-SELF-INS-88 DTSBE451 01385 * MOVE WRK-TIMELY-SI-PAY-AMT TO L102-TIMELY-SI-PAY-AMT DTSBE451 01386 * END-IF. DTSBE451 01387 DTSBE451 01388 PERFORM P4110-PAYMENTS THRU P4110-EXIT DTSBE451 01389 DTSBE451 01390 COMPUTE L102-TAX-BALANCE-AMT = DTSBE451 01391 (L102-TAX-CHARGED-AMT - WRK-TIMELY-PAYMENTS). DTSBE451 01392 DTSBE451 01393 P4100-EXIT. DTSBE451 01394 EXIT. DTSBE451 01395 DTSBE451 01396 P4110-PAYMENTS. DTSBE451 01397 MOVE LOW-VALUE TO MDST-KEY-AREA. DTSBE451 01398 MOVE MPRF-EMP-NO TO MDST-EMP-NO. DTSBE451 01399 SET MDST-DST-88 TO TRUE. DTSBE451 01400 MOVE MDST-KEY-AREA TO MSKL-KEY-AREA. DTSBE451 01401 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE451 01402 IF L910-OK-88 DTSBE451 01403 PERFORM P4111-SCAN-MDST THRU P4111-EXIT DTSBE451 01404 UNTIL L910-NO-REC-88 DTSBE451 01405 END-IF. DTSBE451 01406 ** MOVE WRK-TIMELY-SI-PAY-AMT TO AMT-DISP1. DTSBE451 01407 ** DISPLAY 'TIMELY SI PAYMENTS: ' AMT-DISP1. DTSBE451 01408 DTSBE451 01409 P4110-EXIT. DTSBE451 01410 EXIT. DTSBE451 01411 DTSBE451 01412 P4111-SCAN-MDST. DTSBE451 01413 MOVE MSKL-REC TO MDST-REC. DTSBE451 01414 IF ((MDST-YRQ >= WRK-QTR1 DTSBE451 01415 AND MDST-YRQ <= WRK-QTR4) DTSBE451 01416 AND MDST-RECEIVED-DATE <= MQTR-TAX-DUE-DATE) DTSBE451 01417 PERFORM DTSBE451 01418 VARYING MDST-ACCT-IDX FROM +1 BY +1 DTSBE451 01419 UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT DTSBE451 01420 IF MDST-ACCT-UI-88 (MDST-ACCT-IDX) DTSBE451 01421 ADD MDST-AMT (MDST-ACCT-IDX) DTSBE451 01422 TO WRK-TIMELY-PAYMENTS DTSBE451 01423 END-IF DTSBE451 01424 IF MDST-ACCT-SUR-88 (MDST-ACCT-IDX) AND DTSBE451 01425 MDST-YRQ >= L109-FIRST-PEN-INT-YRQ DTSBE451 01426 ADD MDST-AMT (MDST-ACCT-IDX) DTSBE451 01427 TO WRK-TIMELY-PAYMENTS DTSBE451 01428 END-IF DTSBE451 01429 END-PERFORM DTSBE451 01430 END-IF. DTSBE451 01431 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE451 01432 DTSBE451 01433 P4111-EXIT. DTSBE451 01434 EXIT. DTSBE451 01435 DTSBE451 01436 P4200-GENERATE-T026. DTSBE451 01437 MOVE MPRF-EMP-NO TO T026-EMP-NO. DTSBE451 01438 SET T026-LATE-PEN-CHG TO TRUE. DTSBE451 01439 MOVE MPRF-PRIMARY-NAME TO T026-NAME-CHECK. DTSBE451 01440 MOVE L102-LATE-PEN-CHARGE-CHNG TO T026-AMT. DTSBE451 01441 MOVE +0 TO T026-RECEIVED-DATE. DTSBE451 01442 MOVE WRK-PENALTY-YRQ TO T026-APPLIC-YRQ. DTSBE451 01443 MOVE CACT-APPLIC-LATE-PEN TO T026-APPLIC-IND. DTSBE451 01444 MOVE +0 TO T026-APPLIC-BATCH-NO DTSBE451 01445 T026-APPLIC-ITEM-NO. DTSBE451 01446 DTSBE451 01447 MOVE +0 TO T026-DATE-1 DTSBE451 01448 T026-DATE-2. DTSBE451 01449 MOVE SPACE TO T026-INT-SPAN-IND. DTSBE451 01450 SET T026-NO-INT-RATE-88 TO TRUE. DTSBE451 01451 MOVE 'SYS' TO T026-RESPONSIBLE-ACTIVITY. DTSBE451 01452 MOVE SPACES TO T026-RESPONSIBLE-OP-ID. DTSBE451 01453 PERFORM S927-WRITE-T026 THRU S927-EXIT. DTSBE451 01454 IF L102-LATE-PEN-WAIVE-CHNG > +0 DTSBE451 01455 SET T026-LATE-PEN-WAIVE TO TRUE DTSBE451 01456 MOVE L102-LATE-PEN-WAIVE-CHNG TO T026-AMT DTSBE451 01457 PERFORM S927-WRITE-T026 THRU S927-EXIT DTSBE451 01458 END-IF. DTSBE451 01459 DTSBE451 01460 P4200-EXIT. DTSBE451 01461 EXIT. DTSBE451 01462 DTSBE451 01463 T0000-TERMINATE. DTSBE451 01464 MOVE LOW-VALUES TO FAFD-KEY-AREA. DTSBE451 01465 DTSBE451 01466 SET FAFD-AFD-88 TO TRUE. DTSBE451 01467 DTSBE451 01468 MOVE WRK-PARM-SUBJECT-YR TO FAFD-YR. DTSBE451 01469 DTSBE451 01470 MOVE FAFD-KEY-AREA TO FSKL-KEY-AREA. DTSBE451 01471 DTSBE451 01472 PERFORM S931-READ THRU S931-EXIT. DTSBE451 01473 DTSBE451 01474 IF L931-NO-REC-88 DTSBE451 01475 MOVE LOW-VALUES TO FAFD-DATA-AREA DTSBE451 01476 MOVE +0 TO FAFD-UC30H-MASS-MAIL-DATE DTSBE451 01477 FAFD-UC30H-RPT-DUE-DATE DTSBE451 01478 FAFD-LATE-PEN-ASSESSED-DATE DTSBE451 01479 MOVE WRK-UC30H-FIRST-DEL-CUTOFF-DTE DTSBE451 01480 TO FAFD-UC30H-FIRST-DEL-DATE DTSBE451 01481 MOVE +0 TO FAFD-UC30H-ESTIMATED-DATE DTSBE451 01482 FAFD-UC30H-FINAL-ACTION-DATE DTSBE451 01483 MOVE LECM-CURR-RUN-DATE TO FAFD-ESTB-DATE DTSBE451 01484 FAFD-CHNG-DATE DTSBE451 01485 MOVE FAFD-REC TO FSKL-REC DTSBE451 01486 PERFORM S931-WRITE THRU S931-EXIT DTSBE451 01487 ELSE DTSBE451 01488 MOVE FSKL-REC TO FAFD-REC DTSBE451 01489 MOVE WRK-UC30H-FIRST-DEL-CUTOFF-DTE DTSBE451 01490 TO FAFD-UC30H-FIRST-DEL-DATE DTSBE451 01491 MOVE WRK-PARM-RETURN-BY-DATE TO DTSBE451 01492 FAFD-UC30H-FINAL-ACTION-DATE DTSBE451 01493 MOVE LECM-CURR-RUN-DATE DTSBE451 01494 TO FAFD-CHNG-DATE DTSBE451 01495 MOVE FAFD-REC TO FSKL-REC DTSBE451 01496 PERFORM S931-REWRITE THRU S931-EXIT. DTSBE451 01497 DTSBE451 01498 DISPLAY DTSBE451 01499 SPACE. DTSBE451 01500 DISPLAY '** DTSBE451 TERMINATION **'. DTSBE451 01501 DISPLAY 'DELINQUENT EMPLOYERS: ' WRK-DELINQUENT-CNT. DTSBE451 01502 DISPLAY ' DELQ EMPLS BAD ADDR: ' WRK-RETURN-MAIL-CNT CL**2 01503 DISPLAY ' PENALTIES ASSESSED: ' WRK-PEN-CNT. CL**2 01504 DISPLAY 'SELF-INS PENALTIES: ' WRK-SI-PEN-CNT. DTSBE451 01505 DISPLAY SPACE. DTSBE451 01506 DISPLAY 'TF TABLE ENTRIES : ' WRK-TF-TABLE-CNT. DTSBE451 01507 DISPLAY 'TF BYPASSED : ' WRK-BYPASS-CNT. DTSBE451 01508 DISPLAY 'NOT BYPASSED : '. DTSBE451 01509 PERFORM DTSBE451 01510 VARYING TF-SUB FROM +1 BY +1 DTSBE451 01511 UNTIL TF-SUB > TF-MAX DTSBE451 01512 IF TF-RPT-FOUND-YES-88 (TF-SUB) DTSBE451 01513 IF TF-BYPASSED-NO-88 (TF-SUB) DTSBE451 01514 DISPLAY TF-SUB DTSBE451 01515 END-IF DTSBE451 01516 END-IF DTSBE451 01517 END-PERFORM. DTSBE451 01518 DTSBE451 01519 T0000-EXIT. DTSBE451 01520 EXIT. DTSBE451 01521 EJECT DTSBE451 01522 S1000-PURSUED-RPT-IND. DTSBE451 01523 SET MQTR-RPT-NOT-PURSUED-88 TO TRUE. DTSBE451 01524 DTSBE451 01525 IF (MPRF-NOT-WRITTEN-OFF-88) DTSBE451 01526 AND DTSBE451 01527 (MQTR-CURR-DELINQ-88 OR MQTR-CURR-ESTIM-88) DTSBE451 01528 AND DTSBE451 01529 (MQTR-YRQ >= WRK-FIRST-PURSUED-RPT-YRQ) DTSBE451 01530 SET MQTR-RPT-IS-PURSUED-88 TO TRUE. DTSBE451 01531 DTSBE451 01532 IF MQTR-RPT-IS-PURSUED-88 DTSBE451 01533 SET POST-UPD-RPT-PURSUED-YES-88 TO TRUE. DTSBE451 01534 *& DTSBE451 01535 * IF MQTR-RPT-IS-PURSUED-88 DTSBE451 01536 * DISPLAY 'S1000 ' MPRF-EMP-NO DTSBE451 01537 * ' ' MQTR-YRQ DTSBE451 01538 * ' PRE ' WRK-PRE-UPD-IND DTSBE451 01539 * ' POST ' WRK-POST-UPD-IND. DTSBE451 01540 *& DTSBE451 01541 DTSBE451 01542 S1000-EXIT. DTSBE451 01543 EXIT. DTSBE451 01544 EJECT DTSBE451 01545 S2000-MISS-RPT-CUTOFF-CD. DTSBE451 01546 IF MQTR-RPT-IS-PURSUED-88 DTSBE451 01547 PERFORM S2100-RPT-IS-PURSUED THRU S2100-EXIT DTSBE451 01548 ELSE DTSBE451 01549 IF MQTR-CURR-RCVD-88 DTSBE451 01550 PERFORM S2200-CURR-RCVD THRU S2200-EXIT DTSBE451 01551 ELSE DTSBE451 01552 IF MQTR-CURR-NOT-LIABLE-88 DTSBE451 01553 SET MQTR-MISS-NOT-LIABLE-88 TO TRUE DTSBE451 01554 ELSE DTSBE451 01555 IF MQTR-CURR-NOT-DUE-88 DTSBE451 01556 SET MQTR-MISS-NO-LTR-EXT-88 TO TRUE DTSBE451 01557 ELSE DTSBE451 01558 SET MQTR-MISS-NO-LTR-OTHER-88 TO TRUE. DTSBE451 01559 S2000-EXIT. DTSBE451 01560 EXIT. DTSBE451 01561 SKIP3 DTSBE451 01562 S2100-RPT-IS-PURSUED. DTSBE451 01563 SET MQTR-MISS-NO-LTR-ADDR-88 TO TRUE. DTSBE451 01564 DTSBE451 01565 MOVE LOW-VALUES TO MTAD-KEY-AREA. DTSBE451 01566 DTSBE451 01567 MOVE MPRF-EMP-NO TO MTAD-EMP-NO. DTSBE451 01568 DTSBE451 01569 SET MTAD-TAD-88 TO TRUE. DTSBE451 01570 DTSBE451 01571 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. DTSBE451 01572 DTSBE451 01573 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE451 01574 DTSBE451 01575 PERFORM S2110-MTAD-SCAN THRU S2110-EXIT DTSBE451 01576 UNTIL L910-NO-REC-88. DTSBE451 01577 DTSBE451 01578 DTSBE451 01579 IF MQTR-MISS-LETTER-SENT-88 DTSBE451 01580 GO TO S2100-EXIT. DTSBE451 01581 DTSBE451 01582 DTSBE451 01583 MOVE LOW-VALUES TO MOPO-KEY-AREA. DTSBE451 01584 DTSBE451 01585 MOVE MPRF-EMP-NO TO MOPO-EMP-NO. DTSBE451 01586 DTSBE451 01587 SET MOPO-OPO-88 TO TRUE. DTSBE451 01588 DTSBE451 01589 MOVE MOPO-KEY-AREA TO MSKL-KEY-AREA. DTSBE451 01590 DTSBE451 01591 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE451 01592 DTSBE451 01593 PERFORM DTSBE451 01594 UNTIL L910-NO-REC-88 DTSBE451 01595 MOVE MSKL-REC TO MOPO-REC DTSBE451 01596 IF MOPO-MISSING-RPT-LTRS-YES-88 DTSBE451 01597 SET MQTR-MISS-LETTER-SENT-88 TO TRUE DTSBE451 01598 END-IF DTSBE451 01599 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBE451 01600 END-PERFORM. DTSBE451 01601 DTSBE451 01602 DTSBE451 01603 IF MQTR-MISS-LETTER-SENT-88 DTSBE451 01604 GO TO S2100-EXIT. DTSBE451 01605 DTSBE451 01606 DTSBE451 01607 MOVE LOW-VALUES TO MTAA-KEY-AREA. DTSBE451 01608 DTSBE451 01609 MOVE MPRF-EMP-NO TO MTAA-EMP-NO. DTSBE451 01610 DTSBE451 01611 SET MTAA-TAA-88 TO TRUE. DTSBE451 01612 DTSBE451 01613 MOVE MTAA-KEY-AREA TO MSKL-KEY-AREA. DTSBE451 01614 DTSBE451 01615 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE451 01616 DTSBE451 01617 PERFORM DTSBE451 01618 UNTIL L910-NO-REC-88 DTSBE451 01619 MOVE MSKL-REC TO MTAA-REC DTSBE451 01620 IF MTAA-MISSING-RPT-LTRS-YES-88 DTSBE451 01621 SET MQTR-MISS-LETTER-SENT-88 TO TRUE DTSBE451 01622 END-IF DTSBE451 01623 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBE451 01624 END-PERFORM. DTSBE451 01625 S2100-EXIT. DTSBE451 01626 EXIT. DTSBE451 01627 SKIP3 DTSBE451 01628 S2110-MTAD-SCAN. DTSBE451 01629 MOVE MSKL-REC TO MTAD-REC. DTSBE451 01630 DTSBE451 01631 IF MTAD-MISSING-RPT-LTRS-YES-88 DTSBE451 01632 SET MQTR-MISS-LETTER-SENT-88 TO TRUE DTSBE451 01633 SET L910-NO-REC-88 TO TRUE DTSBE451 01634 ELSE DTSBE451 01635 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE451 01636 S2110-EXIT. DTSBE451 01637 EXIT. DTSBE451 01638 SKIP3 DTSBE451 01639 S2200-CURR-RCVD. DTSBE451 01640 MOVE ALL-NINES-DATE TO WRK-ORIG-RECEIVED-DATE. DTSBE451 01641 DTSBE451 01642 DTSBE451 01643 MOVE LOW-VALUES TO MRPT-KEY-AREA. DTSBE451 01644 DTSBE451 01645 MOVE MPRF-EMP-NO TO MRPT-EMP-NO. DTSBE451 01646 DTSBE451 01647 SET MRPT-RPT-88 TO TRUE. DTSBE451 01648 DTSBE451 01649 MOVE MQTR-YRQ TO MRPT-YRQ. DTSBE451 01650 DTSBE451 01651 MOVE MRPT-KEY-AREA TO MSKL-KEY-AREA. DTSBE451 01652 DTSBE451 01653 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE451 01654 DTSBE451 01655 PERFORM S2210-MRPT-SCAN THRU S2210-EXIT DTSBE451 01656 UNTIL L910-NO-REC-88. DTSBE451 01657 DTSBE451 01658 IF WRK-ORIG-RECEIVED-DATE > MQTR-RPT-DUE-DATE DTSBE451 01659 SET MQTR-MISS-UNTIMELY-88 TO TRUE DTSBE451 01660 ELSE DTSBE451 01661 SET MQTR-MISS-TIMELY-88 TO TRUE. DTSBE451 01662 S2200-EXIT. DTSBE451 01663 EXIT. DTSBE451 01664 SKIP3 DTSBE451 01665 S2210-MRPT-SCAN. DTSBE451 01666 MOVE MSKL-REC TO MRPT-REC. DTSBE451 01667 DTSBE451 01668 IF MQTR-YRQ = MRPT-YRQ DTSBE451 01669 NEXT SENTENCE DTSBE451 01670 ELSE DTSBE451 01671 SET L910-NO-REC-88 TO TRUE DTSBE451 01672 GO TO S2210-EXIT. DTSBE451 01673 DTSBE451 01674 IF MRPT-ORIG-88 DTSBE451 01675 MOVE MRPT-RECEIVED-DATE DTSBE451 01676 TO WRK-ORIG-RECEIVED-DATE. DTSBE451 01677 DTSBE451 01678 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE451 01679 S2210-EXIT. DTSBE451 01680 EXIT. DTSBE451 01681 EJECT DTSBE451 01682 S3000-ESTB-MTCK. DTSBE451 01683 MOVE LOW-VALUES TO MTCK-REC. DTSBE451 01684 DTSBE451 01685 MOVE MPRF-EMP-NO TO MTCK-EMP-NO. DTSBE451 01686 DTSBE451 01687 SET MTCK-TCK-88 TO TRUE. DTSBE451 01688 DTSBE451 01689 ADD +1 TO LECM-EMP-ABSTIME. DTSBE451 01690 DTSBE451 01691 MOVE LECM-EMP-ABSTIME TO MTCK-ESTB-ABSTIME. DTSBE451 01692 DTSBE451 01693 MOVE +0 TO MTCK-PURGE-DATE. DTSBE451 01694 DTSBE451 01695 MOVE +0 TO MTCK-TEXT-CNT. DTSBE451 01696 DTSBE451 01697 SET MTCK-TYPE-CHK-LATE-88 TO TRUE. DTSBE451 01698 DTSBE451 01699 MOVE WRK-TRIGGER-DATE TO MTCK-TRIGGER-DATE. DTSBE451 01700 DTSBE451 01701 MOVE +0 TO MTCK-ACKNOWLEDGED-DATE. DTSBE451 01702 DTSBE451 01703 SET MTCK-SOURCE-SYSTEM-88 TO TRUE. DTSBE451 01704 DTSBE451 01705 SET MTCK-DEST-SYSTEM-88 TO TRUE. DTSBE451 01706 DTSBE451 01707 MOVE MQTR-YRQ TO MTCK-LTE-YRQ. DTSBE451 01708 DTSBE451 01709 SET MTCK-NOT-CONVERTED-88 TO TRUE. DTSBE451 01710 DTSBE451 01711 MOVE LECM-CURR-RUN-DATE TO MTCK-ESTB-DATE DTSBE451 01712 MTCK-CHNG-DATE. DTSBE451 01713 DTSBE451 01714 MOVE MTCK-REC TO MSKL-REC. DTSBE451 01715 DTSBE451 01716 PERFORM S910-WRITE THRU S910-EXIT. DTSBE451 01717 S3000-EXIT. DTSBE451 01718 EXIT. DTSBE451 01719 EJECT DTSBE451 01720 S4000-WRITE-MEVL. DTSBE451 01721 ADD +1000 TO LECM-EMP-ABSTIME. DTSBE451 01722 DTSBE451 01723 DTSBE451 01724 MOVE LECM-EMP-ABSTIME TO L005-ABSTIME. DTSBE451 01725 DTSBE451 01726 PERFORM S005-FROM-ABSTIME THRU S005-EXIT. DTSBE451 01727 DTSBE451 01728 DTSBE451 01729 MOVE LOW-VALUES TO MEVL-REC. DTSBE451 01730 DTSBE451 01731 MOVE MPRF-EMP-NO TO MEVL-EMP-NO. DTSBE451 01732 DTSBE451 01733 SET MEVL-EVL-88 TO TRUE. DTSBE451 01734 DTSBE451 01735 MOVE L005-DATE TO MEVL-DATE. DTSBE451 01736 DTSBE451 01737 MOVE L005-TIME TO MEVL-TIME. DTSBE451 01738 DTSBE451 01739 MOVE ZEROS TO MEVL-PURGE-DATE. DTSBE451 01740 DTSBE451 01741 MOVE EVL-TEXT TO MEVL-TEXT. DTSBE451 01742 DTSBE451 01743 SET MEVL-SOURCE-SYSTEM-88 TO TRUE. DTSBE451 01744 DTSBE451 01745 SET MEVL-NOT-CONVERTED-88 TO TRUE. DTSBE451 01746 DTSBE451 01747 MOVE LECM-CURR-RUN-DATE TO MEVL-ESTB-DATE DTSBE451 01748 MEVL-CHNG-DATE. DTSBE451 01749 DTSBE451 01750 DTSBE451 01751 MOVE MEVL-REC TO MSKL-REC. DTSBE451 01752 DTSBE451 01753 PERFORM S910-WRITE THRU S910-EXIT. DTSBE451 01754 S4000-EXIT. DTSBE451 01755 EXIT. DTSBE451 01756 EJECT DTSBE451 01757 S9100-INCONSISTENT-RPT-TYPE. DTSBE451 01758 MOVE MQTR-YRQ TO L004-QTR-5-9. DTSBE451 01759 DTSBE451 01760 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBE451 01761 DTSBE451 01762 MOVE L004-SLASH-QTR TO MSG4-SLASHED-YRQ. DTSBE451 01763 DTSBE451 01764 MOVE MSG4-ID TO R907-MSG-ID. DTSBE451 01765 DTSBE451 01766 MOVE MSG4-TEXT TO R907-MSG-TEXT. DTSBE451 01767 DTSBE451 01768 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBE451 01769 DTSBE451 01770 MOVE 'Y' TO INCONSISTENCY-ENCOUNTERED-IND. DTSBE451 01771 S9100-EXIT. DTSBE451 01772 EXIT. DTSBE451 01773 EJECT DTSBE451 01774 S001-FROM-FED-8. DTSBE451 01775 SET L001-FROM-FED-8 TO TRUE. DTSBE451 01776 GO TO S001-DATE. DTSBE451 01777 DTSBE451 01778 S001-FROM-CAL-6. DTSBE451 01779 SET L001-FROM-CAL-6 TO TRUE. DTSBE451 01780 GO TO S001-DATE. DTSBE451 01781 DTSBE451 01782 S001-FROM-ABS-DAY. DTSBE451 01783 SET L001-FROM-ABS-DAY TO TRUE. DTSBE451 01784 GO TO S001-DATE. DTSBE451 01785 DTSBE451 01786 S001-DATE. DTSBE451 01787 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBE451 01788 S001-EXIT. DTSBE451 01789 EXIT. DTSBE451 01790 SKIP3 DTSBE451 01791 S004-FROM-5. DTSBE451 01792 SET L004-FROM-5 TO TRUE. DTSBE451 01793 GO TO S004-QTR. DTSBE451 01794 DTSBE451 01795 S004-FROM-ABS. DTSBE451 01796 SET L004-FROM-ABS TO TRUE. DTSBE451 01797 GO TO S004-QTR. DTSBE451 01798 DTSBE451 01799 S004-FROM-3. DTSBE451 01800 SET L004-FROM-3 TO TRUE. DTSBE451 01801 GO TO S004-QTR. DTSBE451 01802 DTSBE451 01803 S004-QTR. DTSBE451 01804 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBE451 01805 S004-EXIT. DTSBE451 01806 EXIT. DTSBE451 01807 SKIP3 DTSBE451 01808 S005-FROM-ABSTIME. DTSBE451 01809 SET L005-FROM-ABSTIME TO TRUE. DTSBE451 01810 GO TO S005-ABSTIME. DTSBE451 01811 DTSBE451 01812 S005-ABSTIME. DTSBE451 01813 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBE451 01814 S005-EXIT. DTSBE451 01815 EXIT. DTSBE451 01816 SKIP3 DTSBE451 01817 S061-DETERMINE-FLD-REP. DTSBE451 01818 MOVE MPRF-FLD-ZIP-ST TO L061-FLD-ZIP-ST. DTSBE451 01819 DTSBE451 01820 MOVE MPRF-EMP-NO TO L061-EMP-NO. DTSBE451 01821 DTSBE451 01822 CALL 'DTSBU061' USING L061-LINK-AREA. DTSBE451 01823 S061-EXIT. DTSBE451 01824 EXIT. DTSBE451 01825 SKIP3 DTSBE451 01826 S064-LOOKUP-FLD-ZIP-ADDR. DTSBE451 01827 MOVE MPRF-EMP-NO TO L064-EMP-NO. DTSBE451 01828 DTSBE451 01829 MOVE MPRF-TAX-REC-ADDR-EXISTS-IND DTSBE451 01830 TO L064-TAX-REC-ADDR-EXISTS-IND. DTSBE451 01831 DTSBE451 01832 CALL 'DTSBU064' USING L064-LINK-AREA. DTSBE451 01833 S064-EXIT. DTSBE451 01834 EXIT. DTSBE451 01835 SKIP3 DTSBE451 01836 S102-DELINQUENCY-RUN. DTSBE451 01837 SET L102-DELINQUENCY-RUN-88 TO TRUE. DTSBE451 01838 CALL 'DTSBU102' USING L102-LINK-AREA. DTSBE451 01839 DTSBE451 01840 S102-EXIT. DTSBE451 01841 EXIT. DTSBE451 01842 S109-LOOKUP-SUR-RATE. DTSBE451 01843 SET L109-CMND-INPUT-QTR-88 TO TRUE. DTSBE451 01844 GO TO S109-CALL-109. DTSBE451 01845 S109-FIRST-PEN-INT-YRQ. DTSBE451 01846 SET L109-CMND-PEN-INT-QTR-88 TO TRUE. DTSBE451 01847 GO TO S109-CALL-109. DTSBE451 01848 S109-CALL-109. DTSBE451 01849 CALL 'DTSBU109' USING L109-LINK-AREA. DTSBE451 01850 S109-EXIT. DTSBE451 01851 EXIT. DTSBE451 01852 SKIP3 DTSBE451 01853 DTSBE451 01854 S111-LOOKUP-TAD. DTSBE451 01855 SET L111-LOOKUP-TAD-88 TO TRUE. DTSBE451 01856 GO TO S111-LOOKUP-ADDR. DTSBE451 01857 DTSBE451 01858 S111-LOOKUP-TAA. DTSBE451 01859 SET L111-LOOKUP-TAA-88 TO TRUE. DTSBE451 01860 GO TO S111-LOOKUP-ADDR. DTSBE451 01861 DTSBE451 01862 S111-LOOKUP-OPO. DTSBE451 01863 SET L111-LOOKUP-OPO-88 TO TRUE. DTSBE451 01864 GO TO S111-LOOKUP-ADDR. DTSBE451 01865 DTSBE451 01866 S111-LOOKUP-ADDR. DTSBE451 01867 MOVE MPRF-EMP-NO TO L111-EMP-NO. DTSBE451 01868 DTSBE451 01869 CALL 'DTSBU111' USING L111-LINK-AREA. DTSBE451 01870 S111-EXIT. DTSBE451 01871 EXIT. DTSBE451 01872 SKIP3 DTSBE451 01873 S112-TAD-ADDR. DTSBE451 01874 SET L112-TAD-ADDR-88 TO TRUE. DTSBE451 01875 GO TO S112-FORMAT-ADDR. DTSBE451 01876 DTSBE451 01877 S112-TAA-ADDR. DTSBE451 01878 SET L112-TAA-ADDR-88 TO TRUE. DTSBE451 01879 GO TO S112-FORMAT-ADDR. DTSBE451 01880 DTSBE451 01881 S112-OPO-ADDR. DTSBE451 01882 SET L112-OPO-ADDR-88 TO TRUE. DTSBE451 01883 GO TO S112-FORMAT-ADDR. DTSBE451 01884 DTSBE451 01885 S112-FORMAT-ADDR. DTSBE451 01886 SET L112-ANCHOR-LAST-88 TO TRUE. DTSBE451 01887 DTSBE451 01888 MOVE MPRF-PRIMARY-NAME TO L112-PRIMARY-NAME. DTSBE451 01889 DTSBE451 01890 CALL 'DTSBU112' USING L112-LINK-AREA. DTSBE451 01891 S112-EXIT. DTSBE451 01892 EXIT. DTSBE451 01893 SKIP3 DTSBE451 01894 S410-FILE-SCHED. DTSBE451 01895 CALL 'DTSBU410' USING L410-LINK-AREA. DTSBE451 01896 S410-EXIT. DTSBE451 01897 EXIT. DTSBE451 01898 SKIP3 DTSBE451 01899 S415-HOUSEHOLD-DATES. DTSBE451 01900 CALL 'DTSBU415' USING L415-LINK-AREA. DTSBE451 01901 S415-EXIT. DTSBE451 01902 EXIT. DTSBE451 01903 SKIP3 DTSBE451 01904 S511-INITIALIZE-MQTR. DTSBE451 01905 CALL 'DTSBU511' USING MQTR-REC. DTSBE451 01906 S511-EXIT. DTSBE451 01907 EXIT. DTSBE451 01908 SKIP3 DTSBE451 01909 S516-LIABILITY. DTSBE451 01910 CALL 'DTSBU516' USING L516-LINK-AREA DTSBE451 01911 MPRF-LINK-REC. DTSBE451 01912 S516-EXIT. DTSBE451 01913 EXIT. DTSBE451 01914 SKIP3 DTSBE451 01915 S910-READ. DTSBE451 01916 SET L910-READ-88 TO TRUE. DTSBE451 01917 GO TO S910-MSTR-IO. DTSBE451 01918 DTSBE451 01919 S910-START-BROWSE. DTSBE451 01920 SET L910-START-BROWSE-88 TO TRUE. DTSBE451 01921 GO TO S910-MSTR-IO. DTSBE451 01922 DTSBE451 01923 S910-READ-NEXT. DTSBE451 01924 SET L910-READ-NEXT-88 TO TRUE. DTSBE451 01925 GO TO S910-MSTR-IO. DTSBE451 01926 DTSBE451 01927 S910-COUNT. DTSBE451 01928 SET L910-COUNT-88 TO TRUE. DTSBE451 01929 GO TO S910-MSTR-IO. DTSBE451 01930 DTSBE451 01931 S910-WRITE. DTSBE451 01932 SET L910-WRITE-88 TO TRUE. DTSBE451 01933 SET LECM-EMP-UPDATED-YES-88 TO TRUE. DTSBE451 01934 GO TO S910-MSTR-IO. DTSBE451 01935 DTSBE451 01936 S910-REWRITE. DTSBE451 01937 SET L910-REWRITE-88 TO TRUE. DTSBE451 01938 SET LECM-EMP-UPDATED-YES-88 TO TRUE. DTSBE451 01939 GO TO S910-MSTR-IO. DTSBE451 01940 DTSBE451 01941 S910-DELETE. DTSBE451 01942 SET L910-DELETE-88 TO TRUE. DTSBE451 01943 SET LECM-EMP-UPDATED-YES-88 TO TRUE. DTSBE451 01944 GO TO S910-MSTR-IO. DTSBE451 01945 DTSBE451 01946 S910-MSTR-IO. DTSBE451 01947 CALL 'DTSBU910' USING L910-LINK-AREA DTSBE451 01948 MSKL-REC. DTSBE451 01949 S910-EXIT. DTSBE451 01950 EXIT. DTSBE451 01951 SKIP3 DTSBE451 01952 S923-OPEN-READ. DTSBE451 01953 SET L923-OPEN-READ-88 TO TRUE. DTSBE451 01954 GO TO S923-ATC-IO. DTSBE451 01955 S923-START-BROWSE. DTSBE451 01956 SET L923-START-BROWSE-88 TO TRUE. DTSBE451 01957 GO TO S923-ATC-IO. DTSBE451 01958 S923-READ-NEXT. DTSBE451 01959 SET L923-READ-NEXT-88 TO TRUE. DTSBE451 01960 GO TO S923-ATC-IO. DTSBE451 01961 S923-CLOSE. DTSBE451 01962 SET L923-CLOSE-88 TO TRUE. DTSBE451 01963 GO TO S923-ATC-IO. DTSBE451 01964 S923-ATC-IO. DTSBE451 01965 CALL 'DTSBU923' USING L923-LINK-AREA DTSBE451 01966 ASKL-REC. DTSBE451 01967 S923-EXIT. DTSBE451 01968 EXIT. DTSBE451 01969 S927-WRITE-T026. DTSBE451 01970 SET L927-WRITE-88 TO TRUE. DTSBE451 01971 CALL 'DTSBU927' USING L927-LINK-AREA DTSBE451 01972 T026-REC. DTSBE451 01973 GO TO S927-EXIT. DTSBE451 01974 DTSBE451 01975 S927-EXIT. DTSBE451 01976 EXIT. DTSBE451 01977 DTSBE451 01978 S931-READ. DTSBE451 01979 SET L931-READ-88 TO TRUE. DTSBE451 01980 GO TO S931-REF-I. DTSBE451 01981 DTSBE451 01982 S931-START-BROWSE. DTSBE451 01983 SET L931-START-BROWSE-88 TO TRUE. DTSBE451 01984 GO TO S931-REF-I. DTSBE451 01985 DTSBE451 01986 S931-READ-NEXT. DTSBE451 01987 SET L931-READ-NEXT-88 TO TRUE. DTSBE451 01988 GO TO S931-REF-I. DTSBE451 01989 DTSBE451 01990 S931-WRITE. DTSBE451 01991 SET L931-WRITE-88 TO TRUE. DTSBE451 01992 GO TO S931-REF-I. DTSBE451 01993 DTSBE451 01994 S931-REWRITE. DTSBE451 01995 SET L931-REWRITE-88 TO TRUE. DTSBE451 01996 GO TO S931-REF-I. DTSBE451 01997 DTSBE451 01998 S931-DELETE. DTSBE451 01999 SET L931-DELETE-88 TO TRUE. DTSBE451 02000 GO TO S931-REF-I. DTSBE451 02001 DTSBE451 02002 S931-REF-I. DTSBE451 02003 CALL 'DTSBU931' USING L931-LINK-AREA DTSBE451 02004 FSKL-REC. DTSBE451 02005 S931-EXIT. DTSBE451 02006 EXIT. DTSBE451 02007 SKIP3 DTSBE451 02008 S946-WRITE-R451. DTSBE451 02009 CALL 'DTSBU946' USING R451-REC. DTSBE451 02010 GO TO S946-EXIT. DTSBE451 02011 DTSBE451 02012 S946-WRITE-R452. DTSBE451 02013 CALL 'DTSBU946' USING R452-REC. DTSBE451 02014 GO TO S946-EXIT. DTSBE451 02015 DTSBE451 02016 S946-WRITE-R716. DTSBE451 02017 CALL 'DTSBU946' USING R716-REC. DTSBE451 02018 GO TO S946-EXIT. DTSBE451 02019 DTSBE451 02020 S946-WRITE-R907. DTSBE451 02021 CALL 'DTSBU946' USING R907-REC. DTSBE451 02022 GO TO S946-EXIT. DTSBE451 02023 DTSBE451 02024 S946-EXIT. DTSBE451 02025 EXIT. DTSBE451 02026 SKIP3 DTSBE451 02027 S999-ABEND. DTSBE451 02028 DISPLAY '*** DTSBE451 ABENDING. ' DTSBE451 02029 ABEND-MSG. DTSBE451 02030 DTSBE451 02031 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBE451 02032 S999-EXIT. DTSBE451 02033 EXIT. DTSBE451