00001 IDENTIFICATION DIVISION. 11/01/13 00002 PROGRAM-ID. DESBD420. DESBD420 00003 AUTHOR. NGC. LV003 00004 DATE-WRITTEN. NOVEMBER 2011. DESBD420 00005 DATE-COMPILED. DESBD420 00006 DESBD420 00007 ***** DESBD420 00008 * DESBD420 00009 * DESBD420 00010 * FUNCTION: EDIT DATA FROM DAILY W4 TRANSACTIONS. DESBD420 00011 * IF ALL RECORDS PASS THE EDITS, THE FILE DESBD420 00012 * IS FORWARDED TO DESBD421, WHICH LOCATES DESBD420 00013 * THE TAX REPORT AND RELEASES THE WAGES. DESBD420 00014 * DESBD420 00015 * MODIFICATION HISTORY: DESBD420 00016 * DESBD420 00017 * 11/22/2011 INITIAL DEVELOPMENT DESBD420 00018 * REFERENCE: PROGRAMMER: GD DESBD420 00019 * DESBD420 00020 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DESBD420 00021 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DESBD420 00022 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DESBD420 00023 * DESBD420 00024 * DESCRIPTION: DESBD420 00025 * DESBD420 00026 * DESBD420 00027 * RECORDS READ: DESBD420 00028 * W4 TRANSACTIONS FROM TDEC. DESBD420 00029 * DESBD420 00030 * PRINTED OUTPUTS: DESBD420 00031 * NONE DESBD420 00032 * DESBD420 00033 * RECORDS WRITTEN: DESBD420 00034 * W001 WAGE RECORD DESBD420 00035 * WXXX MISSING SSN RECORD DESBD420 00036 * DESBD420 00037 * MODULES CALLED: DESBD420 00038 * NONE DESBD420 00039 * DESBD420 00040 ***** DESBD420 00041 DESBD420 00042 ENVIRONMENT DIVISION. DESBD420 00043 SKIP2 DESBD420 00044 INPUT-OUTPUT SECTION. DESBD420 00045 SKIP3 DESBD420 00046 FILE-CONTROL. DESBD420 00047 SELECT TDEC-TRAN-IN ASSIGN TO DTSFTDIN DESBD420 00048 FILE STATUS IS TDEC-IN-STATUS. DESBD420 00049 DESBD420 00050 SELECT TDEC-TRAN-OUT ASSIGN TO DTSFTDO DESBD420 00051 FILE STATUS IS TDEC-OUT-STATUS. DESBD420 00052 DESBD420 00053 DATA DIVISION. DESBD420 00054 DESBD420 00055 FILE SECTION. DESBD420 00056 DESBD420 00057 FD TDEC-TRAN-IN DESBD420 00058 RECORDING MODE IS F DESBD420 00059 LABEL RECORDS ARE STANDARD DESBD420 00060 BLOCK CONTAINS 0 CHARACTERS. DESBD420 00061 SKIP1 DESBD420 00062 01 TDEC-TRAN-IN-REC. DESBD420 00063 ++INCLUDE DTSIX154 DESBD420 00064 DESBD420 00065 FD TDEC-TRAN-OUT DESBD420 00066 RECORDING MODE IS F DESBD420 00067 LABEL RECORDS ARE STANDARD DESBD420 00068 BLOCK CONTAINS 0 CHARACTERS. DESBD420 00069 SKIP1 DESBD420 00070 01 TDEC-TRAN-OUT-REC PIC X(106). DESBD420 00071 DESBD420 00072 WORKING-STORAGE SECTION. DESBD420 000725 77 PAN-VALET PICTURE X(24) VALUE '003DESBD420 11/01/13'. DESBD420 00073 77 PAN-VALET PICTURE X(24) VALUE '003DESBD420 10/30/13'. DESBD420 00074 77 PAN-VALET PICTURE X(24) VALUE '001DESBD420 02/08/13'. DESBD420 00075 77 PAN-VALET PICTURE X(24) VALUE '057DESBD420 01/14/13'. DESBD420 00076 SKIP3 DESBD420 00077 01 W-AREA. DESBD420 00078 05 W-MOD-NAME PIC X(08) VALUE 'DESBD420'. DESBD420 00079 05 WRK-ABEND-CD PIC X(03) VALUE '420'. DESBD420 00080 05 W-TRACE-IND PIC X(01) VALUE 'N'. DESBD420 00081 DESBD420 00082 05 W-ERROR-IND PIC X(01) VALUE 'N'. DESBD420 00083 88 W-ERROR-YES-88 VALUE 'Y'. DESBD420 00084 88 W-ERROR-NO-88 VALUE 'N'. DESBD420 00085 DESBD420 00086 05 TDEC-IN-STATUS PIC X(02) VALUE SPACES. DESBD420 00087 88 TDEC-IN-OK-88 VALUE '00'. DESBD420 00088 88 TDEC-IN-EOF-88 VALUE '10'. DESBD420 00089 DESBD420 00090 05 WRK-RUN-TYPE PIC X(01). DESBD420 00091 88 WRK-RUN-ONTIME-88 VALUE 'O'. DESBD420 00092 88 WRK-RUN-DELINQ-88 VALUE 'D'. DESBD420 00093 DESBD420 00094 05 TDEC-OUT-STATUS PIC X(02) VALUE SPACES. DESBD420 00095 88 TDEC-OUT-OK-88 VALUE '00'. DESBD420 00096 DESBD420 00097 05 W-WAGE-REC-IND PIC X(01) VALUE 'N'. DESBD420 00098 88 W-WAGE-REC-ERR-YES-88 VALUE 'Y'. DESBD420 00099 88 W-WAGE-REC-ERR-NO-88 VALUE 'N'. DESBD420 00100 DESBD420 00101 05 W-EMP-NBR-ERR-IND PIC X(01) VALUE 'N'. DESBD420 00102 88 W-EMP-NBR-ERR-YES-88 VALUE 'Y'. DESBD420 00103 88 W-EMP-NBR-ERR-NO-88 VALUE 'N'. DESBD420 00104 DESBD420 00105 05 W-QTR-ERR-IND PIC X(01) VALUE 'N'. DESBD420 00106 88 W-QTR-ERR-YES-88 VALUE 'Y'. DESBD420 00107 88 W-QTR-ERR-NO-88 VALUE 'N'. DESBD420 00108 DESBD420 00109 05 W-SSN-ERR-IND PIC X(01) VALUE 'N'. DESBD420 00110 88 W-SSN-ERR-YES-88 VALUE 'Y'. DESBD420 00111 88 W-SSN-ERR-NO-88 VALUE 'N'. DESBD420 00112 DESBD420 00113 05 W-BATCH-ERR-IND PIC X(01) VALUE 'N'. DESBD420 00114 88 W-BATCH-ERR-YES-88 VALUE 'Y'. DESBD420 00115 88 W-BATCH-ERR-NO-88 VALUE 'N'. DESBD420 00116 DESBD420 00117 05 W-EMP-NBR-CHNG-IND PIC X(01) VALUE 'N'. DESBD420 00118 88 W-EMP-NBR-CHNG-YES-88 VALUE 'Y'. DESBD420 00119 88 W-EMP-NBR-CHNG-NO-88 VALUE 'N'. DESBD420 00120 DESBD420 00121 05 W-WAGE-ERR-IND PIC X(01) VALUE 'N'. DESBD420 00122 88 W-WAGE-ERR-YES-88 VALUE 'Y'. DESBD420 00123 88 W-WAGE-ERR-NO-88 VALUE 'N'. DESBD420 00124 DESBD420 00125 05 W-WAGE-ON-FILE-IND PIC X(01) VALUE 'N'. DESBD420 00126 88 W-WAGE-ON-FILE-YES-88 VALUE 'Y'. DESBD420 00127 88 W-WAGE-ON-FILE-NO-88 VALUE 'N'. DESBD420 00128 DESBD420 00129 05 WRK-RETURN-CODE PIC S9(04) COMP-3 VALUE +0. DESBD420 00130 05 W-EMP-NO PIC S9(07) COMP-3 VALUE +0. DESBD420 00131 05 W-FEIN-EMP-NO PIC S9(07) COMP-3 VALUE +0. DESBD420 00132 05 W-LAST-EMP-NO PIC S9(07) COMP-3 VALUE +0. DESBD420 00133 05 W-ESTB-DATE PIC S9(09) COMP-3 VALUE +0. DESBD420 00134 DESBD420 00135 05 W-YRQ PIC S9(05) COMP-3 VALUE +0. DESBD420 00136 DESBD420 00137 05 W-CURR-YRQ PIC S9(05) COMP-3 VALUE +0. DESBD420 00138 DESBD420 00139 05 SUB2 PIC S9(04) COMP VALUE +0. DESBD420 00140 05 W-ACCT-NBR-LEN PIC S9(04) COMP VALUE +6. DESBD420 00141 05 W-ACCT-NBR-IN. DESBD420 00142 10 W-ACCT-NBR-IN-X OCCURS 6 TIMES DESBD420 00143 PIC X(01). DESBD420 00144 05 W-ACCT-NBR-9 REDEFINES W-ACCT-NBR-IN DESBD420 00145 PIC 9(06). DESBD420 00146 DESBD420 00147 05 W-SSN-LEN PIC S9(04) COMP VALUE +9. DESBD420 00148 05 W-SSN-IN. DESBD420 00149 10 W-SSN-IN-X OCCURS 9 TIMES DESBD420 00150 PIC X(01). DESBD420 00151 05 W-SSN-9 REDEFINES W-SSN-IN DESBD420 00152 PIC 9(09). DESBD420 00153 DESBD420 00154 05 W-ALL-NINES PIC 9(09) VALUE 999999999. DESBD420 00155 DESBD420 00156 05 W-TDEC-IN-CNT PIC S9(07) COMP-3 VALUE +0. DESBD420 00157 05 W-TDEC-OUT-CNT PIC S9(07) COMP-3 VALUE +0. DESBD420 00158 05 W-ERROR-CNT PIC S9(07) COMP-3 VALUE +0. DESBD420 00159 05 W-REPORT-CNT PIC S9(07) COMP-3 VALUE +0. DESBD420 00160 05 W-SSN-ON-FILE-CNT PIC S9(07) COMP-3 VALUE +0. DESBD420 00161 DESBD420 00162 05 AMT-DISP1 PIC ----------9.99. DESBD420 00163 05 AMT-DISP2 PIC ----------9.99. DESBD420 00164 05 AMT-DISP3 PIC ----------9.99. DESBD420 00165 05 AMT-DISP4 PIC ----------9.99. DESBD420 00166 DESBD420 00167 01 W001-REC. DESBD420 00168 ++INCLUDE DTSIW001 DESBD420 00169 DESBD420 00170 DESBD420 00171 01 L001-LINK-AREA. DESBD420 00172 ++INCLUDE DTSIL001 DESBD420 00173 DESBD420 00174 01 L004-LINK-AREA. DESBD420 00175 ++INCLUDE DTSIL004 DESBD420 00176 DESBD420 00177 01 L005-LINK-AREA. DESBD420 00178 ++INCLUDE DTSIL005 DESBD420 00179 DESBD420 00180 01 L516-LINK-AREA. DESBD420 00181 ++INCLUDE DTSIL516 DESBD420 00182 DESBD420 00183 01 L910-LINK-AREA. DESBD420 00184 ++INCLUDE DTSIL910 DESBD420 00185 DESBD420 00186 01 MSKL-REC. DESBD420 00187 ++INCLUDE DTSIMSKL DESBD420 00188 DESBD420 00189 01 MHDR-REC. DESBD420 00190 ++INCLUDE DTSIMHDR DESBD420 00191 DESBD420 00192 01 MPRF-REC. DESBD420 00193 ++INCLUDE DTSIMPRF DESBD420 00194 DESBD420 00195 01 MRPT-REC. DESBD420 00196 ++INCLUDE DTSIMRPT DESBD420 00197 DESBD420 00198 01 MPAY-REC. DESBD420 00199 ++INCLUDE DTSIMPAY DESBD420 00200 DESBD420 00201 01 L923-LINK-AREA. DESBD420 00202 ++INCLUDE DTSIL923 DESBD420 00203 DESBD420 00204 01 ASKL-REC. DESBD420 00205 ++INCLUDE DTSIASKL DESBD420 00206 DESBD420 00207 01 AHDR-REC. DESBD420 00208 ++INCLUDE DTSIAHDR DESBD420 00209 DESBD420 00210 01 ARPT-REC. DESBD420 00211 ++INCLUDE DTSIARPT DESBD420 00212 EJECT DESBD420 00213 01 AATX-REC. DESBD420 00214 ++INCLUDE DTSIAATX DESBD420 00215 DESBD420 00216 01 APAY-REC. DESBD420 00217 ++INCLUDE DTSIAPAY DESBD420 00218 DESBD420 00219 01 L921-LINK-AREA. DESBD420 00220 ++INCLUDE DTSIL921 DESBD420 00221 SKIP3 DESBD420 00222 01 ISKL-REC. DESBD420 00223 ++INCLUDE DTSIISKL DESBD420 00224 SKIP3 DESBD420 00225 01 IEIN-REC. DESBD420 00226 ++INCLUDE DTSIIEIN DESBD420 00227 DESBD420 00228 01 L981-LINK-AREA. DESBD420 00229 ++INCLUDE DTSIL981 DESBD420 00230 SKIP3 DESBD420 00231 01 WWGH-REC. DESBD420 00232 ++INCLUDE DTSIWWGH DESBD420 00233 LINKAGE SECTION. DESBD420 00234 DESBD420 00235 01 PARM-AREA. DESBD420 00236 05 PARM-LENGTH PIC S9(04) COMP. DESBD420 00237 DESBD420 00238 05 PARM-DATA. DESBD420 00239 10 PARM-RUN-TYPE PIC X(06). DESBD420 00240 88 PARM-RUN-ONTIME-88 VALUE 'ONTIME'. DESBD420 00241 88 PARM-RUN-DELINQ-88 VALUE 'DELINQ'. DESBD420 00242 DESBD420 00243 DESBD420 00244 PROCEDURE DIVISION USING PARM-AREA. DESBD420 00245 DESBD420 00246 DESBD420-MAIN. DESBD420 00247 PERFORM I0000-INIT THRU I0000-EXIT. DESBD420 00248 IF W-ERROR-YES-88 DESBD420 00249 GO TO DESBD420-MAIN-EXIT. DESBD420 00250 DESBD420 00251 PERFORM P0000-PROCESS THRU P0000-EXIT. DESBD420 00252 DESBD420 00253 PERFORM T0000-TERMINATE THRU T0000-EXIT. DESBD420 00254 MOVE WRK-RETURN-CODE TO RETURN-CODE. DESBD420 00255 DESBD420-MAIN-EXIT. DESBD420 00256 GOBACK. DESBD420 00257 DESBD420 00258 I0000-INIT. DESBD420 00259 PERFORM S005-FROM-SYS THRU S005-EXIT. DESBD420 00260 MOVE L005-DATE TO L004-DATE. DESBD420 00261 PERFORM S004-FROM-DATE THRU S004-EXIT. DESBD420 00262 MOVE L004-QTR-5-9 TO W-CURR-YRQ. DESBD420 00263 DESBD420 00264 IF PARM-LENGTH = +6 DESBD420 00265 NEXT SENTENCE DESBD420 00266 ELSE DESBD420 00267 DISPLAY 'PARM-LENGTH NOT EQUAL TO 6 ' PARM-LENGTH DESBD420 00268 PERFORM S999-ABEND THRU S999-EXIT DESBD420 00269 END-IF. DESBD420 00270 DESBD420 00271 IF PARM-RUN-ONTIME-88 DESBD420 00272 OR PARM-RUN-DELINQ-88 DESBD420 00273 MOVE PARM-RUN-TYPE TO WRK-RUN-TYPE DESBD420 00274 ELSE DESBD420 00275 DISPLAY 'INVALID PARM TYPE ' PARM-RUN-TYPE DESBD420 00276 PERFORM S999-ABEND THRU S999-EXIT. DESBD420 00277 DESBD420 00278 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. DESBD420 00279 DESBD420 00280 I0000-EXIT. DESBD420 00281 EXIT. DESBD420 00282 DESBD420 00283 I2000-OPEN-FILES. DESBD420 00284 PERFORM S1000-OPEN-TDEC-IN THRU S1000-EXIT. DESBD420 00285 IF W-ERROR-YES-88 DESBD420 00286 GO TO I2000-EXIT DESBD420 00287 END-IF. DESBD420 00288 DESBD420 00289 PERFORM S1100-OPEN-TDEC-OUT THRU S1100-EXIT. DESBD420 00290 IF W-ERROR-YES-88 DESBD420 00291 GO TO I2000-EXIT DESBD420 00292 END-IF. DESBD420 00293 DESBD420 00294 PERFORM S910A-OPEN-READ THRU S910A-EXIT. DESBD420 00295 PERFORM S921-OPEN-READ THRU S921-EXIT. DESBD420 00296 PERFORM S981A-OPEN-READ THRU S981A-EXIT. DESBD420 00297 DESBD420 00298 I2000-EXIT. DESBD420 00299 EXIT. DESBD420 00300 DESBD420 00301 P0000-PROCESS. DESBD420 00302 PERFORM S1010-READ-TDEC-IN THRU S1010-EXIT. DESBD420 00303 IF TDEC-IN-EOF-88 DESBD420 00304 DISPLAY 'WAGE INPUT FILE IS EMPTY ' DESBD420 00305 MOVE +3 TO WRK-RETURN-CODE DESBD420 00306 GO TO P0000-EXIT DESBD420 00307 END-IF. DESBD420 00308 DESBD420 00309 PERFORM UNTIL TDEC-IN-EOF-88 DESBD420 00310 PERFORM P1000-WAGE-EDIT THRU P1000-EXIT DESBD420 00311 IF W-WAGE-REC-ERR-NO-88 DESBD420 00312 PERFORM S1120-WRITE-TDEC-OUT THRU S1120-EXIT DESBD420 00313 END-IF DESBD420 00314 PERFORM S1010-READ-TDEC-IN THRU S1010-EXIT DESBD420 00315 END-PERFORM. DESBD420 00316 DESBD420 00317 DESBD420 00318 P0000-EXIT. DESBD420 00319 EXIT. DESBD420 00320 DESBD420 00321 P1000-WAGE-EDIT. DESBD420 00322 SET W-WAGE-REC-ERR-NO-88 TO TRUE. DESBD420 00323 DESBD420 00324 PERFORM P1100-EDIT-EMP-NBR THRU P1100-EXIT. DESBD420 00325 PERFORM P1200-EDIT-QTR THRU P1200-EXIT. DESBD420 00326 PERFORM P1300-EDIT-SSN THRU P1300-EXIT. DESBD420 00327 PERFORM P1400-EDIT-WAGES THRU P1400-EXIT. DESBD420 00328 PERFORM P1500-EDIT-BATCH THRU P1500-EXIT. DESBD420 00329 DESBD420 00330 *** PERFORM P1600-WAGES-ON-FILE THRU P1600-EXIT. DESBD420 00331 DESBD420 00332 IF W-EMP-NBR-ERR-YES-88 DESBD420 00333 OR W-QTR-ERR-YES-88 DESBD420 00334 OR W-SSN-ERR-YES-88 DESBD420 00335 OR W-WAGE-ERR-YES-88 DESBD420 00336 ** OR W-WAGE-ON-FILE-YES-88 DESBD420 00337 SET W-WAGE-REC-ERR-YES-88 TO TRUE DESBD420 00338 ADD +1 TO W-ERROR-CNT DESBD420 00339 DISPLAY 'ERROR: ' X154-EMP-NO ' ' X154-QUARTER DESBD420 00340 MOVE +2 TO WRK-RETURN-CODE DESBD420 00341 END-IF. DESBD420 00342 DESBD420 00343 IF W-EMP-NBR-ERR-NO-88 DESBD420 00344 AND W-QTR-ERR-NO-88 DESBD420 00345 IF X154-EMP-NO = W-EMP-NO DESBD420 00346 AND X154-QUARTER = W-YRQ DESBD420 00347 NEXT SENTENCE DESBD420 00348 ELSE DESBD420 00349 ADD +1 TO W-REPORT-CNT DESBD420 00350 MOVE X154-EMP-NO TO W-EMP-NO DESBD420 00351 MOVE X154-QUARTER TO W-YRQ DESBD420 00352 END-IF DESBD420 00353 END-IF. DESBD420 00354 DESBD420 00355 P1000-EXIT. DESBD420 00356 EXIT. DESBD420 00357 DESBD420 00358 P1100-EDIT-EMP-NBR. DESBD420 00359 SET W-EMP-NBR-ERR-NO-88 TO TRUE. DESBD420 00360 DESBD420 00361 INSPECT X154-EMP-NO REPLACING ALL SPACES BY ZEROS. DESBD420 00362 DESBD420 00363 MOVE X154-EMP-NO TO W-ACCT-NBR-IN. DESBD420 00364 DESBD420 00365 PERFORM DESBD420 00366 VARYING SUB2 FROM +1 BY +1 DESBD420 00367 UNTIL SUB2 > W-ACCT-NBR-LEN DESBD420 00368 IF W-ACCT-NBR-IN-X (SUB2) < '0' DESBD420 00369 OR W-ACCT-NBR-IN-X (SUB2) > '9' DESBD420 00370 SET W-EMP-NBR-ERR-YES-88 TO TRUE DESBD420 00371 MOVE X154-EARNINGS TO AMT-DISP1 DESBD420 00372 DISPLAY 'INVALID EMPLOYER NBR: ' X154-EMP-NO DESBD420 00373 ' ' X154-QUARTER ' ' AMT-DISP1 DESBD420 00374 END-IF DESBD420 00375 END-PERFORM. DESBD420 00376 DESBD420 00377 IF W-EMP-NBR-ERR-NO-88 DESBD420 00378 IF X154-EMP-NO = ZERO DESBD420 00379 PERFORM P1110-FROM-FEIN THRU P1110-EXIT DESBD420 00380 MOVE W-FEIN-EMP-NO TO X154-EMP-NO DESBD420 00381 ELSE DESBD420 00382 GO TO P1100-EXIT DESBD420 00383 END-IF DESBD420 00384 END-IF. DESBD420 00385 DESBD420 00386 IF W-FEIN-EMP-NO = ZERO DESBD420 00387 IF X154-ITEM > 0 DESBD420 00388 NEXT SENTENCE DESBD420 00389 ELSE DESBD420 00390 * SET W-EMP-NBR-ERR-YES-88 TO TRUE DESBD420 00391 DISPLAY 'NO EMP NBR, NO FEIN, NO ITEM: ' DESBD420 00392 ' ' X154-EMP-NO ' ' X154-FEIN ' ' X154-ITEM DESBD420 00393 END-IF DESBD420 00394 END-IF. DESBD420 00395 DESBD420 00396 P1100-EXIT. DESBD420 00397 EXIT. DESBD420 00398 DESBD420 00399 P1110-FROM-FEIN. DESBD420 00400 MOVE +0 TO W-FEIN-EMP-NO DESBD420 00401 W-LAST-EMP-NO DESBD420 00402 W-ESTB-DATE. DESBD420 00403 DESBD420 00404 MOVE LOW-VALUE TO IEIN-KEY-AREA DESBD420 00405 SET IEIN-EIN-88 TO TRUE DESBD420 00406 MOVE X154-FEIN TO IEIN-FEIN DESBD420 00407 MOVE +0 TO IEIN-EMP-NO DESBD420 00408 MOVE IEIN-KEY-AREA TO ISKL-KEY-AREA DESBD420 00409 PERFORM S921-START-BROWSE THRU S921-EXIT DESBD420 00410 MOVE ISKL-REC TO IEIN-REC DESBD420 00411 DESBD420 00412 PERFORM DESBD420 00413 UNTIL L921-NO-REC-88 DESBD420 00414 OR W-FEIN-EMP-NO > ZERO DESBD420 00415 IF IEIN-FEIN = X154-FEIN DESBD420 00416 PERFORM P1111-FIND-MPRF THRU P1111-EXIT DESBD420 00417 IF W-FEIN-EMP-NO = ZERO DESBD420 00418 PERFORM S921-READ-NEXT THRU S921-EXIT DESBD420 00419 MOVE ISKL-REC TO IEIN-REC DESBD420 00420 END-IF DESBD420 00421 ELSE DESBD420 00422 SET L921-NO-REC-88 TO TRUE DESBD420 00423 END-IF DESBD420 00424 END-PERFORM. DESBD420 00425 DESBD420 00426 IF W-FEIN-EMP-NO = +0 DESBD420 00427 IF W-LAST-EMP-NO > ZERO DESBD420 00428 MOVE W-LAST-EMP-NO TO W-FEIN-EMP-NO DESBD420 00429 END-IF DESBD420 00430 END-IF. DESBD420 00431 DESBD420 00432 P1110-EXIT. DESBD420 00433 EXIT. DESBD420 00434 DESBD420 00435 P1111-FIND-MPRF. DESBD420 00436 MOVE LOW-VALUES TO MPRF-KEY-AREA. DESBD420 00437 MOVE IEIN-EMP-NO TO MPRF-EMP-NO. DESBD420 00438 SET MPRF-PRF-88 TO TRUE. DESBD420 00439 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DESBD420 00440 PERFORM S910F-READ THRU S910F-EXIT. DESBD420 00441 IF L910-OK-88 DESBD420 00442 MOVE MSKL-REC TO MPRF-REC DESBD420 00443 IF MPRF-STATUS-ACT-88 DESBD420 00444 MOVE MPRF-EMP-NO TO W-FEIN-EMP-NO DESBD420 00445 ELSE DESBD420 00446 IF MPRF-ESTB-DATE > W-ESTB-DATE DESBD420 00447 MOVE MPRF-ESTB-DATE TO W-ESTB-DATE DESBD420 00448 MOVE MPRF-EMP-NO TO W-LAST-EMP-NO DESBD420 00449 END-IF DESBD420 00450 END-IF DESBD420 00451 END-IF. DESBD420 00452 DESBD420 00453 P1111-EXIT. DESBD420 00454 EXIT. DESBD420 00455 DESBD420 00456 P1200-EDIT-QTR. DESBD420 00457 SET W-QTR-ERR-NO-88 TO TRUE. DESBD420 00458 DESBD420 00459 MOVE X154-QUARTER TO L004-QTR-5-X. DESBD420 00460 PERFORM S004-FROM-5 THRU S004-EXIT. DESBD420 00461 IF L004-INVALID-QTR DESBD420 00462 DISPLAY 'BAD QUARTER : ' X154-QUARTER DESBD420 00463 SET W-WAGE-REC-ERR-YES-88 TO TRUE DESBD420 00464 ELSE DESBD420 00465 IF L004-QTR-5-9 > W-CURR-YRQ DESBD420 00466 MOVE X154-EARNINGS TO AMT-DISP1 DESBD420 00467 DISPLAY 'FUTURE QUARTER : ' X154-EMP-NO DESBD420 00468 ' ' X154-QUARTER ' ' AMT-DISP1 DESBD420 00469 SET W-QTR-ERR-YES-88 TO TRUE DESBD420 00470 * ELSE DESBD420 00471 * IF PARM-RUN-ONTIME-88 AND DESBD420 00472 * L004-QTR-5-9 NOT = W-CURR-YRQ DESBD420 00473 * MOVE X154-EARNINGS TO AMT-DISP1 DESBD420 00474 * DISPLAY 'NOT ONTIME QUARTER : ' X154-EMP-NO DESBD420 00475 * ' ' X154-QUARTER ' ' AMT-DISP1 DESBD420 00476 * ELSE DESBD420 00477 * IF PARM-RUN-DELINQ-88 AND DESBD420 00478 * L004-QTR-5-9 = W-CURR-YRQ DESBD420 00479 * MOVE X154-EARNINGS TO AMT-DISP1 DESBD420 00480 * DISPLAY 'NOT DELINQ QUARTER : ' X154-EMP-NO DESBD420 00481 * ' ' X154-QUARTER ' ' AMT-DISP1 DESBD420 00482 * END-IF DESBD420 00483 * END-IF DESBD420 00484 END-IF DESBD420 00485 END-IF. DESBD420 00486 DESBD420 00487 P1200-EXIT. DESBD420 00488 EXIT. DESBD420 00489 DESBD420 00490 P1300-EDIT-SSN. DESBD420 00491 SET W-SSN-ERR-NO-88 TO TRUE. DESBD420 00492 DESBD420 00493 MOVE X154-SSN TO W-SSN-IN. DESBD420 00494 DESBD420 00495 PERFORM DESBD420 00496 VARYING SUB2 FROM +1 BY +1 DESBD420 00497 UNTIL SUB2 > W-SSN-LEN DESBD420 00498 IF W-SSN-IN-X (SUB2) < '0' DESBD420 00499 AND W-SSN-IN-X (SUB2) > '9' DESBD420 00500 SET W-SSN-ERR-YES-88 TO TRUE DESBD420 00501 MOVE X154-EARNINGS TO AMT-DISP1 DESBD420 00502 DISPLAY 'INVALID SSN : ' X154-EMP-NO DESBD420 00503 ' ' X154-SSN ' ' AMT-DISP1 DESBD420 00504 END-IF DESBD420 00505 END-PERFORM. DESBD420 00506 DESBD420 00507 IF X154-SSN = W-ALL-NINES DESBD420 00508 OR X154-SSN = ZERO DESBD420 00509 PERFORM P1310-CHECK-NAME THRU P1310-EXIT DESBD420 00510 END-IF. DESBD420 00511 DESBD420 00512 P1300-EXIT. DESBD420 00513 EXIT. DESBD420 00514 DESBD420 00515 P1310-CHECK-NAME. DESBD420 00516 IF X154-LAST-NAME NOT > SPACES DESBD420 00517 SET W-SSN-ERR-YES-88 TO TRUE DESBD420 00518 MOVE X154-EARNINGS TO AMT-DISP1 DESBD420 00519 DISPLAY 'MISSING SSN - NO NAME: ' X154-EMP-NO DESBD420 00520 ' ' X154-SSN ' ' X154-LAST-NAME DESBD420 00521 ' ' X154-FIRST-NAME ' ' AMT-DISP1 DESBD420 00522 END-IF. DESBD420 00523 P1310-EXIT. DESBD420 00524 EXIT. DESBD420 00525 DESBD420 00526 P1400-EDIT-WAGES. DESBD420 00527 SET W-WAGE-ERR-NO-88 TO TRUE. DESBD420 00528 DESBD420 00529 IF X154-EARNINGS NOT NUMERIC DESBD420 00530 DISPLAY 'NON-NUMERIC EARNINGS: ' X154-EMP-NO DESBD420 00531 ' ' X154-EARNINGS DESBD420 00532 SET W-WAGE-ERR-YES-88 TO TRUE DESBD420 00533 END-IF. DESBD420 00534 DESBD420 00535 P1400-EXIT. DESBD420 00536 EXIT. DESBD420 00537 DESBD420 00538 P1500-EDIT-BATCH. DESBD420 00539 SET W-WAGE-ERR-NO-88 TO TRUE. DESBD420 00540 DESBD420 00541 IF X154-BATCH NOT NUMERIC DESBD420 00542 DISPLAY 'NON-NUMERIC BATCH: ' X154-EMP-NO DESBD420 00543 ' ' X154-BATCH DESBD420 00544 SET W-WAGE-ERR-YES-88 TO TRUE DESBD420 00545 END-IF. DESBD420 00546 DESBD420 00547 DESBD420 00548 P1500-EXIT. DESBD420 00549 EXIT. DESBD420 00550 DESBD420 00551 *P1700-WAGES-ON-FILE. DESBD420 00552 * SET W-WAGE-ON-FILE-NO-88 TO TRUE. DESBD420 00553 * DESBD420 00554 * MOVE LOW-VALUES TO WWGH-KEY-AREA. DESBD420 00555 * MOVE W-EMP-NO TO WWGH-EMP-NO. DESBD420 00556 * MOVE W-YRQ TO WWGH-YRQ. DESBD420 00557 * MOVE T-IN-SSN TO WWGH-SSN. DESBD420 00558 * DESBD420 00559 * PERFORM S981F-READ THRU S981F-EXIT. DESBD420 00560 * DESBD420 00561 * IF L981-OK-88 DESBD420 00562 * SET W-WAGE-ON-FILE-YES-88 TO TRUE DESBD420 00563 * ADD +1 TO W-SSN-ON-FILE-CNT DESBD420 00564 * DISPLAY 'SSN ON FILE ' T-IN-SSN DESBD420 00565 * ' ' W-EMP-NO ' ' W-YRQ DESBD420 00566 * ' ' T-IN-EARNINGS DESBD420 00567 * ' ' WWGH-EARNINGS DESBD420 00568 * END-IF. DESBD420 00569 * DESBD420 00570 *P1700-EXIT. DESBD420 00571 * EXIT. DESBD420 00572 DESBD420 00573 P2000-WRITE-TDEC-OUT. DESBD420 00574 WRITE TDEC-TRAN-OUT-REC FROM TDEC-TRAN-IN-REC. DESBD420 00575 DESBD420 00576 P2000-EXIT. DESBD420 00577 EXIT. DESBD420 00578 DESBD420 00579 T0000-TERMINATE. DESBD420 00580 DESBD420 00581 DISPLAY ' '. DESBD420 00582 DISPLAY ' '. DESBD420 00583 DESBD420 00584 DISPLAY '*** DESBD420 TERMINATION STATISTICS ***'. DESBD420 00585 DESBD420 00586 DISPLAY ' '. DESBD420 00587 DESBD420 00588 DISPLAY ' '. DESBD420 00589 DISPLAY 'W4 TRANSACTIONS READ : 'DESBD420 00590 W-TDEC-IN-CNT. DESBD420 00591 DESBD420 00592 DISPLAY ' '. DESBD420 00593 DISPLAY 'ERRORS FOUND : 'DESBD420 00594 W-ERROR-CNT. DESBD420 00595 DESBD420 00596 DISPLAY ' '. DESBD420 00597 DISPLAY 'TRANSACTIONS WRITTEN : 'DESBD420 00598 W-TDEC-OUT-CNT. DESBD420 00599 DESBD420 00600 DESBD420 00601 PERFORM S1020-CLOSE-TDEC-IN THRU S1020-EXIT. DESBD420 00602 PERFORM S1130-CLOSE-TDEC-OUT THRU S1130-EXIT. DESBD420 00603 DESBD420 00604 PERFORM S910C-CLOSE THRU S910C-EXIT. DESBD420 00605 PERFORM S981C-CLOSE THRU S981C-EXIT. DESBD420 00606 PERFORM S921-CLOSE THRU S921-EXIT. DESBD420 00607 DESBD420 00608 T0000-EXIT. DESBD420 00609 EXIT. DESBD420 00610 DESBD420 00611 S001-FROM-FED-8. DESBD420 00612 SET L001-FROM-FED-8 TO TRUE. DESBD420 00613 GO TO S001-DATE. DESBD420 00614 DESBD420 00615 S001-FROM-CAL-8. DESBD420 00616 SET L001-FROM-CAL-8 TO TRUE. DESBD420 00617 GO TO S001-DATE. DESBD420 00618 DESBD420 00619 S001-FROM-ABS-DAY. DESBD420 00620 SET L001-FROM-ABS-DAY TO TRUE. DESBD420 00621 GO TO S001-DATE. DESBD420 00622 DESBD420 00623 S001-DATE. DESBD420 00624 CALL 'DTSBU001' USING L001-LINK-AREA. DESBD420 00625 S001-EXIT. DESBD420 00626 EXIT. DESBD420 00627 DESBD420 00628 S004-FROM-DATE. DESBD420 00629 SET L004-FROM-DATE TO TRUE. DESBD420 00630 GO TO S004-QTR. DESBD420 00631 DESBD420 00632 S004-FROM-5. DESBD420 00633 SET L004-FROM-5 TO TRUE. DESBD420 00634 GO TO S004-QTR. DESBD420 00635 DESBD420 00636 S004-FROM-ABS. DESBD420 00637 SET L004-FROM-ABS TO TRUE. DESBD420 00638 GO TO S004-QTR. DESBD420 00639 DESBD420 00640 S004-FROM-3. DESBD420 00641 SET L004-FROM-3 TO TRUE. DESBD420 00642 GO TO S004-QTR. DESBD420 00643 DESBD420 00644 S004-QTR. DESBD420 00645 CALL 'DTSBU004' USING L004-LINK-AREA. DESBD420 00646 S004-EXIT. DESBD420 00647 DESBD420 00648 S005-FROM-SYS. DESBD420 00649 SET L005-FROM-SYS TO TRUE. DESBD420 00650 GO TO S005-ABSTIME. DESBD420 00651 DESBD420 00652 S005-ABSTIME. DESBD420 00653 CALL 'DTSBU005' USING L005-LINK-AREA. DESBD420 00654 S005-EXIT. DESBD420 00655 EXIT. DESBD420 00656 DESBD420 00657 S516-LIABILITY-INFO. DESBD420 00658 CALL 'DTSBU516' USING L516-LINK-AREA DESBD420 00659 MPRF-REC. DESBD420 00660 S516-EXIT. DESBD420 00661 EXIT. DESBD420 00662 DESBD420 00663 S910A-OPEN-READ. DESBD420 00664 SET L910-OPEN-READ-88 TO TRUE. DESBD420 00665 PERFORM S910Z-MSTR-I THRU S910Z-EXIT. DESBD420 00666 DESBD420 00667 S910A-EXIT. DESBD420 00668 EXIT. DESBD420 00669 DESBD420 00670 S910C-CLOSE. DESBD420 00671 SET L910-CLOSE-88 TO TRUE. DESBD420 00672 PERFORM S910Z-MSTR-I THRU S910Z-EXIT. DESBD420 00673 DESBD420 00674 S910C-EXIT. DESBD420 00675 EXIT. DESBD420 00676 DESBD420 00677 S910D-START-BROWSE. DESBD420 00678 SET L910-START-BROWSE-88 TO TRUE. DESBD420 00679 PERFORM S910Z-MSTR-I THRU S910Z-EXIT. DESBD420 00680 DESBD420 00681 S910D-EXIT. DESBD420 00682 EXIT. DESBD420 00683 DESBD420 00684 S910E-READ-NEXT. DESBD420 00685 SET L910-READ-NEXT-88 TO TRUE. DESBD420 00686 PERFORM S910Z-MSTR-I THRU S910Z-EXIT. DESBD420 00687 DESBD420 00688 S910E-EXIT. DESBD420 00689 EXIT. DESBD420 00690 DESBD420 00691 S910F-READ. DESBD420 00692 SET L910-READ-88 TO TRUE. DESBD420 00693 PERFORM S910Z-MSTR-I THRU S910Z-EXIT. DESBD420 00694 DESBD420 00695 S910F-EXIT. DESBD420 00696 EXIT. DESBD420 00697 DESBD420 00698 S910Z-MSTR-I. DESBD420 00699 CALL 'DTSBU910' USING L910-LINK-AREA DESBD420 00700 MSKL-REC. DESBD420 00701 S910Z-EXIT. DESBD420 00702 EXIT. DESBD420 00703 DESBD420 00704 S921-OPEN-READ. DESBD420 00705 SET L921-OPEN-READ-88 TO TRUE. DESBD420 00706 GO TO S921-AIX-IO. DESBD420 00707 DESBD420 00708 S921-READ. DESBD420 00709 SET L921-READ-88 TO TRUE. DESBD420 00710 GO TO S921-AIX-IO. DESBD420 00711 DESBD420 00712 S921-START-BROWSE. DESBD420 00713 SET L921-START-BROWSE-88 TO TRUE. DESBD420 00714 GO TO S921-AIX-IO. DESBD420 00715 DESBD420 00716 S921-READ-NEXT. DESBD420 00717 SET L921-READ-NEXT-88 TO TRUE. DESBD420 00718 GO TO S921-AIX-IO. DESBD420 00719 DESBD420 00720 S921-CLOSE. DESBD420 00721 SET L921-CLOSE-88 TO TRUE. DESBD420 00722 GO TO S921-AIX-IO. DESBD420 00723 DESBD420 00724 S921-AIX-IO. DESBD420 00725 CALL 'DTSBU921' USING L921-LINK-AREA DESBD420 00726 ISKL-REC. DESBD420 00727 S921-EXIT. DESBD420 00728 EXIT. DESBD420 00729 DESBD420 00730 S923A-OPEN-READ. DESBD420 00731 SET L923-OPEN-READ-88 TO TRUE. DESBD420 00732 PERFORM S923Z-ATC-IO THRU S923Z-EXIT. DESBD420 00733 DESBD420 00734 S923A-EXIT. DESBD420 00735 EXIT. DESBD420 00736 DESBD420 00737 S923B-START-BROWSE. DESBD420 00738 SET L923-START-BROWSE-88 TO TRUE. DESBD420 00739 PERFORM S923Z-ATC-IO THRU S923Z-EXIT. DESBD420 00740 DESBD420 00741 S923B-EXIT. DESBD420 00742 EXIT. DESBD420 00743 DESBD420 00744 S923C-READ-NEXT. DESBD420 00745 SET L923-READ-NEXT-88 TO TRUE. DESBD420 00746 PERFORM S923Z-ATC-IO THRU S923Z-EXIT. DESBD420 00747 DESBD420 00748 S923C-EXIT. DESBD420 00749 EXIT. DESBD420 00750 DESBD420 00751 S923D-CLOSE. DESBD420 00752 SET L923-CLOSE-88 TO TRUE. DESBD420 00753 PERFORM S923Z-ATC-IO THRU S923Z-EXIT. DESBD420 00754 DESBD420 00755 S923D-EXIT. DESBD420 00756 EXIT. DESBD420 00757 DESBD420 00758 DESBD420 00759 S923Z-ATC-IO. DESBD420 00760 CALL 'DTSBU923' USING L923-LINK-AREA DESBD420 00761 ASKL-REC. DESBD420 00762 S923Z-EXIT. DESBD420 00763 EXIT. DESBD420 00764 DESBD420 00765 S981A-OPEN-READ. DESBD420 00766 SET L981-OPEN-READ-88 TO TRUE. DESBD420 00767 PERFORM S981Z-WAGE-I THRU S981Z-EXIT. DESBD420 00768 DESBD420 00769 S981A-EXIT. DESBD420 00770 EXIT. DESBD420 00771 DESBD420 00772 S981C-CLOSE. DESBD420 00773 SET L981-CLOSE-88 TO TRUE. DESBD420 00774 PERFORM S981Z-WAGE-I THRU S981Z-EXIT. DESBD420 00775 DESBD420 00776 S981C-EXIT. DESBD420 00777 EXIT. DESBD420 00778 DESBD420 00779 S981D-START-BROWSE. DESBD420 00780 SET L981-START-BROWSE-88 TO TRUE. DESBD420 00781 PERFORM S981Z-WAGE-I THRU S981Z-EXIT. DESBD420 00782 DESBD420 00783 S981D-EXIT. DESBD420 00784 EXIT. DESBD420 00785 DESBD420 00786 S981E-READ-NEXT. DESBD420 00787 SET L981-READ-NEXT-88 TO TRUE. DESBD420 00788 PERFORM S981Z-WAGE-I THRU S981Z-EXIT. DESBD420 00789 DESBD420 00790 S981E-EXIT. DESBD420 00791 EXIT. DESBD420 00792 DESBD420 00793 S981F-READ. DESBD420 00794 SET L981-READ-88 TO TRUE. DESBD420 00795 PERFORM S981Z-WAGE-I THRU S981Z-EXIT. DESBD420 00796 DESBD420 00797 S981F-EXIT. DESBD420 00798 EXIT. DESBD420 00799 DESBD420 00800 S981Z-WAGE-I. DESBD420 00801 CALL 'DTSBU981' USING L981-LINK-AREA DESBD420 00802 WWGH-REC. DESBD420 00803 S981Z-EXIT. DESBD420 00804 EXIT. DESBD420 00805 DESBD420 00806 S1000-OPEN-TDEC-IN. DESBD420 00807 OPEN INPUT TDEC-TRAN-IN. DESBD420 00808 IF NOT TDEC-IN-OK-88 DESBD420 00809 DISPLAY 'CANNOT OPEN TDEC-TRAN-IN ' TDEC-IN-STATUS DESBD420 00810 SET W-ERROR-YES-88 TO TRUE DESBD420 00811 END-IF. DESBD420 00812 DESBD420 00813 S1000-EXIT. DESBD420 00814 EXIT. DESBD420 00815 DESBD420 00816 S1010-READ-TDEC-IN. DESBD420 00817 DESBD420 00818 READ TDEC-TRAN-IN. DESBD420 00819 IF TDEC-IN-OK-88 DESBD420 00820 ADD +1 TO W-TDEC-IN-CNT DESBD420 00821 ELSE DESBD420 00822 IF TDEC-IN-EOF-88 DESBD420 00823 DISPLAY 'EOF' DESBD420 00824 ELSE DESBD420 00825 DISPLAY 'CANNOT READ TDEC INPUT ' TDEC-IN-STATUS DESBD420 00826 END-IF DESBD420 00827 END-IF. DESBD420 00828 DESBD420 00829 S1010-EXIT. DESBD420 00830 EXIT. DESBD420 00831 DESBD420 00832 S1020-CLOSE-TDEC-IN. DESBD420 00833 CLOSE TDEC-TRAN-IN. DESBD420 00834 DESBD420 00835 S1020-EXIT. DESBD420 00836 EXIT. DESBD420 00837 DESBD420 00838 S1100-OPEN-TDEC-OUT. DESBD420 00839 OPEN OUTPUT TDEC-TRAN-OUT DESBD420 00840 IF NOT TDEC-OUT-OK-88 DESBD420 00841 DISPLAY 'CANNOT OPEN TDEC-TRAN-OUT ' TDEC-OUT-STATUS DESBD420 00842 SET W-ERROR-YES-88 TO TRUE DESBD420 00843 END-IF. DESBD420 00844 DESBD420 00845 S1100-EXIT. DESBD420 00846 EXIT. DESBD420 00847 DESBD420 00848 S1120-WRITE-TDEC-OUT. DESBD420 00849 WRITE TDEC-TRAN-OUT-REC FROM TDEC-TRAN-IN-REC. DESBD420 00850 IF NOT TDEC-OUT-OK-88 DESBD420 00851 DISPLAY 'CANNOT WRITE TDEC-TRAN-OUT ' TDEC-OUT-STATUS DESBD420 00852 SET W-ERROR-YES-88 TO TRUE DESBD420 00853 ELSE DESBD420 00854 ADD +1 TO W-TDEC-OUT-CNT DESBD420 00855 END-IF. DESBD420 00856 DESBD420 00857 S1120-EXIT. DESBD420 00858 EXIT. DESBD420 00859 DESBD420 00860 S1130-CLOSE-TDEC-OUT. DESBD420 00861 CLOSE TDEC-TRAN-OUT. DESBD420 00862 DESBD420 00863 S1130-EXIT. DESBD420 00864 EXIT. DESBD420 00865 S999-ABEND. DESBD420 00866 CALL 'DTSBU999' USING WRK-ABEND-CD. DESBD420 00867 S999-EXIT. DESBD420 00868 EXIT. DESBD420