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
