00001  IDENTIFICATION DIVISION.                                         06/19/13
00002  PROGRAM-ID.             DTSBU420.                                DTSBU420
00003  AUTHOR.                 TRW.                                        LV027
00004  DATE-WRITTEN.           FEBRUARY 2002.                           DTSBU420
00005  DATE-COMPILED.                                                   DTSBU420
00006      SKIP3                                                        DTSBU420
00007 *****                                                             DTSBU420
00008 *                                                                 DTSBU420
00009 *    FUNCTION:  FORMAT W4 TRANSACTIONS FROM W001 TRANSACTIONS,    DTSBU420
00010 *               AND ADD WWGH WAGE HISTORY RECORDS.                DTSBU420
00011 *               DELETE W001 TRANSACTIONS WHEN THE BATCH IS        DTSBU420
00012 *               DELETED.                                          DTSBU420
00013 *                                                                 DTSBU420
00014 *                                                                 DTSBU420
00015 *    MODIFICATION LOG:                                            DTSBU420
00016 *                                                                 DTSBU420
00017 *    02/07/2002  INITIAL DEVELOPMENT.                             DTSBU420
00018 *                WORK ORDER:                      PROGRAMMER: GD  DTSBU420
00019 *                                                                 DTSBU420
00020 *    03/18/2004  MODIFIED FOR ELECTRONIC FILING AND PAYMENT       DTSBU420
00021 *                PROCESS.                                         DTSBU420
00022 *                WORK ORDER:                      PROGRAMMER: GD  DTSBU420
00023 *                                                                 DTSBU420
00024 *    08/24/2004  REMOVED DISPLAYS                                 DTSBU420
00025 *                WORK ORDER:                      PROGRAMMER: GD  DTSBU420
00026 *                                                                 DTSBU420
00027 *    06/13/2007  MODIFIED TO USE L420-EMP-NO, PASSED FROM         DTSBU420
00028 *                BD371, INSTEAD OF W001-EMP-NO.                   DTSBU420
00029 *                WORK ORDER:                      PROGRAMMER: GD  DTSBU420
00030 *                                                                 DTSBU420
00031 *    11/14/2011  MODIFIED TO WRITE X148 WAGE RECORDS AND X153     DTSBU420
00032 *                MISSING SSN RECORDS TO PASS TO THE SERVER        DTSBU420
00033 *                DATABASE. THE NEW WAGE RECORD INCLUDES           DTSBU420
00034 *                THE ACCOUNTING BATCH AND ITEM NUMBERS.           DTSBU420
00035 *                WORK ORDER:                      PROGRAMMER: GD  DTSBU420
00036 *                                                                 DTSBU420
00037 *    03/02/2012  MODIFIED TO USE THE QUARTER PASSED THROUGH       DTSBU420
00038 *                THE L420 LINKAGE. IF THE QUARTER HAS BEEN        DTSBU420
00039 *                CHANGED, THE WAGES WILL BE POSTED TO THE         DTSBU420
00040 *                CORRECT QUARTER.                                 DTSBU420
00041 *                ANNUAL REPORTS CONTINUE TO USE W001-YRQ.         DTSBU420
00042 *                WORK ORDER:                      PROGRAMMER: GD  DTSBU420
00043 *                                                                 DTSBU420
00044 *    04/19/2012  MODIFIED P1400 TO CHECK FOR COMMAS EMBEDDED IN   DTSBU420
00045 *                NAMES.                                           DTSBU420
00046 *                WORK ORDER:                      PROGRAMMER: GD  DTSBU420
00047 *                                                                 DTSBU420
00048 *    06/22/2012  CORRECTED DELETION PARAGRAPH: START BROWSE SHOULDDTSBU420
00049 *                USE PSEUDO BATCH, NOT REGULAR BATCH.             DTSBU420
00050 *                WORK ORDER:                      PROGRAMMER: GD  DTSBU420
00051 *                                                                 DTSBU420
00052 *    04/05/2013  UPDATED WAGE EXTRACT FOR SERVER.                 DTSBU420
00053 *                WORK ORDER: TKT 1653             PROGRAMMER: GD  DTSBU420
00054 *                                                                 DTSBU420
00055 *    05/22/2013  ADDED A CHECK FOR NON-NUMERIC SSNS. CORRUPTED    DTSBU420
00056 *                SSNS CAUSED A SYSTEM PROBLEM ON 5/21. THIS WILL  DTSBU420
00057 *                PROTECT THE WAGE PROCESS UNTIL THE ORIGINAL      DTSBU420
00058 *                CAUSE OF THE PROBLEM IS IDENTIFIED AND           DTSBU420
00059 *                FIXED.                                           DTSBU420
00060 *                WORK ORDER: TKT 1848             PROGRAMMER: GD  DTSBU420
00061 *                                                                 DTSBU420
00062 *    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBU420
00063 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBU420
00064 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX   DTSBU420
00065 *                                                                 DTSBU420
00066 *                                                                 DTSBU420
00067 *    DESCRIPTION:                                                 DTSBU420
00068 *                                                                 DTSBU420
00069 *        DTSBD371 CALLS THIS PROGRAM WHEN AN ELECTRONIC REPORT    DTSBU420
00070 *        TRANSACTION HAS PROCESSED SUCCESSFULLY.                  DTSBU420
00071 *        DTSBD374 CALLS THIS PROGRAM WHEN AN ANNUAL REPORT        DTSBU420
00072 *        TRANSACTION HAS PROCESSED SUCCESSFULLY.                  DTSBU420
00073 *        DTSBU420 THEN FORMATS W4 TRANSACTIONS FROM W001          DTSBU420
00074 *        TRANSACTIONS, AND WRITES WWGH WAGE HISTORY RECORDS.      DTSBU420
00075 *                                                                 DTSBU420
00076 *        DTSBD180 CALLS THIS PROGRAM WHEN IT DELETES A BATCH      DTSBU420
00077 *        AFTER ALL TRANSACTIONS HAVE BEEN PROCESSED.  DTSBU420    DTSBU420
00078 *        THEN DELETES ALL THE W001 TRANSACTIONS ASSOCIATED WITH   DTSBU420
00079 *        THE BATCH.                                               DTSBU420
00080 *                                                                 DTSBU420
00081 *    GENERAL SPECIFICATIONS:                                      DTSBU420
00082 *                                                                 DTSBU420
00083 *        ALL COMMANDS ARE VALID.                                  DTSBU420
00084 *                                                                 DTSBU420
00085 *        IF AN INVALID COMMAND IS REQUESTED, THEN ABEND THE       DTSBU420
00086 *        MODULE.                                                  DTSBU420
00087 *                                                                 DTSBU420
00088 *        IF A FILE-STATUS OF OTHER THAN '00', '10', OR '23' IS    DTSBU420
00089 *        ENCOUNTERED, THEN ABEND PROCESSING (TOLERATE A           DTSBU420
00090 *        FILE-STATUS OF '97' FROM AN OPEN COMMAND).               DTSBU420
00091 *                                                                 DTSBU420
00092 *                                                                 DTSBU420
00093 *                                                                 DTSBU420
00094 *    COMMAND SPECIFIC SPECIFICATIONS:                             DTSBU420
00095 *                                                                 DTSBU420
00096 *    OPEN-READ                                                    DTSBU420
00097 *        OPEN INPUT.                                              DTSBU420
00098 *                                                                 DTSBU420
00099 *    OPEN-UPDATE                                                  DTSBU420
00100 *        OPEN I-O.                                                DTSBU420
00101 *                                                                 DTSBU420
00102 *    CLOSE                                                        DTSBU420
00103 *                                                                 DTSBU420
00104 *    READ                                                         DTSBU420
00105 *                                                                 DTSBU420
00106 *    START BROWSE                                                 DTSBU420
00107 *        IF THE START-BROWSE IS SUCCESSFUL, THEN PERFORM THE      DTSBU420
00108 *        READ-NEXT LOGIC.  A SUCCESSFUL START-BROWSE RETURNS      DTSBU420
00109 *        A RECORD.                                                DTSBU420
00110 *                                                                 DTSBU420
00111 *    READ NEXT                                                    DTSBU420
00112 *                                                                 DTSBU420
00113 *    WRITE                                                        DTSBU420
00114 *                                                                 DTSBU420
00115 *    REWRITE                                                      DTSBU420
00116 *                                                                 DTSBU420
00117 *    DELETE                                                       DTSBU420
00118 *                                                                 DTSBU420
00119 *                                                                 DTSBU420
00120 *****                                                             DTSBU420
00121      SKIP3                                                        DTSBU420
00122  ENVIRONMENT DIVISION.                                            DTSBU420
00123      SKIP2                                                        DTSBU420
00124  INPUT-OUTPUT SECTION.                                            DTSBU420
00125                                                                   DTSBU420
00126  FILE-CONTROL.                                                    DTSBU420
00127      SELECT WAGE-TRANS-FILE ASSIGN TO DTSFWTRN                    DTSBU420
00128          FILE STATUS IS WAGE-TRANS-STATUS.                        DTSBU420
00129                                                                   DTSBU420
00130      SELECT WAGE-X148-FILE ASSIGN  TO DTSFW148                    DTSBU420
00131          FILE STATUS IS WAGE-X148-STATUS.                         DTSBU420
00132                                                                   DTSBU420
00133      SELECT WAGE-X153-FILE ASSIGN  TO DTSFW153                    DTSBU420
00134          FILE STATUS IS WAGE-X153-STATUS.                         DTSBU420
00135                                                                   DTSBU420
00136  DATA DIVISION.                                                   DTSBU420
00137      SKIP3                                                        DTSBU420
00138  FILE SECTION.                                                    DTSBU420
00139                                                                   DTSBU420
00140  FD  WAGE-TRANS-FILE                                              DTSBU420
00141      RECORDING MODE IS F                                          DTSBU420
00142      BLOCK CONTAINS 0 RECORDS.                                    DTSBU420
00143                                                                   DTSBU420
00144  01  WAGE-TRANS-REC                  PIC  X(80).                  DTSBU420
00145                                                                   DTSBU420
00146  FD  WAGE-X148-FILE                                               DTSBU420
00147      RECORDING MODE IS F                                          DTSBU420
00148      BLOCK CONTAINS 0 RECORDS.                                    DTSBU420
00149                                                                   DTSBU420
00150  01  WAGE-X148-REC                  PIC  X(134).                  DTSBU420
00151                                                                   DTSBU420
00152  FD  WAGE-X153-FILE                                               DTSBU420
00153      RECORDING MODE IS F                                          DTSBU420
00154      BLOCK CONTAINS 0 RECORDS.                                    DTSBU420
00155                                                                   DTSBU420
00156  01  WAGE-X153-REC                  PIC  X(93).                   DTSBU420
00157                                                                   DTSBU420
00158  WORKING-STORAGE SECTION.                                         DTSBU420
001585 77  PAN-VALET PICTURE X(24) VALUE '027DTSBU420  06/19/13'.       DTSBU420
00159  77  PAN-VALET PICTURE X(24) VALUE '007DTSBU420  05/29/13'.       DTSBU420
00160  77  PAN-VALET PICTURE X(24) VALUE '025DTSBU420  04/11/13'.       DTSBU420
00161  77  PAN-VALET PICTURE X(24) VALUE '011DTSBU420  04/05/13'.       DTSBU420
00162  77  PAN-VALET PICTURE X(24) VALUE '021DTSBU420  08/07/12'.       DTSBU420
00163      SKIP3                                                        DTSBU420
00164  01  WRK-AREA.                                                    DTSBU420
00165      05  WRK-ABEND-CD             PIC S9(04)  COMP  VALUE +420.   DTSBU420
00166                                                                   DTSBU420
00167      05  WRK-MOD-NAME             PIC  X(08)  VALUE 'DTSBU420'.   DTSBU420
00168                                                                   DTSBU420
00169      05  WRK-QTR-9                PIC  9(05).                     DTSBU420
00170      05  WRK-QTR-X REDEFINES WRK-QTR-9.                           DTSBU420
00171          10  WRK-QTR-YR           PIC  9(04).                     DTSBU420
00172          10  WRK-QTR-Q            PIC  9(01).                     DTSBU420
00173                                                                   DTSBU420
00174      05  WRK-W2-CNT               PIC S9(07)  COMP-3 VALUE +0.    DTSBU420
00175      05  WRK-W4-CNT               PIC S9(07)  COMP-3 VALUE +0.    DTSBU420
00176      05  WRK-WNAM-CNT             PIC S9(07)  COMP-3 VALUE +0.    DTSBU420
00177      05  WRK-WWGH-CNT             PIC S9(07)  COMP-3 VALUE +0.    DTSBU420
00178      05  WRK-X148-CNT             PIC S9(07)  COMP-3 VALUE +0.    DTSBU420
00179      05  WRK-X153-CNT             PIC S9(07)  COMP-3 VALUE +0.    DTSBU420
00180      05  AMT-DISP1                PIC  Z(06)9.                    DTSBU420
00181      05  AMT-DISP2                PIC  Z(06)9.                    DTSBU420
00182      05  AMT-DISP3                PIC  Z(06)9.                    DTSBU420
00183      05  AMT-DISP4                PIC  Z(06)9.99-.                DTSBU420
00184      05  AMT-DISP5                PIC  ---------9.99.             DTSBU420
00185      05  AMT-DISP6                PIC  ---------9.99.             DTSBU420
00186      05  AMT-DISP7                PIC  ---------9.99.             DTSBU420
00187                                                                   DTSBU420
00188      05  WRK-NET-WAGE             PIC S9(11)V99  COMP-3           DTSBU420
00189                                                     VALUE +0.     DTSBU420
00190                                                                   DTSBU420
00191      05  WAGE-TRANS-STATUS          PIC  X(02).                   DTSBU420
00192          88  WAGE-TRANS-FILE-OK-88       VALUE '00'.              DTSBU420
00193          88  WAGE-TRANS-FILE-NO-REC-88   VALUE '10' '23'.         DTSBU420
00194          88  WAGE-TRANS-FILE-VERIFY-88   VALUE '97'.              DTSBU420
00195                                                                   DTSBU420
00196      05  WAGE-X148-STATUS           PIC  X(02).                   DTSBU420
00197          88  WAGE-X148-FILE-OK-88        VALUE '00'.              DTSBU420
00198          88  WAGE-X148-FILE-VERIFY-88    VALUE '97'.              DTSBU420
00199                                                                   DTSBU420
00200      05  WAGE-X153-STATUS           PIC  X(02).                   DTSBU420
00201          88  WAGE-X153-FILE-OK-88        VALUE '00'.              DTSBU420
00202          88  WAGE-X153-FILE-VERIFY-88    VALUE '97'.              DTSBU420
00203                                                                   DTSBU420
00204      05  WRK-SYS-DATE               PIC S9(09)     COMP-3.        DTSBU420
00205                                                                   DTSBU420
00206  01  WAGE-TRANS-AREA.                                             DTSBU420
00207      05  ESP-TRANSACTION-AREA      PIC  X(80).                    DTSBU420
00208  ++INCLUDE EWGTRNW2                                               DTSBU420
00209  ++INCLUDE EWGTRNW4                                               DTSBU420
00210      EJECT                                                        DTSBU420
00211  01  L983-LINK-AREA.                                              DTSBU420
00212  ++INCLUDE DTSIL983                                               DTSBU420
00213                                                                   DTSBU420
00214  01  WSKL-REC.                                                    DTSBU420
00215  ++INCLUDE DTSIWSKL                                               DTSBU420
00216                                                                   DTSBU420
00217  01  W001-REC.                                                    DTSBU420
00218  ++INCLUDE DTSIW001                                               DTSBU420
00219                                                                   DTSBU420
00220  01  L981-LINK-AREA.                                              DTSBU420
00221  ++INCLUDE DTSIL981                                               DTSBU420
00222                                                                   DTSBU420
00223  01  WWGH-REC.                                                    DTSBU420
00224  ++INCLUDE DTSIWWGH                                               DTSBU420
00225                                                                   DTSBU420
00226  01  L982-LINK-AREA.                                              DTSBU420
00227  ++INCLUDE DTSIL982                                               DTSBU420
00228                                                                   DTSBU420
00229  01  WNAM-REC.                                                    DTSBU420
00230  ++INCLUDE DTSIWNAM                                               DTSBU420
00231                                                                   DTSBU420
00232  01  L004-LINK-AREA.                                              DTSBU420
00233  ++INCLUDE DTSIL004                                               DTSBU420
00234                                                                   DTSBU420
00235  01  L005-LINK-AREA.                                              DTSBU420
00236  ++INCLUDE DTSIL005                                               DTSBU420
00237                                                                   DTSBU420
00238  01  WRK-X148-REC.                                                DTSBU420
00239  ++INCLUDE DTSIX148                                               DTSBU420
00240                                                                   DTSBU420
00241  01  WRK-X153-REC.                                                DTSBU420
00242  ++INCLUDE DTSIX153                                               DTSBU420
00243                                                                   DTSBU420
00244  LINKAGE SECTION.                                                 DTSBU420
00245      SKIP3                                                        DTSBU420
00246  01  L420-LINK-AREA.                                              DTSBU420
00247  ++INCLUDE DTSIL420                                               DTSBU420
00248      EJECT                                                        DTSBU420
00249  PROCEDURE DIVISION USING L420-LINK-AREA.                         DTSBU420
00250                                                                   DTSBU420
00251      EVALUATE TRUE                                                DTSBU420
00252         WHEN L420-CMND-OPEN-88                                    DTSBU420
00253            PERFORM I0000-INIT          THRU I0000-EXIT            DTSBU420
00254                                                                   DTSBU420
00255         WHEN L420-CMND-UPDATE-88                                  DTSBU420
00256            PERFORM P1000-UPDATE        THRU P1000-EXIT            DTSBU420
00257                                                                   DTSBU420
00258         WHEN L420-CMND-DELETE-88                                  DTSBU420
00259            PERFORM P2000-DELETE        THRU P2000-EXIT            DTSBU420
00260                                                                   DTSBU420
00261         WHEN L420-CMND-CLOSE-88                                   DTSBU420
00262            PERFORM T0000-TERM          THRU T0000-EXIT            DTSBU420
00263                                                                   DTSBU420
00264      END-EVALUATE.                                                DTSBU420
00265                                                                   DTSBU420
00266      GOBACK.                                                      DTSBU420
00267      EJECT                                                        DTSBU420
00268  I0000-INIT.                                                      DTSBU420
00269      PERFORM S005-FROM-SYS         THRU S005-EXIT.                DTSBU420
00270      MOVE L005-DATE                TO WRK-SYS-DATE.               DTSBU420
00271                                                                   DTSBU420
00272      PERFORM I2000-OPEN-FILES      THRU I2000-EXIT.               DTSBU420
00273                                                                   DTSBU420
00274  I0000-EXIT.                                                      DTSBU420
00275      EXIT.                                                        DTSBU420
00276                                                                   DTSBU420
00277  I2000-OPEN-FILES.                                                DTSBU420
00278      OPEN OUTPUT WAGE-TRANS-FILE.                                 DTSBU420
00279      IF WAGE-TRANS-FILE-OK-88                                     DTSBU420
00280      OR WAGE-TRANS-FILE-VERIFY-88                                 DTSBU420
00281         NEXT SENTENCE                                             DTSBU420
00282      ELSE                                                         DTSBU420
00283         PERFORM S999-ABEND THRU S999-EXIT                         DTSBU420
00284      END-IF.                                                      DTSBU420
00285                                                                   DTSBU420
00286      OPEN OUTPUT WAGE-X148-FILE.                                  DTSBU420
00287      IF WAGE-X148-FILE-OK-88                                      DTSBU420
00288      OR WAGE-X148-FILE-VERIFY-88                                  DTSBU420
00289         NEXT SENTENCE                                             DTSBU420
00290      ELSE                                                         DTSBU420
00291         PERFORM S999-ABEND THRU S999-EXIT                         DTSBU420
00292      END-IF.                                                      DTSBU420
00293                                                                   DTSBU420
00294      OPEN OUTPUT WAGE-X153-FILE.                                  DTSBU420
00295      IF WAGE-X153-FILE-OK-88                                      DTSBU420
00296      OR WAGE-X153-FILE-VERIFY-88                                  DTSBU420
00297         NEXT SENTENCE                                             DTSBU420
00298      ELSE                                                         DTSBU420
00299         PERFORM S999-ABEND THRU S999-EXIT                         DTSBU420
00300      END-IF.                                                      DTSBU420
00301                                                                   DTSBU420
00302  I2000-EXIT.                                                      DTSBU420
00303      EXIT.                                                        DTSBU420
00304                                                                   DTSBU420
00305  P1000-UPDATE.                                                    DTSBU420
00306      DISPLAY 'BU420 P1000 ' L420-EMP-NO '  ' L420-PSEUDO-BATCH-NO DTSBU420
00307         '  ' L420-PSEUDO-ITEM-NO '  ' L420-BATCH-NO               DTSBU420
00308         '  ' L420-ITEM-NO '  ' L420-YRQ.                          DTSBU420
00309                                                                   DTSBU420
00310      MOVE LOW-VALUE                 TO WSKL-REC.                  DTSBU420
00311      MOVE L420-PSEUDO-BATCH-NO      TO WSKL-BATCH-NO.             DTSBU420
00312      MOVE L420-PSEUDO-ITEM-NO       TO WSKL-ITEM-NO.              DTSBU420
00313      PERFORM S983-START-BROWSE      THRU S983-EXIT.               DTSBU420
00314                                                                   DTSBU420
00315      PERFORM                                                      DTSBU420
00316         UNTIL L983-NO-REC-88                                      DTSBU420
00317         OR WSKL-BATCH-NO NOT = L420-PSEUDO-BATCH-NO               DTSBU420
00318         OR WSKL-ITEM-NO  NOT = L420-PSEUDO-ITEM-NO                DTSBU420
00319            MOVE WSKL-REC                      TO W001-REC         DTSBU420
00320            IF W001-WAGE-CHNG NOT = ZERO                           DTSBU420
00321 *&                                                                DTSBU420
00322               IF W001-SSN NOT NUMERIC                             DTSBU420
00323                   DISPLAY '>>> NON-NUMERIC SSN ' L420-EMP-NO      DTSBU420
00324            '  ' L420-YRQ '  ' L420-BATCH-NO ' ' L420-ITEM-NO      DTSBU420
00325               ELSE                                                DTSBU420
00326 *&                                                                DTSBU420
00327                 PERFORM P1200-WRITE-WAGE-TRANS  THRU P1200-EXIT   DTSBU420
00328                 PERFORM P1300-UPDATE-NAME       THRU P1300-EXIT   DTSBU420
00329               END-IF                                              DTSBU420
00330            END-IF                                                 DTSBU420
00331            PERFORM S983-READ-NEXT             THRU S983-EXIT      DTSBU420
00332      END-PERFORM.                                                 DTSBU420
00333                                                                   DTSBU420
00334                                                                   DTSBU420
00335  P1000-EXIT.                                                      DTSBU420
00336      EXIT.                                                        DTSBU420
00337                                                                   DTSBU420
00338  P1200-WRITE-WAGE-TRANS.                                          DTSBU420
00339                                                                   DTSBU420
00340      PERFORM P1290-NAME-CHECK       THRU P1290-EXIT.              DTSBU420
00341                                                                   DTSBU420
00342      IF L420-RPT-TYPE-ORIG-88                                     DTSBU420
00343         PERFORM P1210-WRITE-W4      THRU P1210-EXIT               DTSBU420
00344      ELSE                                                         DTSBU420
00345      IF L420-RPT-TYPE-WITHDRW-88                                  DTSBU420
00346         PERFORM P1220-WRITE-W2      THRU P1220-EXIT               DTSBU420
00347      ELSE                                                         DTSBU420
00348         PERFORM P1240-SUPPLEMENTAL  THRU P1240-EXIT.              DTSBU420
00349  P1200-EXIT.                                                      DTSBU420
00350      EXIT.                                                        DTSBU420
00351                                                                   DTSBU420
00352  P1210-WRITE-W4.                                                  DTSBU420
00353      IF W001-SSN = ZERO                                           DTSBU420
00354         PERFORM P1500-MISSING-SSN    THRU P1500-EXIT              DTSBU420
00355         GO TO P1210-EXIT                                          DTSBU420
00356      END-IF.                                                      DTSBU420
00357                                                                   DTSBU420
00358      MOVE LOW-VALUES                 TO ESP-TRANSACTION-AREA.     DTSBU420
00359      MOVE W001-SSN                   TO W4-SSN.                   DTSBU420
00360      MOVE 'W4'                       TO W4-TRAN-ID.               DTSBU420
00361      MOVE '00044001'                 TO W4-TRAN-OPER-ID.          DTSBU420
00362      MOVE L420-RECEIVED-DATE         TO W4-DATE-ENTERED.          DTSBU420
00363      MOVE W001-RECEIVED-TIME         TO W4-TIME-ENTERED.          DTSBU420
00364      MOVE W001-NAME                  TO W4-NAME-CHECK.            DTSBU420
00365                                                                   DTSBU420
00366      IF W001-ANNUAL-RPT-88                                        DTSBU420
00367         PERFORM S2000-SET-YRQ        THRU S2000-EXIT              DTSBU420
00368         MOVE WRK-QTR-9               TO W4-QUARTER                DTSBU420
00369      ELSE                                                         DTSBU420
00370         MOVE L420-YRQ                TO W4-QUARTER                DTSBU420
00371      END-IF.                                                      DTSBU420
00372                                                                   DTSBU420
00373      MOVE W001-WAGE-CHNG             TO W4-QUARTER-EARNINGS.      DTSBU420
00374      MOVE 2                          TO W4-AFFI-CODE.             DTSBU420
00375      MOVE L420-EMP-NO                TO W4-ACCOUNT.               DTSBU420
00376      MOVE L420-EMP-NAME              TO W4-EMP-NAME.              DTSBU420
00377      PERFORM S1000-WRITE-WAGE-TRANS  THRU S1000-EXIT.             DTSBU420
00378      ADD +1                          TO WRK-W4-CNT.               DTSBU420
00379                                                                   DTSBU420
00380      MOVE W001-WAGE-CHNG             TO WRK-NET-WAGE.             DTSBU420
00381      PERFORM P1400-WRITE-X148        THRU P1400-EXIT.             DTSBU420
00382                                                                   DTSBU420
00383 *    DISPLAY 'BU420 WRITE ' W4-ACCOUNT '  ' W4-QUARTER            DTSBU420
00384 *       '  ' W4-SSN.                                              DTSBU420
00385  P1210-EXIT.                                                      DTSBU420
00386      EXIT.                                                        DTSBU420
00387                                                                   DTSBU420
00388  P1220-WRITE-W2.                                                  DTSBU420
00389      MOVE LOW-VALUES                 TO ESP-TRANSACTION-AREA.     DTSBU420
00390      MOVE W001-SSN                   TO W2-SSN.                   DTSBU420
00391      MOVE 'W2'                       TO W2-TRAN-ID.               DTSBU420
00392      MOVE '00044001'                 TO W2-OPER-ID.               DTSBU420
00393      MOVE L420-RECEIVED-DATE         TO W2-DATE-ENTERED.          DTSBU420
00394      MOVE W001-RECEIVED-TIME         TO W2-TIME-ENTERED.          DTSBU420
00395      MOVE W001-NAME                  TO W2-NAME.                  DTSBU420
00396      MOVE L420-YRQ                   TO W2-QTR.                   DTSBU420
00397      MOVE L420-EMP-NO                TO W2-ACCOUNT-NUMBER.        DTSBU420
00398      PERFORM S1000-WRITE-WAGE-TRANS  THRU S1000-EXIT.             DTSBU420
00399      ADD +1                          TO WRK-W2-CNT.               DTSBU420
00400                                                                   DTSBU420
00401  P1220-EXIT.                                                      DTSBU420
00402      EXIT.                                                        DTSBU420
00403                                                                   DTSBU420
00404  P1240-SUPPLEMENTAL.                                              DTSBU420
00405                                                                   DTSBU420
00406      MOVE ZERO                         TO WRK-NET-WAGE.           DTSBU420
00407                                                                   DTSBU420
00408      MOVE LOW-VALUE                    TO WWGH-REC.               DTSBU420
00409      MOVE L420-EMP-NO                  TO WWGH-EMP-NO.            DTSBU420
00410      DISPLAY 'P1240 SRC ' W001-SOURCE '  ' W001-YRQ               DTSBU420
00411         '  ' L420-YRQ.                                            DTSBU420
00412      IF W001-ANNUAL-RPT-88                                        DTSBU420
00413         PERFORM S2000-SET-YRQ          THRU S2000-EXIT            DTSBU420
00414         MOVE WRK-QTR-9                 TO W4-QUARTER              DTSBU420
00415      ELSE                                                         DTSBU420
00416         MOVE L420-YRQ                  TO WWGH-YRQ                DTSBU420
00417      END-IF.                                                      DTSBU420
00418      MOVE W001-SSN                     TO WWGH-SSN.               DTSBU420
00419                                                                   DTSBU420
00420      DISPLAY 'BU420 AMEND ' WWGH-EMP-NO '  ' WWGH-YRQ             DTSBU420
00421           '  ' WWGH-SSN.                                          DTSBU420
00422      PERFORM S981D-READ                THRU S981D-EXIT.           DTSBU420
00423                                                                   DTSBU420
00424      IF L981-OK-88                                                DTSBU420
00425         COMPUTE WRK-NET-WAGE =                                    DTSBU420
00426            (W001-WAGE-CHNG - WWGH-EARNINGS)                       DTSBU420
00427      ELSE                                                         DTSBU420
00428         COMPUTE WRK-NET-WAGE = W001-WAGE-CHNG                     DTSBU420
00429      END-IF.                                                      DTSBU420
00430                                                                   DTSBU420
00431      MOVE W001-WAGE-CHNG                TO AMT-DISP5              DTSBU420
00432      MOVE WWGH-EARNINGS                 TO AMT-DISP6              DTSBU420
00433      MOVE WRK-NET-WAGE                  TO AMT-DISP7.             DTSBU420
00434      DISPLAY '  W001: ' AMT-DISP5 '  WGH: ' AMT-DISP6             DTSBU420
00435         '  NET: ' AMT-DISP7.                                      DTSBU420
00436                                                                   DTSBU420
00437      PERFORM P1242-WRITE-W4             THRU P1242-EXIT.          DTSBU420
00438                                                                   DTSBU420
00439  P1240-EXIT.                                                      DTSBU420
00440      EXIT.                                                        DTSBU420
00441                                                                   DTSBU420
00442  P1242-WRITE-W4.                                                  DTSBU420
00443 **************************************************************    DTSBU420
00444 * DO NOT WRITE A W4 IF THE DIFFERENCE BETWEEN WHAT IS ON FILE     DTSBU420
00445 * AND THE NEW WAGE AMOUNT IS < $1.00 - SINCE THE PENNIES ARE      DTSBU420
00446 * NOT SAVED ON THE DOCS FILE, THE AMOUNT WILL NOT CHANGE.         DTSBU420
00447 *                                                                 DTSBU420
00448 * FOR AN AMENDED REPORT, THE AMOUNT IN THE W4 TRANSACTION IS      DTSBU420
00449 * THE NEW AMOUNT: IT WILL REPLACE WHAT IS ALREADY ON FILE.        DTSBU420
00450 **************************************************************    DTSBU420
00451      IF  WRK-NET-WAGE <= +0.99                                    DTSBU420
00452      AND WRK-NET-WAGE >= -0.99                                    DTSBU420
00453         GO TO P1242-EXIT                                          DTSBU420
00454      END-IF.                                                      DTSBU420
00455                                                                   DTSBU420
00456      MOVE LOW-VALUES                 TO ESP-TRANSACTION-AREA.     DTSBU420
00457      MOVE W001-SSN                   TO W4-SSN.                   DTSBU420
00458      MOVE 'W4'                       TO W4-TRAN-ID.               DTSBU420
00459      MOVE '00044001'                 TO W4-TRAN-OPER-ID.          DTSBU420
00460      MOVE L420-RECEIVED-DATE         TO W4-DATE-ENTERED.          DTSBU420
00461      MOVE W001-RECEIVED-TIME         TO W4-TIME-ENTERED.          DTSBU420
00462      MOVE W001-NAME                  TO W4-NAME-CHECK.            DTSBU420
00463      DISPLAY 'P1242 SRC ' W001-SOURCE '  ' W001-YRQ               DTSBU420
00464         '  ' L420-YRQ.                                            DTSBU420
00465      IF W001-ANNUAL-RPT-88                                        DTSBU420
00466         PERFORM S2000-SET-YRQ        THRU S2000-EXIT              DTSBU420
00467         MOVE WRK-QTR-9               TO W4-QUARTER                DTSBU420
00468      ELSE                                                         DTSBU420
00469         MOVE L420-YRQ                TO W4-QUARTER                DTSBU420
00470      END-IF.                                                      DTSBU420
00471       DISPLAY '  '  W4-QUARTER.                                   DTSBU420
00472      MOVE W001-WAGE-CHNG             TO W4-QUARTER-EARNINGS.      DTSBU420
00473      MOVE 2                          TO W4-AFFI-CODE.             DTSBU420
00474      MOVE L420-EMP-NO                TO W4-ACCOUNT.               DTSBU420
00475      MOVE L420-EMP-NAME              TO W4-EMP-NAME.              DTSBU420
00476      PERFORM S1000-WRITE-WAGE-TRANS  THRU S1000-EXIT.             DTSBU420
00477      ADD +1                          TO WRK-W4-CNT.               DTSBU420
00478                                                                   DTSBU420
00479      MOVE W001-WAGE-CHNG             TO WRK-NET-WAGE.             DTSBU420
00480      PERFORM P1400-WRITE-X148        THRU P1400-EXIT.             DTSBU420
00481                                                                   DTSBU420
00482  P1242-EXIT.                                                      DTSBU420
00483      EXIT.                                                        DTSBU420
00484                                                                   DTSBU420
00485  P1290-NAME-CHECK.                                                DTSBU420
00486       IF L420-NAME-TYPE-FULL-88                                   DTSBU420
00487          GO TO P1290-EXIT.                                        DTSBU420
00488                                                                   DTSBU420
00489       MOVE LOW-VALUE                    TO WNAM-REC.              DTSBU420
00490       MOVE W001-SSN                     TO WNAM-SSN.              DTSBU420
00491                                                                   DTSBU420
00492       PERFORM S982A-START-BROWSE        THRU S982A-EXIT.          DTSBU420
00493                                                                   DTSBU420
00494       IF L982-OK-88                                               DTSBU420
00495          IF WNAM-SSN = W001-SSN                                   DTSBU420
00496             MOVE WNAM-NAME              TO W001-NAME.             DTSBU420
00497                                                                   DTSBU420
00498  P1290-EXIT.                                                      DTSBU420
00499      EXIT.                                                        DTSBU420
00500                                                                   DTSBU420
00501  P1300-UPDATE-NAME.                                               DTSBU420
00502 *&                                                                DTSBU420
00503 *    DISPLAY 'DTSBU420 P1300 ' W001-SSN '  ' W001-NAME.           DTSBU420
00504 *&                                                                DTSBU420
00505      MOVE LOW-VALUE                    TO WNAM-REC.               DTSBU420
00506      MOVE W001-SSN                     TO WNAM-SSN.               DTSBU420
00507                                                                   DTSBU420
00508      PERFORM S982A-START-BROWSE        THRU S982A-EXIT.           DTSBU420
00509                                                                   DTSBU420
00510      IF NOT L982-OK-88                                            DTSBU420
00511         PERFORM P1310-ADD-NAME         THRU P1310-EXIT            DTSBU420
00512         GO TO P1300-EXIT                                          DTSBU420
00513      END-IF.                                                      DTSBU420
00514                                                                   DTSBU420
00515      IF WNAM-NAME = W001-NAME                                     DTSBU420
00516         GO TO P1300-EXIT                                          DTSBU420
00517      END-IF.                                                      DTSBU420
00518                                                                   DTSBU420
00519      IF WNAM-TYPE-3CHAR-88                                        DTSBU420
00520         IF L420-NAME-TYPE-FULL-88                                 DTSBU420
00521            PERFORM P1320-REWRITE-NAME  THRU P1320-EXIT            DTSBU420
00522         END-IF                                                    DTSBU420
00523      ELSE                                                         DTSBU420
00524         PERFORM P1310-ADD-NAME         THRU P1310-EXIT            DTSBU420
00525      END-IF.                                                      DTSBU420
00526                                                                   DTSBU420
00527  P1300-EXIT.                                                      DTSBU420
00528      EXIT.                                                        DTSBU420
00529                                                                   DTSBU420
00530  P1310-ADD-NAME.                                                  DTSBU420
00531 *&                                                                DTSBU420
00532 *    DISPLAY 'DTSBU420 P1310 ' W001-LAST-NAME.                    DTSBU420
00533 *&                                                                DTSBU420
00534      MOVE W001-SSN              TO WNAM-SSN.                      DTSBU420
00535      ADD +1                     TO L420-ABSTIME.                  DTSBU420
00536      MOVE L420-ABSTIME          TO L005-ABSTIME.                  DTSBU420
00537      PERFORM S005-FROM-ABS      THRU S005-EXIT.                   DTSBU420
00538      MOVE L005-NINES-COMPLEMENT-ABSTIME                           DTSBU420
00539                                 TO WNAM-NINES-COMPLEMENT-ABSTIME. DTSBU420
00540      MOVE W001-LAST-NAME        TO WNAM-LAST-NAME.                DTSBU420
00541      MOVE W001-FIRST-NAME       TO WNAM-FIRST-NAME.               DTSBU420
00542      MOVE W001-MID-INIT         TO WNAM-MID-INIT.                 DTSBU420
00543      MOVE L420-NAME-TYPE        TO WNAM-NAME-TYPE.                DTSBU420
00544                                                                   DTSBU420
00545      PERFORM S982C-WRITE        THRU S982C-EXIT.                  DTSBU420
00546                                                                   DTSBU420
00547      ADD +1                     TO WRK-WNAM-CNT.                  DTSBU420
00548                                                                   DTSBU420
00549  P1310-EXIT.                                                      DTSBU420
00550      EXIT.                                                        DTSBU420
00551                                                                   DTSBU420
00552  P1320-REWRITE-NAME.                                              DTSBU420
00553 *&                                                                DTSBU420
00554 *    DISPLAY 'DTSBU420 P1320 ' W001-LAST-NAME.                    DTSBU420
00555 *&                                                                DTSBU420
00556      MOVE W001-LAST-NAME        TO WNAM-LAST-NAME.                DTSBU420
00557      MOVE W001-FIRST-NAME       TO WNAM-FIRST-NAME.               DTSBU420
00558      MOVE W001-MID-INIT         TO WNAM-MID-INIT.                 DTSBU420
00559      MOVE L420-NAME-TYPE        TO WNAM-NAME-TYPE.                DTSBU420
00560                                                                   DTSBU420
00561      PERFORM S982D-REWRITE      THRU S982D-EXIT.                  DTSBU420
00562                                                                   DTSBU420
00563      ADD +1                     TO WRK-WNAM-CNT.                  DTSBU420
00564                                                                   DTSBU420
00565  P1320-EXIT.                                                      DTSBU420
00566      EXIT.                                                        DTSBU420
00567                                                                   DTSBU420
00568  P1400-WRITE-X148.                                                DTSBU420
00569      MOVE L420-EMP-NO                TO X148-EMP-NO.              DTSBU420
00570      IF W001-ANNUAL-RPT-88                                        DTSBU420
00571         PERFORM S2000-SET-YRQ        THRU S2000-EXIT              DTSBU420
00572         MOVE WRK-QTR-9               TO W4-QUARTER                DTSBU420
00573      ELSE                                                         DTSBU420
00574         MOVE L420-YRQ                TO L004-QTR-5-9              DTSBU420
00575      END-IF.                                                      DTSBU420
00576      PERFORM S004-FROM-5             THRU S004-EXIT               DTSBU420
00577      IF NOT L004-VALID-QTR                                        DTSBU420
00578         DISPLAY 'DTSBU420: INVALID QUARTER '                      DTSBU420
00579            L420-BATCH-NO '  ' L420-ITEM-NO                        DTSBU420
00580         GO TO P1400-EXIT                                          DTSBU420
00581      ELSE                                                         DTSBU420
00582         MOVE L004-SLASH-5-QTR        TO X148-QUARTER              DTSBU420
00583      END-IF.                                                      DTSBU420
00584      MOVE W001-SSN                   TO X148-SSN.                 DTSBU420
00585      MOVE W001-SOURCE                TO X148-WAGE-SOURCE.         DTSBU420
00586      MOVE WRK-NET-WAGE               TO X148-EARNINGS.            DTSBU420
00587      MOVE W001-LAST-NAME             TO X148-LAST-NAME.           DTSBU420
00588      MOVE W001-FIRST-NAME            TO X148-FIRST-NAME.          DTSBU420
00589      MOVE W001-MID-INIT              TO X148-MID-INIT.            DTSBU420
00590      INSPECT X148-LAST-NAME   REPLACING ALL ',' BY ' '.           DTSBU420
00591      INSPECT X148-FIRST-NAME  REPLACING ALL ',' BY ' '.           DTSBU420
00592      INSPECT X148-MID-INIT    REPLACING ALL ',' BY ' '.           DTSBU420
00593      MOVE L420-BATCH-NO              TO X148-BATCH.               DTSBU420
00594      MOVE L420-ITEM-NO               TO X148-ITEM.                DTSBU420
00595      MOVE L420-SYS-DATE              TO X148-DATE.                DTSBU420
00596      MOVE SPACES                     TO X148-OPID.                DTSBU420
00597                                                                   DTSBU420
00598      WRITE WAGE-X148-REC             FROM WRK-X148-REC.           DTSBU420
00599      IF WAGE-X148-FILE-OK-88                                      DTSBU420
00600         ADD +1                       TO WRK-X148-CNT              DTSBU420
00601         DISPLAY 'BU420 X148: ' X148-EMP-NO '  ' X148-BATCH        DTSBU420
00602            '  ' X148-ITEM '  ' X148-QUARTER                       DTSBU420
00603      ELSE                                                         DTSBU420
00604         DISPLAY 'CANNOT WRITE TO X148 FILE: ' WAGE-X148-STATUS    DTSBU420
00605      END-IF.                                                      DTSBU420
00606                                                                   DTSBU420
00607  P1400-EXIT.                                                      DTSBU420
00608      EXIT.                                                        DTSBU420
00609                                                                   DTSBU420
00610  P1500-MISSING-SSN.                                               DTSBU420
00611      MOVE L420-EMP-NO                TO X153-EMP-NO.              DTSBU420
00612      IF W001-ANNUAL-RPT-88                                        DTSBU420
00613         PERFORM S2000-SET-YRQ        THRU S2000-EXIT              DTSBU420
00614         MOVE WRK-QTR-9               TO W4-QUARTER                DTSBU420
00615      ELSE                                                         DTSBU420
00616         MOVE L420-YRQ                TO L004-QTR-5-9              DTSBU420
00617      END-IF.                                                      DTSBU420
00618      PERFORM S004-FROM-5             THRU S004-EXIT               DTSBU420
00619      IF NOT L004-VALID-QTR                                        DTSBU420
00620         DISPLAY 'DTSBU420: INVALID QUARTER '                      DTSBU420
00621            L420-BATCH-NO '  ' L420-ITEM-NO                        DTSBU420
00622         GO TO P1500-EXIT                                          DTSBU420
00623      ELSE                                                         DTSBU420
00624         MOVE L004-SLASH-5-QTR        TO X153-QUARTER              DTSBU420
00625      END-IF.                                                      DTSBU420
00626      MOVE W001-WAGE-CHNG             TO X153-EARNINGS.            DTSBU420
00627      MOVE L420-BATCH-NO              TO X153-BATCH.               DTSBU420
00628      MOVE L420-ITEM-NO               TO X153-ITEM.                DTSBU420
00629      MOVE W001-SOURCE                TO X153-WAGE-SOURCE.         DTSBU420
00630      MOVE W001-LAST-NAME             TO X153-LAST-NAME.           DTSBU420
00631      MOVE W001-FIRST-NAME            TO X153-FIRST-NAME.          DTSBU420
00632      MOVE W001-MID-INIT              TO X153-MID-INIT.            DTSBU420
00633      INSPECT X153-LAST-NAME   REPLACING ALL ',' BY ' '.           DTSBU420
00634      INSPECT X153-FIRST-NAME  REPLACING ALL ',' BY ' '.           DTSBU420
00635      INSPECT X153-MID-INIT    REPLACING ALL ',' BY ' '.           DTSBU420
00636      MOVE L420-SYS-DATE              TO X153-DATE.                DTSBU420
00637                                                                   DTSBU420
00638      WRITE WAGE-X153-REC             FROM WRK-X153-REC.           DTSBU420
00639      IF WAGE-X153-FILE-OK-88                                      DTSBU420
00640         ADD +1                       TO WRK-X153-CNT              DTSBU420
00641      ELSE                                                         DTSBU420
00642         DISPLAY 'CANNOT WRITE TO X153 FILE: ' WAGE-X153-STATUS    DTSBU420
00643      END-IF.                                                      DTSBU420
00644                                                                   DTSBU420
00645  P1500-EXIT.                                                      DTSBU420
00646      EXIT.                                                        DTSBU420
00647                                                                   DTSBU420
00648  P2000-DELETE.                                                    DTSBU420
00649      MOVE LOW-VALUE                 TO WSKL-REC.                  DTSBU420
00650      MOVE L420-PSEUDO-BATCH-NO      TO WSKL-BATCH-NO.             DTSBU420
00651      MOVE L420-PSEUDO-ITEM-NO       TO WSKL-ITEM-NO.              DTSBU420
00652      PERFORM S983-START-BROWSE      THRU S983-EXIT.               DTSBU420
00653                                                                   DTSBU420
00654      PERFORM                                                      DTSBU420
00655         UNTIL L983-NO-REC-88                                      DTSBU420
00656         OR WSKL-BATCH-NO            NOT = L420-PSEUDO-BATCH-NO    DTSBU420
00657         OR WSKL-ITEM-NO             NOT = L420-PSEUDO-ITEM-NO     DTSBU420
00658            PERFORM S983-DELETE                THRU S983-EXIT      DTSBU420
00659            PERFORM S983-READ-NEXT             THRU S983-EXIT      DTSBU420
00660      END-PERFORM.                                                 DTSBU420
00661                                                                   DTSBU420
00662  P2000-EXIT.                                                      DTSBU420
00663      EXIT.                                                        DTSBU420
00664                                                                   DTSBU420
00665  T0000-TERM.                                                      DTSBU420
00666      CLOSE WAGE-TRANS-FILE                                        DTSBU420
00667            WAGE-X148-FILE                                         DTSBU420
00668            WAGE-X153-FILE.                                        DTSBU420
00669                                                                   DTSBU420
00670      MOVE WRK-W2-CNT                 TO AMT-DISP1.                DTSBU420
00671      MOVE WRK-W4-CNT                 TO AMT-DISP2.                DTSBU420
00672      MOVE WRK-WWGH-CNT               TO AMT-DISP3.                DTSBU420
00673                                                                   DTSBU420
00674      DISPLAY '******************************************'         DTSBU420
00675      DISPLAY '**  DTSBU420 TERMINATION STATISTICS     **'.        DTSBU420
00676      DISPLAY '**  W2 TRANSACTIONS WRITTEN: '                      DTSBU420
00677      DISPLAY AMT-DISP1 ' **'.                                     DTSBU420
00678      DISPLAY '**  W4 TRANSACTIONS WRITTEN: '                      DTSBU420
00679      DISPLAY AMT-DISP2 ' **'.                                     DTSBU420
00680      DISPLAY '**  WWGH TRANSACTIONS WRITTEN: '                    DTSBU420
00681      DISPLAY AMT-DISP3 ' **'.                                     DTSBU420
00682      DISPLAY '**  X148 TRANSACTIONS WRITTEN: '                    DTSBU420
00683      DISPLAY WRK-X148-CNT ' **'.                                  DTSBU420
00684      DISPLAY '**  X153 TRANSACTIONS WRITTEN: '                    DTSBU420
00685      DISPLAY WRK-X153-CNT ' **'.                                  DTSBU420
00686      DISPLAY '******************************************'.        DTSBU420
00687                                                                   DTSBU420
00688  T0000-EXIT.                                                      DTSBU420
00689      EXIT.                                                        DTSBU420
00690                                                                   DTSBU420
00691  S004-FROM-5.                                                     DTSBU420
00692      SET L004-FROM-5        TO TRUE.                              DTSBU420
00693      GO TO S004-YRQ.                                              DTSBU420
00694                                                                   DTSBU420
00695  S004-FROM-DATE.                                                  DTSBU420
00696      SET L004-FROM-DATE     TO TRUE.                              DTSBU420
00697      GO TO S004-YRQ.                                              DTSBU420
00698                                                                   DTSBU420
00699  S004-FROM-ABS.                                                   DTSBU420
00700      SET L004-FROM-ABS      TO TRUE.                              DTSBU420
00701      GO TO S004-YRQ.                                              DTSBU420
00702                                                                   DTSBU420
00703  S004-YRQ.                                                        DTSBU420
00704      CALL 'DTSBU004' USING L004-LINK-AREA.                        DTSBU420
00705                                                                   DTSBU420
00706  S004-EXIT.                                                       DTSBU420
00707      EXIT.                                                        DTSBU420
00708                                                                   DTSBU420
00709  S005-FROM-SYS.                                                   DTSBU420
00710      SET L005-FROM-SYS     TO TRUE.                               DTSBU420
00711      GO S005-ABSTIME.                                             DTSBU420
00712                                                                   DTSBU420
00713  S005-FROM-ABS.                                                   DTSBU420
00714      SET L005-FROM-ABSTIME TO TRUE.                               DTSBU420
00715      GO S005-ABSTIME.                                             DTSBU420
00716                                                                   DTSBU420
00717  S005-ABSTIME.                                                    DTSBU420
00718      CALL 'DTSBU005' USING L005-LINK-AREA.                        DTSBU420
00719                                                                   DTSBU420
00720  S005-EXIT.                                                       DTSBU420
00721      EXIT.                                                        DTSBU420
00722                                                                   DTSBU420
00723  S983-START-BROWSE.                                               DTSBU420
00724      SET L983-START-BROWSE-88 TO TRUE.                            DTSBU420
00725      GO TO S983-WAGE-I.                                           DTSBU420
00726                                                                   DTSBU420
00727  S983-READ-NEXT.                                                  DTSBU420
00728      SET L983-READ-NEXT-88 TO TRUE.                               DTSBU420
00729      GO TO S983-WAGE-I.                                           DTSBU420
00730                                                                   DTSBU420
00731  S983-DELETE.                                                     DTSBU420
00732      SET L983-DELETE-88    TO TRUE.                               DTSBU420
00733      GO TO S983-WAGE-I.                                           DTSBU420
00734                                                                   DTSBU420
00735  S983-WAGE-I.                                                     DTSBU420
00736      CALL 'DTSBU983' USING L983-LINK-AREA                         DTSBU420
00737                            WSKL-REC.                              DTSBU420
00738  S983-EXIT.                                                       DTSBU420
00739      EXIT.                                                        DTSBU420
00740                                                                   DTSBU420
00741  S981A-START-BROWSE.                                              DTSBU420
00742      SET L981-START-BROWSE-88 TO TRUE.                            DTSBU420
00743      PERFORM S981Z-WWGH-IO    THRU S981Z-EXIT.                    DTSBU420
00744                                                                   DTSBU420
00745  S981A-EXIT.                                                      DTSBU420
00746      EXIT.                                                        DTSBU420
00747                                                                   DTSBU420
00748  S981B-READ-NEXT.                                                 DTSBU420
00749      SET L981-READ-NEXT-88    TO TRUE.                            DTSBU420
00750      PERFORM S981Z-WWGH-IO    THRU S981Z-EXIT.                    DTSBU420
00751                                                                   DTSBU420
00752  S981B-EXIT.                                                      DTSBU420
00753      EXIT.                                                        DTSBU420
00754                                                                   DTSBU420
00755  S981C-WRITE.                                                     DTSBU420
00756      SET L981-WRITE-88        TO TRUE.                            DTSBU420
00757      PERFORM S981Z-WWGH-IO    THRU S981Z-EXIT.                    DTSBU420
00758                                                                   DTSBU420
00759  S981C-EXIT.                                                      DTSBU420
00760      EXIT.                                                        DTSBU420
00761                                                                   DTSBU420
00762  S981D-READ.                                                      DTSBU420
00763      SET L981-READ-88         TO TRUE.                            DTSBU420
00764      PERFORM S981Z-WWGH-IO    THRU S981Z-EXIT.                    DTSBU420
00765                                                                   DTSBU420
00766  S981D-EXIT.                                                      DTSBU420
00767      EXIT.                                                        DTSBU420
00768                                                                   DTSBU420
00769  S981Z-WWGH-IO.                                                   DTSBU420
00770      CALL 'DTSBU981' USING L981-LINK-AREA                         DTSBU420
00771                            WWGH-REC.                              DTSBU420
00772  S981Z-EXIT.                                                      DTSBU420
00773      EXIT.                                                        DTSBU420
00774                                                                   DTSBU420
00775  S982A-START-BROWSE.                                              DTSBU420
00776      SET L982-START-BROWSE-88 TO TRUE.                            DTSBU420
00777      PERFORM S982Z-WNAM-IO    THRU S982Z-EXIT.                    DTSBU420
00778                                                                   DTSBU420
00779  S982A-EXIT.                                                      DTSBU420
00780      EXIT.                                                        DTSBU420
00781                                                                   DTSBU420
00782  S982B-READ-NEXT.                                                 DTSBU420
00783      SET L982-READ-NEXT-88    TO TRUE.                            DTSBU420
00784      PERFORM S982Z-WNAM-IO    THRU S982Z-EXIT.                    DTSBU420
00785                                                                   DTSBU420
00786  S982B-EXIT.                                                      DTSBU420
00787      EXIT.                                                        DTSBU420
00788                                                                   DTSBU420
00789  S982C-WRITE.                                                     DTSBU420
00790      SET L982-WRITE-88        TO TRUE.                            DTSBU420
00791      PERFORM S982Z-WNAM-IO    THRU S982Z-EXIT.                    DTSBU420
00792                                                                   DTSBU420
00793  S982C-EXIT.                                                      DTSBU420
00794      EXIT.                                                        DTSBU420
00795                                                                   DTSBU420
00796  S982D-REWRITE.                                                   DTSBU420
00797      SET L982-REWRITE-88        TO TRUE.                          DTSBU420
00798      PERFORM S982Z-WNAM-IO    THRU S982Z-EXIT.                    DTSBU420
00799                                                                   DTSBU420
00800  S982D-EXIT.                                                      DTSBU420
00801      EXIT.                                                        DTSBU420
00802                                                                   DTSBU420
00803  S982F-CLOSE.                                                     DTSBU420
00804      SET L982-CLOSE-88        TO TRUE.                            DTSBU420
00805      PERFORM S982Z-WNAM-IO    THRU S982Z-EXIT.                    DTSBU420
00806                                                                   DTSBU420
00807  S982F-EXIT.                                                      DTSBU420
00808      EXIT.                                                        DTSBU420
00809                                                                   DTSBU420
00810  S982Z-WNAM-IO.                                                   DTSBU420
00811      CALL 'DTSBU982' USING L982-LINK-AREA                         DTSBU420
00812                            WNAM-REC.                              DTSBU420
00813  S982Z-EXIT.                                                      DTSBU420
00814      EXIT.                                                        DTSBU420
00815                                                                   DTSBU420
00816  S1000-WRITE-WAGE-TRANS.                                          DTSBU420
00817      MOVE ESP-TRANSACTION-AREA       TO WAGE-TRANS-REC.           DTSBU420
00818                                                                   DTSBU420
00819      WRITE WAGE-TRANS-REC.                                        DTSBU420
00820                                                                   DTSBU420
00821      IF WAGE-TRANS-FILE-OK-88                                     DTSBU420
00822          NEXT SENTENCE                                            DTSBU420
00823      ELSE                                                         DTSBU420
00824          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBU420
00825  S1000-EXIT.                                                      DTSBU420
00826      EXIT.                                                        DTSBU420
00827                                                                   DTSBU420
00828  S2000-SET-YRQ.                                                   DTSBU420
00829      MOVE L420-YRQ                   TO L004-QTR-5-9.             DTSBU420
00830      MOVE L004-QTR-5-YR              TO WRK-QTR-YR.               DTSBU420
00831                                                                   DTSBU420
00832      MOVE W001-YRQ                   TO L004-QTR-5-9.             DTSBU420
00833      MOVE L004-QTR-5-Q               TO WRK-QTR-Q.                DTSBU420
00834                                                                   DTSBU420
00835  S2000-EXIT.                                                      DTSBU420
00836      EXIT.                                                        DTSBU420
00837                                                                   DTSBU420
00838  S999-ABEND.                                                      DTSBU420
00839      DISPLAY '*** I/O MODULE ABENDING'.                           DTSBU420
00840                                                                   DTSBU420
00841      DISPLAY '*** CMND-CD = ' L983-CMND-CD.                       DTSBU420
00842                                                                   DTSBU420
00843      DISPLAY '*** FILE-STATUS = ' WAGE-TRANS-STATUS.              DTSBU420
00844                                                                   DTSBU420
00845      DISPLAY '*** CALLING MODULE = ' L983-MOD-NAME.               DTSBU420
00846                                                                   DTSBU420
00847                                                                   DTSBU420
00848      CALL 'DTSBU999' USING WRK-ABEND-CD.                          DTSBU420
00849  S999-EXIT.                                                       DTSBU420
00850      EXIT.                                                        DTSBU420
