00001  IDENTIFICATION DIVISION.                                         09/05/25
00002  PROGRAM-ID.             DESBD471.                                DESBD473
00003  AUTHOR.                 NGC.                                        LV047
00004  DATE-WRITTEN.           DECEMBER 2012.                           DESBD473
00005  DATE-COMPILED.                                                   DESBD473
00006      SKIP3                                                        DESBD473
00007 *****                                                             DESBD473
00008 *                                                                 DESBD473
00009 *    ZUNCTION:  DETECT FRAUD EMPLOYERS FILING REPORTS                CL**2
00010 *             FOR TAX WAGES SINCE UIBS   01/21/24  ZL1            DESBD473
00011 *                                                                 DESBD473
00012 *                                                                 DESBD473
00013 *    MODIFICATION LOG:                                            DESBD473
00014 *                                                                 DESBD473
00015 *    12/06/2012  INITIAL DEVELOPMENT.                             DESBD473
00016 *                WORK ORDER:                      PROGRAMMER: GD  DESBD473
00017 *    08/04/2025  MODIFIED PGM TO CHK MRPT FILE INSTEAD OF MQTR       CL*43
00018 *                FOR ORIGINAL REPORTS.            PROGRAMMER: SC     CL*43
00019 *    09/04/2025  MODIFIED PGM TO CHK IF X140-RESP-OPID GREATER       CL*46
00020 *                THAN SPACES. IF YES, IT IS NOT FRAUD,WRITE THE      CL*46
00021 *                RECORD TO PASSED FILE.           PROGRAMMER: SC     CL*46
00022 *    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DESBD473
00023 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DESBD473
00024 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX   DESBD473
00025 *                                                                 DESBD473
00026 *                                                                 DESBD473
00027 *    DESCRIPTION:                                                 DESBD473
00028 *                                                                 DESBD473
00029 *                                                                 DESBD473
00030 *                                                                 DESBD473
00031 *                                                                 DESBD473
00032 *                                                                 DESBD473
00033 *                                                                 DESBD473
00034 *                                                                 DESBD473
00035 *                                                                 DESBD473
00036 *                                                                 DESBD473
00037 *                                                                 DESBD473
00038 *                                                                 DESBD473
00039 *    GENERAL SPECIFICATIONS:                                      DESBD473
00040 *                                                                 DESBD473
00041 *        ALL COMMANDS ARE VALID.                                  DESBD473
00042 *                                                                 DESBD473
00043 *        IF AN INVALID COMMAND IS REQUESTED, THEN ABEND THE       DESBD473
00044 *        MODULE.                                                  DESBD473
00045 *                                                                 DESBD473
00046 *        IF A FILE-STATUS OF OTHER THAN '00', '10', OR '23' IS    DESBD473
00047 *        ENCOUNTERED, THEN ABEND PROCESSING (TOLERATE A           DESBD473
00048 *        FILE-STATUS OF '97' FROM AN OPEN COMMAND).               DESBD473
00049 *                                                                 DESBD473
00050 *                                                                 DESBD473
00051 *                                                                 DESBD473
00052 *    COMMAND SPECIFIC SPECIFICATIONS:                             DESBD473
00053 *                                                                 DESBD473
00054 *    OPEN-READ                                                    DESBD473
00055 *        OPEN INPUT.                                              DESBD473
00056 *                                                                 DESBD473
00057 *    OPEN-UPDATE                                                  DESBD473
00058 *        OPEN I-O.                                                DESBD473
00059 *                                                                 DESBD473
00060 *    CLOSE                                                        DESBD473
00061 *                                                                 DESBD473
00062 *    READ                                                         DESBD473
00063 *                                                                 DESBD473
00064 *    START BROWSE                                                 DESBD473
00065 *        IF THE START-BROWSE IS SUCCESSFUL, THEN PERFORM THE      DESBD473
00066 *        READ-NEXT LOGIC.  A SUCCESSFUL START-BROWSE RETURNS      DESBD473
00067 *        A RECORD.                                                DESBD473
00068 *                                                                 DESBD473
00069 *    READ NEXT                                                    DESBD473
00070 *                                                                 DESBD473
00071 *    WRITE                                                        DESBD473
00072 *                                                                 DESBD473
00073 *    REWRITE                                                      DESBD473
00074 *                                                                 DESBD473
00075 *    DELETE                                                       DESBD473
00076 *                                                                 DESBD473
00077 *                                                                 DESBD473
00078 *****                                                             DESBD473
00079                                                                   DESBD473
00080  ENVIRONMENT DIVISION.                                               CL*10
00081  CONFIGURATION SECTION.                                              CL*10
00082  SPECIAL-NAMES. C01 IS TOP-OF-PAGE.                                  CL*10
00083                                                                   DESBD473
00084  INPUT-OUTPUT SECTION.                                            DESBD473
00085                                                                   DESBD473
00086  FILE-CONTROL.                                                    DESBD473
00087      SELECT RPT-ESSP-FILE ASSIGN TO DTSFX140                         CL**2
00088          FILE STATUS IS WAGE-TRANS-STATUS.                        DESBD473
00089                                                                   DESBD473
00090      SELECT RPT-FRAUD-FILE ASSIGN TO DTSFF140                        CL**2
00091          FILE STATUS IS WAGE-TRANS-STATUS.                           CL**2
00092                                                                      CL**2
00093      SELECT RPT-PASSED-FILE ASSIGN TO DTSFP140                       CL**2
00094          FILE STATUS IS WAGE-TRANS-STATUS.                           CL**2
00095                                                                      CL**5
00096      SELECT RPT-EROR-FILE    ASSIGN TO DTSFR140                      CL**5
00097          FILE STATUS IS REPT-TRANS-STATUS.                           CL*11
00098                                                                   DESBD473
00099  DATA DIVISION.                                                   DESBD473
00100                                                                   DESBD473
00101  FILE SECTION.                                                    DESBD473
00102                                                                   DESBD473
00103  FD  RPT-ESSP-FILE                                                   CL**2
00104      RECORDING MODE IS F                                          DESBD473
00105      BLOCK CONTAINS 0 RECORDS.                                    DESBD473
00106                                                                   DESBD473
00107  01  RPT-ESSP-REC                    PIC  X(512).                    CL**2
00108                                                                   DESBD473
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                                                                   DESBD473
00121  FD  RPT-EROR-FILE                                                   CL**5
00122      RECORDING MODE IS F                                             CL**5
00123      BLOCK CONTAINS 0 RECORDS.                                       CL**5
00124                                                                      CL**5
00125  01  REPT-EROR-REC                    PIC  X(160).                   CL*27
00126                                                                      CL**5
00127                                                                   DESBD473
00128  WORKING-STORAGE SECTION.                                         DESBD473
001285 77  PAN-VALET PICTURE X(24) VALUE '047DESBD473  09/05/25'.       DESBD473
00129      SKIP3                                                        DESBD473
00130  01  WRK-AREA.                                                    DESBD473
00131      05  WRK-ABEND-CD             PIC S9(04)  COMP  VALUE +480.   DESBD473
00132      05  WRK-SYS-ABSTIME         PIC S9(15)    COMP-3 VALUE 0.    DESBD473
00133                                                                   DESBD473
00134      05  WRK-MOD-NAME             PIC  X(08)  VALUE 'DTSBU480'.   DESBD473
00135                                                                   DESBD473
00136      05  W-CURR-EMP-NO            PIC S9(06)  COMP-3 VALUE +0.    DESBD473
00137      05  W-CURR-YRQ               PIC S9(05)  COMP-3              DESBD473
00138                                     VALUE +20121.                 DESBD473
00139      05  W-CURR-BATCH             PIC S9(05)  COMP-3 VALUE +0.    DESBD473
00140      05  W-CURR-ITEM              PIC S9(03)  COMP-3 VALUE +0.    DESBD473
00141      05  W-MQTR-TOT-WAGE          PIC S9(11)V99 COMP-3            DESBD473
00142                                     VALUE +0.                     DESBD473
00143      05  W-WTC-BATCH-NO           PIC S9(05)  COMP-3              DESBD473
00144                                     VALUE +90001.                 DESBD473
00145      05  W-WTC-ITEM-NO            PIC S9(03)  COMP-3              DESBD473
00146                                     VALUE +003.                   DESBD473
00147      05  W-WTC-SEQ-NO             PIC S9(03)  COMP-3              DESBD473
00148                                     VALUE +001.                   DESBD473
00149      05  W-MAX-BATCH              PIC S9(05)  COMP-3 VALUE +0.    DESBD473
00150      05  W-MIN-BATCH              PIC S9(05)  COMP-3              DESBD473
00151                                     VALUE +99999.                 DESBD473
00152      05  WRK-W2-CNT               PIC S9(07)  COMP-3 VALUE +0.    DESBD473
00153      05  WRK-W4-CNT               PIC S9(07)  COMP-3 VALUE +0.    DESBD473
00154      05  WRK-WWGH-CNT             PIC S9(07)  COMP-3 VALUE +0.    DESBD473
00155      05  WRK-DELETE-CNT           PIC S9(07)  COMP-3 VALUE +0.    DESBD473
00156      05  W-BYPASSED-CNT           PIC S9(07)  COMP-3 VALUE +0.    DESBD473
00157      05  W-BACKLOG                PIC S9(07)  COMP-3 VALUE +0.    DESBD473
00158      05  AMT-DISP1                PIC  ----------9.99.            DESBD473
00159      05  AMT-DISP2                PIC  ----------9.99.            DESBD473
00160      05  AMT-DISP3                PIC  ----------9.99.            DESBD473
00161      05  AMT-DISP4                PIC  ----------9.99.            DESBD473
00162                                                                   DESBD473
00163      05  WRK-NET-WAGE             PIC S9(11)V99  COMP-3           DESBD473
00164                                                     VALUE +0.     DESBD473
00165      05  W-WGH-WAGE               PIC S9(11)V99  COMP-3           DESBD473
00166                                                     VALUE +0.     DESBD473
00167      05  WRK-FRAUD-CUTOFF-DATE    PIC S9(09)  COMP-3 VALUE +0.       CL**2
00168      05  W-DIFFERENCE             PIC S9(11)V99  COMP-3           DESBD473
00169                                                     VALUE +0.     DESBD473
00170                                                                   DESBD473
00171      05  NO-REPORT-FILED       PIC 9(9) VALUE 0.                     CL*25
00172      05  RPT-FRAUD-CNT         PIC 9(9) VALUE 0.                     CL*25
00173      05  RPT-PASSED-CNT        PIC 9(9) VALUE 0.                     CL**2
00174      05  RPT-X140-READ         PIC 9(9) VALUE 0.                     CL**3
00175      05  RPT-X140-CNT          PIC 9(9) VALUE 0.                     CL**8
00176      05  WS-LINE-CNT           PIC 9(9) VALUE 60.                    CL**7
00177      05  WS-PAGE-CNT           PIC 9(9) VALUE 0.                     CL*20
00178      05  W2-REC-DELETED PIC 9(9) VALUE 0.                         DESBD473
00179      05  W2-REC-FOUND PIC 9(9) VALUE 0.                           DESBD473
00180      05  W-SLASH-DATE            PIC  X(10).                      DESBD473
00181      05  W-ZDATE REDEFINES W-SLASH-DATE.                          DESBD473
00182               10  W-SLASH-DT-MM       PIC  X(02).                 DESBD473
00183               10  FILLER              PIC  X(01).                 DESBD473
00184               10  W-SLASH-DT-DD       PIC  X(02).                 DESBD473
00185               10  FILLER              PIC  X(01).                 DESBD473
00186               10  W-SLASH-DT-CCYY     PIC  X(04).                 DESBD473
00187                                                                   DESBD473
00188      05  WRK-FED-Z-DATE             PIC 9(8) VALUE ZEROS.            CL*16
00189      05  WRK-FED-8-DATE.                                             CL*16
00190          10  RPT-FED-8-YR           PIC 9(4).                        CL**2
00191          10  RPT-FED-8-MO           PIC 9(2).                        CL**2
00192          10  RPT-FED-8-DA           PIC 9(2).                        CL**2
00193                                                                      CL**2
00194      05  W-RESP-OPID                PIC  X(08).                   DESBD473
00195      05  WRK-ERROR-IND              PIC  X(01).                   DESBD473
00196          88  WRK-ERROR-YES-88            VALUE 'Y'.               DESBD473
00197          88  WRK-ERROR-NO-88             VALUE 'N'.               DESBD473
00198                                                                   DESBD473
00199      05  W-EMP-EXISTS-IND           PIC  X(01).                   DESBD473
00200          88  W-EMP-EXISTS-YES-88      VALUE 'Y'.                  DESBD473
00201          88  W-EMP-EXISTS-NO-88       VALUE 'N'.                  DESBD473
00202      05  W-DELINQUENT-IND           PIC  X(01).                   DESBD473
00203          88  W-DELINQUENT-YES-88      VALUE 'Y'.                  DESBD473
00204          88  W-DELINQUENT-NO-88       VALUE 'N'.                  DESBD473
00205      05  WAGE-TRANS-STATUS          PIC  X(02).                   DESBD473
00206          88  WAGE-TRANS-FILE-OK-88       VALUE '00'.              DESBD473
00207          88  WAGE-TRANS-FILE-NO-REC-88   VALUE '10' '23'.         DESBD473
00208          88  WAGE-TRANS-FILE-VERIFY-88   VALUE '97'.              DESBD473
00209                                                                   DESBD473
00210      05  REPT-TRANS-STATUS          PIC  X(02).                      CL*11
00211          88  REPT-TRANS-FILE-OK-88       VALUE '00'.                 CL*11
00212          88  REPT-TRANS-FILE-NO-REC-88   VALUE '10' '23'.            CL*11
00213          88  REPT-TRANS-FILE-VERIFY-88   VALUE '97'.                 CL*11
00214                                                                      CL*11
00215      05  DOWNLOAD-STATUS            PIC  X(02).                   DESBD473
00216          88  DOWNLOAD-FILE-OK-88         VALUE '00'.              DESBD473
00217                                                                   DESBD473
00218      05  WRK-YRQ                  PIC  9(05).                     DESBD473
00219      05  FILLER REDEFINES WRK-YRQ.                                DESBD473
00220          10  WRK-YRQ-YEAR         PIC  9(04).                     DESBD473
00221          10  WRK-YRQ-QTR          PIC  9(01).                     DESBD473
00222                                                                   DESBD473
00223      05  WRK-YRQ-X.                                               DESBD473
00224          10  WRK-YRQ-YEAR-X       PIC 9(04).                      DESBD473
00225          10  FILLER               PIC X(01) VALUE '/'.            DESBD473
00226          10  WRK-YRQ-QTR-X        PIC 9(01).                      DESBD473
00227      05  WRK-MPRF-IND                PIC  X(01).                     CL**3
00228          88 WRK-MPRF-OK           VALUE 'Y'.                         CL**3
00229          88 WRK-MPRF-NO-REC       VALUE 'N'.                         CL**3
00230                                                                   DESBD473
00231  01  HEADER-1.                                                       CL**6
00232      05  FILLER                   PIC X(01) VALUE SPACES.            CL**6
00233      05  FILLER                   PIC X(49) VALUE '140R1'.           CL**6
00234      05  FILLER                   PIC X(60) VALUE                    CL**6
00235          'DISTRICT OF COLUMBIA'.                                     CL**6
00236      05  FILLER                   PIC X(06) VALUE 'DATE:'.           CL**6
00237 *    05  HDR1-LRCM-SYS-DATE       PIC X(10).                         CL*35
00238      05  HDR3-PAGE                PIC ZZ,ZZ9.                        CL*35
00239  01  HEADER-2.                                                       CL**6
00240      05  FILLER                   PIC X(54) VALUE SPACES.            CL**6
00241      05  FILLER                   PIC X(56) VALUE                    CL**6
00242          'TAX DIVISION'.                                             CL**6
00243      05  FILLER                   PIC X(06) VALUE 'TIME:'.           CL**6
00244      05  HDR2-LRCM-SYS-TIME       PIC X(08).                         CL**6
00245  01  HEADER-3.                                                       CL**6
00246      05  FILLER                   PIC X(01) VALUE SPACES.            CL**6
00247      05  FILLER                   PIC X(38) VALUE                    CL**6
00248          '                               '.                          CL*35
00249      05  HDR3-LITERAL             PIC X(43) VALUE                    CL**6
00250          '  ESSP DAILY POTENTIAL FRAUD REPORTS    '.                 CL**7
00251      05  FILLER                   PIC X(28) VALUE SPACES.            CL**6
00252      05  FILLER                   PIC X(06) VALUE 'DATE:'.           CL*40
00253      05  HDR1-LRCM-SYS-DATE       PIC X(10).                         CL*35
00254                                                                      CL**6
00255  01  HEADER-4.                                                       CL**7
00256      05  FILLER                   PIC X(02)  VALUE SPACES.           CL**6
00257      05  FILLER                   PIC X(07)  VALUE                   CL*38
00258          'EMP NO '.                                                  CL*38
00259      05  FILLER                     PIC  X(01) VALUE ','.            CL*39
00260      05  FILLER                   PIC X(20)  VALUE                   CL*38
00261          '    NAME            '.                                     CL*38
00262      05  FILLER                     PIC  X(01) VALUE ','.            CL*39
00263      05  FILLER                   PIC X(06)  VALUE                   CL*36
00264          ' QTR  '.                                                   CL*36
00265      05  FILLER                     PIC  X(01) VALUE ','.            CL*39
00266      05  FILLER                   PIC X(03)  VALUE                   CL*36
00267             'STA'.                                                   CL*36
00268      05  FILLER                     PIC  X(01) VALUE ','.            CL*39
00269      05  FILLER                   PIC X(03)  VALUE                   CL*36
00270             'CLS'.                                                   CL*36
00271      05  FILLER                     PIC  X(01) VALUE ','.            CL*39
00272      05  FILLER                   PIC X(03)  VALUE                   CL*36
00273             'ORG'.                                                   CL*36
00274      05  FILLER                     PIC  X(01) VALUE ','.            CL*39
00275      05  FILLER                   PIC X(10)  VALUE                   CL*36
00276             ' RECV-DATE'.                                            CL*36
00277      05  FILLER                     PIC  X(01) VALUE ','.            CL*39
00278      05  FILLER                   PIC X(10)  VALUE                   CL*36
00279             '  REG-DATE'.                                            CL*36
00280      05  FILLER                     PIC  X(01) VALUE ','.            CL*39
00281      05  FILLER                   PIC X(12)  VALUE                   CL*40
00282             'TOTAL-AMT   '.                                          CL*40
00283      05  FILLER                     PIC  X(01) VALUE ','.            CL*39
00284      05  FILLER                   PIC X(12)  VALUE                   CL*40
00285             '  TAX-AMT   '.                                          CL*40
00286      05  FILLER                     PIC  X(01) VALUE ','.            CL*39
00287      05  FILLER                   PIC X(12)  VALUE                   CL*40
00288             'EXCES-AMT   '.                                          CL*40
00289      05  FILLER                     PIC  X(01) VALUE ','.            CL*39
00290      05  FILLER                   PIC X(05)  VALUE                   CL*36
00291             '   M1'.                                                 CL*36
00292      05  FILLER                     PIC  X(01) VALUE ','.            CL*39
00293      05  FILLER                   PIC X(05)  VALUE                   CL*36
00294             '   M2'.                                                 CL*36
00295      05  FILLER                     PIC  X(01) VALUE ','.            CL*39
00296      05  FILLER                   PIC X(05)  VALUE                   CL*36
00297             '   M3'.                                                 CL*36
00298      05  FILLER                     PIC  X(01) VALUE ','.            CL*39
00299      05  FILLER                   PIC X(05)  VALUE                   CL*36
00300             ' 1RPT'.                                                 CL*36
00301      05  FILLER                     PIC  X(01) VALUE ','.            CL*39
00302      05  FILLER                   PIC X(10)  VALUE SPACES.           CL*40
00303      05  FILLER                   PIC X(23)  VALUE                   CL*40
00304             'NOTES(VALIDATED/FRAUD)'.                                CL*40
00305  01  HEADER-5.                                                       CL**7
00306      05  FILLER                   PIC X(01)  VALUE SPACES.           CL**6
00307      05  FILLER                   PIC X(132) VALUE SPACES.           CL**6
00308  01  DETAIL-LINE-1.                                                  CL**6
00309      15  FILLER                     PIC  X(02) VALUE SPACES.         CL**6
00310      15  X434-EMP-NO                PIC 999B999 BLANK WHEN ZERO.     CL**8
00311      15  FILLER                     PIC  X(01) VALUE ','.            CL*39
00312      15  X434-NAME-CHECK            PIC  X(20) VALUE SPACES.         CL**8
00313      15  FILLER                     PIC  X(01) VALUE ','.            CL*39
00314      15  X434-QTR.                                                   CL*16
00315        25  X434-QTR-Y                 PIC  X(04).                    CL*16
00316        25  X434-QTR-F                 PIC  X(01).                    CL*16
00317        25  X434-QTR-Q                 PIC  X(01).                    CL*16
00318      15  FILLER                     PIC  X(01) VALUE ','.            CL*39
00319      15  X434-EMP-STATUS            PIC  X(03) VALUE SPACES.         CL*38
00320      15  FILLER                     PIC  X(01) VALUE ','.            CL*39
00321      15  X434-EMP-CLASS             PIC  X(03) VALUE SPACES.         CL*38
00322      15  FILLER                     PIC  X(01) VALUE ','.            CL*39
00323      15  X434-EMP-ORG               PIC  X(03) VALUE SPACES.         CL*38
00324      15  FILLER                     PIC  X(01) VALUE ','.            CL*39
00325      15  X434-RCVD-DATE             PIC  X(10) VALUE SPACES.         CL*38
00326      15  FILLER                     PIC  X(01) VALUE ','.            CL*39
00327      15  X434-REGD-DATE             PIC  X(10) VALUE SPACES.         CL*38
00328      15  FILLER                     PIC  X(01) VALUE ','.            CL*39
00329      15  X434-TOT-WAGE              PIC  --------9.99.               CL**6
00330      15  FILLER                     PIC  X(01) VALUE ','.            CL*39
00331      15  X434-TAX-WAGE              PIC  --------9.99.               CL*14
00332      15  FILLER                     PIC  X(01) VALUE ','.            CL*39
00333      15  X434-EXC-WAGE              PIC  --------9.99.               CL*14
00334      15  FILLER                     PIC  X(01) VALUE ','.            CL*39
00335      15  X434-M1-CNT                PIC  ZZZ99.                      CL*25
00336      15  FILLER                     PIC  X(01) VALUE ','.            CL*39
00337      15  X434-M2-CNT                PIC  ZZZ99.                      CL*25
00338      15  FILLER                     PIC  X(01) VALUE ','.            CL*39
00339      15  X434-M3-CNT                PIC  ZZZ99.                      CL*25
00340      15  FILLER                     PIC  X(01) VALUE ','.            CL*39
00341      15  X434-QTR-FILED             PIC  X.                          CL*26
00342                                                                      CL**7
00343  01  FOOTING-LINE-1.                                                 CL**7
00344      05  FILLER                   PIC  X(25)  VALUE SPACES.          CL**6
00345      05  WS-X140-RED-CNT           PIC  ZZ,ZZ9.                      CL**6
00346      05  FILLER                   PIC  X(02)  VALUE SPACES.          CL**6
00347      05  FILLER                   PIC  X(45) VALUE                   CL**6
00348                       'TOTAL REPORTS RECEIVED FROM ESSP  '.          CL**7
00349      05  FILLER                   PIC  X(32)  VALUE SPACES.          CL**6
00350                                                                      CL**6
00351  01  FOOTING-LINE-2.                                                 CL**7
00352      05  FILLER                   PIC  X(25)  VALUE SPACES.          CL**6
00353      05  WS-X140-PEN-CNT           PIC  ZZ,ZZ9.                      CL**6
00354      05  FILLER                   PIC  X(02)  VALUE SPACES.          CL**6
00355      05  FILLER                   PIC  X(40) VALUE                   CL**6
00356                       ' # OF POTENTIAL FRAUD REPORTS      '.         CL**7
00357      05  FILLER                   PIC  X(32)  VALUE SPACES.          CL**6
00358                                                                      CL**6
00359                                                                      CL**7
00360  01  FOOTING-LINE-3.                                                 CL**7
00361      05  FILLER                   PIC  X(25)  VALUE SPACES.          CL**7
00362      05  WS-X140-PAS-CNT           PIC  ZZ,ZZ9.                      CL**7
00363      05  FILLER                   PIC  X(02)  VALUE SPACES.          CL**7
00364      05  FILLER                   PIC  X(45) VALUE                   CL**7
00365                       'TOTAL REPORTS PASSED TO DUTAS     '.          CL**7
00366      05  FILLER                   PIC  X(32)  VALUE SPACES.          CL**7
00367                                                                      CL**6
00368                                                                      CL**6
00369  01  NOREPORT-LINE.                                                  CL*22
00370      05  FILLER                   PIC  X(35)  VALUE SPACES.          CL*22
00371      05  FILLER                   PIC  X(57) VALUE                   CL*22
00372      ' ********  NO POTENTIAL FRAUD REPORT/WAGES TODAY *******'.     CL*22
00373      05  FILLER                   PIC  X(35)  VALUE SPACES.          CL*22
00374                                                                      CL*22
00375                                                                      CL**6
00376  01  L004-COMM-AREA.                                              DESBD473
00377  ++INCLUDE DTSIL004                                               DESBD473
00378                                                                   DESBD473
00379  01  L001-LINK-AREA.                                                 CL**2
00380  ++INCLUDE DTSIL001                                                  CL**2
00381                                                                      CL**2
00382  01  L005-COMM-AREA.                                              DESBD473
00383  ++INCLUDE DTSIL005                                               DESBD473
00384                                                                   DESBD473
00385  01  L424-LINK-AREA.                                              DESBD473
00386  ++INCLUDE DTSIL424                                               DESBD473
00387                                                                   DESBD473
00388  01  L516-LINK-AREA.                                              DESBD473
00389  ++INCLUDE DTSIL516                                               DESBD473
00390                                                                   DESBD473
00391  01  L910-LINK-AREA.                                              DESBD473
00392  ++INCLUDE DTSIL910                                               DESBD473
00393                                                                   DESBD473
00394  01  X140-REC.                                                       CL**2
00395  ++INCLUDE DTSES140                                                  CL**2
00396                                                                   DESBD473
00397  01  MSKL-REC.                                                    DESBD473
00398  ++INCLUDE DTSIMSKL                                               DESBD473
00399                                                                   DESBD473
00400  01  MPRF-REC.                                                    DESBD473
00401  ++INCLUDE DTSIMPRF                                               DESBD473
00402                                                                   DESBD473
00403  01  MRPT-REC.                                                       CL*42
00404  ++INCLUDE DTSIMRPT                                                  CL*42
00405                                                                   DESBD473
00406  01  L931-LINK-AREA.                                              DESBD473
00407  ++INCLUDE DTSIL931                                               DESBD473
00408                                                                   DESBD473
00409  01  FSKL-REC.                                                    DESBD473
00410  ++INCLUDE DTSIFSKL                                               DESBD473
00411                                                                   DESBD473
00412  01  L981-LINK-AREA.                                              DESBD473
00413  ++INCLUDE DTSIL981                                               DESBD473
00414                                                                   DESBD473
00415  01  WWGH-REC.                                                    DESBD473
00416  ++INCLUDE DTSIWWGH                                               DESBD473
00417                                                                   DESBD473
00418  01  X143-REC.                                                    DESBD473
00419  ++INCLUDE DTSIX143                                               DESBD473
00420                                                                   DESBD473
00421  01  L983-LINK-AREA.                                              DESBD473
00422  ++INCLUDE DTSIL983                                               DESBD473
00423                                                                   DESBD473
00424  01  WSKL-REC.                                                    DESBD473
00425  ++INCLUDE DTSIWSKL                                               DESBD473
00426                                                                   DESBD473
00427  01  W001-REC.                                                    DESBD473
00428  ++INCLUDE DTSIW001                                               DESBD473
00429                                                                   DESBD473
00430  01  L982-LINK-AREA.                                              DESBD473
00431  ++INCLUDE DTSIL982                                               DESBD473
00432                                                                   DESBD473
00433  01  WNAM-REC.                                                    DESBD473
00434  ++INCLUDE DTSIWNAM                                               DESBD473
00435                                                                   DESBD473
00436                                                                   DESBD473
00437  PROCEDURE DIVISION.                                              DESBD473
00438                                                                   DESBD473
00439      PERFORM I0000-INIT             THRU I0000-EXIT.              DESBD473
00440      IF WRK-ERROR-NO-88                                           DESBD473
00441         PERFORM P0000-PROCESS       THRU P0000-EXIT               DESBD473
00442         PERFORM T0000-TERM          THRU T0000-EXIT               DESBD473
00443      END-IF.                                                      DESBD473
00444                                                                   DESBD473
00445      GOBACK.                                                      DESBD473
00446      EJECT                                                        DESBD473
00447  I0000-INIT.                                                      DESBD473
00448      SET WRK-ERROR-NO-88   TO TRUE.                               DESBD473
00449                                                                   DESBD473
00450      OPEN INPUT  RPT-ESSP-FILE.                                      CL**2
00451      IF WAGE-TRANS-FILE-OK-88                                     DESBD473
00452      OR WAGE-TRANS-FILE-VERIFY-88                                 DESBD473
00453         NEXT SENTENCE                                             DESBD473
00454      ELSE                                                         DESBD473
00455         PERFORM S999-ABEND THRU S999-EXIT                         DESBD473
00456      END-IF.                                                      DESBD473
00457                                                                   DESBD473
00458                                                                   DESBD473
00459      OPEN OUTPUT RPT-FRAUD-FILE                                      CL**2
00460      IF WAGE-TRANS-FILE-OK-88                                     DESBD473
00461      OR WAGE-TRANS-FILE-VERIFY-88                                 DESBD473
00462         NEXT SENTENCE                                             DESBD473
00463      ELSE                                                         DESBD473
00464         PERFORM S999-ABEND THRU S999-EXIT                         DESBD473
00465      END-IF.                                                      DESBD473
00466                                                                   DESBD473
00467                                                                      CL**2
00468      OPEN OUTPUT RPT-PASSED-FILE                                     CL**2
00469      IF WAGE-TRANS-FILE-OK-88                                        CL**2
00470      OR WAGE-TRANS-FILE-VERIFY-88                                    CL**2
00471         NEXT SENTENCE                                                CL**2
00472      ELSE                                                            CL**2
00473         PERFORM S999-ABEND THRU S999-EXIT                            CL**2
00474      END-IF.                                                         CL**2
00475                                                                      CL**2
00476                                                                      CL**7
00477      OPEN OUTPUT RPT-EROR-FILE                                       CL**7
00478      IF REPT-TRANS-FILE-OK-88                                        CL*11
00479      OR REPT-TRANS-FILE-VERIFY-88                                    CL*11
00480         NEXT SENTENCE                                                CL**7
00481      ELSE                                                            CL**7
00482         PERFORM S999-ABEND THRU S999-EXIT                            CL**7
00483      END-IF.                                                         CL**7
00484                                                                      CL**7
00485                                                                   DESBD473
00486      PERFORM S005-FROM-SYS THRU S005-EXIT.                           CL**7
00487      MOVE L005-ABSTIME TO WRK-SYS-ABSTIME.                           CL**7
00488      MOVE L005-SLASH-8-DATE TO W-SLASH-DATE.                         CL**7
00489      DISPLAY  'SYS DATE ' W-SLASH-DATE.                              CL**7
00490      MOVE L005-SLASH-8-DATE TO  HDR1-LRCM-SYS-DATE                   CL**7
00491      MOVE L005-DISPLAY-TIME TO  HDR2-LRCM-SYS-TIME                   CL**7
00492                                                                   DESBD473
00493 *    PERFORM S981A-OPEN-UPDATE      THRU S981A-EXIT.              DESBD473
00494 *    PERFORM S983-OPEN-UPDATE       THRU S983-EXIT.               DESBD473
00495      PERFORM S910-OPEN-READ         THRU S910-EXIT.                  CL**2
00496                                                                   DESBD473
00497  I0000-EXIT.                                                      DESBD473
00498      EXIT.                                                        DESBD473
00499                                                                   DESBD473
00500  P0000-PROCESS.                                                   DESBD473
00501      READ RPT-ESSP-FILE     INTO X140-REC                            CL**2
00502                                                                   DESBD473
00503      PERFORM UNTIL WAGE-TRANS-FILE-NO-REC-88                      DESBD473
00504         PERFORM P2000-FIND-MPRF        THRU P2000-EXIT               CL**2
00505         READ RPT-ESSP-FILE   INTO X140-REC                           CL**2
00506                                                                   DESBD473
00507      END-PERFORM.                                                 DESBD473
00508                                                                   DESBD473
00509  P0000-EXIT.                                                      DESBD473
00510      EXIT.                                                        DESBD473
00511                                                                   DESBD473
00512                                                                   DESBD473
00513  P2000-FIND-MPRF.                                                    CL**3
00514         ADD 1 TO RPT-X140-READ.                                      CL**2
00515      MOVE LOW-VALUES TO MSKL-KEY-AREA.                               CL**2
00516                                                                      CL**2
00517 *    MOVE +000001 TO MSKL-EMP-NO.                                    CL**2
00518      MOVE X140-EMP-NO  TO MSKL-EMP-NO.                               CL**2
00519                                                                      CL**2
00520      SET MSKL-PRF-88 TO TRUE.                                        CL**2
00521                                                                      CL**2
00522      PERFORM S910-READ THRU S910-EXIT.                               CL**2
00523      IF L910-OK-88                                                   CL**2
00524         MOVE MSKL-REC TO MPRF-REC                                    CL**2
00525         SET WRK-MPRF-OK TO TRUE                                      CL**2
00526      ELSE                                                            CL**2
00527         DISPLAY 'EMPLOYER NOT IN DUTAS ' X140-EMP-NO                 CL**2
00528         ADD 1 TO RPT-FRAUD-CNT                                       CL*25
00529         WRITE RPT-FRAUD-REC FROM X140-REC                            CL*27
00530         PERFORM P4500-WRITE-EROR-MPRF THRU P4500-EXIT                CL*26
00531         SET L910-NO-REC-88 TO TRUE                                   CL*25
00532         GO TO P2000-EXIT.                                            CL**2
00533                                                                   DESBD473
00534      DISPLAY '               '.                                      CL**4
00535      DISPLAY '----- NEW EMP     ' X140-EMP-NO                        CL**4
00536      IF X140-EMP-NO(1:3) = 186                                       CL*31
00537         DISPLAY '--MINI CONV ACCT- PASSED  ' X140-EMP-NO             CL*31
00538         MOVE '140' TO X140-REC-TYPE                                  CL*34
00539         WRITE RPT-PASSED-REC FROM X140-REC                           CL*31
00540         ADD 1 TO RPT-PASSED-CNT                                      CL*31
00541         GO TO P2000-EXIT.                                            CL*31
00542                                                                      CL**2
00543      IF X140-REC-TYPE = 'REL'                                        CL*32
00544         DISPLAY '--X140 RELEASED - PASSED  ' X140-EMP-NO             CL*32
00545         MOVE '140' TO X140-REC-TYPE                                  CL*33
00546         WRITE RPT-PASSED-REC FROM X140-REC                           CL*32
00547         ADD 1 TO RPT-PASSED-CNT                                      CL*32
00548         GO TO P2000-EXIT.                                            CL*32
00549                                                                      CL*32
00550      IF X140-RESP-OPID > SPACES                                      CL*46
00551         DISPLAY 'UPDATED BY OPERATOR-PASSED ' X140-EMP-NO            CL*47
00552         MOVE '140' TO X140-REC-TYPE                                  CL*46
00553         WRITE RPT-PASSED-REC FROM X140-REC                           CL*46
00554         ADD 1 TO RPT-PASSED-CNT                                      CL*46
00555         GO TO P2000-EXIT.                                            CL*46
00556                                                                      CL*46
00557      MOVE X140-RCVD-DATE      TO  W-SLASH-DATE                       CL**2
00558      DISPLAY 'RPT RECEIVED DATE '  X140-RCVD-DATE                    CL**2
00559                                                                      CL**2
00560      MOVE W-SLASH-DT-DD       TO  RPT-FED-8-DA                       CL**2
00561      MOVE W-SLASH-DT-MM       TO  RPT-FED-8-MO                       CL**2
00562      MOVE W-SLASH-DT-CCYY     TO  RPT-FED-8-YR                       CL**2
00563                                                                      CL**2
00564      MOVE WRK-FED-8-DATE      TO  L001-FED-8-DATE-9                  CL**2
00565      PERFORM S001-FROM-FED-8 THRU S001-EXIT                          CL**2
00566      SUBTRACT 180 FROM L001-JUL-ABS-DAY                              CL*44
00567      PERFORM S001-FROM-ABS-DAY THRU S001-EXIT                        CL**2
00568      MOVE L001-FED-8-DATE-9  TO  WRK-FRAUD-CUTOFF-DATE.              CL**2
00569      DISPLAY 'FRAUD CUTOFF DATE ' L001-FED-8-DATE-9.                 CL**4
00570                                                                      CL**2
00571                                                                      CL**2
00572      PERFORM P5000-FIND-MRPT     THRU P5000-EXIT.                    CL*42
00573                                                                      CL*41
00574      IF MPRF-ESTB-DATE >= WRK-FRAUD-CUTOFF-DATE                      CL**2
00575         DISPLAY 'FRAUD REPORT..... ' MPRF-EMP-NO                     CL**4
00576         DISPLAY 'MPRF ESTB DATE    ' MPRF-ESTB-DATE                  CL**4
00577         DISPLAY 'FRAUD CUTOFF DATE ' WRK-FRAUD-CUTOFF-DATE           CL**4
00578         WRITE RPT-FRAUD-REC FROM X140-REC                            CL**2
00579         ADD 1 TO RPT-FRAUD-CNT                                       CL**2
00580         PERFORM P4000-WRITE-EROR-REPT THRU P4000-EXIT                CL**7
00581      ELSE                                                            CL**2
00582        IF NO-REPORT-FILED = 1                                        CL*41
00583         DISPLAY 'FRAUD 1ST RPT FILED ' MPRF-EMP-NO                   CL*41
00584         WRITE RPT-FRAUD-REC FROM X140-REC                            CL*41
00585         ADD 1 TO RPT-FRAUD-CNT                                       CL*41
00586         PERFORM P4000-WRITE-EROR-REPT THRU P4000-EXIT                CL*41
00587      ELSE                                                            CL*41
00588         WRITE RPT-PASSED-REC FROM X140-REC                           CL**2
00589         ADD 1 TO RPT-PASSED-CNT.                                     CL**2
00590  P2000-EXIT.                                                      DESBD473
00591      EXIT.                                                        DESBD473
00592  P4000-WRITE-EROR-REPT.                                              CL**7
00593                                                                      CL*30
00594      MOVE MPRF-ESTB-DATE      TO  WRK-FED-Z-DATE                     CL*30
00595      MOVE WRK-FED-Z-DATE      TO  L001-FED-8-DATE-9                  CL*16
00596      PERFORM S001-FROM-FED-8 THRU S001-EXIT                          CL*15
00597 *    SUBTRACT 30 FROM L001-JUL-ABS-DAY                               CL*15
00598 *    PERFORM S001-FROM-ABS-DAY THRU S001-EXIT                        CL*15
00599      MOVE L001-SLASH-8-DATE  TO  X434-REGD-DATE.                     CL*15
00600 *    DISPLAY 'REG DATE   ' L001-SLASH-8-DATE.                        CL*25
00601                                                                      CL*15
00602      MOVE X140-EMP-NO          TO  X434-EMP-NO                       CL**6
00603      MOVE X140-QUARTER         TO  X434-QTR                          CL**6
00604      MOVE '/'                  TO  X434-QTR-F                        CL*16
00605                                                                      CL**7
00606                                                                      CL*25
00607         MOVE MPRF-PRIMARY-NAME (1:20)                                CL**7
00608                                     TO X434-NAME-CHECK               CL**7
00609      MOVE MPRF-EMP-STATUS      TO  X434-EMP-STATUS                   CL*16
00610      MOVE MPRF-EMP-CLASS       TO  X434-EMP-CLASS                    CL*16
00611      MOVE MPRF-ORG-TYPE        TO  X434-EMP-ORG                      CL*16
00612      MOVE X140-RCVD-DATE       TO  X434-RCVD-DATE                    CL**6
00613 *    MOVE X140-RCVD-DATE       TO  X434-REGD-DATE                    CL*17
00614      MOVE X140-TOTAL-WAGE      TO  X434-TOT-WAGE                     CL**9
00615      MOVE X140-EXCESS-WAGE     TO  X434-EXC-WAGE                     CL**9
00616      MOVE X140-TAX-WAGE        TO  X434-TAX-WAGE                     CL**9
00617                                                                   DESBD473
00618      MOVE X140-WRKR-CNT-1ST-MNTH    TO X434-M1-CNT.                  CL*25
00619      MOVE X140-WRKR-CNT-2ND-MNTH    TO X434-M2-CNT.                  CL*25
00620      MOVE X140-WRKR-CNT-3RD-MNTH    TO X434-M3-CNT.                  CL*25
00621                                                                      CL**6
00622      PERFORM P5000-FIND-MRPT     THRU P5000-EXIT.                    CL*42
00623         MOVE 'N'               TO  X434-QTR-FILED.                   CL*30
00624      IF NO-REPORT-FILED = 1                                          CL*27
00625         MOVE 'Y'               TO  X434-QTR-FILED.                   CL*27
00626 *    MOVE '               '      TO  X434-MESSAGE                    CL*25
00627                                                                      CL**6
00628      PERFORM P4100-PRINT-HEADER THRU P4100-EXIT.                     CL**6
00629      WRITE REPT-EROR-REC FROM DETAIL-LINE-1  AFTER 1.                CL**7
00630      ADD  1    TO WS-LINE-CNT.                                       CL**7
00631  P4000-EXIT.                                                         CL**6
00632        EXIT.                                                         CL**6
00633  P4500-WRITE-EROR-MPRF.                                              CL*25
00634                                                                      CL*25
00635      MOVE SPACES             TO  X434-REGD-DATE.                     CL*25
00636                                                                      CL*25
00637      MOVE X140-EMP-NO          TO  X434-EMP-NO                       CL*25
00638      MOVE X140-QUARTER         TO  X434-QTR                          CL*25
00639      MOVE '/'                  TO  X434-QTR-F                        CL*25
00640                                                                      CL*25
00641      MOVE 'N'               TO  X434-QTR-FILED                       CL*25
00642         MOVE 'EMPLOYER NOT IN DUTAS'                                 CL*25
00643                                     TO X434-NAME-CHECK               CL*25
00644      MOVE SPACES               TO  X434-EMP-STATUS                   CL*25
00645      MOVE SPACES               TO  X434-EMP-CLASS                    CL*25
00646      MOVE SPACES               TO  X434-EMP-ORG                      CL*25
00647      MOVE X140-RCVD-DATE       TO  X434-RCVD-DATE                    CL*25
00648      MOVE X140-TOTAL-WAGE      TO  X434-TOT-WAGE                     CL*25
00649      MOVE X140-EXCESS-WAGE     TO  X434-EXC-WAGE                     CL*25
00650      MOVE X140-TAX-WAGE        TO  X434-TAX-WAGE                     CL*25
00651                                                                      CL*25
00652      MOVE X140-WRKR-CNT-1ST-MNTH    TO X434-M1-CNT.                  CL*25
00653      MOVE X140-WRKR-CNT-2ND-MNTH    TO X434-M2-CNT.                  CL*25
00654      MOVE X140-WRKR-CNT-3RD-MNTH    TO X434-M3-CNT.                  CL*25
00655                                                                      CL*25
00656 *    MOVE '               '      TO  X434-MESSAGE                    CL*25
00657                                                                      CL*25
00658      PERFORM P4100-PRINT-HEADER THRU P4100-EXIT.                     CL*25
00659      WRITE REPT-EROR-REC FROM DETAIL-LINE-1  AFTER 1.                CL*25
00660      ADD  1    TO WS-LINE-CNT.                                       CL*25
00661  P4500-EXIT.                                                         CL*25
00662        EXIT.                                                         CL*25
00663                                                                      CL*26
00664  P5000-FIND-MRPT.                                                    CL*42
00665                                                                      CL*25
00666        MOVE 0 TO NO-REPORT-FILED                                     CL*25
00667      MOVE LOW-VALUES TO MRPT-KEY-AREA.                               CL*42
00668                                                                      CL*25
00669      MOVE MPRF-EMP-NO   TO MRPT-EMP-NO.                              CL*42
00670      SET MRPT-RPT-88    TO TRUE.                                     CL*42
00671      MOVE 20201         TO MRPT-YRQ.                                 CL*42
00672      MOVE MRPT-KEY-AREA TO MSKL-KEY-AREA.                            CL*42
00673                                                                      CL*25
00674      PERFORM S910-START-BROWSE  THRU S910-EXIT.                      CL*25
00675      IF L910-NO-REC-88                                               CL*25
00676        MOVE 1 TO NO-REPORT-FILED                                     CL*25
00677         DISPLAY 'NO QTRS FILED ' MPRF-EMP-NO '  ' WRK-YRQ.           CL*25
00678  P5000-EXIT.                                                         CL*25
00679        EXIT.                                                         CL*25
00680                                                                      CL*25
00681  P4100-PRINT-HEADER.                                                 CL*25
00682       IF WS-LINE-CNT GREATER 58                                      CL**7
00683          MOVE +0          TO WS-LINE-CNT                             CL**6
00684          ADD  +1          TO WS-PAGE-CNT                             CL**6
00685          MOVE WS-PAGE-CNT TO HDR3-PAGE                               CL**6
00686 *        WRITE REPT-EROR-REC FROM HEADER-1 AFTER TOP-OF-PAGE         CL*35
00687 *        WRITE REPT-EROR-REC FROM HEADER-2 AFTER 1                   CL*35
00688          WRITE REPT-EROR-REC FROM HEADER-3 AFTER TOP-OF-PAGE         CL*35
00689          WRITE REPT-EROR-REC FROM HEADER-5 AFTER 1                   CL*20
00690          WRITE REPT-EROR-REC FROM HEADER-4 AFTER 1                   CL**7
00691          ADD +6    TO WS-LINE-CNT.                                   CL**7
00692  P4100-EXIT.                                                         CL**6
00693        EXIT.                                                         CL**6
00694  T0000-TERM.                                                      DESBD473
00695                                                                   DESBD473
00696                                                                   DESBD473
00697      DISPLAY '******************************************'         DESBD473
00698      DISPLAY '**  DTSBD473 TERMINATION STATISTICS     **'.           CL**2
00699                                                                   DESBD473
00700      DISPLAY 'TOTAL ESSP X140   READ    = ' RPT-X140-READ.           CL**2
00701      DISPLAY 'TOTAL FRAUD RPTS WRITTEN   = ' RPT-FRAUD-CNT.          CL**2
00702      DISPLAY 'TOTAL RPTS PASSED TO DUTAS = ' RPT-PASSED-CNT.         CL**2
00703      DISPLAY '  '.                                                DESBD473
00704      MOVE RPT-FRAUD-CNT      TO  WS-X140-PEN-CNT.                    CL**7
00705      MOVE RPT-X140-READ      TO  WS-X140-RED-CNT.                    CL*14
00706      MOVE RPT-PASSED-CNT     TO  WS-X140-PAS-CNT.                    CL**7
00707                                                                      CL*22
00708      IF RPT-FRAUD-CNT = ZERO                                         CL*22
00709      PERFORM P4100-PRINT-HEADER THRU P4100-EXIT                      CL*22
00710      WRITE REPT-EROR-REC FROM NOREPORT-LINE  AFTER 5.                CL*22
00711                                                                      CL*22
00712      WRITE REPT-EROR-REC FROM FOOTING-LINE-1 AFTER 5                 CL*22
00713      WRITE REPT-EROR-REC FROM FOOTING-LINE-2 AFTER 1                 CL**7
00714      WRITE REPT-EROR-REC FROM FOOTING-LINE-3 AFTER 1                 CL**7
00715      CLOSE RPT-ESSP-FILE RPT-FRAUD-FILE RPT-PASSED-FILE.             CL**7
00716  T0000-EXIT.                                                      DESBD473
00717      EXIT.                                                        DESBD473
00718                                                                   DESBD473
00719  S004-EDIT-QTR.                                                   DESBD473
00720      CALL 'DTSBU004' USING L004-COMM-AREA.                        DESBD473
00721                                                                   DESBD473
00722  S004-EXIT.                                                       DESBD473
00723      EXIT.                                                        DESBD473
00724  S005-FROM-SYS.                                                   DESBD473
00725                                                                   DESBD473
00726      SET L005-FROM-SYS TO TRUE.                                   DESBD473
00727      GO TO S005-ABSTIME.                                          DESBD473
00728                                                                   DESBD473
00729  S005-ABSTIME.                                                    DESBD473
00730                                                                   DESBD473
00731      CALL 'DTSBU005' USING L005-COMM-AREA.                        DESBD473
00732                                                                   DESBD473
00733  S005-EXIT.                                                       DESBD473
00734      EXIT.                                                        DESBD473
00735                                                                   DESBD473
00736                                                                      CL**2
00737  S001-FROM-FED-8.                                                    CL**2
00738      SET L001-FROM-FED-8 TO TRUE.                                    CL**2
00739      GO TO S001-DATE.                                                CL**2
00740      SKIP1                                                           CL**2
00741  S001-FROM-ABS-DAY.                                                  CL**2
00742      SET L001-FROM-ABS-DAY TO TRUE.                                  CL**2
00743      GO TO S001-DATE.                                                CL**2
00744      SKIP1                                                           CL**2
00745  S001-FROM-CAL-6.                                                    CL**2
00746      SET L001-FROM-CAL-6 TO TRUE.                                    CL**2
00747      GO TO S001-DATE.                                                CL**2
00748      SKIP1                                                           CL**2
00749  S001-DATE.                                                          CL**2
00750      CALL 'DTSBU001' USING L001-LINK-AREA.                           CL**2
00751  S001-EXIT.                                                          CL**2
00752      EXIT.                                                           CL**2
00753                                                                   DESBD473
00754                                                                   DESBD473
00755  S516-LIABILITY-INFO.                                             DESBD473
00756      CALL 'DTSBU516' USING L516-LINK-AREA                         DESBD473
00757                            MPRF-REC.                              DESBD473
00758  S516-EXIT.                                                       DESBD473
00759      EXIT.                                                        DESBD473
00760                                                                   DESBD473
00761  S910-OPEN-READ.                                                  DESBD473
00762      SET L910-OPEN-READ-88 TO TRUE.                               DESBD473
00763      GO TO S910-MSTR-IO.                                          DESBD473
00764                                                                   DESBD473
00765  S910-READ.                                                       DESBD473
00766      SET L910-READ-88 TO TRUE.                                    DESBD473
00767      GO TO S910-MSTR-IO.                                          DESBD473
00768                                                                   DESBD473
00769  S910-START-BROWSE.                                               DESBD473
00770      SET L910-START-BROWSE-88 TO TRUE.                            DESBD473
00771      GO TO S910-MSTR-IO.                                          DESBD473
00772                                                                   DESBD473
00773  S910-READ-NEXT.                                                  DESBD473
00774      SET L910-READ-NEXT-88 TO TRUE.                               DESBD473
00775      GO TO S910-MSTR-IO.                                          DESBD473
00776                                                                   DESBD473
00777  S910-CLOSE.                                                      DESBD473
00778      SET L910-CLOSE-88     TO TRUE.                               DESBD473
00779      GO TO S910-MSTR-IO.                                          DESBD473
00780                                                                   DESBD473
00781  S910-MSTR-IO.                                                    DESBD473
00782      CALL 'DTSBU910' USING L910-LINK-AREA                         DESBD473
00783                            MSKL-REC.                              DESBD473
00784  S910-EXIT.                                                       DESBD473
00785      EXIT.                                                        DESBD473
00786                                                                   DESBD473
00787  S931-OPEN-READ.                                                  DESBD473
00788      SET L931-OPEN-READ-88 TO TRUE.                               DESBD473
00789      GO TO S931-REF-IO.                                           DESBD473
00790                                                                   DESBD473
00791  S931-CLOSE.                                                      DESBD473
00792      SET L931-CLOSE-88 TO TRUE.                                   DESBD473
00793      GO TO S931-REF-IO.                                           DESBD473
00794                                                                   DESBD473
00795  S931-REF-IO.                                                     DESBD473
00796      CALL 'DTSBU931' USING L931-LINK-AREA                         DESBD473
00797                            FSKL-REC.                              DESBD473
00798  S931-EXIT.                                                       DESBD473
00799      EXIT.                                                        DESBD473
00800                                                                   DESBD473
00801  S981A-OPEN-UPDATE.                                               DESBD473
00802      SET L981-OPEN-UPDATE-88  TO TRUE.                            DESBD473
00803      PERFORM S981Z-WWGH-IO    THRU S981Z-EXIT.                    DESBD473
00804                                                                   DESBD473
00805  S981A-EXIT.                                                      DESBD473
00806      EXIT.                                                        DESBD473
00807                                                                   DESBD473
00808  S981B-WRITE.                                                     DESBD473
00809      SET L981-WRITE-88        TO TRUE.                            DESBD473
00810      PERFORM S981Z-WWGH-IO    THRU S981Z-EXIT.                    DESBD473
00811                                                                   DESBD473
00812  S981B-EXIT.                                                      DESBD473
00813      EXIT.                                                        DESBD473
00814  S981C-READ.                                                      DESBD473
00815      SET L981-READ-88        TO TRUE.                             DESBD473
00816      PERFORM S981Z-WWGH-IO    THRU S981Z-EXIT.                    DESBD473
00817                                                                   DESBD473
00818  S981C-EXIT.                                                      DESBD473
00819      EXIT.                                                        DESBD473
00820  S981E-DELETE.                                                    DESBD473
00821      SET L981-DELETE-88        TO TRUE.                           DESBD473
00822      PERFORM S981Z-WWGH-IO    THRU S981Z-EXIT.                    DESBD473
00823                                                                   DESBD473
00824  S981E-EXIT.                                                      DESBD473
00825      EXIT.                                                        DESBD473
00826                                                                   DESBD473
00827  S981D-CLOSE.                                                     DESBD473
00828      SET L981-CLOSE-88        TO TRUE.                            DESBD473
00829      PERFORM S981Z-WWGH-IO    THRU S981Z-EXIT.                    DESBD473
00830                                                                   DESBD473
00831  S981D-EXIT.                                                      DESBD473
00832      EXIT.                                                        DESBD473
00833                                                                   DESBD473
00834  S981Z-WWGH-IO.                                                   DESBD473
00835      CALL 'DTSBU981' USING L981-LINK-AREA                         DESBD473
00836                            WWGH-REC.                              DESBD473
00837  S981Z-EXIT.                                                      DESBD473
00838      EXIT.                                                        DESBD473
00839                                                                   DESBD473
00840  S983-OPEN-UPDATE.                                                DESBD473
00841      SET L983-OPEN-UPDATE-88  TO TRUE.                            DESBD473
00842      GO TO S983-WAGE-I.                                           DESBD473
00843                                                                   DESBD473
00844  S983-WRITE.                                                      DESBD473
00845      SET L983-WRITE-88        TO TRUE.                            DESBD473
00846      GO TO S983-WAGE-I.                                           DESBD473
00847                                                                   DESBD473
00848  S983-DELETE.                                                     DESBD473
00849      SET L983-DELETE-88    TO TRUE.                               DESBD473
00850      GO TO S983-WAGE-I.                                           DESBD473
00851                                                                   DESBD473
00852  S983-CLOSE.                                                      DESBD473
00853      SET L983-CLOSE-88    TO TRUE.                                DESBD473
00854      GO TO S983-WAGE-I.                                           DESBD473
00855                                                                   DESBD473
00856  S983-WAGE-I.                                                     DESBD473
00857      CALL 'DTSBU983' USING L983-LINK-AREA                         DESBD473
00858                            WSKL-REC.                              DESBD473
00859  S983-EXIT.                                                       DESBD473
00860      EXIT.                                                        DESBD473
00861                                                                   DESBD473
00862  S982A-START-BROWSE.                                              DESBD473
00863      SET L982-START-BROWSE-88 TO TRUE.                            DESBD473
00864      PERFORM S982Z-WNAM-IO    THRU S982Z-EXIT.                    DESBD473
00865                                                                   DESBD473
00866  S982A-EXIT.                                                      DESBD473
00867      EXIT.                                                        DESBD473
00868                                                                   DESBD473
00869  S982B-READ-NEXT.                                                 DESBD473
00870      SET L982-READ-NEXT-88    TO TRUE.                            DESBD473
00871      PERFORM S982Z-WNAM-IO    THRU S982Z-EXIT.                    DESBD473
00872                                                                   DESBD473
00873  S982B-EXIT.                                                      DESBD473
00874      EXIT.                                                        DESBD473
00875                                                                   DESBD473
00876  S982C-OPEN-READ.                                                 DESBD473
00877      SET L982-OPEN-READ-88    TO TRUE.                            DESBD473
00878      PERFORM S982Z-WNAM-IO    THRU S982Z-EXIT.                    DESBD473
00879                                                                   DESBD473
00880  S982C-EXIT.                                                      DESBD473
00881      EXIT.                                                        DESBD473
00882                                                                   DESBD473
00883  S982D-CLOSE.                                                     DESBD473
00884      SET L982-CLOSE-88        TO TRUE.                            DESBD473
00885      PERFORM S982Z-WNAM-IO    THRU S982Z-EXIT.                    DESBD473
00886                                                                   DESBD473
00887  S982D-EXIT.                                                      DESBD473
00888      EXIT.                                                        DESBD473
00889                                                                   DESBD473
00890  S982Z-WNAM-IO.                                                   DESBD473
00891      CALL 'DTSBU982' USING L982-LINK-AREA                         DESBD473
00892                            WNAM-REC.                              DESBD473
00893  S982Z-EXIT.                                                      DESBD473
00894      EXIT.                                                        DESBD473
00895                                                                   DESBD473
00896                                                                   DESBD473
00897  S999-ABEND.                                                      DESBD473
00898      DISPLAY '*** I/O MODULE ABENDING'.                           DESBD473
00899                                                                   DESBD473
00900      DISPLAY '*** CMND-CD = ' L983-CMND-CD.                       DESBD473
00901                                                                   DESBD473
00902      DISPLAY '*** FILE-STATUS = ' WAGE-TRANS-STATUS.              DESBD473
00903                                                                   DESBD473
00904      DISPLAY '*** CALLING MODULE = ' L983-MOD-NAME.               DESBD473
00905                                                                   DESBD473
00906                                                                   DESBD473
00907      CALL 'DTSBU999' USING WRK-ABEND-CD.                          DESBD473
00908  S999-EXIT.                                                       DESBD473
00909      EXIT.                                                        DESBD473
