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