00001 IDENTIFICATION DIVISION. 05/03/21 00002 PROGRAM-ID. DTSBE321. DTSBE321 00003 AUTHOR. TRW. LV062 00004 DATE-WRITTEN. SEPTEMBER 2002. DTSBE321 00005 DATE-COMPILED. DTSBE321 00006 SKIP3 DTSBE321 00007 ****** DTSBE321 00008 * *** ANNUAL FILER PENALTY PROCESS *** DTSBE321 00009 * DTSBE321 00010 * NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE DTSBE321 00011 * NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE DTSBE321 00012 * NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE DTSBE321 00013 * DTSBE321 00014 * THE PENALTY ASSESSMENT PROCESS IS DESIGNED TO BE RUN DTSBE321 00015 * IMMEDIATELY PRIOR TO A DAILY UPDATE RUN. DTSBE321 00016 * DTSBE321 00017 * IF THE PENALTY ASSESSMENT PROCESS IS RUN IMMEDIATELY DTSBE321 00018 * AFTER A DAILY UPDATE RUN, NOTHING TOO TERRIBLE WILL DTSBE321 00019 * OCCUR. THE BTC RECORDS GENERATED BY DTSBE321 WILL NOT DTSBE321 00020 * BE CONVERTED TO TAX ACCOUNTING ADJUSTMENT TRANSACTIONS DTSBE321 00021 * AND THE TAX ACCOUNTING ADJUSTMENT TRANSACTIONS POSTED DTSBE321 00022 * TO THE EMPLOYER ACCOUNTS UNTIL THE FOLLOWING WORK DAY. DTSBE321 00023 * THUS, DURING THE NEXT WORK DAY, STAFF USING CICS TO DTSBE321 00024 * DISPLAY EMPLOYER ACCOUNT INFORMATION WILL NOT SEE THE DTSBE321 00025 * PENALTY CHARGED AMOUNTS ASSESSED BY DTSBE321. DTSBE321 00026 * DTSBE321 00027 * NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE DTSBE321 00028 * NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE DTSBE321 00029 * NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE DTSBE321 00030 * DTSBE321 00031 * DTSBE321 00032 * FUNCTION: ANNUAL PENALTY ASSESSMENT. DTSBE321 00033 * DTSBE321 00034 * DTSBE321 00035 * MODIFICATION LOG: DTSBE321 00036 * DTSBE321 00037 * 05/15/2002 INITIAL DEVELOPMENT. COPIED FROM DTSBE320. DTSBE321 00038 * REFERENCE: HOUSEHOLD PROGRAMM: ZL1 DTSBE321 00039 * DTSBE321 00040 * 05/06/2004 UPDATED FOR NEW VERSION OF DTSIL102 DTSBE321 00041 * REFERENCE: PROGRAMM: GD DTSBE321 00042 * DTSBE321 00043 * 06/08/2005 UPDATED FOR NEW PENALTY PROCESS. DTSBE321 00044 * REFERENCE: DIR 107 PROGRAMM: GD DTSBE321 00045 * DTSBE321 00046 * 09/10/2007 UPDATED P2000 TO PASS LECM-CURR-RUN-DATE TO DTSBE321 00047 * 09/10/2007 NEW FIELD L102-CURR-RUN-DATE DTSBE321 00048 * REFERENCE: PROGRAMM: ZL1 DTSBE321 00049 * DTSBE321 00050 * 03/10/2013 UPDATED TO INCLUDE TIMELY PAYMENTS FOR DTSBE321 00051 * CALCULATIONS INSTEAD OF BALANCE DUE AMT DTSBE321 00052 * REFERENCE: PROGRAMM: ZL1 DTSBE321 00053 * DTSBE321 00054 * DTSBE321 00055 * 03/15/2014 UPDATED TO INCLUDE PRINTING LATE PENALTY DTSBE321 00056 * NOTICES AND MISSING REPORTS NOTICES ALSO DTSBE321 00057 * ADD EVENT LOG RECORD FOR EACH OCCURANCE DTSBE321 00058 * AND READ TRANSACTION FILE FOR ANY REPORT DTSBE321 00059 * WAITING TO BE PROCESSED. DTSBE321 00060 * REFERENCE: PROGRAMM: ZL1 DTSBE321 00061 * DTSBE321 00062 * 06/19/2014 THIS PROGRAM RUNS BEFORE THE DAILY UPDATES TO CL**2 00063 * CREATE TRANSACTIONS FOR PENALTY AND MISSING CL**2 00064 * REPORTS. ANY ICESA SUBMITTIONS PROCESSED DURING CL**2 00065 * THE DAY WERE BEING MISSED AS THE TRANSACTION WERE CL**2 00066 * NOT YET PROCESSED BY THE DAILY UPDATE THERFORE CL**2 00067 * THIS PROGRAM COUNTED AS MISSING AND GENERATED A CL**2 00068 * MISSING REPORT NOTICE ALONG WITH A PENALTY. TO CL**2 00069 * RESOLVE THIS ISSUE MODIFIED PROGRAM TO READ THE CL**2 00070 * REPORT FILE BX212 CREATED BY THE ICESA UPLOAD CL**2 00071 * TO BYPASS ANY EMPLOYER FOUND ON THE ICESA FILE CL**2 00072 * AND NOT GENERATE ANY MISSING REPORT NOTICE. CL**2 00073 * REFERENCE: PROGRAMMER: ZL1 CL**2 00074 * CL**3 00075 * 04/15/2015 MODIFIED PROGRAM TO CHECKFOR LIABILE QUARTERS CL**3 00076 * ONLY. IF ALL LIABLE QUARTERS ARE FILED FOR CL**3 00077 * ANNUAL FILERS A COMPLETE REPORT IS MARKED. CL**3 00078 * CHANGED YEAR IN PROGRAM FOR EACH RUN. CL*28 00079 * REFERENCE: PROGRAMM: ZL1 CL**3 00080 * CL**3 00081 * 05/05/2020 MODIFIED PROGRAM TO CHECK SOL RECORDS FOR THE CL*61 00082 * FIRST LIAB QUARTER. IF THE FIRST LIAB QUARTER CL*61 00083 * IS GREATER THAN THE CURRENT QTR DO NOT INCLUDE CL*61 00084 * IN THIS RUN. CL*61 00085 * REFERENCE: PROGRAMM: ZL1 CL*61 00086 * CL*61 00087 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**2 00088 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBE321 00089 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBE321 00090 * DTSBE321 00091 * DTSBE321 00092 * DESCRIPTION: DTSBE321 00093 * DTSBE321 00094 * SEE SECTION 3.3.3.4 OF DC REQUIREMENTS. DTSBE321 00095 * DTSBE321 00096 * DTSBE321 00097 * RECORDS READ: DTSBE321 00098 * DTSBE321 00099 * MASTER: DTSBE321 00100 * DTSBE321 00101 * MHDR DTSBE321 00102 * MQTR DTSBE321 00103 * MRPT DTSBE321 00104 * DTSBE321 00105 * DTSBE321 00106 * ALTERNATE INDEX: DTSBE321 00107 * DTSBE321 00108 * NONE. DTSBE321 00109 * DTSBE321 00110 * DTSBE321 00111 * REFERENCE: DTSBE321 00112 * DTSBE321 00113 * FQTR DTSBE321 00114 * DTSBE321 00115 * DTSBE321 00116 * RECORDS UPDATED: DTSBE321 00117 * DTSBE321 00118 * MHDR (REWRITE) DTSBE321 00119 * DTSBE321 00120 * DTSBE321 00121 * REPORT RECORDS WRITTEN: DTSBE321 00122 * DTSBE321 00123 * NONE. DTSBE321 00124 * DTSBE321 00125 * DTSBE321 00126 * BATCH TRANSACTION COLLECTION RECORDS WRITTEN: DTSBE321 00127 * DTSBE321 00128 * T026. DTSBE321 00129 * DTSBE321 00130 * DTSBE321 00131 * MODULES CALLED: DTSBE321 00132 * DTSBE321 00133 * DTSBU001 DATE CONVERSION/EDIT. DTSBE321 00134 * DTSBU004 QUARTER CONVERSION/EDIT. DTSBE321 00135 * DTSBU103 PENALTY CHARGE CALCULATION (ANNUAL). DTSBE321 00136 * DTSBU910 MASTER FILE I/O DRIVER. DTSBE321 00137 * DTSBU931 REFERENCE FILE I/O DRIVER. DTSBE321 00138 * DTSBU946 VARIABLE LENGTH RECORDS SEQUENTIAL OUTPUT 1. DTSBE321 00139 * DTSBU947 VARIABLE LENGTH RECORDS SEQUENTIAL OUTPUT 2. DTSBE321 00140 * DTSBE321 00141 ****** DTSBE321 00142 DTSBE321 00143 DTSBE321 00144 ENVIRONMENT DIVISION. DTSBE321 00145 INPUT-OUTPUT SECTION. DTSBE321 00146 FILE-CONTROL. DTSBE321 00147 SELECT PENALTY-FILE ASSIGN TO DTSFTPEN DTSBE321 00148 FILE STATUS IS PENALTY-STATUS. DTSBE321 00149 CL**2 00150 SELECT EMP-RPT-FILE ASSIGN TO DTSBX212 CL**2 00151 FILE STATUS IS PENALTY-STATUS. CL**2 00152 DTSBE321 00153 DATA DIVISION. DTSBE321 00154 FILE SECTION. DTSBE321 00155 DTSBE321 00156 FD PENALTY-FILE DTSBE321 00157 RECORDING MODE IS F DTSBE321 00158 LABEL RECORDS ARE STANDARD DTSBE321 00159 BLOCK CONTAINS 0 CHARACTERS. DTSBE321 00160 SKIP1 DTSBE321 00161 01 PENALTY-REC PIC X(130). CL*34 00162 FD EMP-RPT-FILE CL**2 00163 RECORDING MODE IS F CL**2 00164 BLOCK CONTAINS 0 RECORDS CL**2 00165 LABEL RECORDS ARE OMITTED. CL**2 00166 CL**2 00167 01 EMP-RPT-REC PIC X(106). CL**2 00168 CL**2 00169 DTSBE321 00170 WORKING-STORAGE SECTION. DTSBE321 001705 77 PAN-VALET PICTURE X(24) VALUE '062DTSBE321 05/03/21'. DTSBE321 00171 77 PAN-VALET PICTURE X(24) VALUE '009DTSBE321 04/25/14'. DTSBE321 00172 77 PAN-VALET PICTURE X(24) VALUE '176DTSBE321 04/24/14'. DTSBE321 00173 77 PAN-VALET PICTURE X(24) VALUE '007DTSBE321 08/18/08'. DTSBE321 00174 DTSBE321 00175 01 WRK-AREA. DTSBE321 00176 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +321.DTSBE321 00177 DTSBE321 00178 05 ABEND-MSG PIC X(60). DTSBE321 00179 DTSBE321 00180 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBE321'.DTSBE321 00181 DTSBE321 00182 05 ALL-NINES-DATE PIC S9(09) COMP-3 DTSBE321 00183 VALUE +999999999. DTSBE321 00184 DTSBE321 00185 05 WS-LIAB-QTR-RPT-MISSING PIC 9(05) VALUE 0. CL**5 00186 05 WRK-PARM-SUBJECT-YRQ PIC S9(05) COMP-3. DTSBE321 00187 05 WRK-END-SUBJECT-YRQ PIC S9(05) COMP-3 CL*51 00188 VALUE +20204. CL*62 00189 05 WRK-SUBJECT-SLASH-QTR PIC X(04). DTSBE321 00190 DTSBE321 00191 05 WRK-UC30H-DEL-YRQ PIC S9(05) COMP-3. DTSBE321 00192 05 WRK-MSOL-CNT PIC S9(05) VALUE 0. CL*54 00193 05 WRK-SUB-YRQ PIC 9(05) VALUE 0. CL*60 00194 DTSBE321 00195 05 WRK-FIRST-YRQ PIC S9(05) COMP-3 CL*55 00196 VALUE +0. CL*55 00197 CL*53 00198 05 WRK-FIRST-ANN-YRQ PIC S9(05) COMP-3 CL*53 00199 VALUE +20021. DTSBE321 00200 DTSBE321 00201 05 WRK-LAST-LIAB-YRQ PIC S9(05) COMP-3 CL*23 00202 VALUE +0. CL*23 00203 05 WRK-YRQ PIC S9(05) COMP-3. DTSBE321 00204 05 WRK-TOLERANCE-AMT PIC S9(09)V99 COMP-3 CL*39 00205 * VALUE +100.00. CL*39 00206 VALUE +50.00. CL*39 00207 DTSBE321 00208 05 WRK-YRQ1-MISSING PIC S9(05) COMP-3 VALUE 0. CL*26 00209 05 WRK-YRQ2-MISSING PIC S9(05) COMP-3 VALUE 0. CL*26 00210 05 WRK-YRQ3-MISSING PIC S9(05) COMP-3 VALUE 0. CL*26 00211 05 WRK-YRQ4-MISSING PIC S9(05) COMP-3 VALUE 0. CL*26 00212 CL**4 00213 05 WRK-ERROR-IND PIC X(01). DTSBE321 00214 88 WRK-ERROR-NO-88 VALUE 'N'. DTSBE321 00215 88 WRK-ERROR-YES-88 VALUE 'Y'. DTSBE321 00216 05 WRK-MSOL-IND PIC X(01). CL*53 00217 88 WRK-MSOL-OK VALUE 'Y'. CL*53 00218 88 WRK-MSOL-NO-REC VALUE 'N'. CL*53 00219 DTSBE321 00220 05 WRK-REPORT-IND PIC X(01). DTSBE321 00221 88 WRK-REPORT-FOUND-NO-88 VALUE 'N'. DTSBE321 00222 88 WRK-REPORT-FOUND-YES-88 VALUE 'Y'. DTSBE321 00223 DTSBE321 00224 05 GENERATE-LTR-IND PIC X(01). DTSBE321 00225 88 GENERATE-NO-LTR-88 VALUE '0'. DTSBE321 00226 88 GENERATE-MISS-RPT-YES-88 VALUE '1'. DTSBE321 00227 88 GENERATE-MISS-RPT-NO-88 VALUE 'N'. DTSBE321 00228 88 GENERATE-LATE-PEN-LTR-88 VALUE '2'. DTSBE321 00229 88 GENERATE-MISS-QTR-YES-88 VALUE '3'. CL**5 00230 88 GENERATE-MISS-QTR-NO-88 VALUE 'B'. CL**5 00231 DTSBE321 00232 05 PENALTY-STATUS PIC X(02) VALUE SPACES. DTSBE321 00233 88 PENALTY-OK-88 VALUE '00'. DTSBE321 00234 DTSBE321 00235 05 WRK-FIRST-PEN-INT-YRQ PIC S9(05) COMP-3. DTSBE321 00236 05 WRK-EMP-NO PIC S9(07) COMP-3 CL**2 00237 VALUE +0. CL**2 00238 CL**2 00239 05 WRK-ICESA-YRQ. CL**2 00240 10 WRK-ICESA-CCYY PIC 9999. CL**2 00241 10 FILLER PIC X. CL**2 00242 10 WRK-ICESA-QTR PIC 9. CL**2 00243 CL**2 00244 05 WRK-RPT. CL**2 00245 10 WRK-RPT-CCYY PIC 9999. CL**2 00246 10 WRK-RPT-QTR PIC 9. CL**2 00247 05 WRK-RPT-WS REDEFINES WRK-RPT PIC 9(5). CL**2 00248 CL**2 00249 05 WRK-RPT-YRQ PIC S9(5) COMP-3 CL**2 00250 VALUE +0. CL**2 00251 CL**2 00252 DTSBE321 00253 05 WRK-DOMESTIC-CNT PIC S9(07) COMP-3 VALUE +0. CL**5 00254 05 WRK-ANN-FILER-CNT PIC S9(07) COMP-3 VALUE +0. CL**5 00255 05 WRK-PENALTY-CNT PIC S9(07) COMP-3 VALUE +0. CL**4 00256 05 WRK-T026-PEN-CNT PIC S9(07) COMP-3 VALUE +0. CL*20 00257 05 WRK-T026-MIS-CNT PIC S9(07) COMP-3 VALUE +0. CL*20 00258 05 WRK-TF-TABLE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBE321 00259 05 WRK-REP-FND-CNT PIC S9(07) COMP-3 VALUE +0. DTSBE321 00260 05 WRK-PAR-FND-CNT PIC S9(07) COMP-3 VALUE +0. CL**5 00261 05 WRK-BYPASS-CNT PIC S9(07) COMP-3 VALUE +0. DTSBE321 00262 05 WRK-LATE-LTR-CNT PIC S9(07) COMP-3 VALUE +0. DTSBE321 00263 05 WRK-MISS-LTR-CNT PIC S9(07) COMP-3 VALUE +0. DTSBE321 00264 DTSBE321 00265 05 AMT-DISP1 PIC --------9.99. DTSBE321 00266 05 AMT-DISP2 PIC --------9.99. CL*40 00267 05 AMT-DISP3 PIC --------9.99. CL*40 00268 DTSBE321 00269 05 WRK-TIMELY-PAYMENTS PIC S9(09)V9(02) COMP-3. DTSBE321 00270 * 05 WRK-TOLERANCE-AMT PIC S9(09)V9(02) COMP-3. CL*40 00271 05 TF-SUB PIC S9(07) COMP-3. DTSBE321 00272 05 TF-MAX PIC S9(07) COMP-3 DTSBE321 00273 VALUE +999999. DTSBE321 00274 05 TRANS-FILE-RPTS OCCURS 999999 TIMES. DTSBE321 00275 10 TRANS-FILE-RPT-IND PIC X(01). DTSBE321 00276 88 TF-RPT-FOUND-YES-88 VALUE 'Y'. DTSBE321 00277 88 TF-RPT-FOUND-NO-88 VALUE 'N'. DTSBE321 00278 10 TRANS-BYPASSED-IND PIC X(01). DTSBE321 00279 88 TF-BYPASSED-YES-88 VALUE 'Y'. DTSBE321 00280 88 TF-BYPASSED-NO-88 VALUE 'N'. DTSBE321 00281 DTSBE321 00282 05 W-PENALTY-REC. DTSBE321 00283 10 W-EMP-NO PIC 9(06). CL*34 00284 10 FILLER PIC X(01) VALUE ','. CL*34 00285 10 W-FEIN-NO PIC 9(09). CL*34 00286 10 FILLER PIC X(01) VALUE ','. CL*34 00287 10 W-NAME PIC X(30). CL*34 00288 10 FILLER PIC X(01) VALUE ','. CL*34 00289 10 W-CHG PIC --------9.99. CL*34 00290 10 FILLER PIC X(01) VALUE ','. CL*34 00291 10 W-PAID PIC --------9.99. CL*34 00292 10 FILLER PIC X(01) VALUE ','. CL*34 00293 10 W-BAL PIC --------9.99. CL*34 00294 10 FILLER PIC X(01) VALUE ','. CL*34 00295 10 W-PEN PIC ------9.99. CL*34 00296 10 FILLER PIC X(01) VALUE ','. CL*34 00297 10 W-NOTE PIC X(30). CL*34 00298 DTSBE321 00299 01 EVL-LOG-AREA. DTSBE321 00300 10 EVL-TEXT PIC X(27) DTSBE321 00301 VALUE 'NOTICE OF LATE PENALTY FOR '. DTSBE321 00302 10 EVL-SLASH-QTR PIC X(4). DTSBE321 00303 10 FILLER PIC X(9) DTSBE321 00304 VALUE ' MAILED '. DTSBE321 00305 10 EVL-ADDR-TYPE PIC X(04). DTSBE321 00306 10 EVL-ADDR-ID-NO PIC XXX. DTSBE321 00307 10 FILLER PIC X(03) VALUE SPACE. DTSBE321 00308 01 EVL-TEXT-MISS-LTR. DTSBE321 00309 10 FILLER PIC X(27) DTSBE321 00310 VALUE 'MISSING REPORT NOTICE FOR '. DTSBE321 00311 01 EVL-TEXT-MISS-QTR-LTR. CL**5 00312 10 FILLER PIC X(29) CL**6 00313 VALUE 'INCOMPLETE REPORT FILED FOR '. CL**5 00314 01 EVL-TEXT-PEN-LTR. DTSBE321 00315 10 FILLER PIC X(27) DTSBE321 00316 VALUE 'NOTICE OF LATE PENALTY FOR '. DTSBE321 00317 EJECT DTSBE321 00318 01 MSG-AREA. DTSBE321 00319 05 MSG1-AREA. DTSBE321 00320 10 MSG1-ID PIC X(03) VALUE '321'. DTSBE321 00321 10 MSG1-TEXT. DTSBE321 00322 15 FILLER PIC X(40) DTSBE321 00323 VALUE 'ANNUAL FILER: QUARTERLY REPORT ON FILE '. DTSBE321 00324 15 FILLER PIC X(40) DTSBE321 00325 VALUE ' '. DTSBE321 00326 EJECT DTSBE321 00327 01 W-EMP-RPT-REC. CL**2 00328 ++INCLUDE DTSIX212 CL**2 00329 CL**2 00330 01 L001-LINK-AREA. DTSBE321 00331 ++INCLUDE DTSIL001 DTSBE321 00332 EJECT DTSBE321 00333 01 L004-LINK-AREA. DTSBE321 00334 ++INCLUDE DTSIL004 DTSBE321 00335 EJECT DTSBE321 00336 01 L005-LINK-AREA. DTSBE321 00337 ++INCLUDE DTSIL005 DTSBE321 00338 EJECT DTSBE321 00339 01 L102-LINK-AREA. DTSBE321 00340 ++INCLUDE DTSIL102 DTSBE321 00341 EJECT DTSBE321 00342 01 L101-LINK-AREA. DTSBE321 00343 ++INCLUDE DTSIL101 DTSBE321 00344 EJECT DTSBE321 00345 01 L109-LINK-AREA. DTSBE321 00346 ++INCLUDE DTSIL109 DTSBE321 00347 EJECT DTSBE321 00348 01 L111-LINK-AREA. DTSBE321 00349 ++INCLUDE DTSIL111 DTSBE321 00350 EJECT DTSBE321 00351 01 L112-LINK-AREA. DTSBE321 00352 ++INCLUDE DTSIL112 DTSBE321 00353 EJECT DTSBE321 00354 01 L410-LINK-AREA. DTSBE321 00355 ++INCLUDE DTSIL410 DTSBE321 00356 EJECT DTSBE321 00357 01 L415-LINK-AREA. DTSBE321 00358 ++INCLUDE DTSIL415 DTSBE321 00359 EJECT DTSBE321 00360 01 L516-LINK-AREA. CL**6 00361 ++INCLUDE DTSIL516 CL**6 00362 EJECT CL**6 00363 01 L910-LINK-AREA. DTSBE321 00364 ++INCLUDE DTSIL910 DTSBE321 00365 SKIP3 DTSBE321 00366 01 MSKL-REC. DTSBE321 00367 ++INCLUDE DTSIMSKL DTSBE321 00368 SKIP3 DTSBE321 00369 01 R321-REC. DTSBE321 00370 ++INCLUDE DTSIR321 DTSBE321 00371 SKIP3 DTSBE321 00372 01 FAFD-REC. DTSBE321 00373 ++INCLUDE DTSIFAFD DTSBE321 00374 SKIP3 DTSBE321 00375 01 MQTR-REC. DTSBE321 00376 ++INCLUDE DTSIMQTR DTSBE321 00377 01 MEVL-REC. DTSBE321 00378 ++INCLUDE DTSIMEVL DTSBE321 00379 01 MSOL-REC. CL*53 00380 ++INCLUDE DTSIMSOL CL*53 00381 SKIP3 DTSBE321 00382 01 L923-LINK-AREA. DTSBE321 00383 ++INCLUDE DTSIL923 DTSBE321 00384 EJECT DTSBE321 00385 01 ASKL-REC. DTSBE321 00386 ++INCLUDE DTSIASKL DTSBE321 00387 EJECT DTSBE321 00388 01 ARPT-REC. DTSBE321 00389 ++INCLUDE DTSIARPT DTSBE321 00390 SKIP3 DTSBE321 00391 01 MRPT-REC. DTSBE321 00392 ++INCLUDE DTSIMRPT DTSBE321 00393 SKIP3 DTSBE321 00394 01 MDST-REC. DTSBE321 00395 ++INCLUDE DTSIMDST DTSBE321 00396 EJECT DTSBE321 00397 01 L931-LINK-AREA. DTSBE321 00398 ++INCLUDE DTSIL931 DTSBE321 00399 SKIP3 DTSBE321 00400 01 FSKL-REC. DTSBE321 00401 ++INCLUDE DTSIFSKL DTSBE321 00402 SKIP3 DTSBE321 00403 01 FQTR-REC. DTSBE321 00404 ++INCLUDE DTSIFQTR DTSBE321 00405 EJECT DTSBE321 00406 01 R907-REC. DTSBE321 00407 ++INCLUDE DTSIR907 DTSBE321 00408 EJECT DTSBE321 00409 01 L927-LINK-AREA. DTSBE321 00410 ++INCLUDE DTSIL927 DTSBE321 00411 SKIP3 DTSBE321 00412 01 T026-REC. DTSBE321 00413 ++INCLUDE DTSIT026 DTSBE321 00414 EJECT DTSBE321 00415 01 CACT-LITERALS. DTSBE321 00416 ++INCLUDE DTSICACT DTSBE321 00417 EJECT DTSBE321 00418 LINKAGE SECTION. DTSBE321 00419 SKIP3 DTSBE321 00420 01 LECM-LINK-AREA. DTSBE321 00421 ++INCLUDE DTSILECM DTSBE321 00422 SKIP3 DTSBE321 00423 10 FILLER REDEFINES LECM-EXTRACT-PARMS. DTSBE321 00424 15 LECM-PARM-SUBJECT-YRQ PIC X(03). DTSBE321 00425 15 FILLER PIC X(65). DTSBE321 00426 EJECT DTSBE321 00427 01 MPRF-LINK-REC. DTSBE321 00428 ++INCLUDE DTSIMPRF DTSBE321 00429 EJECT DTSBE321 00430 PROCEDURE DIVISION USING LECM-LINK-AREA DTSBE321 00431 MPRF-LINK-REC. DTSBE321 00432 DTSBE321 00433 EVALUATE TRUE DTSBE321 00434 WHEN LECM-PROCESS-88 DTSBE321 00435 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBE321 00436 DTSBE321 00437 WHEN LECM-INITIALIZE-88 DTSBE321 00438 PERFORM I0000-INITIALIZE THRU I0000-EXIT DTSBE321 00439 DTSBE321 00440 WHEN LECM-TERMINATE-88 DTSBE321 00441 PERFORM T0000-TERMINATE THRU T0000-EXIT DTSBE321 00442 DTSBE321 00443 WHEN OTHER DTSBE321 00444 MOVE 'INVALID LECM-CALL-TYPE-IND ENCOUNTERED' DTSBE321 00445 TO ABEND-MSG DTSBE321 00446 PERFORM S999-ABEND THRU S999-EXIT. DTSBE321 00447 DTSBE321 00448 DTSBE321 00449 GOBACK. DTSBE321 00450 EJECT DTSBE321 00451 I0000-INITIALIZE. DTSBE321 00452 MOVE LECM-TRACE-IND TO L910-TRACE-IND DTSBE321 00453 L931-TRACE-IND. DTSBE321 00454 DTSBE321 00455 MOVE WRK-MOD-NAME TO L910-MOD-NAME DTSBE321 00456 L931-MOD-NAME DTSBE321 00457 R907-MODULE-NAME. DTSBE321 00458 DTSBE321 00459 DTSBE321 00460 MOVE LENGTH OF R907-REC TO R907-LENGTH. DTSBE321 00461 DTSBE321 00462 MOVE '907' TO R907-REC-TYPE. DTSBE321 00463 DTSBE321 00464 MOVE LENGTH OF T026-REC TO T026-LENGTH. DTSBE321 00465 DTSBE321 00466 MOVE '026' TO T026-REC-TYPE. DTSBE321 00467 DTSBE321 00468 MOVE LENGTH OF R321-REC TO R321-LENGTH. DTSBE321 00469 DTSBE321 00470 MOVE '321' TO R321-REC-TYPE. DTSBE321 00471 DTSBE321 00472 MOVE WRK-MOD-NAME TO T026-ORIGIN. DTSBE321 00473 DTSBE321 00474 MOVE LECM-SYS-DATE TO T026-SYS-DATE. DTSBE321 00475 DTSBE321 00476 MOVE LECM-SYS-TIME TO T026-SYS-TIME. DTSBE321 00477 DTSBE321 00478 DTSBE321 00479 PERFORM I1000-EDIT-AND-DEFAULT-PARMS THRU I1000-EXIT. DTSBE321 00480 DTSBE321 00481 DTSBE321 00482 IF WRK-PARM-SUBJECT-YRQ > WRK-UC30H-DEL-YRQ DTSBE321 00483 MOVE WRK-PARM-SUBJECT-YRQ DTSBE321 00484 TO WRK-UC30H-DEL-YRQ. DTSBE321 00485 DTSBE321 00486 PERFORM S109-FIRST-PEN-INT-YRQ THRU S109-EXIT. DTSBE321 00487 MOVE L109-FIRST-PEN-INT-YRQ TO WRK-FIRST-PEN-INT-YRQ. DTSBE321 00488 DTSBE321 00489 OPEN OUTPUT PENALTY-FILE DTSBE321 00490 IF NOT PENALTY-OK-88 DTSBE321 00491 DISPLAY 'CANNOT OPEN PENALTY FILE- PROGRAM WILL DIE ' CL**9 00492 PENALTY-STATUS DTSBE321 00493 PERFORM S999-ABEND THRU S999-EXIT CL**9 00494 END-IF. DTSBE321 00495 CL**2 00496 OPEN INPUT EMP-RPT-FILE CL**2 00497 IF NOT PENALTY-OK-88 CL**2 00498 DISPLAY 'CANNOT OPEN ICESA FILE- PROGRAM WILL DIE ' CL**9 00499 PENALTY-STATUS CL**2 00500 PERFORM S999-ABEND THRU S999-EXIT CL**9 00501 END-IF. CL**2 00502 CL**2 00503 DTSBE321 00504 PERFORM I3000-TRANS-FILE-RPTS THRU I3000-EXIT. DTSBE321 00505 DTSBE321 00506 ** SET LECM-MST-OPEN-UPDATE-HDR-88 TO TRUE. DTSBE321 00507 SET LECM-MST-OPEN-UPDATE-88 TO TRUE. DTSBE321 00508 DTSBE321 00509 SET LECM-REF-OPEN-UPDATE-88 TO TRUE. DTSBE321 00510 DTSBE321 00511 I0000-EXIT. DTSBE321 00512 EXIT. DTSBE321 00513 SKIP3 DTSBE321 00514 I1000-EDIT-AND-DEFAULT-PARMS. DTSBE321 00515 SET L415-MODE-MOST-RECENT-88 TO TRUE. DTSBE321 00516 PERFORM S415-HOUSEHOLD-DATES THRU S415-EXIT. DTSBE321 00517 IF L415-OK-88 DTSBE321 00518 MOVE L415-UC30H-FIRST-DEL-STRT-YRQ DTSBE321 00519 TO WRK-UC30H-DEL-YRQ DTSBE321 00520 ELSE DTSBE321 00521 MOVE ZEROS TO WRK-UC30H-DEL-YRQ. DTSBE321 00522 DTSBE321 00523 IF LECM-PARM-SUBJECT-YRQ = SPACES DTSBE321 00524 AND WRK-UC30H-DEL-YRQ = ZEROS DTSBE321 00525 MOVE 'PARM-SUBJECT-YRQ REQUIRED ' TO ABEND-MSG DTSBE321 00526 PERFORM S999-ABEND THRU S999-EXIT. DTSBE321 00527 DTSBE321 00528 DTSBE321 00529 IF LECM-PARM-SUBJECT-YRQ = SPACES DTSBE321 00530 MOVE WRK-UC30H-DEL-YRQ TO L004-QTR-5-9 DTSBE321 00531 ADD 1 TO L004-QTR-5-YR DTSBE321 00532 PERFORM S004-FROM-5 THRU S004-EXIT DTSBE321 00533 MOVE L004-QTR-5-9 TO WRK-PARM-SUBJECT-YRQ DTSBE321 00534 ELSE DTSBE321 00535 MOVE LECM-PARM-SUBJECT-YRQ TO L004-QTR-3-X DTSBE321 00536 MOVE '1' TO L004-QTR-3-Q-X DTSBE321 00537 PERFORM S004-FROM-3 THRU S004-EXIT DTSBE321 00538 IF L004-VALID-QTR DTSBE321 00539 MOVE L004-QTR-5-9 TO WRK-PARM-SUBJECT-YRQ DTSBE321 00540 ELSE DTSBE321 00541 MOVE 'PARM-SUBJECT-YRQ NOT VALID' DTSBE321 00542 TO ABEND-MSG DTSBE321 00543 PERFORM S999-ABEND THRU S999-EXIT. DTSBE321 00544 DTSBE321 00545 DISPLAY 'BE321 SUBJECT START YRQ ' WRK-PARM-SUBJECT-YRQ CL*49 00546 DISPLAY SPACE. DTSBE321 00547 MOVE WRK-PARM-SUBJECT-YRQ TO WRK-SUB-YRQ. CL*60 00548 MOVE WRK-SUB-YRQ TO L004-QTR-5-AREA CL*60 00549 MOVE '4' TO L004-QTR-5-Q CL*53 00550 DISPLAY ' SUB YRQ ' WRK-SUB-YRQ CL*60 00551 DISPLAY ' ZND YRQ ' L004-QTR-5-9 CL*60 00552 PERFORM S004-FROM-5 THRU S004-EXIT CL*53 00553 IF L004-VALID-QTR CL*53 00554 MOVE L004-QTR-5-9 TO WRK-END-SUBJECT-YRQ CL*53 00555 ELSE CL*53 00556 DISPLAY ' END YRQ ' L004-QTR-5-9 CL*56 00557 MOVE 'END-SUBJECT-YRQ NOT VALID' CL*53 00558 TO ABEND-MSG CL*53 00559 PERFORM S999-ABEND THRU S999-EXIT. CL*53 00560 CL*49 00561 DISPLAY 'BE321 SUBJECT ENDIN YRQ ' WRK-END-SUBJECT-YRQ CL*51 00562 DISPLAY SPACE. CL*49 00563 DTSBE321 00564 IF WRK-UC30H-DEL-YRQ = ZEROS DTSBE321 00565 GO TO I1000-EXIT. DTSBE321 00566 DTSBE321 00567 MOVE WRK-UC30H-DEL-YRQ TO L004-QTR-5-9. DTSBE321 00568 ADD 1 TO L004-QTR-5-YR. DTSBE321 00569 DTSBE321 00570 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBE321 00571 DTSBE321 00572 IF L004-QTR-5-9 = WRK-PARM-SUBJECT-YRQ DTSBE321 00573 NEXT SENTENCE DTSBE321 00574 ELSE DTSBE321 00575 DISPLAY 'BE321 UC30H +1 YRQ ' L004-QTR-5-9 DTSBE321 00576 DISPLAY 'BE321 WRK PARM YRQ ' WRK-PARM-SUBJECT-YRQ DTSBE321 00577 MOVE DTSBE321 00578 'PARM-SUBJECT-YRQ NOT COMPATIBLE WITH WRK-UC30-DEL-YRQ' DTSBE321 00579 TO ABEND-MSG DTSBE321 00580 PERFORM S999-ABEND THRU S999-EXIT. DTSBE321 00581 I1000-EXIT. DTSBE321 00582 EXIT. DTSBE321 00583 EJECT DTSBE321 00584 I3000-TRANS-FILE-RPTS. DTSBE321 00585 PERFORM DTSBE321 00586 VARYING TF-SUB FROM +1 BY +1 DTSBE321 00587 UNTIL TF-SUB > TF-MAX DTSBE321 00588 SET TF-RPT-FOUND-NO-88 (TF-SUB) TO TRUE DTSBE321 00589 SET TF-BYPASSED-NO-88 (TF-SUB) TO TRUE DTSBE321 00590 END-PERFORM. DTSBE321 00591 DTSBE321 00592 PERFORM S923-OPEN-READ THRU S923-EXIT. DTSBE321 00593 DTSBE321 00594 MOVE ZERO TO ASKL-BATCH-NO DTSBE321 00595 ASKL-ITEM-NO. DTSBE321 00596 DTSBE321 00597 PERFORM S923-START-BROWSE THRU S923-EXIT. DTSBE321 00598 PERFORM UNTIL L923-NO-REC-88 DTSBE321 00599 IF ASKL-RPT-88 DTSBE321 00600 MOVE ASKL-REC TO ARPT-REC DTSBE321 00601 * PERFORM I3300-TRANS-ARPT THRU I3300-EXIT CL*27 00602 IF (ARPT-ORIG-88 DTSBE321 00603 AND ARPT-YRQ = WRK-PARM-SUBJECT-YRQ DTSBE321 00604 AND ARPT-NOT-PROCESSED-88) DTSBE321 00605 IF NOT ARPT-EMP-NO-NO-ENTRY-88 DTSBE321 00606 SET TF-RPT-FOUND-YES-88 (ARPT-EMP-NO) TO TRUE DTSBE321 00607 ADD +1 TO WRK-TF-TABLE-CNT DTSBE321 00608 * DISPLAY 'I3 ' ARPT-EMP-NO ' ' ARPT-BATCH-NO CL*27 00609 * ' ' ARPT-ITEM-NO CL*27 00610 END-IF DTSBE321 00611 END-IF DTSBE321 00612 END-IF DTSBE321 00613 PERFORM S923-READ-NEXT THRU S923-EXIT DTSBE321 00614 END-PERFORM. DTSBE321 00615 DTSBE321 00616 PERFORM S923-CLOSE THRU S923-EXIT. DTSBE321 00617 PERFORM I4000-TRANS-ICESA THRU I4000-EXIT. CL**2 00618 CL**2 00619 I3000-EXIT. CL**2 00620 EXIT. CL**2 00621 I3300-TRANS-ARPT. CL*10 00622 DISPLAY ARPT-BATCH-NO ' ' ARPT-ITEM-NO ' ' CL*10 00623 ARPT-YRQ ' ' ARPT-EMP-NO ' ' CL*10 00624 ARPT-RECEIVED-DATE ' ' CL*10 00625 ARPT-DEPOSIT-DATE ' ' CL*10 00626 ARPT-REMIT-AMT. CL*10 00627 I3300-EXIT. CL*11 00628 EXIT. CL*10 00629 CL*10 00630 I4000-TRANS-ICESA. CL**2 00631 READ EMP-RPT-FILE INTO W-EMP-RPT-REC AT END CL**2 00632 GO TO I4000-EXIT. CL**2 00633 MOVE X212-EMP-NBR TO WRK-EMP-NO CL**2 00634 MOVE '2020/1' TO WRK-ICESA-YRQ CL*62 00635 MOVE WRK-ICESA-CCYY TO WRK-RPT-CCYY CL**2 00636 MOVE WRK-ICESA-QTR TO WRK-RPT-QTR CL**2 00637 CL**2 00638 MOVE WRK-RPT-WS TO WRK-RPT-YRQ. CL**2 00639 * CL*15 00640 * FOR ANNAUL FILERS ALWAYS SET QTR TO 1 CL*15 00641 * CL*15 00642 IF WRK-RPT-YRQ = WRK-PARM-SUBJECT-YRQ CL**2 00643 SET TF-RPT-FOUND-YES-88 (WRK-EMP-NO) TO TRUE CL**2 00644 DISPLAY 'EMPLR BYPASSED: ' WRK-EMP-NO ' ' WRK-RPT-YRQ CL*19 00645 ADD +1 TO WRK-TF-TABLE-CNT. CL**2 00646 CL**2 00647 GO TO I4000-TRANS-ICESA. CL**2 00648 I4000-EXIT. CL**2 00649 EXIT. CL**2 00650 P0000-PROCESS. DTSBE321 00651 DTSBE321 00652 MOVE MPRF-EMP-NO TO R907-EMP-NO. DTSBE321 00653 IF MPRF-STATUS-ACT-88 CL*25 00654 IF MPRF-STATUS-SUB-88 DTSBE321 00655 IF MPRF-ORG-HSEHLD-DMSTIC-88 DTSBE321 00656 NEXT SENTENCE DTSBE321 00657 ELSE DTSBE321 00658 GO TO P0000-EXIT DTSBE321 00659 ELSE DTSBE321 00660 GO TO P0000-EXIT CL*25 00661 ELSE CL*25 00662 GO TO P0000-EXIT. CL*25 00663 CL**3 00664 MOVE ZEROS TO WS-LIAB-QTR-RPT-MISSING CL**4 00665 SET GENERATE-NO-LTR-88 TO TRUE DTSBE321 00666 SET GENERATE-MISS-RPT-NO-88 TO TRUE DTSBE321 00667 SET GENERATE-MISS-QTR-NO-88 TO TRUE CL**4 00668 SET WRK-REPORT-FOUND-NO-88 TO TRUE. DTSBE321 00669 DTSBE321 00670 SET L410-MODE-INPUT-YRQ-88 TO TRUE. DTSBE321 00671 MOVE MPRF-EMP-NO TO L410-EMP-NO. DTSBE321 00672 MOVE WRK-PARM-SUBJECT-YRQ TO L410-YRQ DTSBE321 00673 PERFORM S410-FILE-SCHED THRU S410-EXIT. DTSBE321 00674 DTSBE321 00675 IF NOT L410-ANN-SCHED-88 DTSBE321 00676 ADD 1 TO WRK-DOMESTIC-CNT CL**4 00677 GO TO P0000-EXIT. DTSBE321 00678 CL*53 00679 PERFORM P0900-LIABLE-MSOL THRU P0900-EXIT. CL*53 00680 CL*49 00681 IF WRK-FIRST-YRQ > WRK-END-SUBJECT-YRQ CL*53 00682 ADD 1 TO WRK-DOMESTIC-CNT CL*49 00683 DISPLAY ' LIABILITY STARTS NEXT YEAR: ' MPRF-EMP-NO CL*50 00684 ' ' WRK-FIRST-YRQ CL*53 00685 GO TO P0000-EXIT. CL*49 00686 CL*49 00687 ADD 1 TO WRK-ANN-FILER-CNT. CL**3 00688 CL**3 00689 * DISPLAY ' EMP ANNUAL FILER: ' MPRF-EMP-NO CL*36 00690 CL*34 00691 MOVE ZEROS TO L102-TAX-BALANCE-AMT CL*34 00692 L102-LATE-PEN-CHARGE-CHNG CL*34 00693 L102-TAX-CHARGED-AMT CL*34 00694 WRK-TIMELY-PAYMENTS. CL*34 00695 CL*34 00696 IF TF-RPT-FOUND-YES-88 (MPRF-EMP-NO) CL*20 00697 SET TF-BYPASSED-YES-88 (MPRF-EMP-NO) TO TRUE CL*20 00698 ADD +1 TO WRK-BYPASS-CNT CL*20 00699 DISPLAY ' ANNUAL REPORT FOUND IN TRANS ' MPRF-EMP-NO CL*20 00700 GO TO P0000-EXIT. CL*20 00701 CL**3 00702 PERFORM P1000-LIABLE-QTRS THRU P1000-EXIT. DTSBE321 00703 DTSBE321 00704 IF WRK-REPORT-FOUND-NO-88 DTSBE321 00705 ADD 1 TO WRK-MISS-LTR-CNT DTSBE321 00706 SET GENERATE-MISS-RPT-YES-88 TO TRUE DTSBE321 00707 PERFORM P3000-GENERATE-T026 THRU P3000-EXIT DTSBE321 00708 PERFORM P2500-GEN-MISS-R321 THRU P2500-EXIT DTSBE321 00709 PERFORM P2600-GENERATE-ELOG THRU P2600-EXIT DTSBE321 00710 MOVE 100.00 TO W-PEN CL*34 00711 MOVE ' *** MISSING REPORT' TO W-NOTE CL*34 00712 PERFORM P4000-WRITE-RPT THRU P4000-EXIT CL*34 00713 GO TO P0000-EXIT. CL*30 00714 * ELSE CL*30 00715 * DISPLAY ' ANNUAL FILER REPORT FOUND ' MPRF-EMP-NO. CL*30 00716 CL**4 00717 IF WS-LIAB-QTR-RPT-MISSING > 0 CL**4 00718 ADD +1 TO WRK-PAR-FND-CNT CL**7 00719 * DISPLAY ' PARTIAL REPORT FILED ' MPRF-EMP-NO CL*34 00720 SET GENERATE-MISS-QTR-YES-88 TO TRUE CL**4 00721 PERFORM P2550-GEN-MISS-QTR-R321 THRU P2550-EXIT CL**4 00722 PERFORM P2650-GEN-MISS-ELOG THRU P2650-EXIT CL**4 00723 MOVE ' *** PARTIAL REPORT' TO W-NOTE CL*34 00724 PERFORM P4000-WRITE-RPT THRU P4000-EXIT CL*34 00725 * GO TO P0000-EXIT CL*41 00726 ELSE CL**4 00727 * DISPLAY MPRF-EMP-NO ' ' MPRF-FEIN ' ' MPRF-PRIMARY-NAME CL*33 00728 * ' *** REPORT FILED ' CL*33 00729 ADD +1 TO WRK-REP-FND-CNT. DTSBE321 00730 DTSBE321 00731 IF WRK-ERROR-YES-88 DTSBE321 00732 DISPLAY ' ANN EMP FILED QTRLY RPT: ' MPRF-EMP-NO CL**3 00733 GO TO P0000-EXIT. DTSBE321 00734 DTSBE321 00735 IF WRK-LAST-LIAB-YRQ = ZERO DTSBE321 00736 DISPLAY ' EMP LAST LIAB QTR = 0 ' MPRF-EMP-NO DTSBE321 00737 GO TO P0000-EXIT. DTSBE321 00738 DTSBE321 00739 PERFORM P2000-INITIALIZE-L102 THRU P2000-EXIT. DTSBE321 00740 CL*39 00741 IF L102-TAX-CHARGED-AMT = ZEROS OR CL*39 00742 L102-TAX-BALANCE-AMT = ZEROS OR CL*39 00743 L102-LATE-PEN-CHARGED-AMT > ZEROS CL*39 00744 GO TO P0000-EXIT. CL*39 00745 CL*39 00746 MOVE L102-TAX-CHARGED-AMT TO AMT-DISP3 CL*39 00747 MOVE L102-TAX-BALANCE-AMT TO AMT-DISP1 CL*39 00748 MOVE WRK-TIMELY-PAYMENTS TO AMT-DISP2 CL*39 00749 DISPLAY 'PEN YR20 ' MPRF-EMP-NO ' ' MPRF-EMP-CLASS CL*62 00750 ' RCVD ' L102-OR-RECEIVED-DATE CL*39 00751 ' CHRG ' AMT-DISP3 CL*39 00752 ' PAID ' AMT-DISP2 CL*39 00753 ' BALN ' AMT-DISP1 CL*39 00754 CL*39 00755 IF L102-TAX-BALANCE-AMT < WRK-TOLERANCE-AMT AND CL*39 00756 WRK-TIMELY-PAYMENTS > ZEROS CL*39 00757 MOVE 100 TO L102-LATE-PEN-CHARGE-CHNG CL*39 00758 MOVE L102-LATE-PEN-CHARGE-CHNG TO CL*39 00759 L102-LATE-PEN-WAIVE-CHNG CL*39 00760 MOVE L102-TAX-BALANCE-AMT TO AMT-DISP2 CL*39 00761 MOVE WRK-TIMELY-PAYMENTS TO AMT-DISP1 CL*39 00762 DISPLAY 'PEN WAIVE ' MPRF-EMP-NO ' ' MPRF-EMP-CLASS CL*39 00763 ' RCVD ' L102-OR-RECEIVED-DATE CL*39 00764 ' BAL ' AMT-DISP2 CL*39 00765 ' PAID ' AMT-DISP1 CL*39 00766 PERFORM P3000-GENERATE-T026 THRU P3000-EXIT CL*39 00767 PERFORM P2600-GENERATE-ELOG THRU P2600-EXIT CL*39 00768 MOVE ' *** PENALTY WAIVED ' TO W-NOTE CL*42 00769 PERFORM P4000-WRITE-RPT THRU P4000-EXIT CL*42 00770 GO TO P0000-EXIT. CL*39 00771 CL*39 00772 IF L102-TAX-BALANCE-AMT < WRK-TOLERANCE-AMT AND CL*39 00773 WRK-TIMELY-PAYMENTS = ZEROS CL*39 00774 MOVE 100 TO L102-LATE-PEN-CHARGE-CHNG CL*39 00775 MOVE L102-TAX-CHARGED-AMT TO AMT-DISP2 CL*39 00776 MOVE WRK-TIMELY-PAYMENTS TO AMT-DISP1 CL*39 00777 DISPLAY 'PEN GIVEN ' MPRF-EMP-NO ' ' MPRF-EMP-CLASS CL*40 00778 ' RCVD ' L102-OR-RECEIVED-DATE CL*39 00779 ' CHRG ' AMT-DISP2 CL*39 00780 ' PAID ' AMT-DISP1 CL*39 00781 SET GENERATE-LATE-PEN-LTR-88 TO TRUE CL*39 00782 * ADD 1 TO WRK-PEN-LTR-CNT CL*40 00783 PERFORM P3000-GENERATE-T026 THRU P3000-EXIT CL*39 00784 PERFORM P2500-GEN-MISS-R321 THRU P2500-EXIT CL*39 00785 PERFORM P2600-GENERATE-ELOG THRU P2600-EXIT CL*39 00786 MOVE ' *** PENALTY GIVEN ' TO W-NOTE CL*42 00787 PERFORM P4000-WRITE-RPT THRU P4000-EXIT CL*42 00788 GO TO P0000-EXIT. CL*39 00789 CL*39 00790 DTSBE321 00791 * DISPLAY ' ORIG REC DATE ' L102-OR-RECEIVED-DATE CL*31 00792 * ' DUE DATE ' L102-RPT-DUE-DATE CL*31 00793 DTSBE321 00794 DTSBE321 00795 PERFORM S102A-PEN-ASSESSMENT-RUN THRU S102A-EXIT. DTSBE321 00796 DTSBE321 00797 MOVE L102-LATE-PEN-CHARGE-CHNG TO AMT-DISP1. DTSBE321 00798 CL*39 00799 IF L102-LATE-PEN-CHARGE-CHNG > +0 CL*39 00800 IF TF-RPT-FOUND-YES-88 (MPRF-EMP-NO) CL*39 00801 SET TF-BYPASSED-YES-88 (MPRF-EMP-NO) TO TRUE CL*39 00802 ADD +1 TO WRK-BYPASS-CNT CL*39 00803 GO TO P0000-EXIT CL*39 00804 ELSE CL*39 00805 MOVE L102-TAX-CHARGED-AMT TO AMT-DISP2 CL*39 00806 MOVE WRK-TIMELY-PAYMENTS TO AMT-DISP1 CL*39 00807 DISPLAY 'PEN-102 ' MPRF-EMP-NO ' ' MPRF-EMP-CLASS CL*39 00808 ' RCVD ' L102-OR-RECEIVED-DATE CL*39 00809 ' CHRG ' AMT-DISP2 CL*39 00810 ' PAID ' AMT-DISP1 CL*39 00811 SET GENERATE-LATE-PEN-LTR-88 TO TRUE CL*39 00812 * ADD 1 TO WRK-PEN-LTR-CNT CL*40 00813 PERFORM P3000-GENERATE-T026 THRU P3000-EXIT CL*39 00814 PERFORM P2500-GEN-MISS-R321 THRU P2500-EXIT CL*39 00815 PERFORM P2600-GENERATE-ELOG THRU P2600-EXIT CL*39 00816 * GO TO P0000-EXIT CL*42 00817 END-IF. CL*39 00818 DTSBE321 00819 * IF L102-LATE-PEN-CHARGE-CHNG > +0 CL*39 00820 * PERFORM P3000-GENERATE-T026 THRU P3000-EXIT CL*39 00821 * PERFORM P2500-GEN-MISS-R321 THRU P2500-EXIT CL*39 00822 * PERFORM P2600-GENERATE-ELOG THRU P2600-EXIT. CL*39 00823 DTSBE321 00824 * DISPLAY 'BE321 PENALTY ' MPRF-EMP-NO ' ' AMT-DISP1 CL*33 00825 * ' ' MPRF-PRIMARY-NAME. CL*33 00826 IF L102-LATE-PEN-CHARGE-CHNG > 0 CL*43 00827 * DISPLAY MPRF-EMP-NO ' ' MPRF-FEIN ' ' MPRF-PRIMARY-NAME CL*34 00828 * ' ' L102-TAX-CHARGED-AMT CL*34 00829 * ' ' WRK-TIMELY-PAYMENTS CL*34 00830 * ' ' L102-TAX-BALANCE-AMT CL*34 00831 * ' ' L102-LATE-PEN-CHARGED-AMT CL*34 00832 * ' *** PENALTY ASSESSED ' CL*34 00833 MOVE ' *** PENALTY ASSESSED' TO W-NOTE CL*34 00834 PERFORM P4000-WRITE-RPT THRU P4000-EXIT CL*34 00835 ELSE CL*33 00836 * DISPLAY MPRF-EMP-NO ' ' MPRF-FEIN ' ' MPRF-PRIMARY-NAME CL*34 00837 * ' ' L102-TAX-CHARGED-AMT CL*34 00838 * ' ' WRK-TIMELY-PAYMENTS CL*34 00839 * ' ' L102-TAX-BALANCE-AMT CL*34 00840 * ' ' L102-LATE-PEN-CHARGED-AMT. CL*34 00841 * MOVE ' ' TO W-NOTE CL*42 00842 MOVE ' *** NO PENALTY ASSED' TO W-NOTE CL*42 00843 PERFORM P4000-WRITE-RPT THRU P4000-EXIT. CL*34 00844 * DISPLAY ' TIMLY-PYMT ' WRK-TIMELY-PAYMENTS. CL*31 00845 * DISPLAY ' TAX-BAL-AMT ' L102-TAX-BALANCE-AMT. CL*31 00846 * DISPLAY ' TAX-CHG-AMT ' L102-TAX-CHARGED-AMT. CL*31 00847 * DISPLAY ' LATE-PEN-MT ' L102-LATE-PEN-CHARGED-AMT. CL*31 00848 * DISPLAY ' TOL-AMT ' WRK-TOLERANCE-AMT. CL*31 00849 CL*39 00850 DISPLAY '*NO-PEN ' MPRF-EMP-NO ' ' MPRF-EMP-CLASS CL*39 00851 ' RCVD ' L102-OR-RECEIVED-DATE CL*39 00852 ' CHRG ' AMT-DISP2 CL*39 00853 ' PAID ' AMT-DISP1. CL*39 00854 DTSBE321 00855 P0000-EXIT. DTSBE321 00856 EXIT. DTSBE321 00857 DTSBE321 00858 P0900-LIABLE-MSOL. CL*53 00859 MOVE ZERO TO WRK-FIRST-YRQ CL*53 00860 WRK-MSOL-CNT. CL*53 00861 CL*53 00862 * SET WRK-MSOL-NO-REC TO TRUE CL*53 00863 * SET WRK-WITHDRAWN-NO TO TRUE CL*54 00864 MOVE LOW-VALUES TO MSKL-KEY-AREA. CL*53 00865 CL*53 00866 MOVE MPRF-EMP-NO TO MSKL-EMP-NO. CL*53 00867 CL*53 00868 SET MSKL-SOL-88 TO TRUE. CL*53 00869 CL*53 00870 PERFORM S910-START-BROWSE THRU S910-EXIT. CL*53 00871 PERFORM UNTIL L910-NO-REC-88 CL*53 00872 MOVE MSKL-REC TO MSOL-REC CL*53 00873 IF MSOL-INACT-ACTIVE-88 CL*53 00874 IF MSOL-FIRST-LIAB-YRQ > WRK-FIRST-YRQ CL*53 00875 MOVE MSOL-FIRST-LIAB-YRQ TO WRK-FIRST-YRQ CL*53 00876 END-IF CL*53 00877 END-IF CL*53 00878 PERFORM S910-READ-NEXT THRU S910-EXIT CL*53 00879 END-PERFORM. CL*53 00880 CL*53 00881 P0900-EXIT. CL*53 00882 EXIT. CL*53 00883 DTSBE321 00884 P1000-LIABLE-QTRS. DTSBE321 00885 MOVE +0 TO L102-TAX-CHARGED-AMT DTSBE321 00886 L102-TAX-BALANCE-AMT DTSBE321 00887 L102-LATE-PEN-CHARGED-AMT DTSBE321 00888 L102-LATE-PEN-CHARGE-CHNG CL*24 00889 L101-INT-CHARGE-CHNG CL*12 00890 L101-INT-WAIVE-CHNG CL*12 00891 L101-INT-PER-MONTH CL*12 00892 WRK-TOLERANCE-AMT DTSBE321 00893 WRK-TIMELY-PAYMENTS. DTSBE321 00894 DTSBE321 00895 SET WRK-ERROR-NO-88 TO TRUE. DTSBE321 00896 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSBE321 00897 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBE321 00898 SET MQTR-QTR-88 TO TRUE. DTSBE321 00899 DTSBE321 00900 MOVE WRK-PARM-SUBJECT-YRQ TO WRK-YRQ. DTSBE321 00901 PERFORM P1100-CHK-MQTR THRU P1100-EXIT. DTSBE321 00902 IF WRK-ERROR-YES-88 DTSBE321 00903 GO TO P1000-EXIT. DTSBE321 00904 DTSBE321 00905 MOVE WRK-YRQ TO L004-QTR-5-9. DTSBE321 00906 MOVE 2 TO L004-QTR-5-Q. DTSBE321 00907 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBE321 00908 MOVE L004-QTR-5-9 TO WRK-YRQ. DTSBE321 00909 DTSBE321 00910 PERFORM P1100-CHK-MQTR THRU P1100-EXIT. DTSBE321 00911 IF WRK-ERROR-YES-88 DTSBE321 00912 GO TO P1000-EXIT. DTSBE321 00913 DTSBE321 00914 MOVE WRK-YRQ TO L004-QTR-5-9. DTSBE321 00915 MOVE 3 TO L004-QTR-5-Q. DTSBE321 00916 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBE321 00917 MOVE L004-QTR-5-9 TO WRK-YRQ. DTSBE321 00918 DTSBE321 00919 PERFORM P1100-CHK-MQTR THRU P1100-EXIT. DTSBE321 00920 IF WRK-ERROR-YES-88 DTSBE321 00921 GO TO P1000-EXIT. DTSBE321 00922 DTSBE321 00923 MOVE WRK-YRQ TO L004-QTR-5-9. DTSBE321 00924 MOVE 4 TO L004-QTR-5-Q. DTSBE321 00925 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBE321 00926 MOVE L004-QTR-5-9 TO WRK-YRQ. DTSBE321 00927 DTSBE321 00928 PERFORM P1100-CHK-MQTR THRU P1100-EXIT. DTSBE321 00929 IF WRK-ERROR-YES-88 DTSBE321 00930 GO TO P1000-EXIT. DTSBE321 00931 DTSBE321 00932 DTSBE321 00933 P1000-EXIT. DTSBE321 00934 EXIT. DTSBE321 00935 P1100-CHK-MQTR. DTSBE321 00936 MOVE WRK-YRQ TO MQTR-YRQ. DTSBE321 00937 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBE321 00938 PERFORM S910-READ THRU S910-EXIT. DTSBE321 00939 IF L910-NO-REC-88 DTSBE321 00940 PERFORM P1150-LIABLE-QTR THRU P1150-EXIT CL**3 00941 GO TO P1100-EXIT DTSBE321 00942 ELSE DTSBE321 00943 SET WRK-REPORT-FOUND-YES-88 TO TRUE DTSBE321 00944 MOVE MSKL-REC TO MQTR-REC. DTSBE321 00945 DTSBE321 00946 IF MQTR-CURR-RCVD-88 DTSBE321 00947 IF MQTR-ANNUAL-YES-88 DTSBE321 00948 MOVE MQTR-YRQ TO WRK-LAST-LIAB-YRQ DTSBE321 00949 ELSE DTSBE321 00950 DISPLAY 'MQTR RPT TYPE NOT ANNUAL: ' MQTR-EMP-NO CL**3 00951 ' ' MQTR-CURR-RPT-TYPE CL**3 00952 SET WRK-ERROR-YES-88 TO TRUE DTSBE321 00953 PERFORM P1110-ERR-RPT THRU P1110-EXIT DTSBE321 00954 GO TO P1100-EXIT DTSBE321 00955 END-IF DTSBE321 00956 ELSE DTSBE321 00957 DISPLAY 'MQTR RPT TYPE: ' MQTR-EMP-NO ' ' MQTR-CURR-RPT-TYPE CL**3 00958 SET WRK-REPORT-FOUND-NO-88 TO TRUE CL**3 00959 GO TO P1100-EXIT CL**3 00960 END-IF. DTSBE321 00961 DTSBE321 00962 PERFORM DTSBE321 00963 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSBE321 00964 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT DTSBE321 00965 IF MQTR-ACCT-LATE-PEN-88 (MQTR-ACCT-IDX) DTSBE321 00966 ADD MQTR-CHARGED-AMT (MQTR-ACCT-IDX) DTSBE321 00967 TO L102-LATE-PEN-CHARGED-AMT DTSBE321 00968 END-IF DTSBE321 00969 IF MQTR-ACCT-UI-88 (MQTR-ACCT-IDX) DTSBE321 00970 ADD MQTR-CHARGED-AMT (MQTR-ACCT-IDX) DTSBE321 00971 TO L102-TAX-CHARGED-AMT DTSBE321 00972 * ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSBE321 00973 * TO WRK-TAX-BALANCE-AMT DTSBE321 00974 END-IF DTSBE321 00975 IF MQTR-ACCT-SUR-88 (MQTR-ACCT-IDX) DTSBE321 00976 IF MQTR-YRQ >= WRK-FIRST-PEN-INT-YRQ DTSBE321 00977 ADD MQTR-CHARGED-AMT (MQTR-ACCT-IDX) DTSBE321 00978 TO L102-TAX-CHARGED-AMT DTSBE321 00979 END-IF DTSBE321 00980 END-IF DTSBE321 00981 IF MQTR-TOLER-AMT (MQTR-ACCT-IDX) > 0 DTSBE321 00982 ADD MQTR-TOLER-AMT (MQTR-ACCT-IDX) DTSBE321 00983 TO WRK-TOLERANCE-AMT DTSBE321 00984 END-IF DTSBE321 00985 DTSBE321 00986 END-PERFORM. DTSBE321 00987 PERFORM P1200-PAYMENTS THRU P1200-EXIT. DTSBE321 00988 COMPUTE L102-TAX-BALANCE-AMT = DTSBE321 00989 (L102-TAX-CHARGED-AMT - WRK-TIMELY-PAYMENTS). DTSBE321 00990 DTSBE321 00991 MOVE MQTR-PEN-AREA TO L102-PEN-AREA. DTSBE321 00992 DTSBE321 00993 DTSBE321 00994 P1100-EXIT. DTSBE321 00995 EXIT. DTSBE321 00996 SKIP3 DTSBE321 00997 DTSBE321 00998 P1110-ERR-RPT. DTSBE321 00999 MOVE MSG1-ID TO R907-MSG-ID DTSBE321 01000 MOVE MSG1-TEXT TO R907-MSG-TEXT DTSBE321 01001 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBE321 01002 EXIT. DTSBE321 01003 SKIP3 DTSBE321 01004 P1110-EXIT. DTSBE321 01005 EXIT. DTSBE321 01006 SKIP3 DTSBE321 01007 CL**3 01008 P1150-LIABLE-QTR. CL**3 01009 MOVE WRK-YRQ TO L516-YRQ. CL**3 01010 PERFORM S516-LIABILITY THRU S516-EXIT. CL**3 01011 IF L516-NOT-LIABLE-88 CL**4 01012 GO TO P1150-EXIT. CL**4 01013 CL**4 01014 ADD 1 TO WS-LIAB-QTR-RPT-MISSING. CL*29 01015 DISPLAY 'LIABLE QTR REPORT NOT FILED: ' MPRF-EMP-NO ' ' CL**4 01016 WRK-YRQ. CL**3 01017 IF WRK-YRQ = 20201 CL*62 01018 MOVE WRK-YRQ TO WRK-YRQ1-MISSING CL**6 01019 ELSE CL**4 01020 IF WRK-YRQ = 20202 CL*62 01021 MOVE WRK-YRQ TO WRK-YRQ2-MISSING CL**6 01022 ELSE CL**4 01023 IF WRK-YRQ = 20203 CL*62 01024 MOVE WRK-YRQ TO WRK-YRQ3-MISSING CL**6 01025 ELSE CL**4 01026 MOVE WRK-YRQ TO WRK-YRQ4-MISSING. CL**6 01027 P1150-EXIT. CL**3 01028 EXIT. CL**3 01029 SKIP3 CL**3 01030 CL**3 01031 P1200-PAYMENTS. DTSBE321 01032 ********************************************************** DTSBE321 01033 * INCLUDE ONLY PAYMENTS OF UI TAX IN TIMELY PAYMENT TOTAL. DTSBE321 01034 ********************************************************** DTSBE321 01035 MOVE LOW-VALUE TO MDST-KEY-AREA. DTSBE321 01036 MOVE MPRF-EMP-NO TO MDST-EMP-NO. DTSBE321 01037 SET MDST-DST-88 TO TRUE. DTSBE321 01038 MOVE MDST-KEY-AREA TO MSKL-KEY-AREA. DTSBE321 01039 DTSBE321 01040 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE321 01041 IF L910-OK-88 DTSBE321 01042 PERFORM P1210-SCAN-MDST THRU P1210-EXIT DTSBE321 01043 UNTIL L910-NO-REC-88. DTSBE321 01044 DTSBE321 01045 P1200-EXIT. DTSBE321 01046 EXIT. DTSBE321 01047 SKIP3 DTSBE321 01048 P1210-SCAN-MDST. DTSBE321 01049 MOVE MSKL-REC TO MDST-REC. DTSBE321 01050 DTSBE321 01051 IF (MDST-YRQ = MQTR-YRQ DTSBE321 01052 AND MDST-RECEIVED-DATE <= MQTR-TAX-DUE-DATE) DTSBE321 01053 PERFORM DTSBE321 01054 VARYING MDST-ACCT-IDX FROM +1 BY +1 DTSBE321 01055 UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT DTSBE321 01056 IF MDST-ACCT-UI-88 (MDST-ACCT-IDX) DTSBE321 01057 ADD MDST-AMT (MDST-ACCT-IDX) DTSBE321 01058 TO WRK-TIMELY-PAYMENTS DTSBE321 01059 END-IF DTSBE321 01060 IF MDST-ACCT-SUR-88 (MDST-ACCT-IDX) DTSBE321 01061 ADD MDST-AMT (MDST-ACCT-IDX) DTSBE321 01062 TO WRK-TIMELY-PAYMENTS DTSBE321 01063 END-IF DTSBE321 01064 END-PERFORM DTSBE321 01065 END-IF. DTSBE321 01066 DTSBE321 01067 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE321 01068 DTSBE321 01069 DTSBE321 01070 DTSBE321 01071 P1210-EXIT. DTSBE321 01072 EXIT. DTSBE321 01073 SKIP3 DTSBE321 01074 DTSBE321 01075 P2000-INITIALIZE-L102. DTSBE321 01076 *& DTSBE321 01077 * DISPLAY 'BU322 P2000 LAST LIAB YRQ ' DTSBE321 01078 * WRK-LAST-LIAB-YRQ. DTSBE321 01079 *& DTSBE321 01080 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSBE321 01081 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBE321 01082 SET MQTR-QTR-88 TO TRUE. DTSBE321 01083 MOVE WRK-LAST-LIAB-YRQ TO MQTR-YRQ. DTSBE321 01084 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBE321 01085 PERFORM S910-READ THRU S910-EXIT. DTSBE321 01086 IF L910-NO-REC-88 DTSBE321 01087 MOVE 'CANNOT READ LAST LIABLE QUARTER ' DTSBE321 01088 TO ABEND-MSG DTSBE321 01089 PERFORM S999-ABEND THRU S999-EXIT DTSBE321 01090 ELSE DTSBE321 01091 MOVE MSKL-REC TO MQTR-REC. DTSBE321 01092 DTSBE321 01093 MOVE MPRF-EMP-CLASS TO L102-EMP-CLASS. DTSBE321 01094 DTSBE321 01095 MOVE +0 TO L102-TRAN-RECEIVED-DATE. DTSBE321 01096 DTSBE321 01097 MOVE +0 TO L102-LATE-PEN-CHARGE-CHNG. DTSBE321 01098 DTSBE321 01099 SET L102-WAIVE-LATE-PEN-NO-88 TO TRUE. DTSBE321 01100 DTSBE321 01101 MOVE WRK-LAST-LIAB-YRQ TO L102-LAST-PEN-ASSESSED-YRQ. DTSBE321 01102 DTSBE321 01103 MOVE +0 TO L102-OR-RECEIVED-DATE. DTSBE321 01104 DTSBE321 01105 MOVE LECM-CURR-RUN-DATE TO L102-CURR-RUN-DATE. DTSBE321 01106 DTSBE321 01107 IF MQTR-CURR-RCVD-88 DTSBE321 01108 MOVE LOW-VALUES TO MRPT-KEY-AREA DTSBE321 01109 MOVE MPRF-EMP-NO TO MRPT-EMP-NO DTSBE321 01110 SET MRPT-RPT-88 TO TRUE DTSBE321 01111 * MOVE WRK-LAST-LIAB-YRQ TO MRPT-YRQ DTSBE321 01112 MOVE MQTR-YRQ TO MRPT-YRQ DTSBE321 01113 MOVE MRPT-KEY-AREA TO MSKL-KEY-AREA DTSBE321 01114 PERFORM S910-START-BROWSE THRU S910-EXIT DTSBE321 01115 PERFORM P2100-MRPT-SCAN THRU P2100-EXIT DTSBE321 01116 UNTIL L910-NO-REC-88. DTSBE321 01117 DTSBE321 01118 MOVE WRK-LAST-LIAB-YRQ TO L102-MQTR-YRQ. DTSBE321 01119 DTSBE321 01120 MOVE MQTR-TAX-DUE-DATE TO L102-TAX-DUE-DATE DTSBE321 01121 R321-TAX-DUE-DATE. DTSBE321 01122 MOVE MQTR-RPT-DUE-DATE TO L102-RPT-DUE-DATE DTSBE321 01123 R321-RPT-DUE-DATE. DTSBE321 01124 DTSBE321 01125 * MOVE WRK-LATE-PEN-CHARGED-AMT DTSBE321 01126 * TO L102-LATE-PEN-CHARGED-AMT. DTSBE321 01127 * MOVE WRK-TAX-CHARGED-AMT DTSBE321 01128 * TO L102-TAX-CHARGED-AMT. DTSBE321 01129 * MOVE WRK-TAX-BALANCE-AMT DTSBE321 01130 * TO L102-TAX-BALANCE-AMT. DTSBE321 01131 * DTSBE321 01132 MOVE MQTR-PEN-AREA TO L102-PEN-AREA. DTSBE321 01133 DTSBE321 01134 * MOVE ZERO TO L102-TIMELY-SI-PAY-AMT. DTSBE321 01135 DTSBE321 01136 *& DTSBE321 01137 DISPLAY 'BU322 ' MPRF-EMP-NO CL*44 01138 ' LAST LIAB YRQ ' WRK-LAST-LIAB-YRQ. CL*44 01139 DISPLAY ' PEN ' L102-LATE-PEN-CHARGED-AMT. CL*44 01140 DISPLAY ' TAX CHG ' L102-TAX-CHARGED-AMT. CL*44 01141 DISPLAY ' TAX BAL ' L102-TAX-BALANCE-AMT. CL*44 01142 DISPLAY ' INT BAL ' L101-INT-CHARGE-CHNG. CL*44 01143 *& DTSBE321 01144 P2000-EXIT. DTSBE321 01145 EXIT. DTSBE321 01146 SKIP3 DTSBE321 01147 DTSBE321 01148 P2100-MRPT-SCAN. DTSBE321 01149 MOVE MSKL-REC TO MRPT-REC. DTSBE321 01150 DTSBE321 01151 IF MRPT-YRQ NOT = MQTR-YRQ DTSBE321 01152 * IF MRPT-YRQ NOT = WRK-LAST-LIAB-YRQ DTSBE321 01153 SET L910-NO-REC-88 TO TRUE DTSBE321 01154 GO TO P2100-EXIT. DTSBE321 01155 DTSBE321 01156 IF MRPT-ORIG-88 DTSBE321 01157 **** IF MRPT-RECEIVED-DATE > L102-OR-RECEIVED-DATE DTSBE321 01158 MOVE MRPT-RECEIVED-DATE TO L102-OR-RECEIVED-DATE. DTSBE321 01159 DTSBE321 01160 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE321 01161 P2100-EXIT. DTSBE321 01162 EXIT. DTSBE321 01163 P2500-GEN-MISS-R321. DTSBE321 01164 MOVE MPRF-EMP-NO TO R321-EMP-NO. DTSBE321 01165 ** MOVE WRK-PARM-SUBJECT-YRQ TO WRK-SUBJECT-SLASH-QTR DTSBE321 01166 DISPLAY 'MQTR-YRQ ' MQTR-YRQ DTSBE321 01167 MOVE MQTR-YRQ TO R321-YRQ. DTSBE321 01168 DTSBE321 01169 MOVE LECM-CURR-RUN-DATE TO R321-MAIL-DATE. DTSBE321 01170 DTSBE321 01171 MOVE +0 TO R321-UI-TAX-CHARGED-AMT DTSBE321 01172 R321-PEN-CHARGED-AMT DTSBE321 01173 R321-UI-TAX-PAID-AMT DTSBE321 01174 R321-INT-COMP-DATE DTSBE321 01175 R321-UI-TOL-AMT DTSBE321 01176 R321-INT-CHARGED-AMT. DTSBE321 01177 DTSBE321 01178 IF GENERATE-MISS-RPT-YES-88 DTSBE321 01179 CL**3 01180 SET R321-GENERATE-MISS-RPT-LTR-88 TO TRUE DTSBE321 01181 MOVE ZERO TO R321-INT-COMP-DATE DTSBE321 01182 GO TO P2500-GENERATE-R321-CONTINUE DTSBE321 01183 END-IF. DTSBE321 01184 DTSBE321 01185 SET R321-GENERATE-LATE-PEN-LTR-88 TO TRUE. DTSBE321 01186 DTSBE321 01187 MOVE R321-MAIL-DATE TO L001-FED-8-DATE-9 DTSBE321 01188 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBE321 01189 ADD +14 TO L001-JUL-ABS-DAY DTSBE321 01190 PERFORM S001-FROM-ABS-DAY THRU S001-EXIT. DTSBE321 01191 MOVE L001-FED-8-DATE-9 TO R321-INT-COMP-DATE. DTSBE321 01192 MOVE L102-LATE-PEN-CHARGE-CHNG TO R321-PEN-CHARGED-AMT. DTSBE321 01193 MOVE L102-TAX-CHARGED-AMT TO R321-UI-TAX-CHARGED-AMT. DTSBE321 01194 MOVE WRK-TIMELY-PAYMENTS TO R321-UI-TAX-PAID-AMT. DTSBE321 01195 MOVE +0 TO L101-PAID-CHNG. DTSBE321 01196 MOVE R321-INT-COMP-DATE TO L101-RECEIVED-DATE DTSBE321 01197 MOVE WRK-TOLERANCE-AMT TO R321-UI-TOL-AMT. DTSBE321 01198 MOVE MQTR-RPT-DUE-DATE TO R321-RPT-DUE-DATE. DTSBE321 01199 MOVE MQTR-TAX-DUE-DATE TO L101-TAX-DUE-DATE DTSBE321 01200 R321-TAX-DUE-DATE. DTSBE321 01201 MOVE MQTR-INT-AREA TO L101-INT-AREA. DTSBE321 01202 PERFORM P2510-MQTR-ACCT-LOOP THRU P2510-EXIT DTSBE321 01203 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSBE321 01204 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT. DTSBE321 01205 DTSBE321 01206 PERFORM S101-PER-MONTH-NO THRU S101-EXIT. DTSBE321 01207 DTSBE321 01208 ADD L101-INT-CHARGE-CHNG TO R321-INT-CHARGED-AMT. DTSBE321 01209 DTSBE321 01210 P2500-GENERATE-R321-CONTINUE. DTSBE321 01211 DTSBE321 01212 SET L111-LOOKUP-TAD-88 TO TRUE. DTSBE321 01213 SET L111-ID-NO-TAD-MAIL-88 TO TRUE. DTSBE321 01214 DTSBE321 01215 PERFORM S111-LOOKUP-ADDR THRU S111-EXIT. DTSBE321 01216 DTSBE321 01217 IF L111-ADDR-FOUND-88 DTSBE321 01218 MOVE L111-ADDR-TYPE TO L112-ADDR-TYPE DTSBE321 01219 SET L112-ANCHOR-LAST-88 TO TRUE DTSBE321 01220 MOVE MPRF-PRIMARY-NAME TO L112-PRIMARY-NAME DTSBE321 01221 MOVE L111-RETURN-AREA TO L112-NAME-ADDRESS-AREA DTSBE321 01222 PERFORM S112-FORMAT-ADDR THRU S112-EXIT DTSBE321 01223 ELSE DTSBE321 01224 MOVE ALL '?' TO L112-ADDRESS DTSBE321 01225 L112-MAILING-ADDRESS. DTSBE321 01226 MOVE L112-MAILING-ADDRESS TO R321-FMT-ADDR. DTSBE321 01227 DTSBE321 01228 MOVE L112-ZIP TO R321-ZIP. DTSBE321 01229 MOVE L112-ADVANCED-BARCODE TO R321-ADVANCED-BARCODE. DTSBE321 01230 DTSBE321 01231 PERFORM S946-WRITE-R321 THRU S946-EXIT. DTSBE321 01232 DTSBE321 01233 P2500-EXIT. DTSBE321 01234 EXIT. DTSBE321 01235 EJECT DTSBE321 01236 P2550-GEN-MISS-QTR-R321. CL**4 01237 MOVE MPRF-EMP-NO TO R321-EMP-NO. CL**4 01238 ** MOVE WRK-PARM-SUBJECT-YRQ TO WRK-SUBJECT-SLASH-QTR CL**4 01239 DISPLAY 'MQTR-YRQ ' MQTR-YRQ CL**4 01240 MOVE MQTR-YRQ TO R321-YRQ. CL**4 01241 CL**4 01242 MOVE MQTR-RPT-DUE-DATE TO R321-RPT-DUE-DATE. CL**7 01243 IF WRK-YRQ1-MISSING > 0 CL**7 01244 MOVE WRK-YRQ1-MISSING TO R321-YRQ1-MISSING CL**7 01245 ELSE CL**7 01246 MOVE ZEROS TO R321-YRQ1-MISSING. CL**8 01247 IF WRK-YRQ2-MISSING > 0 CL**7 01248 MOVE WRK-YRQ2-MISSING TO R321-YRQ2-MISSING CL**7 01249 ELSE CL**7 01250 MOVE ZEROS TO R321-YRQ2-MISSING. CL**8 01251 IF WRK-YRQ3-MISSING > 0 CL**7 01252 MOVE WRK-YRQ3-MISSING TO R321-YRQ3-MISSING CL**7 01253 ELSE CL**7 01254 MOVE ZEROS TO R321-YRQ3-MISSING. CL**8 01255 IF WRK-YRQ4-MISSING > 0 CL**7 01256 MOVE WRK-YRQ4-MISSING TO R321-YRQ4-MISSING CL**7 01257 ELSE CL**7 01258 MOVE ZEROS TO R321-YRQ4-MISSING. CL**8 01259 CL**7 01260 MOVE LECM-CURR-RUN-DATE TO R321-MAIL-DATE. CL**4 01261 CL**4 01262 MOVE +0 TO R321-UI-TAX-CHARGED-AMT CL**4 01263 R321-PEN-CHARGED-AMT CL**4 01264 R321-UI-TAX-PAID-AMT CL**4 01265 R321-INT-COMP-DATE CL**4 01266 R321-UI-TOL-AMT CL**4 01267 R321-INT-CHARGED-AMT. CL**4 01268 CL**4 01269 SET R321-GENERATE-MISS-QTR-LTR-88 TO TRUE CL**4 01270 MOVE ZERO TO R321-INT-COMP-DATE CL**4 01271 CL**4 01272 CL**4 01273 SET L111-LOOKUP-TAD-88 TO TRUE. CL**4 01274 SET L111-ID-NO-TAD-MAIL-88 TO TRUE. CL**4 01275 CL**4 01276 PERFORM S111-LOOKUP-ADDR THRU S111-EXIT. CL**4 01277 CL**4 01278 IF L111-ADDR-FOUND-88 CL**4 01279 MOVE L111-ADDR-TYPE TO L112-ADDR-TYPE CL**4 01280 SET L112-ANCHOR-LAST-88 TO TRUE CL**4 01281 MOVE MPRF-PRIMARY-NAME TO L112-PRIMARY-NAME CL**4 01282 MOVE L111-RETURN-AREA TO L112-NAME-ADDRESS-AREA CL**4 01283 PERFORM S112-FORMAT-ADDR THRU S112-EXIT CL**4 01284 ELSE CL**4 01285 MOVE ALL '?' TO L112-ADDRESS CL**4 01286 L112-MAILING-ADDRESS. CL**4 01287 MOVE L112-MAILING-ADDRESS TO R321-FMT-ADDR. CL**4 01288 CL**4 01289 MOVE L112-ZIP TO R321-ZIP. CL**4 01290 MOVE L112-ADVANCED-BARCODE TO R321-ADVANCED-BARCODE. CL**4 01291 CL**4 01292 PERFORM S946-WRITE-R321 THRU S946-EXIT. CL**4 01293 CL**4 01294 P2550-EXIT. CL**6 01295 EXIT. CL**4 01296 P2510-MQTR-ACCT-LOOP. DTSBE321 01297 IF MQTR-ACCT-UI-88 (MQTR-ACCT-IDX) DTSBE321 01298 ADD MQTR-PAID-AMT (MQTR-ACCT-IDX) DTSBE321 01299 ** TO R321-UI-TAX-PAID-AMT DTSBE321 01300 TO WRK-TIMELY-PAYMENTS DTSBE321 01301 ELSE DTSBE321 01302 IF MQTR-ACCT-UI-88 (MQTR-ACCT-IDX) DTSBE321 01303 ADD MQTR-CHARGED-AMT (MQTR-ACCT-IDX) DTSBE321 01304 TO L101-PAID-CHNG DTSBE321 01305 ELSE DTSBE321 01306 IF MQTR-ACCT-SUR-88 (MQTR-ACCT-IDX) DTSBE321 01307 IF MQTR-YRQ >= WRK-FIRST-PEN-INT-YRQ DTSBE321 01308 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSBE321 01309 TO L101-PAID-CHNG DTSBE321 01310 END-IF DTSBE321 01311 ELSE DTSBE321 01312 IF MQTR-ACCT-INT-88 (MQTR-ACCT-IDX) DTSBE321 01313 ADD MQTR-CHARGED-AMT (MQTR-ACCT-IDX) DTSBE321 01314 TO L101-INT-CHARGE-CHNG DTSBE321 01315 DISPLAY 'L101-INT-CHARGE-CHNG' L101-INT-CHARGE-CHNG CL*48 01316 DISPLAY 'MPRF-EMP-NO ' MPRF-EMP-NO CL*46 01317 ELSE DTSBE321 01318 IF (MQTR-ACCT-LATE-PEN-88 (MQTR-ACCT-IDX)) DTSBE321 01319 OR DTSBE321 01320 (MQTR-ACCT-NSF-PEN-88 (MQTR-ACCT-IDX)) DTSBE321 01321 OR DTSBE321 01322 (MQTR-ACCT-MISC-PEN-88 (MQTR-ACCT-IDX)) DTSBE321 01323 ADD MQTR-CHARGED-AMT (MQTR-ACCT-IDX) DTSBE321 01324 TO L102-LATE-PEN-CHARGE-CHNG. DTSBE321 01325 P2510-EXIT. DTSBE321 01326 EXIT. DTSBE321 01327 EJECT DTSBE321 01328 P2600-GENERATE-ELOG. DTSBE321 01329 DTSBE321 01330 MOVE LOW-VALUES TO MEVL-REC. DTSBE321 01331 MOVE WRK-PARM-SUBJECT-YRQ TO EVL-SLASH-QTR DTSBE321 01332 MOVE SPACES TO EVL-ADDR-TYPE DTSBE321 01333 MOVE SPACES TO EVL-ADDR-ID-NO DTSBE321 01334 ADD +1000 TO LECM-EMP-ABSTIME. DTSBE321 01335 MOVE LECM-EMP-ABSTIME TO L005-ABSTIME. DTSBE321 01336 DTSBE321 01337 PERFORM S005-FROM-ABSTIME THRU S005-EXIT. DTSBE321 01338 MOVE MPRF-EMP-NO TO MEVL-EMP-NO. DTSBE321 01339 DTSBE321 01340 SET MEVL-EVL-88 TO TRUE. DTSBE321 01341 MOVE L005-DATE TO MEVL-DATE. DTSBE321 01342 DTSBE321 01343 MOVE L005-TIME TO MEVL-TIME. DTSBE321 01344 MOVE ZEROS TO MEVL-PURGE-DATE. DTSBE321 01345 DTSBE321 01346 IF R321-GENERATE-MISS-RPT-LTR-88 DTSBE321 01347 MOVE EVL-TEXT-MISS-LTR TO EVL-TEXT DTSBE321 01348 ELSE DTSBE321 01349 MOVE EVL-TEXT-PEN-LTR TO EVL-TEXT DTSBE321 01350 ADD +1 TO WRK-LATE-LTR-CNT DTSBE321 01351 END-IF. DTSBE321 01352 DTSBE321 01353 MOVE EVL-LOG-AREA TO MEVL-TEXT. DTSBE321 01354 SET MEVL-SOURCE-SYSTEM-88 TO TRUE. DTSBE321 01355 DTSBE321 01356 SET MEVL-NOT-CONVERTED-88 TO TRUE. DTSBE321 01357 DTSBE321 01358 MOVE LECM-CURR-RUN-DATE TO MEVL-ESTB-DATE DTSBE321 01359 MEVL-CHNG-DATE. DTSBE321 01360 MOVE MEVL-REC TO MSKL-REC. DTSBE321 01361 PERFORM S910-WRITE THRU S910-EXIT. DTSBE321 01362 P2600-EXIT. DTSBE321 01363 EXIT. DTSBE321 01364 EJECT DTSBE321 01365 DTSBE321 01366 P2650-GEN-MISS-ELOG. CL**4 01367 CL**4 01368 MOVE LOW-VALUES TO MEVL-REC. CL**4 01369 MOVE WRK-PARM-SUBJECT-YRQ TO EVL-SLASH-QTR CL**4 01370 MOVE SPACES TO EVL-ADDR-TYPE CL**4 01371 MOVE SPACES TO EVL-ADDR-ID-NO CL**4 01372 ADD +1000 TO LECM-EMP-ABSTIME. CL**4 01373 MOVE LECM-EMP-ABSTIME TO L005-ABSTIME. CL**4 01374 CL**4 01375 PERFORM S005-FROM-ABSTIME THRU S005-EXIT. CL**4 01376 MOVE MPRF-EMP-NO TO MEVL-EMP-NO. CL**4 01377 CL**4 01378 SET MEVL-EVL-88 TO TRUE. CL**4 01379 MOVE L005-DATE TO MEVL-DATE. CL**4 01380 CL**4 01381 MOVE L005-TIME TO MEVL-TIME. CL**4 01382 MOVE ZEROS TO MEVL-PURGE-DATE. CL**4 01383 CL**4 01384 MOVE EVL-TEXT-MISS-QTR-LTR TO EVL-TEXT CL**6 01385 CL**4 01386 MOVE EVL-LOG-AREA TO MEVL-TEXT. CL**4 01387 SET MEVL-SOURCE-SYSTEM-88 TO TRUE. CL**4 01388 CL**4 01389 SET MEVL-NOT-CONVERTED-88 TO TRUE. CL**4 01390 CL**4 01391 MOVE LECM-CURR-RUN-DATE TO MEVL-ESTB-DATE CL**4 01392 MEVL-CHNG-DATE. CL**4 01393 MOVE MEVL-REC TO MSKL-REC. CL**4 01394 PERFORM S910-WRITE THRU S910-EXIT. CL**4 01395 P2650-EXIT. CL**4 01396 EXIT. CL**4 01397 EJECT CL**4 01398 CL**4 01399 P3000-GENERATE-T026. DTSBE321 01400 DTSBE321 01401 MOVE MPRF-EMP-NO TO T026-EMP-NO. DTSBE321 01402 DTSBE321 01403 SET T026-LATE-PEN-CHG TO TRUE. DTSBE321 01404 DTSBE321 01405 MOVE MPRF-PRIMARY-NAME TO T026-NAME-CHECK. DTSBE321 01406 CL*16 01407 IF GENERATE-MISS-RPT-YES-88 CL*18 01408 ADD +1 TO WRK-T026-MIS-CNT CL*20 01409 MOVE 100.00 TO T026-AMT DTSBE321 01410 W-PEN CL*35 01411 ELSE DTSBE321 01412 DISPLAY ' LATE PEN: ' MPRF-EMP-NO CL*37 01413 ADD +1 TO WRK-T026-PEN-CNT CL*20 01414 MOVE L102-LATE-PEN-CHARGE-CHNG TO T026-AMT CL*19 01415 W-PEN CL*35 01416 END-IF. CL*19 01417 CL*19 01418 MOVE +0 TO T026-RECEIVED-DATE. DTSBE321 01419 DTSBE321 01420 IF WRK-LAST-LIAB-YRQ = 0 DTSBE321 01421 MOVE WRK-PARM-SUBJECT-YRQ TO T026-APPLIC-YRQ DTSBE321 01422 ELSE DTSBE321 01423 MOVE WRK-LAST-LIAB-YRQ TO T026-APPLIC-YRQ. DTSBE321 01424 DTSBE321 01425 MOVE CACT-APPLIC-LATE-PEN TO T026-APPLIC-IND. DTSBE321 01426 DTSBE321 01427 MOVE +0 TO T026-APPLIC-BATCH-NO DTSBE321 01428 T026-APPLIC-ITEM-NO. DTSBE321 01429 DTSBE321 01430 MOVE +0 TO T026-DATE-1 DTSBE321 01431 T026-DATE-2. DTSBE321 01432 DTSBE321 01433 MOVE SPACE TO T026-INT-SPAN-IND. DTSBE321 01434 DTSBE321 01435 SET T026-NO-INT-RATE-88 TO TRUE. DTSBE321 01436 DTSBE321 01437 MOVE 'SYS' TO T026-RESPONSIBLE-ACTIVITY. DTSBE321 01438 DTSBE321 01439 MOVE SPACES TO T026-RESPONSIBLE-OP-ID. DTSBE321 01440 DTSBE321 01441 PERFORM S927-WRITE-T026 THRU S927-EXIT. DTSBE321 01442 DTSBE321 01443 CL*34 01444 P3000-EXIT. DTSBE321 01445 EXIT. DTSBE321 01446 P4000-WRITE-RPT. CL*34 01447 MOVE MPRF-EMP-NO TO W-EMP-NO. CL*34 01448 MOVE MPRF-FEIN TO W-FEIN-NO. CL*34 01449 MOVE MPRF-PRIMARY-NAME TO W-NAME. CL*34 01450 MOVE L102-TAX-BALANCE-AMT TO W-BAL. CL*34 01451 MOVE L102-LATE-PEN-CHARGE-CHNG TO W-PEN. CL*34 01452 MOVE L102-TAX-CHARGED-AMT TO W-CHG. CL*34 01453 MOVE WRK-TIMELY-PAYMENTS TO W-PAID. CL*34 01454 CL*34 01455 WRITE PENALTY-REC FROM W-PENALTY-REC. CL*34 01456 P4000-EXIT. CL*34 01457 EXIT. CL*34 01458 T0000-TERMINATE. DTSBE321 01459 MOVE LOW-VALUES TO FAFD-KEY-AREA. DTSBE321 01460 DTSBE321 01461 SET FAFD-AFD-88 TO TRUE. DTSBE321 01462 DTSBE321 01463 MOVE WRK-PARM-SUBJECT-YRQ TO L004-QTR-5-9 DTSBE321 01464 MOVE L004-QTR-5-YR TO FAFD-YR. DTSBE321 01465 DTSBE321 01466 MOVE FAFD-KEY-AREA TO FSKL-KEY-AREA. DTSBE321 01467 DTSBE321 01468 PERFORM S931-READ THRU S931-EXIT. DTSBE321 01469 DTSBE321 01470 IF L931-NO-REC-88 DTSBE321 01471 MOVE LOW-VALUES TO FAFD-DATA-AREA DTSBE321 01472 MOVE LECM-CURR-RUN-DATE DTSBE321 01473 TO FAFD-LATE-PEN-ASSESSED-DATE DTSBE321 01474 MOVE +0 TO FAFD-UC30H-FIRST-DEL-DATE DTSBE321 01475 FAFD-UC30H-ESTIMATED-DATE DTSBE321 01476 FAFD-UC30H-FINAL-ACTION-DATE DTSBE321 01477 FAFD-UC30H-MASS-MAIL-DATE DTSBE321 01478 FAFD-UC30H-RPT-DUE-DATE DTSBE321 01479 MOVE LECM-CURR-RUN-DATE DTSBE321 01480 TO FAFD-ESTB-DATE DTSBE321 01481 FAFD-CHNG-DATE DTSBE321 01482 MOVE FAFD-REC TO FSKL-REC DTSBE321 01483 PERFORM S931-WRITE THRU S931-EXIT DTSBE321 01484 ELSE DTSBE321 01485 MOVE FSKL-REC TO FAFD-REC DTSBE321 01486 MOVE LECM-CURR-RUN-DATE DTSBE321 01487 TO FAFD-LATE-PEN-ASSESSED-DATE DTSBE321 01488 MOVE LECM-CURR-RUN-DATE DTSBE321 01489 TO FAFD-CHNG-DATE DTSBE321 01490 MOVE FAFD-REC TO FSKL-REC DTSBE321 01491 PERFORM S931-REWRITE THRU S931-EXIT. DTSBE321 01492 DTSBE321 01493 DISPLAY '***** **** BE321 TERMINATION **********'. CL**6 01494 DISPLAY ' '. CL**3 01495 DISPLAY 'DOMESTIC ANNUAL MISSING REPORTS/LATE PENALTY RUN '. CL**3 01496 DISPLAY ' '. CL**3 01497 DISPLAY 'TOTAL DOMESTIC FILERS READ: ' WRK-DOMESTIC-CNT. CL**5 01498 DISPLAY ' ANNUAL FILERS READ: ' WRK-ANN-FILER-CNT. CL**5 01499 DISPLAY ' COMPLETE REPORTS FILED: ' WRK-REP-FND-CNT. CL**4 01500 DISPLAY ' LATE PENALTIES NOT PAID: ' WRK-T026-PEN-CNT. CL*20 01501 DISPLAY ' PARTIAL REPORTS FILED: ' WRK-PAR-FND-CNT. CL**4 01502 DISPLAY ' ACCOUNTS BYPASSED: ' WRK-BYPASS-CNT. CL**3 01503 DISPLAY ' COMPLETE REPORT MISSNG: ' WRK-MISS-LTR-CNT. CL**4 01504 DISPLAY ' LATE PENALTIES MISS RPT: ' WRK-T026-MIS-CNT. CL*20 01505 DISPLAY ' '. CL**3 01506 DISPLAY SPACE. DTSBE321 01507 CLOSE PENALTY-FILE EMP-RPT-FILE. CL**2 01508 CL**4 01509 DTSBE321 01510 T0000-EXIT. DTSBE321 01511 EXIT. DTSBE321 01512 EJECT DTSBE321 01513 S001-FROM-FED-8. DTSBE321 01514 SET L001-FROM-FED-8 TO TRUE. DTSBE321 01515 GO TO S001-DATE. DTSBE321 01516 DTSBE321 01517 S001-FROM-CAL-6. DTSBE321 01518 SET L001-FROM-CAL-6 TO TRUE. DTSBE321 01519 GO TO S001-DATE. DTSBE321 01520 DTSBE321 01521 S001-FROM-ABS-DAY. DTSBE321 01522 SET L001-FROM-ABS-DAY TO TRUE. DTSBE321 01523 GO TO S001-DATE. DTSBE321 01524 DTSBE321 01525 S001-DATE. DTSBE321 01526 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBE321 01527 S001-EXIT. DTSBE321 01528 EXIT. DTSBE321 01529 SKIP3 DTSBE321 01530 S004-FROM-5. DTSBE321 01531 SET L004-FROM-5 TO TRUE. DTSBE321 01532 GO TO S004-QTR. DTSBE321 01533 DTSBE321 01534 S004-FROM-ABS. DTSBE321 01535 SET L004-FROM-ABS TO TRUE. DTSBE321 01536 GO TO S004-QTR. DTSBE321 01537 DTSBE321 01538 S004-FROM-3. DTSBE321 01539 SET L004-FROM-3 TO TRUE. DTSBE321 01540 GO TO S004-QTR. DTSBE321 01541 DTSBE321 01542 S004-QTR. DTSBE321 01543 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBE321 01544 S004-EXIT. DTSBE321 01545 EXIT. DTSBE321 01546 SKIP3 DTSBE321 01547 S005-FROM-ABSTIME. DTSBE321 01548 SET L005-FROM-ABSTIME TO TRUE. DTSBE321 01549 GO TO S005-ABSTIME. DTSBE321 01550 DTSBE321 01551 S005-ABSTIME. DTSBE321 01552 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBE321 01553 S005-EXIT. DTSBE321 01554 EXIT. DTSBE321 01555 S101-PER-MONTH-NO. DTSBE321 01556 SET L101-PER-MONTH-NO-88 TO TRUE. DTSBE321 01557 GO TO S101-INT-COMP. DTSBE321 01558 DTSBE321 01559 S101-INT-COMP. DTSBE321 01560 CALL 'DTSBU101' USING L101-LINK-AREA. DTSBE321 01561 S101-EXIT. DTSBE321 01562 EXIT. DTSBE321 01563 S102A-PEN-ASSESSMENT-RUN. DTSBE321 01564 SET L102-PEN-ASSESSMENT-RUN-88 TO TRUE. DTSBE321 01565 PERFORM S102Z-PEN-COMP THRU S102Z-EXIT. DTSBE321 01566 DTSBE321 01567 S102A-EXIT. DTSBE321 01568 EXIT. DTSBE321 01569 S102Z-PEN-COMP. DTSBE321 01570 CALL 'DTSBU102' USING L102-LINK-AREA. DTSBE321 01571 S102Z-EXIT. DTSBE321 01572 EXIT. DTSBE321 01573 SKIP3 DTSBE321 01574 S109-FIRST-PEN-INT-YRQ. DTSBE321 01575 SET L109-CMND-PEN-INT-QTR-88 TO TRUE. DTSBE321 01576 GO TO S109-SUR-RATE. DTSBE321 01577 DTSBE321 01578 S109-SUR-RATE. DTSBE321 01579 CALL 'DTSBU109' USING L109-LINK-AREA. DTSBE321 01580 S109-EXIT. DTSBE321 01581 EXIT. DTSBE321 01582 DTSBE321 01583 S111-LOOKUP-ADDR. DTSBE321 01584 MOVE MPRF-EMP-NO TO L111-EMP-NO. DTSBE321 01585 DTSBE321 01586 CALL 'DTSBU111' USING L111-LINK-AREA. DTSBE321 01587 S111-EXIT. DTSBE321 01588 EXIT. DTSBE321 01589 SKIP3 DTSBE321 01590 S112-FORMAT-ADDR. DTSBE321 01591 CALL 'DTSBU112' USING L112-LINK-AREA. DTSBE321 01592 S112-EXIT. DTSBE321 01593 EXIT. DTSBE321 01594 SKIP3 DTSBE321 01595 S410-FILE-SCHED. DTSBE321 01596 CALL 'DTSBU410' USING L410-LINK-AREA. DTSBE321 01597 S410-EXIT. DTSBE321 01598 EXIT. DTSBE321 01599 SKIP3 DTSBE321 01600 S415-HOUSEHOLD-DATES. DTSBE321 01601 CALL 'DTSBU415' USING L415-LINK-AREA. DTSBE321 01602 S415-EXIT. DTSBE321 01603 EXIT. DTSBE321 01604 SKIP3 DTSBE321 01605 S511-MQTR-INIT. DTSBE321 01606 CALL 'DTSBU511' USING MQTR-REC. DTSBE321 01607 S511-EXIT. DTSBE321 01608 EXIT. DTSBE321 01609 SKIP3 DTSBE321 01610 S516-LIABILITY. CL**5 01611 CALL 'DTSBU516' USING L516-LINK-AREA CL**5 01612 MPRF-LINK-REC. CL**6 01613 CL**5 01614 S516-EXIT. CL**5 01615 EXIT. CL**5 01616 SKIP3 CL**5 01617 S910-READ. DTSBE321 01618 SET L910-READ-88 TO TRUE. DTSBE321 01619 GO TO S910-MSTR-IO. DTSBE321 01620 DTSBE321 01621 S910-START-BROWSE. DTSBE321 01622 SET L910-START-BROWSE-88 TO TRUE. DTSBE321 01623 GO TO S910-MSTR-IO. DTSBE321 01624 DTSBE321 01625 S910-READ-NEXT. DTSBE321 01626 SET L910-READ-NEXT-88 TO TRUE. DTSBE321 01627 GO TO S910-MSTR-IO. DTSBE321 01628 DTSBE321 01629 *S910-COUNT. DTSBE321 01630 *****SET L910-COUNT-88 TO TRUE. DTSBE321 01631 *****GO TO S910-MSTR-IO. DTSBE321 01632 DTSBE321 01633 S910-WRITE. DTSBE321 01634 SET L910-WRITE-88 TO TRUE. DTSBE321 01635 SET LECM-EMP-UPDATED-YES-88 TO TRUE. DTSBE321 01636 GO TO S910-MSTR-IO. DTSBE321 01637 DTSBE321 01638 S910-REWRITE. DTSBE321 01639 SET L910-REWRITE-88 TO TRUE. DTSBE321 01640 SET LECM-EMP-UPDATED-YES-88 TO TRUE. DTSBE321 01641 GO TO S910-MSTR-IO. DTSBE321 01642 DTSBE321 01643 *S910-DELETE. DTSBE321 01644 *****SET L910-DELETE-88 TO TRUE. DTSBE321 01645 *****SET LECM-EMP-UPDATED-YES-88 TO TRUE. DTSBE321 01646 *****GO TO S910-MSTR-IO. DTSBE321 01647 DTSBE321 01648 S910-MSTR-IO. DTSBE321 01649 CALL 'DTSBU910' USING L910-LINK-AREA DTSBE321 01650 MSKL-REC. DTSBE321 01651 S910-EXIT. DTSBE321 01652 EXIT. DTSBE321 01653 SKIP3 DTSBE321 01654 S923-OPEN-READ. DTSBE321 01655 SET L923-OPEN-READ-88 TO TRUE. DTSBE321 01656 GO TO S923-ATC-IO. DTSBE321 01657 DTSBE321 01658 S923-START-BROWSE. DTSBE321 01659 SET L923-START-BROWSE-88 TO TRUE. DTSBE321 01660 GO TO S923-ATC-IO. DTSBE321 01661 DTSBE321 01662 S923-READ-NEXT. DTSBE321 01663 SET L923-READ-NEXT-88 TO TRUE. DTSBE321 01664 GO TO S923-ATC-IO. DTSBE321 01665 S923-CLOSE. DTSBE321 01666 SET L923-CLOSE-88 TO TRUE. DTSBE321 01667 GO TO S923-ATC-IO. DTSBE321 01668 DTSBE321 01669 S923-ATC-IO. DTSBE321 01670 CALL 'DTSBU923' USING L923-LINK-AREA DTSBE321 01671 ASKL-REC. DTSBE321 01672 S923-EXIT. DTSBE321 01673 EXIT. DTSBE321 01674 S931-READ. DTSBE321 01675 SET L931-READ-88 TO TRUE. DTSBE321 01676 GO TO S931-REF-I. DTSBE321 01677 DTSBE321 01678 *S931-START-BROWSE. DTSBE321 01679 *****SET L931-START-BROWSE-88 TO TRUE. DTSBE321 01680 *****GO TO S931-REF-I. DTSBE321 01681 DTSBE321 01682 *S931-READ-NEXT. DTSBE321 01683 *****SET L931-READ-NEXT-88 TO TRUE. DTSBE321 01684 *****GO TO S931-REF-I. DTSBE321 01685 DTSBE321 01686 S931-WRITE. DTSBE321 01687 SET L931-WRITE-88 TO TRUE. DTSBE321 01688 GO TO S931-REF-I. DTSBE321 01689 DTSBE321 01690 S931-REWRITE. DTSBE321 01691 SET L931-REWRITE-88 TO TRUE. DTSBE321 01692 GO TO S931-REF-I. DTSBE321 01693 DTSBE321 01694 *S931-DELETE. DTSBE321 01695 *****SET L931-DELETE-88 TO TRUE. DTSBE321 01696 *****GO TO S931-REF-I. DTSBE321 01697 DTSBE321 01698 S931-REF-I. DTSBE321 01699 CALL 'DTSBU931' USING L931-LINK-AREA DTSBE321 01700 FSKL-REC. DTSBE321 01701 S931-EXIT. DTSBE321 01702 EXIT. DTSBE321 01703 SKIP3 DTSBE321 01704 S946-WRITE-R907. DTSBE321 01705 DTSBE321 01706 CALL 'DTSBU946' USING R907-REC. DTSBE321 01707 GO TO S946-EXIT. DTSBE321 01708 S946-WRITE-R321. DTSBE321 01709 DTSBE321 01710 CALL 'DTSBU946' USING R321-REC. DTSBE321 01711 GO TO S946-EXIT. DTSBE321 01712 DTSBE321 01713 S946-EXIT. DTSBE321 01714 EXIT. DTSBE321 01715 SKIP3 DTSBE321 01716 S927-WRITE-T026. DTSBE321 01717 SET L927-WRITE-88 TO TRUE. DTSBE321 01718 CALL 'DTSBU927' USING L927-LINK-AREA DTSBE321 01719 T026-REC. DTSBE321 01720 GO TO S927-EXIT. DTSBE321 01721 DTSBE321 01722 S927-EXIT. DTSBE321 01723 EXIT. DTSBE321 01724 SKIP3 DTSBE321 01725 S999-ABEND. DTSBE321 01726 DISPLAY '*** DTSBE321 ABENDING. ' DTSBE321 01727 ABEND-MSG. DTSBE321 01728 DTSBE321 01729 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBE321 01730 S999-EXIT. DTSBE321 01731 EXIT. DTSBE321