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