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