00001 IDENTIFICATION DIVISION. 11/07/13 00002 PROGRAM-ID. DTSACH01. DTSACH01 00003 AUTHOR. NGI. LV006 00004 DATE-WRITTEN. JUNE 2009. DTSACH01 00005 DATE-COMPILED. DTSACH01 00006 SKIP3 DTSACH01 00007 ***** DTSACH01 00008 * DTSACH01 00009 * FUNCTION: REPRINT DUTAS REPORTS FROM ARCHIVE FILE DTSACH01 00010 * DTSACH01 00011 * DTSACH01 00012 * MODIFICATION LOG: DTSACH01 00013 * DTSACH01 00014 * 06/10/09 INITIAL DEVELOPMENT. DTSACH01 00015 * WORK ORDER: PROGRAMMER: ZL1 DTSACH01 00016 * DTSACH01 00017 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSACH01 00018 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSACH01 00019 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSACH01 00020 * DTSACH01 00021 * DTSACH01 00022 * DESCRIPTION: DTSACH01 00023 * DTSACH01 00024 * DTSACH01 PERFORMS ALL REQUIRED REPRINTING OF FORMS AND DTSACH01 00025 * LETTERS FROM ARCHIVE FILE. DTSACH01 00026 * DTSACH01 00027 * DTSACH01 00028 * GENERAL SPECIFICATIONS: DTSACH01 00029 * DTSACH01 00030 * TO ADD A NEW REPORT FOR ARCHIVING THE FOLLOWING STEPS DTSACH01 00031 * MUST BE COMPLETED: DTSACH01 00032 * 1. INCLUDE THE REPORT NUMBER IN DTSACH01 (IF JOB DTSACH01 00033 * WILL RUN DAILY) OR INCLUDE A SORT STEP TO SELECT DTSACH01 00034 * REPORT IF RUN STANDALONE. DTSACH01 00035 * 2. CHANGE PROC DTSACH01 TO INCLUDE REPORT NAME FOR DTSACH01 00036 * REPRINTING DTSACH01 00037 * 3. CHANGE PROGRAM DTSACH01 TO INCLUDE THE REPORT DTSACH01 00038 * (IR) COPYBOOK DTSACH01 00039 * CODE AN IF STATEMTNT FOR NEW REPORT DTSACH01 00040 * CODE SUBROUTING TO CHECK RUN DATE AND EMP NO DTSACH01 00041 ***** DTSACH01 00042 * THE FOLLOWING OUTPUTS ARE CURRENTLY BEING ARCHIVED DTSACH01 00043 ***** D 102 - REGISTRATION CYCLE A - FIRST LETTER DTSACH01 00044 ***** D 103 - REGISTRATION CYCLE A - SECOND LETTER DTSACH01 00045 ***** D 105 - REGISTRATION CYCLE A - COOPERATING LETTER DTSACH01 00046 ***** D 108 - NOT LIABLE DTSACH01 00047 ***** D 109 - MISSING REPORTS DTSACH01 00048 ***** D 112 - LIABLE NOTICE DTSACH01 00049 ***** D 115 - WELCOME LETTER DTSACH01 00050 ***** D 117 - INACTIVATION LETTER DTSACH01 00051 ***** D 131 - HOUSEHOLD FILING STATUS DTSACH01 00052 ***** D 309 - CREDIT MEMO DTSACH01 00053 ***** D 316 - ESTIMATED REPORT LETTER(DTSRQ412 & BATCH RELESE) DTSACH01 00054 ***** D 317 - TAXABLE WAGE ERROR LETTER DTSACH01 00055 ***** D 319 - RETURN CHECK NOTICE DTSACH01 00056 ***** D 320 - PENALTY ASSESSMENT NOTICE DTSACH01 00057 ***** D 325 - SELF-INSURED ADMIN ASSESSMENT BILL DTSACH01 00058 ***** D 403 - LEIN DTSACH01 00059 ***** M 405 - LEIN RELEASE(DTSPMON1) DTSACH01 00060 ***** D 408 - PAYMENT PLAN SATISFIED DTSACH01 00061 ***** M 414 - STATEMENT OF ACCOUNTS (DTSPMON1) DTSACH01 00062 ***** D 415 - DEBIT MEMO DTSACH01 00063 ***** R 417 - FIRST DELINQUENCY(DTSRQ321/DTSRQ417) DTSACH01 00064 ***** R 421 - FINAL DELINQUENCY(DTSRQ420) DTSACH01 00065 ***** R 433 - SELF INSURED DELINQUENCY (DTSRQ433) DTSACH01 00066 ***** D 434 - DEFERRED PAYMENT CONTRACT DTSACH01 00067 ***** R 451 - ANNUAL FIRST DELINQUENCY (DTSRQ451) DTSACH01 00068 ***** R 453 - ANNUAL FINAL DELINQUENCY (DTSRQ453) DTSACH01 00069 ***** R 503 - QUARTERLY FILERS RATE NOTICES (DTSRQ500) DTSACH01 00070 ***** R 518 - ANNUAL FILERS RATE NOTICES (DTSRQ518) DTSACH01 00071 ***** D 615 - AUDIT NOTIFCATION LETTER DTSACH01 00072 ***** Q 712 - REQUEST FOR FEIN DTSACH01 00073 ***** D 726 - MISSING EMPLOYEE COUNTS DTSACH01 00074 ***** D 903 - REQUEST FOR FEIN (CICS OVERNIGHT PRINT) DTSACH01 00075 ***** DTSACH01 00076 ***** DTSACH01 00077 ***** D - ARCHIVED FROM THE DAILY RUN DTSPDAY1 DTSACH01 00078 ***** M - ARCHIVED FROM THE MONTHLY RUN DTSPMON1 DTSACH01 00079 ***** R - ARCHIVED FROM ON REQUEST JOBS DTSACH01 00080 ***** DTSACH01 00081 ***** DTSACH01 00082 ENVIRONMENT DIVISION. DTSACH01 00083 SKIP2 DTSACH01 00084 INPUT-OUTPUT SECTION. DTSACH01 00085 DTSACH01 00086 FILE-CONTROL. DTSACH01 00087 SELECT OPTIONAL VAR-FILE ASSIGN TO DTSACHIN DTSACH01 00088 FILE STATUS IS FILE-STATUS. DTSACH01 00089 SELECT ACH-PARM ASSIGN TO DTSACHPM DTSACH01 00090 FILE STATUS IS FILE-STATUS. DTSACH01 00091 SELECT ACH-EMPL ASSIGN TO DTSACHEM DTSACH01 00092 FILE STATUS IS FILE-STATUS. DTSACH01 00093 SKIP3 DTSACH01 00094 DATA DIVISION. DTSACH01 00095 SKIP3 DTSACH01 00096 FILE SECTION. DTSACH01 00097 SKIP3 DTSACH01 00098 FD ACH-PARM DTSACH01 00099 RECORDING MODE IS F DTSACH01 00100 BLOCK CONTAINS 0 RECORDS. DTSACH01 00101 01 PARM-REC. DTSACH01 00102 05 PARM-REC-TYPE PIC X(03). DTSACH01 00103 05 PARM-REC-SUB-TYPE. DTSACH01 00104 10 PARM-REC-SUB-TYPEA PIC X(01). DTSACH01 00105 10 PARM-REC-SUB-TYPEB PIC X(01). DTSACH01 00106 05 PARM-REC-START-DATE PIC 9(08). DTSACH01 00107 05 PARM-REC-END-DATE PIC 9(08). DTSACH01 00108 05 FILLER PIC X(59). DTSACH01 00109 DTSACH01 00110 FD ACH-EMPL DTSACH01 00111 RECORDING MODE IS F DTSACH01 00112 BLOCK CONTAINS 0 RECORDS. DTSACH01 00113 01 EMPL-REC. DTSACH01 00114 05 EMPL-NO PIC 9(06). DTSACH01 00115 05 FILLER PIC X(74). DTSACH01 00116 DTSACH01 00117 FD VAR-FILE DTSACH01 00118 RECORDING MODE IS V DTSACH01 00119 BLOCK CONTAINS 0 RECORDS. DTSACH01 00120 DTSACH01 00121 01 FILE-REC. DTSACH01 00122 ++INCLUDE DTSIRVAR DTSACH01 00123 SKIP3 DTSACH01 00124 01 RSK3-REC. DTSACH01 00125 ++INCLUDE DTSIRSK3 DTSACH01 00126 EJECT DTSACH01 00127 WORKING-STORAGE SECTION. DTSACH01 001275 77 PAN-VALET PICTURE X(24) VALUE '006DTSACH01 11/07/13'. DTSACH01 00128 77 PAN-VALET PICTURE X(24) VALUE '004DTSACH01 11/06/13'. DTSACH01 00129 77 PAN-VALET PICTURE X(24) VALUE '004DTSACH01 11/19/09'. DTSACH01 00130 SKIP3 DTSACH01 00131 01 WRK-AREA. DTSACH01 00132 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +941.DTSACH01 00133 DTSACH01 00134 05 VAR-CHAR-CNT PIC S9(04) COMP. DTSACH01 00135 05 WRK-REC-CNT PIC S9(07) COMP-3. DTSACH01 00136 05 WRK-REC-START-DATE PIC S9(09) COMP-3 VALUE +0. DTSACH01 00137 05 WRK-REC-END-DATE PIC S9(09) COMP-3 VALUE +0. DTSACH01 00138 05 WRK-REC-EMP-NO PIC S9(07) COMP-3 VALUE +0. DTSACH01 00139 05 WRK-ACH-EMP-NO PIC S9(07) COMP-3 VALUE +0. DTSACH01 00140 05 WRK-REC-MAIL-DATE PIC S9(09) COMP-3 VALUE +0. DTSACH01 00141 05 WRK-DISP-ENO PIC 9(06) VALUE 0. DTSACH01 00142 05 WRK-DISP-MAIL-DATE PIC 9(08) VALUE 0. DTSACH01 00143 05 WRK-DISP-STA-DATE PIC 9(08) VALUE 0. DTSACH01 00144 05 WRK-DISP-END-DATE PIC 9(08) VALUE 0. DTSACH01 00145 05 WRK-EMP-NO PIC 9(06) VALUE 0. DTSACH01 00146 05 EINDEX PIC 9(06) VALUE 0. DTSACH01 00147 05 SINDEX PIC 9(06) VALUE 0. DTSACH01 00148 DTSACH01 00149 05 REC-STATUS PIC 9(01). DTSACH01 00150 88 WRITE-OK-88 VALUE 0. DTSACH01 00151 88 WRITE-NO-REC-88 VALUE 1. DTSACH01 00152 DTSACH01 00153 05 FILE-STATUS PIC X(02). DTSACH01 00154 88 FILE-OK-88 VALUE '00'. DTSACH01 00155 88 FILE-NO-REC-88 VALUE '10'. DTSACH01 00156 EJECT DTSACH01 00157 DTSACH01 00158 01 EMPL-TABLE. DTSACH01 00159 05 ETBL-EMP OCCURS 100 TIMES PIC 9(6). DTSACH01 00160 DTSACH01 00161 01 RLEN-LENGTH-LITERALS. DTSACH01 00162 ++INCLUDE DTSIRLEN DTSACH01 00163 EJECT DTSACH01 00164 01 R102-REC. DTSACH01 00165 ++INCLUDE DTSIR102 DTSACH01 00166 01 R103-REC. DTSACH01 00167 ++INCLUDE DTSIR103 DTSACH01 00168 01 R105-REC. DTSACH01 00169 ++INCLUDE DTSIR105 DTSACH01 00170 01 R108-REC. DTSACH01 00171 ++INCLUDE DTSIR108 DTSACH01 00172 01 R109-REC. DTSACH01 00173 ++INCLUDE DTSIR109 DTSACH01 00174 01 R112-REC. DTSACH01 00175 ++INCLUDE DTSIR112 DTSACH01 00176 01 R115-REC. DTSACH01 00177 ++INCLUDE DTSIR115 DTSACH01 00178 01 R117-REC. DTSACH01 00179 ++INCLUDE DTSIR117 DTSACH01 00180 01 R131-REC. DTSACH01 00181 ++INCLUDE DTSIR131 DTSACH01 00182 01 R309-REC. DTSACH01 00183 ++INCLUDE DTSIR309 DTSACH01 00184 01 R316-REC. DTSACH01 00185 ++INCLUDE DTSIR316 DTSACH01 00186 01 R317-REC. DTSACH01 00187 ++INCLUDE DTSIR317 DTSACH01 00188 01 R319-REC. DTSACH01 00189 ++INCLUDE DTSIR319 DTSACH01 00190 01 R320-REC. DTSACH01 00191 ++INCLUDE DTSIR320 DTSACH01 00192 01 R325-REC. DTSACH01 00193 ++INCLUDE DTSIR325 DTSACH01 00194 01 R403-REC. DTSACH01 00195 ++INCLUDE DTSIR403 DTSACH01 00196 01 R405-REC. DTSACH01 00197 ++INCLUDE DTSIR405 DTSACH01 00198 01 R408-REC. DTSACH01 00199 ++INCLUDE DTSIR408 DTSACH01 00200 01 R414-REC. DTSACH01 00201 ++INCLUDE DTSIR414 DTSACH01 00202 01 R415-REC. DTSACH01 00203 ++INCLUDE DTSIR415 DTSACH01 00204 01 R417-REC. DTSACH01 00205 ++INCLUDE DTSIR417 DTSACH01 00206 01 R421-REC. DTSACH01 00207 ++INCLUDE DTSIR421 DTSACH01 00208 01 R433-REC. DTSACH01 00209 ++INCLUDE DTSIR433 DTSACH01 00210 01 R434-REC. DTSACH01 00211 ++INCLUDE DTSIR434 DTSACH01 00212 01 R451-REC. DTSACH01 00213 ++INCLUDE DTSIR451 DTSACH01 00214 01 R453-REC. DTSACH01 00215 ++INCLUDE DTSIR453 DTSACH01 00216 01 R503-REC. DTSACH01 00217 ++INCLUDE DTSIR503 DTSACH01 00218 01 R608-REC. DTSACH01 00219 ++INCLUDE DTSIR608 DTSACH01 00220 01 R615-REC. DTSACH01 00221 ++INCLUDE DTSIR615 DTSACH01 00222 01 R712-REC. DTSACH01 00223 ++INCLUDE DTSIR712 DTSACH01 00224 01 R726-REC. DTSACH01 00225 ++INCLUDE DTSIR726 DTSACH01 00226 01 R903-REC. DTSACH01 00227 ++INCLUDE DTSIR903 DTSACH01 00228 EJECT DTSACH01 00229 01 L001-LINK-AREA. DTSACH01 00230 ++INCLUDE DTSIL001 DTSACH01 00231 EJECT DTSACH01 00232 01 L941-REC. DTSACH01 00233 ++INCLUDE DTSIL941 DTSACH01 00234 EJECT DTSACH01 00235 LINKAGE SECTION. DTSACH01 00236 PROCEDURE DIVISION. DTSACH01 00237 DTSACH01 00238 PERFORM P1100-OPEN-READ THRU P1100-EXIT. DTSACH01 00239 PERFORM P1150-LOAD-EMP THRU P1150-EXIT. DTSACH01 00240 PERFORM P2300-READ-NEXT THRU P2300-EXIT. DTSACH01 00241 PERFORM P1200-CLOSE THRU P1200-EXIT. DTSACH01 00242 DTSACH01 00243 GOBACK. DTSACH01 00244 EJECT DTSACH01 00245 P1100-OPEN-READ. DTSACH01 00246 OPEN INPUT VAR-FILE ACH-PARM ACH-EMPL. DTSACH01 00247 IF FILE-OK-88 DTSACH01 00248 SET L941-READ-NEXT-88 TO TRUE DTSACH01 00249 ELSE DTSACH01 00250 PERFORM S999-ABEND THRU S999-EXIT. DTSACH01 00251 DTSACH01 00252 READ ACH-PARM. DTSACH01 00253 IF FILE-OK-88 DTSACH01 00254 NEXT SENTENCE DTSACH01 00255 ELSE DTSACH01 00256 PERFORM S999-ABEND THRU S999-EXIT. DTSACH01 00257 DTSACH01 00258 DISPLAY ' PARM REC ' PARM-REC. DTSACH01 00259 IF PARM-REC-TYPE = SPACES DTSACH01 00260 DISPLAY ' PARM RECORD TYPE IS MISSING ' DTSACH01 00261 PERFORM S999-ABEND THRU S999-EXIT. DTSACH01 00262 DTSACH01 00263 IF PARM-REC-START-DATE = SPACES DTSACH01 00264 DISPLAY ' PARM START DATE IS MISSING ' DTSACH01 00265 PERFORM S999-ABEND THRU S999-EXIT DTSACH01 00266 ELSE DTSACH01 00267 MOVE PARM-REC-START-DATE TO L001-FED-8-DATE-9 DTSACH01 00268 WRK-REC-START-DATE DTSACH01 00269 WRK-DISP-STA-DATE DTSACH01 00270 PERFORM S001-DATE THRU S001-EXIT. DTSACH01 00271 DTSACH01 00272 IF PARM-REC-END-DATE = SPACES DTSACH01 00273 DISPLAY ' PARM END DATE IS MISSING ' DTSACH01 00274 PERFORM S999-ABEND THRU S999-EXIT DTSACH01 00275 ELSE DTSACH01 00276 MOVE PARM-REC-END-DATE TO L001-FED-8-DATE-9 DTSACH01 00277 WRK-REC-END-DATE DTSACH01 00278 WRK-DISP-END-DATE DTSACH01 00279 PERFORM S001-DATE THRU S001-EXIT. DTSACH01 00280 MOVE +0 TO WRK-REC-CNT. DTSACH01 00281 MOVE 1 TO EINDEX. DTSACH01 00282 MOVE ZEROS TO EMPL-TABLE. DTSACH01 00283 P1100-EXIT. DTSACH01 00284 EXIT. DTSACH01 00285 P1150-LOAD-EMP. DTSACH01 00286 READ ACH-EMPL AT END GO TO P1150-EXIT. DTSACH01 00287 MOVE EMPL-NO TO ETBL-EMP(EINDEX) DTSACH01 00288 ADD 1 TO EINDEX DTSACH01 00289 MOVE EINDEX TO SINDEX DTSACH01 00290 IF EINDEX > 99 DTSACH01 00291 DISPLAY '*** EMP TABLE IS TO SMALL UP INDEX' DTSACH01 00292 PERFORM S999-ABEND THRU S999-EXIT DTSACH01 00293 END-IF. DTSACH01 00294 GO TO P1150-LOAD-EMP. DTSACH01 00295 P1150-EXIT. DTSACH01 00296 EXIT. DTSACH01 00297 P1200-CLOSE. DTSACH01 00298 CLOSE VAR-FILE ACH-PARM ACH-EMPL. DTSACH01 00299 DTSACH01 00300 IF NOT FILE-OK-88 DTSACH01 00301 PERFORM S999-ABEND THRU S999-EXIT. DTSACH01 00302 DTSACH01 00303 P1200-EXIT. DTSACH01 00304 EXIT. DTSACH01 00305 EJECT DTSACH01 00306 P2300-READ-NEXT. DTSACH01 00307 MOVE 0 TO REC-STATUS. DTSACH01 00308 IF L941-NO-REC-88 DTSACH01 00309 GO TO P2300-EXIT. DTSACH01 00310 READ VAR-FILE. DTSACH01 00311 DTSACH01 00312 IF FILE-NO-REC-88 DTSACH01 00313 SET L941-NO-REC-88 TO TRUE DTSACH01 00314 GO TO P2300-EXIT. DTSACH01 00315 DTSACH01 00316 IF NOT FILE-OK-88 DTSACH01 00317 PERFORM S999-ABEND THRU S999-EXIT. DTSACH01 00318 DTSACH01 00319 IF RSK3-REC-TYPE = '000' OR SPACES OR LOW-VALUES DTSACH01 00320 GO TO P2300-READ-NEXT. DTSACH01 00321 DTSACH01 00322 IF RSK3-REC-TYPE LESS THAN PARM-REC-TYPE DTSACH01 00323 GO TO P2300-READ-NEXT. DTSACH01 00324 DTSACH01 00325 IF RSK3-REC-TYPE GREATER THAN PARM-REC-TYPE DTSACH01 00326 GO TO P2300-EXIT. DTSACH01 00327 DTSACH01 00328 IF PARM-REC-TYPE = '102' DTSACH01 00329 PERFORM P102-1ST-LETTER THRU P102-EXIT DTSACH01 00330 GO TO P2300-CONTINUE. DTSACH01 00331 DTSACH01 00332 IF PARM-REC-TYPE = '103' DTSACH01 00333 PERFORM P103-2ND-LETTER THRU P103-EXIT DTSACH01 00334 GO TO P2300-CONTINUE. DTSACH01 00335 DTSACH01 00336 IF PARM-REC-TYPE = '105' DTSACH01 00337 PERFORM P105-CST-LETTER THRU P105-EXIT DTSACH01 00338 GO TO P2300-CONTINUE. DTSACH01 00339 DTSACH01 00340 IF PARM-REC-TYPE = '108' DTSACH01 00341 PERFORM P108-NLL-LETTER THRU P108-EXIT DTSACH01 00342 GO TO P2300-CONTINUE. DTSACH01 00343 DTSACH01 00344 IF PARM-REC-TYPE = '109' DTSACH01 00345 PERFORM P109-MIS-LETTER THRU P109-EXIT DTSACH01 00346 GO TO P2300-CONTINUE. DTSACH01 00347 DTSACH01 00348 IF PARM-REC-TYPE = '112' DTSACH01 00349 PERFORM P112-LIA-NOTICE THRU P112-EXIT DTSACH01 00350 GO TO P2300-CONTINUE. DTSACH01 00351 DTSACH01 00352 IF PARM-REC-TYPE = '115' DTSACH01 00353 PERFORM P115-WEL-LETTER THRU P115-EXIT DTSACH01 00354 GO TO P2300-CONTINUE. DTSACH01 00355 DTSACH01 00356 IF PARM-REC-TYPE = '117' DTSACH01 00357 PERFORM P117-INA-LETTER THRU P117-EXIT DTSACH01 00358 GO TO P2300-CONTINUE. DTSACH01 00359 DTSACH01 00360 IF PARM-REC-TYPE = '131' DTSACH01 00361 PERFORM P131-HFS-LETTER THRU P131-EXIT DTSACH01 00362 GO TO P2300-CONTINUE. DTSACH01 00363 DTSACH01 00364 IF PARM-REC-TYPE = '309' DTSACH01 00365 PERFORM P309-CDT-LETTER THRU P309-EXIT DTSACH01 00366 GO TO P2300-CONTINUE. DTSACH01 00367 DTSACH01 00368 IF PARM-REC-TYPE = '316' DTSACH01 00369 PERFORM P316-EST-LETTER THRU P316-EXIT DTSACH01 00370 GO TO P2300-CONTINUE. DTSACH01 00371 DTSACH01 00372 IF PARM-REC-TYPE = '317' DTSACH01 00373 PERFORM P317-TAX-NOTICE THRU P317-EXIT DTSACH01 00374 GO TO P2300-CONTINUE. DTSACH01 00375 DTSACH01 00376 IF PARM-REC-TYPE = '319' DTSACH01 00377 PERFORM P319-RET-LETTER THRU P319-EXIT DTSACH01 00378 GO TO P2300-CONTINUE. DTSACH01 00379 DTSACH01 00380 IF PARM-REC-TYPE = '320' DTSACH01 00381 PERFORM P320-PEN-LETTER THRU P320-EXIT DTSACH01 00382 GO TO P2300-CONTINUE. DTSACH01 00383 DTSACH01 00384 IF PARM-REC-TYPE = '325' DTSACH01 00385 PERFORM P325-SIA-LETTER THRU P325-EXIT DTSACH01 00386 GO TO P2300-CONTINUE. DTSACH01 00387 DTSACH01 00388 IF PARM-REC-TYPE = '403' DTSACH01 00389 PERFORM P403-LIN-LETTER THRU P403-EXIT DTSACH01 00390 GO TO P2300-CONTINUE. DTSACH01 00391 DTSACH01 00392 IF PARM-REC-TYPE = '405' DTSACH01 00393 PERFORM P405-LRE-LETTER THRU P405-EXIT DTSACH01 00394 GO TO P2300-CONTINUE. DTSACH01 00395 DTSACH01 00396 IF PARM-REC-TYPE = '408' DTSACH01 00397 PERFORM P408-PPS-LETTER THRU P408-EXIT DTSACH01 00398 GO TO P2300-CONTINUE. DTSACH01 00399 DTSACH01 00400 IF PARM-REC-TYPE = '414' DTSACH01 00401 PERFORM P414-SOA-NOTICE THRU P414-EXIT DTSACH01 00402 GO TO P2300-CONTINUE. DTSACH01 00403 DTSACH01 00404 IF PARM-REC-TYPE = '415' DTSACH01 00405 PERFORM P415-DEB-LETTER THRU P415-EXIT DTSACH01 00406 GO TO P2300-CONTINUE. DTSACH01 00407 DTSACH01 00408 IF PARM-REC-TYPE = '417' DTSACH01 00409 PERFORM P417-1ST-LETTER THRU P417-EXIT DTSACH01 00410 GO TO P2300-CONTINUE. DTSACH01 00411 DTSACH01 00412 IF PARM-REC-TYPE = '421' DTSACH01 00413 PERFORM P421-FIN-LETTER THRU P421-EXIT DTSACH01 00414 GO TO P2300-CONTINUE. DTSACH01 00415 DTSACH01 00416 IF PARM-REC-TYPE = '433' DTSACH01 00417 PERFORM P433-2ND-SILETR THRU P433-EXIT DTSACH01 00418 GO TO P2300-CONTINUE. DTSACH01 00419 DTSACH01 00420 IF PARM-REC-TYPE = '434' DTSACH01 00421 PERFORM P434-DPC-LETTER THRU P434-EXIT DTSACH01 00422 GO TO P2300-CONTINUE. DTSACH01 00423 DTSACH01 00424 IF PARM-REC-TYPE = '451' DTSACH01 00425 PERFORM P451-AN1-LETTER THRU P451-EXIT DTSACH01 00426 GO TO P2300-CONTINUE. DTSACH01 00427 DTSACH01 00428 IF PARM-REC-TYPE = '453' DTSACH01 00429 PERFORM P453-ANF-LETTER THRU P453-EXIT DTSACH01 00430 GO TO P2300-CONTINUE. DTSACH01 00431 DTSACH01 00432 IF PARM-REC-TYPE = '503' DTSACH01 00433 PERFORM P503-RTE-NOTICE THRU P503-EXIT DTSACH01 00434 GO TO P2300-CONTINUE. DTSACH01 00435 DTSACH01 00436 IF PARM-REC-TYPE = '615' DTSACH01 00437 PERFORM P615-AUD-LETTER THRU P615-EXIT DTSACH01 00438 GO TO P2300-CONTINUE. DTSACH01 00439 DTSACH01 00440 IF PARM-REC-TYPE = '712' DTSACH01 00441 PERFORM P712-FIN-LETTER THRU P712-EXIT DTSACH01 00442 GO TO P2300-CONTINUE. DTSACH01 00443 DTSACH01 00444 IF PARM-REC-TYPE = '726' DTSACH01 00445 PERFORM P726-MEC-LETTER THRU P726-EXIT DTSACH01 00446 GO TO P2300-CONTINUE. DTSACH01 00447 DTSACH01 00448 IF PARM-REC-TYPE = '903' DTSACH01 00449 PERFORM P903-FID-LETTER THRU P903-EXIT DTSACH01 00450 GO TO P2300-CONTINUE. DTSACH01 00451 DTSACH01 00452 DISPLAY ' RECORD BYPASSED ' PARM-REC-TYPE. DTSACH01 00453 GO TO P2300-READ-NEXT. DTSACH01 00454 P2300-CONTINUE. DTSACH01 00455 DTSACH01 00456 MOVE 1 TO EINDEX DTSACH01 00457 PERFORM S102-EMP THRU S102-EXIT UNTIL EINDEX > SINDEX. DTSACH01 00458 DTSACH01 00459 IF REC-STATUS = 1 DTSACH01 00460 GO TO P2300-READ-NEXT. DTSACH01 00461 DTSACH01 00462 PERFORM S103-MAIL-DATE THRU S103-EXIT DTSACH01 00463 DTSACH01 00464 IF REC-STATUS = 1 DTSACH01 00465 GO TO P2300-READ-NEXT. DTSACH01 00466 DTSACH01 00467 ADD +1 TO WRK-REC-CNT. DTSACH01 00468 DTSACH01 00469 CALL 'DTSBU946' USING RSK3-REC. DTSACH01 00470 GO TO P2300-READ-NEXT. DTSACH01 00471 P2300-EXIT. DTSACH01 00472 EXIT. DTSACH01 00473 EJECT DTSACH01 00474 P102-1ST-LETTER. DTSACH01 00475 MOVE RSK3-REC TO R102-REC. DTSACH01 00476 MOVE R102-EMP-NO TO WRK-REC-EMP-NO WRK-EMP-NO. DTSACH01 00477 MOVE R102-MAIL-DATE TO WRK-REC-MAIL-DATE DTSACH01 00478 WRK-DISP-MAIL-DATE. DTSACH01 00479 P102-EXIT. DTSACH01 00480 EXIT. DTSACH01 00481 P103-2ND-LETTER. DTSACH01 00482 MOVE RSK3-REC TO R103-REC. DTSACH01 00483 MOVE R103-EMP-NO TO WRK-REC-EMP-NO WRK-EMP-NO. DTSACH01 00484 MOVE R103-MAIL-DATE TO WRK-REC-MAIL-DATE DTSACH01 00485 WRK-DISP-MAIL-DATE. DTSACH01 00486 P103-EXIT. DTSACH01 00487 EXIT. DTSACH01 00488 P105-CST-LETTER. DTSACH01 00489 MOVE RSK3-REC TO R105-REC. DTSACH01 00490 MOVE R105-EMP-NO TO WRK-REC-EMP-NO WRK-EMP-NO. DTSACH01 00491 MOVE R105-MAIL-DATE TO WRK-REC-MAIL-DATE DTSACH01 00492 WRK-DISP-MAIL-DATE. DTSACH01 00493 P105-EXIT. DTSACH01 00494 EXIT. DTSACH01 00495 P108-NLL-LETTER. DTSACH01 00496 MOVE RSK3-REC TO R108-REC. DTSACH01 00497 MOVE R108-EMP-NO TO WRK-REC-EMP-NO WRK-EMP-NO. DTSACH01 00498 MOVE R108-MAIL-DATE TO WRK-REC-MAIL-DATE DTSACH01 00499 WRK-DISP-MAIL-DATE. DTSACH01 00500 P108-EXIT. DTSACH01 00501 EXIT. DTSACH01 00502 P109-MIS-LETTER. DTSACH01 00503 MOVE RSK3-REC TO R109-REC. DTSACH01 00504 MOVE R109-EMP-NO TO WRK-REC-EMP-NO WRK-EMP-NO. DTSACH01 00505 MOVE R109-MAIL-DATE TO WRK-REC-MAIL-DATE DTSACH01 00506 WRK-DISP-MAIL-DATE. DTSACH01 00507 P109-EXIT. DTSACH01 00508 EXIT. DTSACH01 00509 P112-LIA-NOTICE. DTSACH01 00510 MOVE RSK3-REC TO R112-REC. DTSACH01 00511 MOVE R112-EMP-NO TO WRK-REC-EMP-NO WRK-EMP-NO. DTSACH01 00512 MOVE R112-RUN-DATE TO WRK-REC-MAIL-DATE DTSACH01 00513 WRK-DISP-MAIL-DATE. DTSACH01 00514 P112-EXIT. DTSACH01 00515 EXIT. DTSACH01 00516 P115-WEL-LETTER. DTSACH01 00517 MOVE RSK3-REC TO R115-REC. DTSACH01 00518 MOVE R115-EMP-NO TO WRK-REC-EMP-NO WRK-EMP-NO. DTSACH01 00519 MOVE R115-MAIL-DATE TO WRK-REC-MAIL-DATE DTSACH01 00520 WRK-DISP-MAIL-DATE. DTSACH01 00521 P115-EXIT. DTSACH01 00522 EXIT. DTSACH01 00523 P117-INA-LETTER. DTSACH01 00524 MOVE RSK3-REC TO R117-REC. DTSACH01 00525 MOVE R117-EMP-NO TO WRK-REC-EMP-NO WRK-EMP-NO. DTSACH01 00526 MOVE R117-MAIL-DATE TO WRK-REC-MAIL-DATE DTSACH01 00527 WRK-DISP-MAIL-DATE. DTSACH01 00528 P117-EXIT. DTSACH01 00529 EXIT. DTSACH01 00530 P131-HFS-LETTER. DTSACH01 00531 MOVE RSK3-REC TO R131-REC. DTSACH01 00532 MOVE R131-EMP-NO TO WRK-REC-EMP-NO WRK-EMP-NO. DTSACH01 00533 MOVE R131-RUN-DATE TO WRK-REC-MAIL-DATE DTSACH01 00534 WRK-DISP-MAIL-DATE. DTSACH01 00535 P131-EXIT. DTSACH01 00536 EXIT. DTSACH01 00537 P309-CDT-LETTER. DTSACH01 00538 MOVE RSK3-REC TO R309-REC. DTSACH01 00539 MOVE R309-EMP-NO TO WRK-REC-EMP-NO WRK-EMP-NO. DTSACH01 00540 MOVE R309-STMT-DATE TO WRK-REC-MAIL-DATE DTSACH01 00541 WRK-DISP-MAIL-DATE. DTSACH01 00542 P309-EXIT. DTSACH01 00543 EXIT. DTSACH01 00544 P316-EST-LETTER. DTSACH01 00545 MOVE RSK3-REC TO R316-REC. DTSACH01 00546 MOVE R316-EMP-NO TO WRK-REC-EMP-NO WRK-EMP-NO. DTSACH01 00547 MOVE R316-MAIL-DATE TO WRK-REC-MAIL-DATE DTSACH01 00548 WRK-DISP-MAIL-DATE. DTSACH01 00549 P316-EXIT. DTSACH01 00550 EXIT. DTSACH01 00551 P317-TAX-NOTICE. DTSACH01 00552 MOVE RSK3-REC TO R317-REC. DTSACH01 00553 MOVE R317-EMP-NO TO WRK-REC-EMP-NO WRK-EMP-NO. DTSACH01 00554 MOVE R317-MAIL-DATE TO WRK-REC-MAIL-DATE DTSACH01 00555 WRK-DISP-MAIL-DATE. DTSACH01 00556 P317-EXIT. DTSACH01 00557 EXIT. DTSACH01 00558 P319-RET-LETTER. DTSACH01 00559 MOVE RSK3-REC TO R319-REC. DTSACH01 00560 MOVE R319-EMP-NO TO WRK-REC-EMP-NO WRK-EMP-NO. DTSACH01 00561 MOVE R319-CURR-MAIL-DATE TO WRK-REC-MAIL-DATE DTSACH01 00562 WRK-DISP-MAIL-DATE. DTSACH01 00563 P319-EXIT. DTSACH01 00564 EXIT. DTSACH01 00565 P320-PEN-LETTER. DTSACH01 00566 MOVE RSK3-REC TO R320-REC. DTSACH01 00567 MOVE R320-EMP-NO TO WRK-REC-EMP-NO WRK-EMP-NO. DTSACH01 00568 MOVE R320-MAIL-DATE TO WRK-REC-MAIL-DATE DTSACH01 00569 WRK-DISP-MAIL-DATE. DTSACH01 00570 P320-EXIT. DTSACH01 00571 EXIT. DTSACH01 00572 P325-SIA-LETTER. DTSACH01 00573 MOVE RSK3-REC TO R325-REC. DTSACH01 00574 MOVE R325-EMP-NO TO WRK-REC-EMP-NO WRK-EMP-NO. DTSACH01 00575 MOVE R325-STMT-DATE TO WRK-REC-MAIL-DATE DTSACH01 00576 WRK-DISP-MAIL-DATE. DTSACH01 00577 P325-EXIT. DTSACH01 00578 EXIT. DTSACH01 00579 DTSACH01 00580 P403-LIN-LETTER. DTSACH01 00581 MOVE RSK3-REC TO R403-REC. DTSACH01 00582 MOVE R403-EMP-NO TO WRK-REC-EMP-NO WRK-EMP-NO. DTSACH01 00583 MOVE R403-STMT-DATE TO WRK-REC-MAIL-DATE DTSACH01 00584 WRK-DISP-MAIL-DATE. DTSACH01 00585 P403-EXIT. DTSACH01 00586 EXIT. DTSACH01 00587 DTSACH01 00588 P405-LRE-LETTER. DTSACH01 00589 MOVE RSK3-REC TO R405-REC. DTSACH01 00590 MOVE R405-EMP-NO TO WRK-REC-EMP-NO WRK-EMP-NO. DTSACH01 00591 MOVE R405-STMT-DATE TO WRK-REC-MAIL-DATE DTSACH01 00592 WRK-DISP-MAIL-DATE. DTSACH01 00593 P405-EXIT. DTSACH01 00594 EXIT. DTSACH01 00595 DTSACH01 00596 P408-PPS-LETTER. DTSACH01 00597 MOVE RSK3-REC TO R408-REC. DTSACH01 00598 MOVE R408-EMP-NO TO WRK-REC-EMP-NO WRK-EMP-NO. DTSACH01 00599 MOVE R408-PERIOD-START-DATE TO WRK-REC-MAIL-DATE DTSACH01 00600 WRK-DISP-MAIL-DATE. DTSACH01 00601 P408-EXIT. DTSACH01 00602 EXIT. DTSACH01 00603 DTSACH01 00604 P414-SOA-NOTICE. DTSACH01 00605 MOVE RSK3-REC TO R414-REC. DTSACH01 00606 MOVE R414-EMP-NO TO WRK-REC-EMP-NO WRK-EMP-NO. DTSACH01 00607 MOVE R414-STMT-DATE TO WRK-REC-MAIL-DATE DTSACH01 00608 WRK-DISP-MAIL-DATE. DTSACH01 00609 P414-EXIT. DTSACH01 00610 EXIT. DTSACH01 00611 DTSACH01 00612 P415-DEB-LETTER. DTSACH01 00613 MOVE RSK3-REC TO R415-REC. DTSACH01 00614 MOVE R415-EMP-NO TO WRK-REC-EMP-NO WRK-EMP-NO. DTSACH01 00615 MOVE R415-STMT-DATE TO WRK-REC-MAIL-DATE DTSACH01 00616 WRK-DISP-MAIL-DATE. DTSACH01 00617 P415-EXIT. DTSACH01 00618 EXIT. DTSACH01 00619 P417-1ST-LETTER. DTSACH01 00620 MOVE RSK3-REC TO R417-REC. DTSACH01 00621 MOVE R417-EMP-NO TO WRK-REC-EMP-NO WRK-EMP-NO. DTSACH01 00622 MOVE R417-MAIL-DATE TO WRK-REC-MAIL-DATE DTSACH01 00623 WRK-DISP-MAIL-DATE. DTSACH01 00624 P417-EXIT. DTSACH01 00625 EXIT. DTSACH01 00626 P421-FIN-LETTER. DTSACH01 00627 MOVE RSK3-REC TO R421-REC. DTSACH01 00628 MOVE R421-EMP-NO TO WRK-REC-EMP-NO WRK-EMP-NO. DTSACH01 00629 MOVE R421-MAIL-DATE TO WRK-REC-MAIL-DATE DTSACH01 00630 WRK-DISP-MAIL-DATE. DTSACH01 00631 P421-EXIT. DTSACH01 00632 EXIT. DTSACH01 00633 DTSACH01 00634 P433-2ND-SILETR. DTSACH01 00635 MOVE RSK3-REC TO R433-REC. DTSACH01 00636 MOVE R433-EMP-NO TO WRK-REC-EMP-NO WRK-EMP-NO. DTSACH01 00637 MOVE R433-STMT-DATE TO WRK-REC-MAIL-DATE DTSACH01 00638 WRK-DISP-MAIL-DATE. DTSACH01 00639 P433-EXIT. DTSACH01 00640 EXIT. DTSACH01 00641 DTSACH01 00642 DTSACH01 00643 P434-DPC-LETTER. DTSACH01 00644 MOVE RSK3-REC TO R434-REC. DTSACH01 00645 MOVE R434-EMP-NO TO WRK-REC-EMP-NO WRK-EMP-NO. DTSACH01 00646 MOVE R434-STMT-DATE TO WRK-REC-MAIL-DATE DTSACH01 00647 WRK-DISP-MAIL-DATE. DTSACH01 00648 P434-EXIT. DTSACH01 00649 EXIT. DTSACH01 00650 DTSACH01 00651 P451-AN1-LETTER. DTSACH01 00652 MOVE RSK3-REC TO R451-REC. DTSACH01 00653 MOVE R451-EMP-NO TO WRK-REC-EMP-NO WRK-EMP-NO. DTSACH01 00654 MOVE R451-MAIL-DATE TO WRK-REC-MAIL-DATE DTSACH01 00655 WRK-DISP-MAIL-DATE. DTSACH01 00656 P451-EXIT. DTSACH01 00657 EXIT. DTSACH01 00658 DTSACH01 00659 P453-ANF-LETTER. DTSACH01 00660 MOVE RSK3-REC TO R453-REC. DTSACH01 00661 MOVE R453-EMP-NO TO WRK-REC-EMP-NO WRK-EMP-NO. DTSACH01 00662 MOVE R453-MAIL-DATE TO WRK-REC-MAIL-DATE DTSACH01 00663 WRK-DISP-MAIL-DATE. DTSACH01 00664 P453-EXIT. DTSACH01 00665 EXIT. DTSACH01 00666 DTSACH01 00667 P503-RTE-NOTICE. DTSACH01 00668 MOVE RSK3-REC TO R503-REC. DTSACH01 00669 MOVE R503-EMP-NO TO WRK-REC-EMP-NO WRK-EMP-NO. DTSACH01 00670 MOVE R503-NOTICE-DATE TO WRK-REC-MAIL-DATE DTSACH01 00671 WRK-DISP-MAIL-DATE. DTSACH01 00672 P503-EXIT. DTSACH01 00673 EXIT. DTSACH01 00674 DTSACH01 00675 P615-AUD-LETTER. DTSACH01 00676 MOVE RSK3-REC TO R615-REC. DTSACH01 00677 MOVE R615-EMP-NO TO WRK-REC-EMP-NO WRK-EMP-NO. DTSACH01 00678 MOVE R615-STMT-DATE TO WRK-REC-MAIL-DATE DTSACH01 00679 WRK-DISP-MAIL-DATE. DTSACH01 00680 P615-EXIT. DTSACH01 00681 EXIT. DTSACH01 00682 DTSACH01 00683 P712-FIN-LETTER. DTSACH01 00684 MOVE RSK3-REC TO R712-REC. DTSACH01 00685 MOVE R712-EMP-NO TO WRK-REC-EMP-NO WRK-EMP-NO. DTSACH01 00686 MOVE R712-MAIL-DATE TO WRK-REC-MAIL-DATE DTSACH01 00687 WRK-DISP-MAIL-DATE. DTSACH01 00688 P712-EXIT. DTSACH01 00689 EXIT. DTSACH01 00690 DTSACH01 00691 P726-MEC-LETTER. DTSACH01 00692 MOVE RSK3-REC TO R726-REC. DTSACH01 00693 MOVE R726-EMP-NO TO WRK-REC-EMP-NO WRK-EMP-NO. DTSACH01 00694 MOVE R726-MAIL-DATE TO WRK-REC-MAIL-DATE DTSACH01 00695 WRK-DISP-MAIL-DATE. DTSACH01 00696 P726-EXIT. DTSACH01 00697 EXIT. DTSACH01 00698 DTSACH01 00699 P903-FID-LETTER. DTSACH01 00700 MOVE RSK3-REC TO R903-REC. DTSACH01 00701 MOVE R903-EMP-NO TO WRK-REC-EMP-NO WRK-EMP-NO. DTSACH01 00702 MOVE R903-MAIL-DATE TO WRK-REC-MAIL-DATE DTSACH01 00703 WRK-DISP-MAIL-DATE. DTSACH01 00704 P903-EXIT. DTSACH01 00705 EXIT. DTSACH01 00706 DTSACH01 00707 S001-DATE. DTSACH01 00708 DTSACH01 00709 SET L001-FROM-FED-8 TO TRUE. DTSACH01 00710 CALL 'DTSBU001' USING L001-LINK-AREA. DTSACH01 00711 IF L001-INVALID-DATE DTSACH01 00712 DISPLAY '*** L001 RECEIVED BAD DATE' DTSACH01 00713 PERFORM S999-ABEND THRU S999-EXIT. DTSACH01 00714 DTSACH01 00715 S001-EXIT. DTSACH01 00716 EXIT. DTSACH01 00717 S102-EMP. DTSACH01 00718 MOVE ETBL-EMP(EINDEX) TO WRK-ACH-EMP-NO DTSACH01 00719 WRK-DISP-ENO. DTSACH01 00720 IF WRK-ACH-EMP-NO = WRK-REC-EMP-NO DTSACH01 00721 MOVE 0 TO REC-STATUS DTSACH01 00722 MOVE 99 TO EINDEX DTSACH01 00723 GO TO S102-EXIT DTSACH01 00724 ELSE DTSACH01 00725 MOVE 1 TO REC-STATUS DTSACH01 00726 ADD 1 TO EINDEX. DTSACH01 00727 S102-EXIT. DTSACH01 00728 EXIT. DTSACH01 00729 S103-MAIL-DATE. DTSACH01 00730 DTSACH01 00731 IF WRK-REC-MAIL-DATE > WRK-REC-END-DATE OR DTSACH01 00732 WRK-REC-MAIL-DATE < WRK-REC-START-DATE DTSACH01 00733 MOVE 1 TO REC-STATUS DTSACH01 00734 ELSE DTSACH01 00735 MOVE 0 TO REC-STATUS. DTSACH01 00736 S103-EXIT. DTSACH01 00737 EXIT. DTSACH01 00738 S999-ABEND. DTSACH01 00739 DISPLAY '*** I/O MODULE ABENDING'. DTSACH01 00740 DISPLAY '*** FILE-STATUS = ' FILE-STATUS. DTSACH01 00741 DTSACH01 00742 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSACH01 00743 S999-EXIT. DTSACH01 00744 EXIT. DTSACH01