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