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