giteaadmin/DUTAS
4
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
2a54f65e13ffdac7ccbe8ea99bd8eb7cbb392cec
DUTAS/Batch/DTSBE451.cob
Neeraj Kumar ca3572c5df DUTAS re-platformed to Raincode - Initial Source Code
2025-07-21 11:20:11 -04:00

2035 lines
161 KiB
COBOL
Raw Blame History

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
Reference in New Issue View Git Blame Copy Permalink