746 lines
59 KiB
COBOL
746 lines
59 KiB
COBOL
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
|