00001 IDENTIFICATION DIVISION. 10/02/24 00002 PROGRAM-ID. DESBD471. DESBD474 00003 AUTHOR. NGC. LV018 00004 DATE-WRITTEN. DECEMBER 2012. DESBD474 00005 DATE-COMPILED. DESBD474 00006 SKIP3 DESBD474 00007 ***** DESBD474 00008 * DESBD474 00009 * ZUNCTION: DETECT FRAUD EMPLOYERS FILING REPORTS CL**2 00010 * REMOVE WAGES FOR UIBS 01/21/24 ZL1 CL**6 00011 * DESBD474 00012 * DESBD474 00013 * MODIFICATION LOG: DESBD474 00014 * DESBD474 00015 * 12/06/2012 INITIAL DEVELOPMENT. DESBD474 00016 * WORK ORDER: PROGRAMMER: GD DESBD474 00017 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DESBD474 00018 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DESBD474 00019 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DESBD474 00020 * DESBD474 00021 * DESBD474 00022 * DESCRIPTION: DESBD474 00023 * DESBD474 00024 * DESBD474 00025 * DESBD474 00026 * DESBD474 00027 * DESBD474 00028 * DESBD474 00029 * DESBD474 00030 * DESBD474 00031 * DESBD474 00032 * DESBD474 00033 * DESBD474 00034 * GENERAL SPECIFICATIONS: DESBD474 00035 * DESBD474 00036 * ALL COMMANDS ARE VALID. DESBD474 00037 * DESBD474 00038 * IF AN INVALID COMMAND IS REQUESTED, THEN ABEND THE DESBD474 00039 * MODULE. DESBD474 00040 * DESBD474 00041 * IF A FILE-STATUS OF OTHER THAN '00', '10', OR '23' IS DESBD474 00042 * ENCOUNTERED, THEN ABEND PROCESSING (TOLERATE A DESBD474 00043 * FILE-STATUS OF '97' FROM AN OPEN COMMAND). DESBD474 00044 * DESBD474 00045 * DESBD474 00046 * DESBD474 00047 * COMMAND SPECIFIC SPECIFICATIONS: DESBD474 00048 * DESBD474 00049 * OPEN-READ DESBD474 00050 * OPEN INPUT. DESBD474 00051 * DESBD474 00052 * OPEN-UPDATE DESBD474 00053 * OPEN I-O. DESBD474 00054 * DESBD474 00055 * CLOSE DESBD474 00056 * DESBD474 00057 * READ DESBD474 00058 * DESBD474 00059 * START BROWSE DESBD474 00060 * IF THE START-BROWSE IS SUCCESSFUL, THEN PERFORM THE DESBD474 00061 * READ-NEXT LOGIC. A SUCCESSFUL START-BROWSE RETURNS DESBD474 00062 * A RECORD. DESBD474 00063 * DESBD474 00064 * READ NEXT DESBD474 00065 * DESBD474 00066 * WRITE DESBD474 00067 * DESBD474 00068 * REWRITE DESBD474 00069 * DESBD474 00070 * DELETE DESBD474 00071 * DESBD474 00072 * DESBD474 00073 ***** DESBD474 00074 DESBD474 00075 ENVIRONMENT DIVISION. DESBD474 00076 DESBD474 00077 INPUT-OUTPUT SECTION. DESBD474 00078 DESBD474 00079 FILE-CONTROL. DESBD474 00080 SELECT X140-FRAUD-FILE ASSIGN TO DTSFF140 CL**6 00081 FILE STATUS IS X140-TRANS-STATUS. CL*17 00082 DESBD474 00083 SELECT RPT-ESSP-FILE ASSIGN TO DTSFX144 CL**6 00084 FILE STATUS IS X144-TRANS-STATUS. CL*13 00085 CL**6 00086 SELECT RPT-FRAUD-FILE ASSIGN TO DTSFF144 CL**6 00087 FILE STATUS IS F144-TRANS-STATUS. CL*13 00088 CL**2 00089 SELECT RPT-PASSED-FILE ASSIGN TO DTSFP144 CL**6 00090 FILE STATUS IS P144-TRANS-STATUS. CL*13 00091 CL**5 00092 DESBD474 00093 DATA DIVISION. DESBD474 00094 DESBD474 00095 FILE SECTION. DESBD474 00096 DESBD474 00097 FD RPT-ESSP-FILE CL**2 00098 RECORDING MODE IS F DESBD474 00099 BLOCK CONTAINS 0 RECORDS. DESBD474 00100 DESBD474 00101 01 RPT-ESSP-REC PIC X(512). CL**2 00102 CL**6 00103 FD X140-FRAUD-FILE CL**6 00104 RECORDING MODE IS F CL**6 00105 BLOCK CONTAINS 0 RECORDS. CL**6 00106 CL**6 00107 01 X140-FRAUD-REC PIC X(512). CL**6 00108 DESBD474 00109 FD RPT-FRAUD-FILE CL**2 00110 RECORDING MODE IS F CL**2 00111 BLOCK CONTAINS 0 RECORDS. CL**2 00112 CL**2 00113 01 RPT-FRAUD-REC PIC X(512). CL**2 00114 CL**2 00115 FD RPT-PASSED-FILE CL**2 00116 RECORDING MODE IS F CL**2 00117 BLOCK CONTAINS 0 RECORDS. CL**2 00118 CL**2 00119 01 RPT-PASSED-REC PIC X(512). CL**2 00120 DESBD474 00121 CL**5 00122 DESBD474 00123 WORKING-STORAGE SECTION. DESBD474 001235 77 PAN-VALET PICTURE X(24) VALUE '018DESBD474 10/02/24'. DESBD474 00124 SKIP3 DESBD474 00125 01 WRK-AREA. DESBD474 00126 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +480. DESBD474 00127 05 WRK-SYS-ABSTIME PIC S9(15) COMP-3 VALUE 0. DESBD474 00128 DESBD474 00129 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBU480'. DESBD474 00130 DESBD474 00131 05 W-CURR-EMP-NO PIC S9(06) COMP-3 VALUE +0. DESBD474 00132 05 W-CURR-YRQ PIC S9(05) COMP-3 DESBD474 00133 VALUE +20121. DESBD474 00134 05 W-CURR-BATCH PIC S9(05) COMP-3 VALUE +0. DESBD474 00135 05 W-CURR-ITEM PIC S9(03) COMP-3 VALUE +0. DESBD474 00136 05 W-MQTR-TOT-WAGE PIC S9(11)V99 COMP-3 DESBD474 00137 VALUE +0. DESBD474 00138 05 W-WTC-BATCH-NO PIC S9(05) COMP-3 DESBD474 00139 VALUE +90001. DESBD474 00140 05 W-WTC-ITEM-NO PIC S9(03) COMP-3 DESBD474 00141 VALUE +003. DESBD474 00142 05 W-WTC-SEQ-NO PIC S9(03) COMP-3 DESBD474 00143 VALUE +001. DESBD474 00144 05 W-MAX-BATCH PIC S9(05) COMP-3 VALUE +0. DESBD474 00145 05 W-MIN-BATCH PIC S9(05) COMP-3 DESBD474 00146 VALUE +99999. DESBD474 00147 05 WRK-W2-CNT PIC S9(07) COMP-3 VALUE +0. DESBD474 00148 05 WRK-W4-CNT PIC S9(07) COMP-3 VALUE +0. DESBD474 00149 05 WRK-WWGH-CNT PIC S9(07) COMP-3 VALUE +0. DESBD474 00150 05 WRK-DELETE-CNT PIC S9(07) COMP-3 VALUE +0. DESBD474 00151 05 W-BYPASSED-CNT PIC S9(07) COMP-3 VALUE +0. DESBD474 00152 05 W-BACKLOG PIC S9(07) COMP-3 VALUE +0. DESBD474 00153 05 AMT-DISP1 PIC ----------9.99. DESBD474 00154 05 AMT-DISP2 PIC ----------9.99. DESBD474 00155 05 AMT-DISP3 PIC ----------9.99. DESBD474 00156 05 AMT-DISP4 PIC ----------9.99. DESBD474 00157 DESBD474 00158 05 WRK-NET-WAGE PIC S9(11)V99 COMP-3 DESBD474 00159 VALUE +0. DESBD474 00160 05 W-WGH-WAGE PIC S9(11)V99 COMP-3 DESBD474 00161 VALUE +0. DESBD474 00162 05 WRK-FRAUD-CUTOFF-DATE PIC S9(09) COMP-3 VALUE +0. CL**2 00163 05 W-DIFFERENCE PIC S9(11)V99 COMP-3 DESBD474 00164 VALUE +0. DESBD474 00165 DESBD474 00166 05 RPT-FRAUD-CNT PIC 9(9) VALUE 0. CL**2 00167 05 RPT-PASSED-CNT PIC 9(9) VALUE 0. CL**2 00168 05 RPT-X140-READ PIC 9(9) VALUE 0. CL**3 00169 05 RPT-X144-CNT PIC 9(9) VALUE 0. CL*12 00170 05 WRK-TF-TABLE-CNT PIC 9(9) VALUE 0. CL**9 00171 05 W2-REC-FOUND PIC 9(9) VALUE 0. DESBD474 00172 05 W-SLASH-DATE PIC X(10). DESBD474 00173 05 W-ZDATE REDEFINES W-SLASH-DATE. DESBD474 00174 10 W-SLASH-DT-MM PIC X(02). DESBD474 00175 10 FILLER PIC X(01). DESBD474 00176 10 W-SLASH-DT-DD PIC X(02). DESBD474 00177 10 FILLER PIC X(01). DESBD474 00178 10 W-SLASH-DT-CCYY PIC X(04). DESBD474 00179 DESBD474 00180 05 WRK-FED-8-DATE. CL**2 00181 10 RPT-FED-8-YR PIC 9(4). CL**2 00182 10 RPT-FED-8-MO PIC 9(2). CL**2 00183 10 RPT-FED-8-DA PIC 9(2). CL**2 00184 CL**2 00185 05 W-RESP-OPID PIC X(08). DESBD474 00186 05 WRK-ERROR-IND PIC X(01). DESBD474 00187 88 WRK-ERROR-YES-88 VALUE 'Y'. DESBD474 00188 88 WRK-ERROR-NO-88 VALUE 'N'. DESBD474 00189 DESBD474 00190 05 W-EMP-EXISTS-IND PIC X(01). DESBD474 00191 88 W-EMP-EXISTS-YES-88 VALUE 'Y'. DESBD474 00192 88 W-EMP-EXISTS-NO-88 VALUE 'N'. DESBD474 00193 05 W-DELINQUENT-IND PIC X(01). DESBD474 00194 88 W-DELINQUENT-YES-88 VALUE 'Y'. DESBD474 00195 88 W-DELINQUENT-NO-88 VALUE 'N'. DESBD474 00196 05 WAGE-TRANS-STATUS PIC X(02). DESBD474 00197 88 WAGE-TRANS-FILE-OK-88 VALUE '00'. DESBD474 00198 88 WAGE-TRANS-FILE-NO-REC-88 VALUE '10' '23'. DESBD474 00199 88 WAGE-TRANS-FILE-VERIFY-88 VALUE '97'. DESBD474 00200 DESBD474 00201 05 X144-TRANS-STATUS PIC X(02). CL**6 00202 88 X144-TRANS-FILE-OK-88 VALUE '00'. CL**6 00203 88 X144-TRANS-FILE-NO-REC-88 VALUE '10' '23'. CL**6 00204 88 X144-TRANS-FILE-VERIFY-88 VALUE '97'. CL**6 00205 CL**6 00206 05 X140-TRANS-STATUS PIC X(02). CL*15 00207 88 X140-TRANS-FILE-OK-88 VALUE '00'. CL*15 00208 88 X140-TRANS-FILE-NO-REC-88 VALUE '10' '23'. CL*15 00209 88 X140-TRANS-FILE-VERIFY-88 VALUE '97'. CL*15 00210 CL*15 00211 05 F144-TRANS-STATUS PIC X(02). CL*13 00212 88 F144-TRANS-FILE-OK-88 VALUE '00'. CL*13 00213 88 F144-TRANS-FILE-NO-REC-88 VALUE '10' '23'. CL*13 00214 88 F144-TRANS-FILE-VERIFY-88 VALUE '97'. CL*13 00215 CL*13 00216 05 P144-TRANS-STATUS PIC X(02). CL*13 00217 88 P144-TRANS-FILE-OK-88 VALUE '00'. CL*13 00218 88 P144-TRANS-FILE-NO-REC-88 VALUE '10' '23'. CL*13 00219 88 P144-TRANS-FILE-VERIFY-88 VALUE '97'. CL*13 00220 CL*13 00221 05 DOWNLOAD-STATUS PIC X(02). DESBD474 00222 88 DOWNLOAD-FILE-OK-88 VALUE '00'. DESBD474 00223 DESBD474 00224 05 WRK-YRQ PIC 9(05). DESBD474 00225 05 FILLER REDEFINES WRK-YRQ. DESBD474 00226 10 WRK-YRQ-YEAR PIC 9(04). DESBD474 00227 10 WRK-YRQ-QTR PIC 9(01). DESBD474 00228 DESBD474 00229 05 WRK-YRQ-X. DESBD474 00230 10 WRK-YRQ-YEAR-X PIC 9(04). DESBD474 00231 10 FILLER PIC X(01) VALUE '/'. DESBD474 00232 10 WRK-YRQ-QTR-X PIC 9(01). DESBD474 00233 05 WRK-MPRF-IND PIC X(01). CL**3 00234 88 WRK-MPRF-OK VALUE 'Y'. CL**3 00235 88 WRK-MPRF-NO-REC VALUE 'N'. CL**3 00236 CL**7 00237 01 WRK-TABLES. CL**7 00238 05 WRK-EMP-NO PIC 9(06) VALUE ZEROS. CL**7 00239 05 TF-SUB PIC S9(07) COMP-3. CL**7 00240 05 TF-MAX PIC S9(07) COMP-3 CL**7 00241 VALUE +999999. CL*10 00242 05 TRANS-FILE-RPTS OCCURS 999999 TIMES. CL*10 00243 10 TRANS-FILE-RPT-IND PIC X(01). CL**7 00244 88 TF-RPT-FOUND-YES-88 VALUE 'Y'. CL**7 00245 88 TF-RPT-FOUND-NO-88 VALUE 'N'. CL**7 00246 10 TRANS-BYPASSED-IND PIC X(01). CL**7 00247 88 TF-BYPASSED-YES-88 VALUE 'Y'. CL**7 00248 88 TF-BYPASSED-NO-88 VALUE 'N'. CL**7 00249 DESBD474 00250 01 L004-COMM-AREA. DESBD474 00251 ++INCLUDE DTSIL004 DESBD474 00252 DESBD474 00253 01 L001-LINK-AREA. CL**2 00254 ++INCLUDE DTSIL001 CL**2 00255 CL**2 00256 01 L005-COMM-AREA. DESBD474 00257 ++INCLUDE DTSIL005 DESBD474 00258 DESBD474 00259 01 L424-LINK-AREA. DESBD474 00260 ++INCLUDE DTSIL424 DESBD474 00261 DESBD474 00262 01 L516-LINK-AREA. DESBD474 00263 ++INCLUDE DTSIL516 DESBD474 00264 DESBD474 00265 01 L910-LINK-AREA. DESBD474 00266 ++INCLUDE DTSIL910 DESBD474 00267 DESBD474 00268 01 X140-REC. CL**2 00269 ++INCLUDE DTSES140 CL**2 00270 DESBD474 00271 01 X144-REC. CL**6 00272 ++INCLUDE DTSES144 CL**6 00273 CL**6 00274 01 X147-REC. CL**6 00275 ++INCLUDE DTSES147 CL**6 00276 CL**6 00277 01 MSKL-REC. DESBD474 00278 ++INCLUDE DTSIMSKL DESBD474 00279 DESBD474 00280 01 MPRF-REC. DESBD474 00281 ++INCLUDE DTSIMPRF DESBD474 00282 DESBD474 00283 01 MQTR-REC. DESBD474 00284 ++INCLUDE DTSIMQTR DESBD474 00285 DESBD474 00286 01 L931-LINK-AREA. DESBD474 00287 ++INCLUDE DTSIL931 DESBD474 00288 DESBD474 00289 01 FSKL-REC. DESBD474 00290 ++INCLUDE DTSIFSKL DESBD474 00291 DESBD474 00292 01 L981-LINK-AREA. DESBD474 00293 ++INCLUDE DTSIL981 DESBD474 00294 DESBD474 00295 01 WWGH-REC. DESBD474 00296 ++INCLUDE DTSIWWGH DESBD474 00297 DESBD474 00298 01 X143-REC. DESBD474 00299 ++INCLUDE DTSIX143 DESBD474 00300 DESBD474 00301 01 L983-LINK-AREA. DESBD474 00302 ++INCLUDE DTSIL983 DESBD474 00303 DESBD474 00304 01 WSKL-REC. DESBD474 00305 ++INCLUDE DTSIWSKL DESBD474 00306 DESBD474 00307 01 W001-REC. DESBD474 00308 ++INCLUDE DTSIW001 DESBD474 00309 DESBD474 00310 01 L982-LINK-AREA. DESBD474 00311 ++INCLUDE DTSIL982 DESBD474 00312 DESBD474 00313 01 WNAM-REC. DESBD474 00314 ++INCLUDE DTSIWNAM DESBD474 00315 DESBD474 00316 DESBD474 00317 PROCEDURE DIVISION. DESBD474 00318 DESBD474 00319 PERFORM I0000-INIT THRU I0000-EXIT. DESBD474 00320 IF WRK-ERROR-NO-88 DESBD474 00321 PERFORM P0000-PROCESS THRU P0000-EXIT DESBD474 00322 PERFORM T0000-TERM THRU T0000-EXIT DESBD474 00323 END-IF. DESBD474 00324 DESBD474 00325 GOBACK. DESBD474 00326 EJECT DESBD474 00327 I0000-INIT. DESBD474 00328 SET WRK-ERROR-NO-88 TO TRUE. DESBD474 00329 DESBD474 00330 OPEN INPUT RPT-ESSP-FILE. CL**2 00331 IF X144-TRANS-FILE-OK-88 CL*16 00332 OR X144-TRANS-FILE-VERIFY-88 CL*16 00333 NEXT SENTENCE DESBD474 00334 ELSE DESBD474 00335 DISPLAY ' FILE ISSUE X144 ESSP-FILE ' CL*16 00336 PERFORM S999-ABEND THRU S999-EXIT DESBD474 00337 END-IF. DESBD474 00338 DESBD474 00339 OPEN INPUT X140-FRAUD-FILE. CL**6 00340 IF X140-TRANS-FILE-OK-88 CL*13 00341 OR X140-TRANS-FILE-VERIFY-88 CL*13 00342 NEXT SENTENCE CL**6 00343 ELSE CL**6 00344 DISPLAY ' FILE ISSUE X140-FRAUD-FILE ' CL*16 00345 PERFORM S999-ABEND THRU S999-EXIT CL**6 00346 END-IF. CL**6 00347 CL**6 00348 DESBD474 00349 OPEN OUTPUT RPT-FRAUD-FILE CL**2 00350 IF F144-TRANS-FILE-OK-88 CL*13 00351 OR F144-TRANS-FILE-VERIFY-88 CL*13 00352 NEXT SENTENCE DESBD474 00353 ELSE DESBD474 00354 DISPLAY ' FILE ISSUE F144-FRAUD-FILE ' CL*16 00355 PERFORM S999-ABEND THRU S999-EXIT DESBD474 00356 END-IF. DESBD474 00357 DESBD474 00358 CL**2 00359 OPEN OUTPUT RPT-PASSED-FILE CL**2 00360 IF P144-TRANS-FILE-OK-88 CL*13 00361 OR P144-TRANS-FILE-VERIFY-88 CL*13 00362 NEXT SENTENCE CL**2 00363 ELSE CL**2 00364 DISPLAY ' FILE ISSUE P144-PASSD-FILE ' CL*16 00365 PERFORM S999-ABEND THRU S999-EXIT CL**2 00366 END-IF. CL**2 00367 CL**2 00368 DESBD474 00369 * PERFORM S005-FROM-SYS THRU S005-EXIT. CL**3 00370 * MOVE L005-ABSTIME TO WRK-SYS-ABSTIME. CL**3 00371 * MOVE L005-SLASH-8-DATE TO W-SLASH-DATE. CL**3 00372 * DISPLAY 'SYS DATE ' W-SLASH-DATE. CL**3 00373 DESBD474 00374 * PERFORM S981A-OPEN-UPDATE THRU S981A-EXIT. DESBD474 00375 * PERFORM S983-OPEN-UPDATE THRU S983-EXIT. DESBD474 00376 PERFORM S910-OPEN-READ THRU S910-EXIT. CL**2 00377 DESBD474 00378 I0000-EXIT. DESBD474 00379 EXIT. DESBD474 00380 DESBD474 00381 P0000-PROCESS. DESBD474 00382 READ X140-FRAUD-FILE INTO X140-REC CL**6 00383 DESBD474 00384 PERFORM UNTIL X140-TRANS-FILE-NO-REC-88 CL*16 00385 PERFORM P1100-LOAD-X140-TABLE THRU P1100-EXIT CL**7 00386 READ X140-FRAUD-FILE INTO X140-REC CL**6 00387 DESBD474 00388 END-PERFORM. DESBD474 00389 CL**7 00390 DISPLAY ' TOTAL X140 LOADED IN TABLE ' WRK-TF-TABLE-CNT. CL**7 00391 CL**7 00392 READ RPT-ESSP-FILE INTO X144-REC. CL*14 00393 CL**7 00394 PERFORM UNTIL X144-TRANS-FILE-NO-REC-88 CL**7 00395 PERFORM P3000-FIND-X144 THRU P3000-EXIT CL*12 00396 READ RPT-ESSP-FILE INTO X144-REC CL**7 00397 CL**7 00398 END-PERFORM. CL**7 00399 DESBD474 00400 P0000-EXIT. DESBD474 00401 EXIT. DESBD474 00402 DESBD474 00403 DESBD474 00404 P1100-LOAD-X140-TABLE. CL**9 00405 CL**7 00406 ADD 1 TO RPT-X140-READ. CL*18 00407 MOVE X140-EMP-NO TO WRK-EMP-NO CL**7 00408 CL**7 00409 SET TF-RPT-FOUND-YES-88 (WRK-EMP-NO) TO TRUE. CL**7 00410 ADD +1 TO WRK-TF-TABLE-CNT CL**7 00411 DISPLAY 'EMP-LOADED IN TABLE: ' WRK-EMP-NO. CL**7 00412 CL**7 00413 P1100-EXIT. CL**7 00414 EXIT. CL**7 00415 CL**7 00416 P2000-FIND-MPRF. CL**7 00417 MOVE LOW-VALUES TO MSKL-KEY-AREA. CL**2 00418 CL**2 00419 * MOVE +000001 TO MSKL-EMP-NO. CL**2 00420 MOVE X140-EMP-NO TO MSKL-EMP-NO. CL**2 00421 CL**2 00422 SET MSKL-PRF-88 TO TRUE. CL**2 00423 CL**2 00424 PERFORM S910-READ THRU S910-EXIT. CL**2 00425 IF L910-OK-88 CL**2 00426 MOVE MSKL-REC TO MPRF-REC CL**2 00427 SET WRK-MPRF-OK TO TRUE CL**2 00428 ELSE CL**2 00429 DISPLAY 'EMPLOYER NOT IN DUTAS ' X140-EMP-NO CL**2 00430 * SET L910-NO-REC-88 TO TRUE CL**2 00431 GO TO P2000-EXIT. CL**2 00432 DESBD474 00433 DISPLAY ' '. CL**4 00434 DISPLAY '----- NEW EMP ' X140-EMP-NO CL**4 00435 CL**2 00436 MOVE X140-RCVD-DATE TO W-SLASH-DATE CL**2 00437 DISPLAY 'RPT RECEIVED DATE ' X140-RCVD-DATE CL**2 00438 CL**2 00439 MOVE W-SLASH-DT-DD TO RPT-FED-8-DA CL**2 00440 MOVE W-SLASH-DT-MM TO RPT-FED-8-MO CL**2 00441 MOVE W-SLASH-DT-CCYY TO RPT-FED-8-YR CL**2 00442 CL**2 00443 MOVE WRK-FED-8-DATE TO L001-FED-8-DATE-9 CL**2 00444 PERFORM S001-FROM-FED-8 THRU S001-EXIT CL**2 00445 SUBTRACT 30 FROM L001-JUL-ABS-DAY CL**2 00446 PERFORM S001-FROM-ABS-DAY THRU S001-EXIT CL**2 00447 MOVE L001-FED-8-DATE-9 TO WRK-FRAUD-CUTOFF-DATE. CL**2 00448 DISPLAY 'FRAUD CUTOFF DATE ' L001-FED-8-DATE-9. CL**4 00449 CL**2 00450 CL**2 00451 IF MPRF-ESTB-DATE >= WRK-FRAUD-CUTOFF-DATE CL**2 00452 DISPLAY 'FRAUD REPORT..... ' MPRF-EMP-NO CL**4 00453 DISPLAY 'MPRF ESTB DATE ' MPRF-ESTB-DATE CL**4 00454 DISPLAY 'FRAUD CUTOFF DATE ' WRK-FRAUD-CUTOFF-DATE CL**4 00455 WRITE RPT-FRAUD-REC FROM X140-REC CL**2 00456 ADD 1 TO RPT-FRAUD-CNT CL**2 00457 ELSE CL**2 00458 WRITE RPT-PASSED-REC FROM X140-REC CL**2 00459 ADD 1 TO RPT-PASSED-CNT. CL**2 00460 P2000-EXIT. DESBD474 00461 EXIT. DESBD474 00462 DESBD474 00463 P3000-FIND-X144. CL**6 00464 ADD 1 TO RPT-X144-CNT. CL*11 00465 MOVE X144-EMP-NO TO WRK-EMP-NO CL**8 00466 IF TF-RPT-FOUND-YES-88 (WRK-EMP-NO) CL**7 00467 DISPLAY 'FRAUD WAGES ..... ' X144-EMP-NO CL*18 00468 WRITE RPT-FRAUD-REC FROM X144-REC CL**8 00469 ADD 1 TO RPT-FRAUD-CNT CL**8 00470 ELSE CL**8 00471 WRITE RPT-PASSED-REC FROM X144-REC CL**8 00472 ADD 1 TO RPT-PASSED-CNT. CL**8 00473 CL**6 00474 P3000-EXIT. CL**6 00475 EXIT. CL**6 00476 T0000-TERM. DESBD474 00477 DESBD474 00478 CLOSE RPT-ESSP-FILE RPT-FRAUD-FILE RPT-PASSED-FILE CL**8 00479 X140-FRAUD-FILE. CL**8 00480 DESBD474 00481 DISPLAY '******************************************' DESBD474 00482 DISPLAY '** DTSBD473 TERMINATION STATISTICS **'. CL**2 00483 DESBD474 00484 DISPLAY 'TOTAL ESSP X140 FRAUD RPTS READ = ' RPT-X140-READ. CL*11 00485 DISPLAY 'TOTAL ESSP X144 WAGES READ = ' RPT-X144-CNT. CL*11 00486 DISPLAY 'TOTAL FRAUD X144 WAGES WRITTEN = ' RPT-FRAUD-CNT. CL*11 00487 DISPLAY 'TOTAL X144 WAGES PASSED TO DUTAS = ' RPT-PASSED-CNT. CL*11 00488 DISPLAY ' '. DESBD474 00489 T0000-EXIT. DESBD474 00490 EXIT. DESBD474 00491 DESBD474 00492 S004-EDIT-QTR. DESBD474 00493 CALL 'DTSBU004' USING L004-COMM-AREA. DESBD474 00494 DESBD474 00495 S004-EXIT. DESBD474 00496 EXIT. DESBD474 00497 S005-FROM-SYS. DESBD474 00498 DESBD474 00499 SET L005-FROM-SYS TO TRUE. DESBD474 00500 GO TO S005-ABSTIME. DESBD474 00501 DESBD474 00502 S005-ABSTIME. DESBD474 00503 DESBD474 00504 CALL 'DTSBU005' USING L005-COMM-AREA. DESBD474 00505 DESBD474 00506 S005-EXIT. DESBD474 00507 EXIT. DESBD474 00508 DESBD474 00509 CL**2 00510 S001-FROM-FED-8. CL**2 00511 SET L001-FROM-FED-8 TO TRUE. CL**2 00512 GO TO S001-DATE. CL**2 00513 SKIP1 CL**2 00514 S001-FROM-ABS-DAY. CL**2 00515 SET L001-FROM-ABS-DAY TO TRUE. CL**2 00516 GO TO S001-DATE. CL**2 00517 SKIP1 CL**2 00518 S001-FROM-CAL-6. CL**2 00519 SET L001-FROM-CAL-6 TO TRUE. CL**2 00520 GO TO S001-DATE. CL**2 00521 SKIP1 CL**2 00522 S001-DATE. CL**2 00523 CALL 'DTSBU001' USING L001-LINK-AREA. CL**2 00524 S001-EXIT. CL**2 00525 EXIT. CL**2 00526 DESBD474 00527 DESBD474 00528 S516-LIABILITY-INFO. DESBD474 00529 CALL 'DTSBU516' USING L516-LINK-AREA DESBD474 00530 MPRF-REC. DESBD474 00531 S516-EXIT. DESBD474 00532 EXIT. DESBD474 00533 DESBD474 00534 S910-OPEN-READ. DESBD474 00535 SET L910-OPEN-READ-88 TO TRUE. DESBD474 00536 GO TO S910-MSTR-IO. DESBD474 00537 DESBD474 00538 S910-READ. DESBD474 00539 SET L910-READ-88 TO TRUE. DESBD474 00540 GO TO S910-MSTR-IO. DESBD474 00541 DESBD474 00542 S910-START-BROWSE. DESBD474 00543 SET L910-START-BROWSE-88 TO TRUE. DESBD474 00544 GO TO S910-MSTR-IO. DESBD474 00545 DESBD474 00546 S910-READ-NEXT. DESBD474 00547 SET L910-READ-NEXT-88 TO TRUE. DESBD474 00548 GO TO S910-MSTR-IO. DESBD474 00549 DESBD474 00550 S910-CLOSE. DESBD474 00551 SET L910-CLOSE-88 TO TRUE. DESBD474 00552 GO TO S910-MSTR-IO. DESBD474 00553 DESBD474 00554 S910-MSTR-IO. DESBD474 00555 CALL 'DTSBU910' USING L910-LINK-AREA DESBD474 00556 MSKL-REC. DESBD474 00557 S910-EXIT. DESBD474 00558 EXIT. DESBD474 00559 DESBD474 00560 S931-OPEN-READ. DESBD474 00561 SET L931-OPEN-READ-88 TO TRUE. DESBD474 00562 GO TO S931-REF-IO. DESBD474 00563 DESBD474 00564 S931-CLOSE. DESBD474 00565 SET L931-CLOSE-88 TO TRUE. DESBD474 00566 GO TO S931-REF-IO. DESBD474 00567 DESBD474 00568 S931-REF-IO. DESBD474 00569 CALL 'DTSBU931' USING L931-LINK-AREA DESBD474 00570 FSKL-REC. DESBD474 00571 S931-EXIT. DESBD474 00572 EXIT. DESBD474 00573 DESBD474 00574 S981A-OPEN-UPDATE. DESBD474 00575 SET L981-OPEN-UPDATE-88 TO TRUE. DESBD474 00576 PERFORM S981Z-WWGH-IO THRU S981Z-EXIT. DESBD474 00577 DESBD474 00578 S981A-EXIT. DESBD474 00579 EXIT. DESBD474 00580 DESBD474 00581 S981B-WRITE. DESBD474 00582 SET L981-WRITE-88 TO TRUE. DESBD474 00583 PERFORM S981Z-WWGH-IO THRU S981Z-EXIT. DESBD474 00584 DESBD474 00585 S981B-EXIT. DESBD474 00586 EXIT. DESBD474 00587 S981C-READ. DESBD474 00588 SET L981-READ-88 TO TRUE. DESBD474 00589 PERFORM S981Z-WWGH-IO THRU S981Z-EXIT. DESBD474 00590 DESBD474 00591 S981C-EXIT. DESBD474 00592 EXIT. DESBD474 00593 S981E-DELETE. DESBD474 00594 SET L981-DELETE-88 TO TRUE. DESBD474 00595 PERFORM S981Z-WWGH-IO THRU S981Z-EXIT. DESBD474 00596 DESBD474 00597 S981E-EXIT. DESBD474 00598 EXIT. DESBD474 00599 DESBD474 00600 S981D-CLOSE. DESBD474 00601 SET L981-CLOSE-88 TO TRUE. DESBD474 00602 PERFORM S981Z-WWGH-IO THRU S981Z-EXIT. DESBD474 00603 DESBD474 00604 S981D-EXIT. DESBD474 00605 EXIT. DESBD474 00606 DESBD474 00607 S981Z-WWGH-IO. DESBD474 00608 CALL 'DTSBU981' USING L981-LINK-AREA DESBD474 00609 WWGH-REC. DESBD474 00610 S981Z-EXIT. DESBD474 00611 EXIT. DESBD474 00612 DESBD474 00613 S983-OPEN-UPDATE. DESBD474 00614 SET L983-OPEN-UPDATE-88 TO TRUE. DESBD474 00615 GO TO S983-WAGE-I. DESBD474 00616 DESBD474 00617 S983-WRITE. DESBD474 00618 SET L983-WRITE-88 TO TRUE. DESBD474 00619 GO TO S983-WAGE-I. DESBD474 00620 DESBD474 00621 S983-DELETE. DESBD474 00622 SET L983-DELETE-88 TO TRUE. DESBD474 00623 GO TO S983-WAGE-I. DESBD474 00624 DESBD474 00625 S983-CLOSE. DESBD474 00626 SET L983-CLOSE-88 TO TRUE. DESBD474 00627 GO TO S983-WAGE-I. DESBD474 00628 DESBD474 00629 S983-WAGE-I. DESBD474 00630 CALL 'DTSBU983' USING L983-LINK-AREA DESBD474 00631 WSKL-REC. DESBD474 00632 S983-EXIT. DESBD474 00633 EXIT. DESBD474 00634 DESBD474 00635 S982A-START-BROWSE. DESBD474 00636 SET L982-START-BROWSE-88 TO TRUE. DESBD474 00637 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. DESBD474 00638 DESBD474 00639 S982A-EXIT. DESBD474 00640 EXIT. DESBD474 00641 DESBD474 00642 S982B-READ-NEXT. DESBD474 00643 SET L982-READ-NEXT-88 TO TRUE. DESBD474 00644 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. DESBD474 00645 DESBD474 00646 S982B-EXIT. DESBD474 00647 EXIT. DESBD474 00648 DESBD474 00649 S982C-OPEN-READ. DESBD474 00650 SET L982-OPEN-READ-88 TO TRUE. DESBD474 00651 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. DESBD474 00652 DESBD474 00653 S982C-EXIT. DESBD474 00654 EXIT. DESBD474 00655 DESBD474 00656 S982D-CLOSE. DESBD474 00657 SET L982-CLOSE-88 TO TRUE. DESBD474 00658 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. DESBD474 00659 DESBD474 00660 S982D-EXIT. DESBD474 00661 EXIT. DESBD474 00662 DESBD474 00663 S982Z-WNAM-IO. DESBD474 00664 CALL 'DTSBU982' USING L982-LINK-AREA DESBD474 00665 WNAM-REC. DESBD474 00666 S982Z-EXIT. DESBD474 00667 EXIT. DESBD474 00668 DESBD474 00669 DESBD474 00670 S999-ABEND. DESBD474 00671 DISPLAY '*** I/O MODULE ABENDING'. DESBD474 00672 DESBD474 00673 DISPLAY '*** CMND-CD = ' L983-CMND-CD. DESBD474 00674 DESBD474 00675 DISPLAY '*** FILE-STATUS = ' WAGE-TRANS-STATUS. DESBD474 00676 DESBD474 00677 DISPLAY '*** CALLING MODULE = ' L983-MOD-NAME. DESBD474 00678 DESBD474 00679 DESBD474 00680 CALL 'DTSBU999' USING WRK-ABEND-CD. DESBD474 00681 S999-EXIT. DESBD474 00682 EXIT. DESBD474