00001  IDENTIFICATION DIVISION.                                         01/24/24
00002  PROGRAM-ID.             DESBD470.                                DESBD470
00003  AUTHOR.                 NGC.                                        LV131
00004  DATE-WRITTEN.           DECEMBER 2012.                              CL113
00005  DATE-COMPILED.                                                   DESBD470
00006      SKIP3                                                        DESBD470
00007 *****                                                             DESBD470
00008 *                                                                 DESBD470
00009 *    ZUNCTION:  DELETE WAGES TO WGH FILE FOR TESTING.                CL129
00010 *             FOR TAX WAGES SINCE UIBS   01/21/24  ZL1               CL117
00011 *                                                                 DESBD470
00012 *                                                                 DESBD470
00013 *    MODIFICATION LOG:                                            DESBD470
00014 *                                                                 DESBD470
00015 *    12/06/2012  INITIAL DEVELOPMENT.                                CL113
00016 *                WORK ORDER:                      PROGRAMMER: GD  DESBD470
00017 *    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DESBD470
00018 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DESBD470
00019 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX   DESBD470
00020 *                                                                 DESBD470
00021 *                                                                 DESBD470
00022 *    DESCRIPTION:                                                 DESBD470
00023 *                                                                 DESBD470
00024 *                                                                    CL*89
00025 *                                                                    CL*89
00026 *                                                                    CL*89
00027 *                                                                    CL*89
00028 *                                                                 DESBD470
00029 *                                                                    CL*89
00030 *                                                                    CL*89
00031 *                                                                    CL*89
00032 *                                                                    CL*89
00033 *                                                                 DESBD470
00034 *    GENERAL SPECIFICATIONS:                                      DESBD470
00035 *                                                                 DESBD470
00036 *        ALL COMMANDS ARE VALID.                                  DESBD470
00037 *                                                                 DESBD470
00038 *        IF AN INVALID COMMAND IS REQUESTED, THEN ABEND THE       DESBD470
00039 *        MODULE.                                                  DESBD470
00040 *                                                                 DESBD470
00041 *        IF A FILE-STATUS OF OTHER THAN '00', '10', OR '23' IS    DESBD470
00042 *        ENCOUNTERED, THEN ABEND PROCESSING (TOLERATE A           DESBD470
00043 *        FILE-STATUS OF '97' FROM AN OPEN COMMAND).               DESBD470
00044 *                                                                 DESBD470
00045 *                                                                 DESBD470
00046 *                                                                 DESBD470
00047 *    COMMAND SPECIFIC SPECIFICATIONS:                             DESBD470
00048 *                                                                 DESBD470
00049 *    OPEN-READ                                                    DESBD470
00050 *        OPEN INPUT.                                              DESBD470
00051 *                                                                 DESBD470
00052 *    OPEN-UPDATE                                                  DESBD470
00053 *        OPEN I-O.                                                DESBD470
00054 *                                                                 DESBD470
00055 *    CLOSE                                                        DESBD470
00056 *                                                                 DESBD470
00057 *    READ                                                         DESBD470
00058 *                                                                 DESBD470
00059 *    START BROWSE                                                 DESBD470
00060 *        IF THE START-BROWSE IS SUCCESSFUL, THEN PERFORM THE      DESBD470
00061 *        READ-NEXT LOGIC.  A SUCCESSFUL START-BROWSE RETURNS      DESBD470
00062 *        A RECORD.                                                DESBD470
00063 *                                                                 DESBD470
00064 *    READ NEXT                                                    DESBD470
00065 *                                                                 DESBD470
00066 *    WRITE                                                        DESBD470
00067 *                                                                 DESBD470
00068 *    REWRITE                                                      DESBD470
00069 *                                                                 DESBD470
00070 *    DELETE                                                       DESBD470
00071 *                                                                 DESBD470
00072 *                                                                 DESBD470
00073 *****                                                             DESBD470
00074                                                                      CL114
00075  ENVIRONMENT DIVISION.                                               CL114
00076                                                                      CL114
00077  INPUT-OUTPUT SECTION.                                               CL114
00078                                                                   DESBD470
00079  FILE-CONTROL.                                                       CL114
00080      SELECT WAGE-TRANS-FILE ASSIGN TO DTSFWTRN                       CL114
00081          FILE STATUS IS WAGE-TRANS-STATUS.                           CL114
00082                                                                      CL114
00083 *    SELECT TAXWGH-FILE ASSIGN TO DTSXWGH                            CL129
00084 *        FILE STATUS IS DOWNLOAD-STATUS.                             CL129
00085                                                                   DESBD470
00086  DATA DIVISION.                                                   DESBD470
00087                                                                      CL114
00088  FILE SECTION.                                                       CL114
00089                                                                      CL114
00090  FD  WAGE-TRANS-FILE                                                 CL114
00091      RECORDING MODE IS F                                             CL114
00092      BLOCK CONTAINS 0 RECORDS.                                       CL114
00093                                                                      CL114
00094  01  WAGE-TRANS-REC                  PIC  X(80).                     CL131
00095                                                                      CL114
00096 *FD  TAXWGH-FILE                                                     CL129
00097 *    RECORDING MODE IS F                                             CL129
00098 *    BLOCK CONTAINS 0 RECORDS.                                       CL129
00099                                                                      CL117
00100 *01  TAXWGH-REC                    PIC  X(18).                       CL129
00101                                                                   DESBD470
00102  WORKING-STORAGE SECTION.                                         DESBD470
001025 77  PAN-VALET PICTURE X(24) VALUE '131DESBD470  01/24/24'.       DESBD470
00103      SKIP3                                                        DESBD470
00104  01  WRK-AREA.                                                    DESBD470
00105      05  WRK-ABEND-CD             PIC S9(04)  COMP  VALUE +480.      CL114
00106                                                                   DESBD470
00107      05  WRK-MOD-NAME             PIC  X(08)  VALUE 'DTSBU480'.      CL114
00108                                                                   DESBD470
00109      05  W-CURR-EMP-NO            PIC S9(06)  COMP-3 VALUE +0.    DESBD470
00110      05  W-CURR-YRQ               PIC S9(05)  COMP-3                 CL*62
00111                                     VALUE +20121.                    CL*62
00112      05  W-CURR-BATCH             PIC S9(05)  COMP-3 VALUE +0.       CL*53
00113      05  W-CURR-ITEM              PIC S9(03)  COMP-3 VALUE +0.       CL*81
00114      05  W-MQTR-TOT-WAGE          PIC S9(11)V99 COMP-3               CL*58
00115                                     VALUE +0.                        CL*58
00116      05  W-WTC-BATCH-NO           PIC S9(05)  COMP-3                 CL*90
00117                                     VALUE +90001.                    CL*95
00118      05  W-WTC-ITEM-NO            PIC S9(03)  COMP-3                 CL*90
00119                                     VALUE +003.                      CL*98
00120      05  W-WTC-SEQ-NO             PIC S9(03)  COMP-3                 CL*92
00121                                     VALUE +001.                      CL*92
00122      05  W-MAX-BATCH              PIC S9(05)  COMP-3 VALUE +0.       CL*52
00123      05  W-MIN-BATCH              PIC S9(05)  COMP-3                 CL*52
00124                                     VALUE +99999.                    CL*52
00125      05  WRK-W2-CNT               PIC S9(07)  COMP-3 VALUE +0.    DESBD470
00126      05  WRK-W4-CNT               PIC S9(07)  COMP-3 VALUE +0.    DESBD470
00127      05  WRK-WWGH-CNT             PIC S9(07)  COMP-3 VALUE +0.    DESBD470
00128      05  WRK-DELETE-CNT           PIC S9(07)  COMP-3 VALUE +0.    DESBD470
00129      05  W-BYPASSED-CNT           PIC S9(07)  COMP-3 VALUE +0.    DESBD470
00130      05  W-BACKLOG                PIC S9(07)  COMP-3 VALUE +0.       CL**9
00131      05  AMT-DISP1                PIC  ----------9.99.               CL*60
00132      05  AMT-DISP2                PIC  ----------9.99.               CL*60
00133      05  AMT-DISP3                PIC  ----------9.99.               CL*60
00134      05  AMT-DISP4                PIC  ----------9.99.               CL*57
00135                                                                   DESBD470
00136      05  WRK-NET-WAGE             PIC S9(11)V99  COMP-3           DESBD470
00137                                                     VALUE +0.     DESBD470
00138      05  W-WGH-WAGE               PIC S9(11)V99  COMP-3              CL*70
00139                                                     VALUE +0.        CL*70
00140      05  W-WORKER-CNT             PIC S9(07)  COMP-3 VALUE +0.       CL*63
00141      05  W-DIFFERENCE             PIC S9(11)V99  COMP-3              CL*63
00142                                                     VALUE +0.        CL*63
00143                                                                   DESBD470
00144      05  W2-REC-READ  PIC 9(9) VALUE 0.                              CL124
00145      05  W4-REC-READ  PIC 9(9) VALUE 0.                              CL124
00146      05  W4-REC-FOUND PIC 9(9) VALUE 0.                              CL124
00147      05  W4-REC-ADDED PIC 9(9) VALUE 0.                              CL124
00148      05  W2-REC-DELETED PIC 9(9) VALUE 0.                            CL124
00149      05  W2-REC-FOUND PIC 9(9) VALUE 0.                              CL124
00150                                                                      CL123
00151      05  W-RESP-OPID                PIC  X(08).                      CL*78
00152      05  WRK-ERROR-IND              PIC  X(01).                   DESBD470
00153          88  WRK-ERROR-YES-88            VALUE 'Y'.               DESBD470
00154          88  WRK-ERROR-NO-88             VALUE 'N'.               DESBD470
00155                                                                   DESBD470
00156      05  W-EMP-EXISTS-IND           PIC  X(01).                      CL*67
00157          88  W-EMP-EXISTS-YES-88      VALUE 'Y'.                     CL*67
00158          88  W-EMP-EXISTS-NO-88       VALUE 'N'.                     CL*67
00159      05  W-DELINQUENT-IND           PIC  X(01).                      CL*67
00160          88  W-DELINQUENT-YES-88      VALUE 'Y'.                     CL*67
00161          88  W-DELINQUENT-NO-88       VALUE 'N'.                     CL*67
00162      05  WAGE-TRANS-STATUS          PIC  X(02).                   DESBD470
00163          88  WAGE-TRANS-FILE-OK-88       VALUE '00'.              DESBD470
00164          88  WAGE-TRANS-FILE-NO-REC-88   VALUE '10' '23'.         DESBD470
00165          88  WAGE-TRANS-FILE-VERIFY-88   VALUE '97'.              DESBD470
00166                                                                   DESBD470
00167      05  DOWNLOAD-STATUS            PIC  X(02).                   DESBD470
00168          88  DOWNLOAD-FILE-OK-88         VALUE '00'.              DESBD470
00169                                                                   DESBD470
00170      05  WRK-YRQ                  PIC  9(05).                     DESBD470
00171      05  FILLER REDEFINES WRK-YRQ.                                DESBD470
00172          10  WRK-YRQ-YEAR         PIC  9(04).                     DESBD470
00173          10  WRK-YRQ-QTR          PIC  9(01).                     DESBD470
00174                                                                   DESBD470
00175      05  WRK-YRQ-X.                                               DESBD470
00176          10  WRK-YRQ-YEAR-X       PIC 9(04).                      DESBD470
00177          10  FILLER               PIC X(01) VALUE '/'.            DESBD470
00178          10  WRK-YRQ-QTR-X        PIC 9(01).                      DESBD470
00179                                                                   DESBD470
00180  01  L004-COMM-AREA.                                                 CL*35
00181  ++INCLUDE DTSIL004                                                  CL*35
00182                                                                      CL*35
00183  01  L424-LINK-AREA.                                                 CL100
00184  ++INCLUDE DTSIL424                                                  CL100
00185                                                                      CL100
00186  01  L516-LINK-AREA.                                                 CL*48
00187  ++INCLUDE DTSIL516                                                  CL*48
00188                                                                      CL*48
00189  01  L910-LINK-AREA.                                                 CL*47
00190  ++INCLUDE DTSIL910                                                  CL*47
00191                                                                      CL*47
00192  01  X147-REC.                                                       CL129
00193  ++INCLUDE DTSIX147                                                  CL129
00194                                                                      CL129
00195  01  MSKL-REC.                                                       CL*47
00196  ++INCLUDE DTSIMSKL                                                  CL*47
00197                                                                      CL*47
00198  01  MPRF-REC.                                                       CL*47
00199  ++INCLUDE DTSIMPRF                                                  CL*47
00200                                                                      CL*47
00201  01  MQTR-REC.                                                       CL*47
00202  ++INCLUDE DTSIMQTR                                                  CL*47
00203                                                                      CL*47
00204  01  L931-LINK-AREA.                                                 CL*50
00205  ++INCLUDE DTSIL931                                                  CL*50
00206                                                                      CL*50
00207  01  FSKL-REC.                                                       CL*50
00208  ++INCLUDE DTSIFSKL                                                  CL*50
00209                                                                      CL*50
00210  01  L981-LINK-AREA.                                                 CL*69
00211  ++INCLUDE DTSIL981                                                  CL*69
00212                                                                      CL*69
00213  01  WWGH-REC.                                                       CL*69
00214  ++INCLUDE DTSIWWGH                                                  CL*69
00215                                                                      CL*69
00216  01  L983-LINK-AREA.                                              DESBD470
00217  ++INCLUDE DTSIL983                                               DESBD470
00218                                                                   DESBD470
00219  01  WSKL-REC.                                                    DESBD470
00220  ++INCLUDE DTSIWSKL                                               DESBD470
00221                                                                   DESBD470
00222  01  W001-REC.                                                    DESBD470
00223  ++INCLUDE DTSIW001                                               DESBD470
00224                                                                   DESBD470
00225  01  L982-LINK-AREA.                                              DESBD470
00226  ++INCLUDE DTSIL982                                               DESBD470
00227                                                                   DESBD470
00228  01  WNAM-REC.                                                    DESBD470
00229  ++INCLUDE DTSIWNAM                                               DESBD470
00230                                                                      CL114
00231  01  WAGE-TRANS-AREA.                                                CL131
00232      05  ESP-TRANSACTION-AREA       PIC  X(80).                      CL131
00233  ++INCLUDE EWGTRNW2                                                  CL131
00234                                                                      CL114
00235  PROCEDURE DIVISION.                                              DESBD470
00236                                                                   DESBD470
00237      PERFORM I0000-INIT             THRU I0000-EXIT.                 CL*96
00238      IF WRK-ERROR-NO-88                                           DESBD470
00239         PERFORM P0000-PROCESS       THRU P0000-EXIT                  CL114
00240         PERFORM T0000-TERM          THRU T0000-EXIT               DESBD470
00241      END-IF.                                                      DESBD470
00242                                                                   DESBD470
00243      GOBACK.                                                      DESBD470
00244      EJECT                                                        DESBD470
00245  I0000-INIT.                                                      DESBD470
00246      SET WRK-ERROR-NO-88   TO TRUE.                               DESBD470
00247                                                                   DESBD470
00248      OPEN INPUT  WAGE-TRANS-FILE.                                    CL115
00249      IF WAGE-TRANS-FILE-OK-88                                        CL114
00250      OR WAGE-TRANS-FILE-VERIFY-88                                    CL114
00251         NEXT SENTENCE                                                CL114
00252      ELSE                                                            CL114
00253         PERFORM S999-ABEND THRU S999-EXIT                            CL114
00254      END-IF.                                                         CL114
00255                                                                      CL114
00256                                                                      CL117
00257 *    OPEN OUTPUT TAXWGH-FILE.                                        CL129
00258 *    IF WAGE-TRANS-FILE-OK-88                                        CL129
00259 *    OR WAGE-TRANS-FILE-VERIFY-88                                    CL129
00260 *       NEXT SENTENCE                                                CL129
00261 *    ELSE                                                            CL129
00262 *       PERFORM S999-ABEND THRU S999-EXIT                            CL129
00263 *    END-IF.                                                         CL129
00264                                                                      CL117
00265      PERFORM S981A-OPEN-UPDATE      THRU S981A-EXIT.                 CL*89
00266      PERFORM S983-OPEN-UPDATE       THRU S983-EXIT.                  CL*89
00267      PERFORM S931-OPEN-READ         THRU S931-EXIT.                  CL102
00268                                                                      CL*35
00269  I0000-EXIT.                                                      DESBD470
00270      EXIT.                                                        DESBD470
00271                                                                      CL*35
00272  P0000-PROCESS.                                                      CL114
00273      READ WAGE-TRANS-FILE     INTO ESP-TRANSACTION-AREA              CL131
00274                                                                      CL114
00275      PERFORM UNTIL WAGE-TRANS-FILE-NO-REC-88                         CL114
00276         PERFORM P2000-WGH              THRU P2000-EXIT               CL115
00277         READ WAGE-TRANS-FILE  INTO ESP-TRANSACTION-AREA              CL131
00278                                                                      CL114
00279      END-PERFORM.                                                    CL114
00280                                                                      CL114
00281  P0000-EXIT.                                                         CL114
00282      EXIT.                                                           CL114
00283                                                                      CL114
00284                                                                      CL*60
00285  P2000-WGH.                                                          CL*92
00286      IF W2-TRAN-ID = 'W2'                                            CL131
00287         ADD 1 TO W2-REC-READ                                         CL131
00288      ELSE                                                            CL131
00289       DISPLAY 'RECORD NOT W2     ' W2-TRAN-ID                        CL131
00290      GO TO P2000-EXIT.                                               CL131
00291                                                                      CL123
00292      MOVE LOW-VALUE                    TO WWGH-REC.                  CL*73
00293      MOVE W2-ACCOUNT-NUMBER          TO WWGH-EMP-NO.                 CL131
00294      MOVE W2-QTR                       TO WWGH-YRQ                   CL131
00295      MOVE W2-SSN                       TO WWGH-SSN.                  CL131
00296 *    MOVE X147-EARNINGS          TO WWGH-EARNINGS.                   CL130
00297      PERFORM S981C-READ                THRU S981C-EXIT.              CL117
00298      IF L981-OK-88                                                   CL117
00299         DISPLAY 'WGH REC FOUND ' WWGH-EMP-NO '  ' WWGH-YRQ           CL129
00300            '  ' WWGH-SSN ' ' WWGH-EARNINGS                           CL129
00301      ELSE                                                            CL117
00302       DISPLAY 'WGH REC NOT FOUND ' W2-ACCOUNT-NUMBER                 CL131
00303            '  ' W2-SSN ' ' W2-QTR                                    CL131
00304      GO TO P2000-EXIT.                                               CL129
00305                                                                      CL117
00306        ADD 1 TO W2-REC-FOUND                                         CL123
00307         PERFORM S981E-DELETE              THRU S981E-EXIT            CL117
00308        IF NOT L981-OK-88                                             CL117
00309         DISPLAY 'DELET FAILED ' W2-ACCOUNT-NUMBER                    CL131
00310            '  ' W2-SSN ' ' W2-QTR                                    CL131
00311        ELSE                                                          CL121
00312         ADD 1 TO W2-REC-DELETED                                      CL123
00313         DISPLAY 'WAGES DELETED' WWGH-EMP-NO '  ' WWGH-YRQ            CL129
00314            '  ' WWGH-SSN.                                            CL129
00315      GO TO P2000-EXIT.                                               CL117
00316                                                                      CL117
00317  P2000-CONTINUE.                                                     CL117
00318 *    IF W4-TRAN-ID = 'W2'                                            CL129
00319 *       GO TO P2000-EXIT.                                            CL129
00320                                                                      CL127
00321 *    MOVE LOW-VALUE                    TO WWGH-REC.                  CL129
00322 *    MOVE W4-ACCOUNT                   TO WWGH-EMP-NO.               CL129
00323 *    MOVE W4-QUARTER                   TO WWGH-YRQ                   CL129
00324 *    MOVE W4-SSN                       TO WWGH-SSN.                  CL129
00325 *    MOVE W4-QUARTER-EARNINGS          TO WWGH-EARNINGS.             CL129
00326                                                                      CL117
00327 *    WRITE TAXWGH-REC  FROM WWGH-REC.                                CL129
00328 *    ADD 1 TO W4-REC-ADDED.                                          CL129
00329 *    PERFORM S981B-WRITE               THRU S981B-EXIT.              CL128
00330 *    IF NOT L981-OK-88                                               CL128
00331 *       DISPLAY 'WRITE FAILED ' W4-ACCOUNT '  ' W4-QUARTER           CL128
00332 *          '  ' W4-SSN.                                              CL128
00333                                                                      CL*73
00334  P2000-EXIT.                                                         CL*92
00335      EXIT.                                                           CL*73
00336                                                                      CL*69
00337  T0000-TERM.                                                      DESBD470
00338      PERFORM S981D-CLOSE      THRU S981D-EXIT.                       CL*73
00339      PERFORM S983-CLOSE       THRU S983-EXIT.                        CL*69
00340      PERFORM S931-CLOSE       THRU S931-EXIT.                        CL102
00341                                                                   DESBD470
00342 *    CLOSE WAGE-TRANS-FILE   TAXWGH-FILE.                            CL130
00343      CLOSE WAGE-TRANS-FILE.                                          CL130
00344                                                                   DESBD470
00345      DISPLAY '******************************************'         DESBD470
00346      DISPLAY '**  DTSBZ479 TERMINATION STATISTICS     **'.           CL*91
00347                                                                      CL123
00348      DISPLAY 'TOTAL W4 TRANS REC READ    = ' W4-REC-READ.            CL123
00349      DISPLAY 'TOTAL W4 TRANS REC FOUND   = ' W4-REC-FOUND.           CL123
00350      DISPLAY 'TOTAL W4 TRANS REC ADDED   = ' W4-REC-ADDED.           CL123
00351      DISPLAY 'TOTAL W2 TRANS REC READ    = ' W2-REC-READ.            CL123
00352      DISPLAY 'TOTAL W2 TRANS REC FOUND   = ' W2-REC-FOUND.           CL123
00353      DISPLAY 'TOTAL W2 TRANS REC DELETED = ' W2-REC-DELETED.         CL125
00354      DISPLAY '  '.                                                   CL123
00355  T0000-EXIT.                                                      DESBD470
00356      EXIT.                                                        DESBD470
00357                                                                   DESBD470
00358  S004-EDIT-QTR.                                                      CL*35
00359      CALL 'DTSBU004' USING L004-COMM-AREA.                           CL*35
00360                                                                      CL*35
00361  S004-EXIT.                                                          CL*35
00362      EXIT.                                                           CL*35
00363                                                                      CL*35
00364  S516-LIABILITY-INFO.                                                CL*48
00365      CALL 'DTSBU516' USING L516-LINK-AREA                            CL*48
00366                            MPRF-REC.                                 CL*48
00367  S516-EXIT.                                                          CL*48
00368      EXIT.                                                           CL*48
00369                                                                      CL*48
00370  S910-OPEN-READ.                                                     CL*47
00371      SET L910-OPEN-READ-88 TO TRUE.                                  CL*47
00372      GO TO S910-MSTR-IO.                                             CL*47
00373                                                                      CL*47
00374  S910-READ.                                                          CL*47
00375      SET L910-READ-88 TO TRUE.                                       CL*47
00376      GO TO S910-MSTR-IO.                                             CL*47
00377                                                                      CL*47
00378  S910-START-BROWSE.                                                  CL*47
00379      SET L910-START-BROWSE-88 TO TRUE.                               CL*49
00380      GO TO S910-MSTR-IO.                                             CL*47
00381                                                                      CL*47
00382  S910-READ-NEXT.                                                     CL*47
00383      SET L910-READ-NEXT-88 TO TRUE.                                  CL*47
00384      GO TO S910-MSTR-IO.                                             CL*47
00385                                                                      CL*47
00386  S910-CLOSE.                                                         CL*47
00387      SET L910-CLOSE-88     TO TRUE.                                  CL*47
00388      GO TO S910-MSTR-IO.                                             CL*47
00389                                                                      CL*47
00390  S910-MSTR-IO.                                                       CL*47
00391      CALL 'DTSBU910' USING L910-LINK-AREA                            CL*47
00392                            MSKL-REC.                                 CL*47
00393  S910-EXIT.                                                          CL*47
00394      EXIT.                                                           CL*47
00395                                                                      CL*47
00396  S931-OPEN-READ.                                                     CL*50
00397      SET L931-OPEN-READ-88 TO TRUE.                                  CL*50
00398      GO TO S931-REF-IO.                                              CL*50
00399                                                                      CL*50
00400  S931-CLOSE.                                                         CL*50
00401      SET L931-CLOSE-88 TO TRUE.                                      CL*50
00402      GO TO S931-REF-IO.                                              CL*50
00403                                                                      CL*50
00404  S931-REF-IO.                                                        CL*50
00405      CALL 'DTSBU931' USING L931-LINK-AREA                            CL*50
00406                            FSKL-REC.                                 CL*50
00407  S931-EXIT.                                                          CL*50
00408      EXIT.                                                           CL*50
00409                                                                      CL*50
00410  S981A-OPEN-UPDATE.                                                  CL*89
00411      SET L981-OPEN-UPDATE-88  TO TRUE.                               CL*89
00412      PERFORM S981Z-WWGH-IO    THRU S981Z-EXIT.                       CL*69
00413                                                                      CL*69
00414  S981A-EXIT.                                                         CL*69
00415      EXIT.                                                           CL*69
00416                                                                      CL*69
00417  S981B-WRITE.                                                        CL*91
00418      SET L981-WRITE-88        TO TRUE.                               CL*91
00419      PERFORM S981Z-WWGH-IO    THRU S981Z-EXIT.                       CL*69
00420                                                                      CL*69
00421  S981B-EXIT.                                                         CL*69
00422      EXIT.                                                           CL*69
00423  S981C-READ.                                                         CL117
00424      SET L981-READ-88        TO TRUE.                                CL117
00425      PERFORM S981Z-WWGH-IO    THRU S981Z-EXIT.                       CL117
00426                                                                      CL117
00427  S981C-EXIT.                                                         CL117
00428      EXIT.                                                           CL117
00429  S981E-DELETE.                                                       CL118
00430      SET L981-DELETE-88        TO TRUE.                              CL117
00431      PERFORM S981Z-WWGH-IO    THRU S981Z-EXIT.                       CL117
00432                                                                      CL117
00433  S981E-EXIT.                                                         CL117
00434      EXIT.                                                           CL117
00435                                                                      CL*69
00436  S981D-CLOSE.                                                        CL*69
00437      SET L981-CLOSE-88        TO TRUE.                               CL*69
00438      PERFORM S981Z-WWGH-IO    THRU S981Z-EXIT.                       CL*69
00439                                                                      CL*69
00440  S981D-EXIT.                                                         CL*69
00441      EXIT.                                                           CL*69
00442                                                                      CL*69
00443  S981Z-WWGH-IO.                                                      CL*69
00444      CALL 'DTSBU981' USING L981-LINK-AREA                            CL*69
00445                            WWGH-REC.                                 CL*69
00446  S981Z-EXIT.                                                         CL*69
00447      EXIT.                                                           CL*69
00448                                                                      CL*69
00449  S983-OPEN-UPDATE.                                                DESBD470
00450      SET L983-OPEN-UPDATE-88  TO TRUE.                            DESBD470
00451      GO TO S983-WAGE-I.                                           DESBD470
00452                                                                   DESBD470
00453  S983-WRITE.                                                         CL*90
00454      SET L983-WRITE-88        TO TRUE.                               CL*90
00455      GO TO S983-WAGE-I.                                           DESBD470
00456                                                                   DESBD470
00457  S983-DELETE.                                                     DESBD470
00458      SET L983-DELETE-88    TO TRUE.                               DESBD470
00459      GO TO S983-WAGE-I.                                           DESBD470
00460                                                                   DESBD470
00461  S983-CLOSE.                                                      DESBD470
00462      SET L983-CLOSE-88    TO TRUE.                                DESBD470
00463      GO TO S983-WAGE-I.                                           DESBD470
00464                                                                   DESBD470
00465  S983-WAGE-I.                                                     DESBD470
00466      CALL 'DTSBU983' USING L983-LINK-AREA                         DESBD470
00467                            WSKL-REC.                              DESBD470
00468  S983-EXIT.                                                       DESBD470
00469      EXIT.                                                        DESBD470
00470                                                                   DESBD470
00471  S982A-START-BROWSE.                                              DESBD470
00472      SET L982-START-BROWSE-88 TO TRUE.                            DESBD470
00473      PERFORM S982Z-WNAM-IO    THRU S982Z-EXIT.                    DESBD470
00474                                                                   DESBD470
00475  S982A-EXIT.                                                      DESBD470
00476      EXIT.                                                        DESBD470
00477                                                                   DESBD470
00478  S982B-READ-NEXT.                                                 DESBD470
00479      SET L982-READ-NEXT-88    TO TRUE.                            DESBD470
00480      PERFORM S982Z-WNAM-IO    THRU S982Z-EXIT.                    DESBD470
00481                                                                   DESBD470
00482  S982B-EXIT.                                                      DESBD470
00483      EXIT.                                                        DESBD470
00484                                                                   DESBD470
00485  S982C-OPEN-READ.                                                 DESBD470
00486      SET L982-OPEN-READ-88    TO TRUE.                            DESBD470
00487      PERFORM S982Z-WNAM-IO    THRU S982Z-EXIT.                    DESBD470
00488                                                                   DESBD470
00489  S982C-EXIT.                                                      DESBD470
00490      EXIT.                                                        DESBD470
00491                                                                   DESBD470
00492  S982D-CLOSE.                                                     DESBD470
00493      SET L982-CLOSE-88        TO TRUE.                            DESBD470
00494      PERFORM S982Z-WNAM-IO    THRU S982Z-EXIT.                    DESBD470
00495                                                                   DESBD470
00496  S982D-EXIT.                                                      DESBD470
00497      EXIT.                                                        DESBD470
00498                                                                   DESBD470
00499  S982Z-WNAM-IO.                                                   DESBD470
00500      CALL 'DTSBU982' USING L982-LINK-AREA                         DESBD470
00501                            WNAM-REC.                              DESBD470
00502  S982Z-EXIT.                                                      DESBD470
00503      EXIT.                                                        DESBD470
00504                                                                   DESBD470
00505                                                                   DESBD470
00506  S999-ABEND.                                                      DESBD470
00507      DISPLAY '*** I/O MODULE ABENDING'.                           DESBD470
00508                                                                   DESBD470
00509      DISPLAY '*** CMND-CD = ' L983-CMND-CD.                       DESBD470
00510                                                                   DESBD470
00511      DISPLAY '*** FILE-STATUS = ' WAGE-TRANS-STATUS.              DESBD470
00512                                                                   DESBD470
00513      DISPLAY '*** CALLING MODULE = ' L983-MOD-NAME.               DESBD470
00514                                                                   DESBD470
00515                                                                   DESBD470
00516      CALL 'DTSBU999' USING WRK-ABEND-CD.                          DESBD470
00517  S999-EXIT.                                                       DESBD470
00518      EXIT.                                                        DESBD470
