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