00001  IDENTIFICATION DIVISION.                                         11/01/13
00002  PROGRAM-ID.             DESBD420.                                DESBD420
00003  AUTHOR.                 NGC.                                        LV003
00004  DATE-WRITTEN.           NOVEMBER 2011.                           DESBD420
00005  DATE-COMPILED.                                                   DESBD420
00006                                                                   DESBD420
00007 *****                                                             DESBD420
00008 *                                                                 DESBD420
00009 *                                                                 DESBD420
00010 *    FUNCTION:  EDIT DATA FROM DAILY W4 TRANSACTIONS.             DESBD420
00011 *               IF ALL RECORDS PASS THE EDITS, THE FILE           DESBD420
00012 *               IS FORWARDED TO DESBD421, WHICH LOCATES           DESBD420
00013 *               THE TAX REPORT AND RELEASES THE WAGES.            DESBD420
00014 *                                                                 DESBD420
00015 *    MODIFICATION HISTORY:                                        DESBD420
00016 *                                                                 DESBD420
00017 *    11/22/2011  INITIAL DEVELOPMENT                              DESBD420
00018 *                REFERENCE:                     PROGRAMMER: GD    DESBD420
00019 *                                                                 DESBD420
00020 *    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DESBD420
00021 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DESBD420
00022 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX   DESBD420
00023 *                                                                 DESBD420
00024 *    DESCRIPTION:                                                 DESBD420
00025 *                                                                 DESBD420
00026 *                                                                 DESBD420
00027 *    RECORDS READ:                                                DESBD420
00028 *        W4 TRANSACTIONS FROM TDEC.                               DESBD420
00029 *                                                                 DESBD420
00030 *    PRINTED OUTPUTS:                                             DESBD420
00031 *        NONE                                                     DESBD420
00032 *                                                                 DESBD420
00033 *    RECORDS WRITTEN:                                             DESBD420
00034 *       W001 WAGE RECORD                                          DESBD420
00035 *       WXXX MISSING SSN RECORD                                   DESBD420
00036 *                                                                 DESBD420
00037 *    MODULES CALLED:                                              DESBD420
00038 *         NONE                                                    DESBD420
00039 *                                                                 DESBD420
00040 *****                                                             DESBD420
00041                                                                   DESBD420
00042  ENVIRONMENT DIVISION.                                            DESBD420
00043      SKIP2                                                        DESBD420
00044  INPUT-OUTPUT SECTION.                                            DESBD420
00045      SKIP3                                                        DESBD420
00046  FILE-CONTROL.                                                    DESBD420
00047      SELECT TDEC-TRAN-IN           ASSIGN TO DTSFTDIN             DESBD420
00048             FILE STATUS IS TDEC-IN-STATUS.                        DESBD420
00049                                                                   DESBD420
00050      SELECT TDEC-TRAN-OUT          ASSIGN TO DTSFTDO              DESBD420
00051             FILE STATUS IS TDEC-OUT-STATUS.                       DESBD420
00052                                                                   DESBD420
00053  DATA DIVISION.                                                   DESBD420
00054                                                                   DESBD420
00055  FILE SECTION.                                                    DESBD420
00056                                                                   DESBD420
00057  FD  TDEC-TRAN-IN                                                 DESBD420
00058      RECORDING MODE IS F                                          DESBD420
00059      LABEL RECORDS ARE STANDARD                                   DESBD420
00060      BLOCK CONTAINS 0 CHARACTERS.                                 DESBD420
00061      SKIP1                                                        DESBD420
00062  01  TDEC-TRAN-IN-REC.                                            DESBD420
00063  ++INCLUDE DTSIX154                                               DESBD420
00064                                                                   DESBD420
00065  FD  TDEC-TRAN-OUT                                                DESBD420
00066      RECORDING MODE IS F                                          DESBD420
00067      LABEL RECORDS ARE STANDARD                                   DESBD420
00068      BLOCK CONTAINS 0 CHARACTERS.                                 DESBD420
00069      SKIP1                                                        DESBD420
00070  01  TDEC-TRAN-OUT-REC               PIC X(106).                  DESBD420
00071                                                                   DESBD420
00072  WORKING-STORAGE SECTION.                                         DESBD420
000725 77  PAN-VALET PICTURE X(24) VALUE '003DESBD420  11/01/13'.       DESBD420
00073  77  PAN-VALET PICTURE X(24) VALUE '003DESBD420  10/30/13'.       DESBD420
00074  77  PAN-VALET PICTURE X(24) VALUE '001DESBD420  02/08/13'.       DESBD420
00075  77  PAN-VALET PICTURE X(24) VALUE '057DESBD420  01/14/13'.       DESBD420
00076      SKIP3                                                        DESBD420
00077  01  W-AREA.                                                      DESBD420
00078      05  W-MOD-NAME                  PIC  X(08) VALUE 'DESBD420'. DESBD420
00079      05  WRK-ABEND-CD                PIC  X(03) VALUE '420'.      DESBD420
00080      05  W-TRACE-IND                 PIC  X(01) VALUE 'N'.        DESBD420
00081                                                                   DESBD420
00082      05  W-ERROR-IND                 PIC  X(01) VALUE 'N'.        DESBD420
00083          88 W-ERROR-YES-88             VALUE 'Y'.                 DESBD420
00084          88 W-ERROR-NO-88              VALUE 'N'.                 DESBD420
00085                                                                   DESBD420
00086      05  TDEC-IN-STATUS              PIC  X(02) VALUE SPACES.     DESBD420
00087          88  TDEC-IN-OK-88             VALUE '00'.                DESBD420
00088          88  TDEC-IN-EOF-88            VALUE '10'.                DESBD420
00089                                                                   DESBD420
00090       05  WRK-RUN-TYPE                PIC  X(01).                 DESBD420
00091           88  WRK-RUN-ONTIME-88      VALUE 'O'.                   DESBD420
00092           88  WRK-RUN-DELINQ-88      VALUE 'D'.                   DESBD420
00093                                                                   DESBD420
00094      05  TDEC-OUT-STATUS             PIC  X(02) VALUE SPACES.     DESBD420
00095          88  TDEC-OUT-OK-88            VALUE '00'.                DESBD420
00096                                                                   DESBD420
00097      05  W-WAGE-REC-IND               PIC  X(01) VALUE 'N'.       DESBD420
00098          88  W-WAGE-REC-ERR-YES-88      VALUE 'Y'.                DESBD420
00099          88  W-WAGE-REC-ERR-NO-88       VALUE 'N'.                DESBD420
00100                                                                   DESBD420
00101      05  W-EMP-NBR-ERR-IND            PIC  X(01) VALUE 'N'.       DESBD420
00102          88  W-EMP-NBR-ERR-YES-88       VALUE 'Y'.                DESBD420
00103          88  W-EMP-NBR-ERR-NO-88        VALUE 'N'.                DESBD420
00104                                                                   DESBD420
00105      05  W-QTR-ERR-IND                PIC  X(01) VALUE 'N'.       DESBD420
00106          88  W-QTR-ERR-YES-88           VALUE 'Y'.                DESBD420
00107          88  W-QTR-ERR-NO-88            VALUE 'N'.                DESBD420
00108                                                                   DESBD420
00109      05  W-SSN-ERR-IND                PIC  X(01) VALUE 'N'.       DESBD420
00110          88  W-SSN-ERR-YES-88           VALUE 'Y'.                DESBD420
00111          88  W-SSN-ERR-NO-88            VALUE 'N'.                DESBD420
00112                                                                   DESBD420
00113      05  W-BATCH-ERR-IND              PIC  X(01) VALUE 'N'.       DESBD420
00114          88  W-BATCH-ERR-YES-88         VALUE 'Y'.                DESBD420
00115          88  W-BATCH-ERR-NO-88          VALUE 'N'.                DESBD420
00116                                                                   DESBD420
00117      05  W-EMP-NBR-CHNG-IND           PIC  X(01) VALUE 'N'.       DESBD420
00118          88  W-EMP-NBR-CHNG-YES-88      VALUE 'Y'.                DESBD420
00119          88  W-EMP-NBR-CHNG-NO-88       VALUE 'N'.                DESBD420
00120                                                                   DESBD420
00121      05  W-WAGE-ERR-IND               PIC  X(01) VALUE 'N'.       DESBD420
00122          88  W-WAGE-ERR-YES-88          VALUE 'Y'.                DESBD420
00123          88  W-WAGE-ERR-NO-88           VALUE 'N'.                DESBD420
00124                                                                   DESBD420
00125      05  W-WAGE-ON-FILE-IND           PIC  X(01) VALUE 'N'.       DESBD420
00126          88  W-WAGE-ON-FILE-YES-88      VALUE 'Y'.                DESBD420
00127          88  W-WAGE-ON-FILE-NO-88       VALUE 'N'.                DESBD420
00128                                                                   DESBD420
00129      05  WRK-RETURN-CODE         PIC S9(04)    COMP-3 VALUE +0.   DESBD420
00130      05  W-EMP-NO                PIC S9(07)    COMP-3 VALUE +0.   DESBD420
00131      05  W-FEIN-EMP-NO           PIC S9(07)    COMP-3 VALUE +0.   DESBD420
00132      05  W-LAST-EMP-NO           PIC S9(07)    COMP-3 VALUE +0.   DESBD420
00133      05  W-ESTB-DATE             PIC S9(09)    COMP-3 VALUE +0.   DESBD420
00134                                                                   DESBD420
00135      05  W-YRQ                   PIC S9(05)    COMP-3 VALUE +0.   DESBD420
00136                                                                   DESBD420
00137      05  W-CURR-YRQ              PIC S9(05)    COMP-3 VALUE +0.   DESBD420
00138                                                                   DESBD420
00139      05  SUB2                    PIC S9(04) COMP VALUE +0.        DESBD420
00140      05  W-ACCT-NBR-LEN          PIC S9(04) COMP VALUE +6.        DESBD420
00141      05  W-ACCT-NBR-IN.                                           DESBD420
00142          10  W-ACCT-NBR-IN-X  OCCURS 6 TIMES                      DESBD420
00143                                  PIC X(01).                       DESBD420
00144      05  W-ACCT-NBR-9 REDEFINES W-ACCT-NBR-IN                     DESBD420
00145                                  PIC 9(06).                       DESBD420
00146                                                                   DESBD420
00147      05  W-SSN-LEN               PIC S9(04) COMP VALUE +9.        DESBD420
00148      05  W-SSN-IN.                                                DESBD420
00149          10  W-SSN-IN-X       OCCURS 9 TIMES                      DESBD420
00150                                  PIC X(01).                       DESBD420
00151      05  W-SSN-9      REDEFINES W-SSN-IN                          DESBD420
00152                                  PIC 9(09).                       DESBD420
00153                                                                   DESBD420
00154      05  W-ALL-NINES             PIC  9(09) VALUE 999999999.      DESBD420
00155                                                                   DESBD420
00156      05  W-TDEC-IN-CNT             PIC S9(07)  COMP-3 VALUE +0.   DESBD420
00157      05  W-TDEC-OUT-CNT            PIC S9(07)  COMP-3 VALUE +0.   DESBD420
00158      05  W-ERROR-CNT               PIC S9(07)  COMP-3 VALUE +0.   DESBD420
00159      05  W-REPORT-CNT              PIC S9(07)  COMP-3 VALUE +0.   DESBD420
00160      05  W-SSN-ON-FILE-CNT         PIC S9(07)  COMP-3 VALUE +0.   DESBD420
00161                                                                   DESBD420
00162      05  AMT-DISP1                   PIC ----------9.99.          DESBD420
00163      05  AMT-DISP2                   PIC ----------9.99.          DESBD420
00164      05  AMT-DISP3                   PIC ----------9.99.          DESBD420
00165      05  AMT-DISP4                   PIC ----------9.99.          DESBD420
00166                                                                   DESBD420
00167  01  W001-REC.                                                    DESBD420
00168  ++INCLUDE DTSIW001                                               DESBD420
00169                                                                   DESBD420
00170                                                                   DESBD420
00171  01  L001-LINK-AREA.                                              DESBD420
00172  ++INCLUDE DTSIL001                                               DESBD420
00173                                                                   DESBD420
00174  01  L004-LINK-AREA.                                              DESBD420
00175  ++INCLUDE DTSIL004                                               DESBD420
00176                                                                   DESBD420
00177  01  L005-LINK-AREA.                                              DESBD420
00178  ++INCLUDE DTSIL005                                               DESBD420
00179                                                                   DESBD420
00180  01  L516-LINK-AREA.                                              DESBD420
00181  ++INCLUDE DTSIL516                                               DESBD420
00182                                                                   DESBD420
00183  01  L910-LINK-AREA.                                              DESBD420
00184  ++INCLUDE DTSIL910                                               DESBD420
00185                                                                   DESBD420
00186  01  MSKL-REC.                                                    DESBD420
00187  ++INCLUDE DTSIMSKL                                               DESBD420
00188                                                                   DESBD420
00189  01  MHDR-REC.                                                    DESBD420
00190  ++INCLUDE DTSIMHDR                                               DESBD420
00191                                                                   DESBD420
00192  01  MPRF-REC.                                                    DESBD420
00193  ++INCLUDE DTSIMPRF                                               DESBD420
00194                                                                   DESBD420
00195  01  MRPT-REC.                                                    DESBD420
00196  ++INCLUDE DTSIMRPT                                               DESBD420
00197                                                                   DESBD420
00198  01  MPAY-REC.                                                    DESBD420
00199  ++INCLUDE DTSIMPAY                                               DESBD420
00200                                                                   DESBD420
00201  01  L923-LINK-AREA.                                              DESBD420
00202  ++INCLUDE DTSIL923                                               DESBD420
00203                                                                   DESBD420
00204  01  ASKL-REC.                                                    DESBD420
00205  ++INCLUDE DTSIASKL                                               DESBD420
00206                                                                   DESBD420
00207  01  AHDR-REC.                                                    DESBD420
00208  ++INCLUDE DTSIAHDR                                               DESBD420
00209                                                                   DESBD420
00210  01  ARPT-REC.                                                    DESBD420
00211  ++INCLUDE DTSIARPT                                               DESBD420
00212      EJECT                                                        DESBD420
00213  01  AATX-REC.                                                    DESBD420
00214  ++INCLUDE DTSIAATX                                               DESBD420
00215                                                                   DESBD420
00216  01  APAY-REC.                                                    DESBD420
00217  ++INCLUDE DTSIAPAY                                               DESBD420
00218                                                                   DESBD420
00219  01  L921-LINK-AREA.                                              DESBD420
00220  ++INCLUDE DTSIL921                                               DESBD420
00221      SKIP3                                                        DESBD420
00222  01  ISKL-REC.                                                    DESBD420
00223  ++INCLUDE DTSIISKL                                               DESBD420
00224      SKIP3                                                        DESBD420
00225  01  IEIN-REC.                                                    DESBD420
00226  ++INCLUDE DTSIIEIN                                               DESBD420
00227                                                                   DESBD420
00228  01  L981-LINK-AREA.                                              DESBD420
00229  ++INCLUDE DTSIL981                                               DESBD420
00230      SKIP3                                                        DESBD420
00231  01  WWGH-REC.                                                    DESBD420
00232  ++INCLUDE DTSIWWGH                                               DESBD420
00233  LINKAGE SECTION.                                                 DESBD420
00234                                                                   DESBD420
00235  01  PARM-AREA.                                                   DESBD420
00236      05  PARM-LENGTH                PIC S9(04)  COMP.             DESBD420
00237                                                                   DESBD420
00238      05  PARM-DATA.                                               DESBD420
00239           10  PARM-RUN-TYPE          PIC  X(06).                  DESBD420
00240               88  PARM-RUN-ONTIME-88     VALUE 'ONTIME'.          DESBD420
00241               88  PARM-RUN-DELINQ-88     VALUE 'DELINQ'.          DESBD420
00242                                                                   DESBD420
00243                                                                   DESBD420
00244  PROCEDURE DIVISION USING PARM-AREA.                              DESBD420
00245                                                                   DESBD420
00246  DESBD420-MAIN.                                                   DESBD420
00247      PERFORM I0000-INIT         THRU I0000-EXIT.                  DESBD420
00248      IF W-ERROR-YES-88                                            DESBD420
00249         GO TO DESBD420-MAIN-EXIT.                                 DESBD420
00250                                                                   DESBD420
00251      PERFORM P0000-PROCESS    THRU P0000-EXIT.                    DESBD420
00252                                                                   DESBD420
00253      PERFORM T0000-TERMINATE THRU T0000-EXIT.                     DESBD420
00254      MOVE WRK-RETURN-CODE   TO RETURN-CODE.                       DESBD420
00255  DESBD420-MAIN-EXIT.                                              DESBD420
00256      GOBACK.                                                      DESBD420
00257                                                                   DESBD420
00258  I0000-INIT.                                                      DESBD420
00259      PERFORM S005-FROM-SYS                  THRU S005-EXIT.       DESBD420
00260      MOVE L005-DATE                         TO L004-DATE.         DESBD420
00261      PERFORM S004-FROM-DATE                 THRU S004-EXIT.       DESBD420
00262      MOVE L004-QTR-5-9                      TO W-CURR-YRQ.        DESBD420
00263                                                                   DESBD420
00264      IF PARM-LENGTH = +6                                          DESBD420
00265         NEXT SENTENCE                                             DESBD420
00266      ELSE                                                         DESBD420
00267         DISPLAY 'PARM-LENGTH NOT EQUAL TO 6 ' PARM-LENGTH         DESBD420
00268         PERFORM S999-ABEND THRU S999-EXIT                         DESBD420
00269      END-IF.                                                      DESBD420
00270                                                                   DESBD420
00271      IF PARM-RUN-ONTIME-88                                        DESBD420
00272         OR PARM-RUN-DELINQ-88                                     DESBD420
00273            MOVE PARM-RUN-TYPE             TO WRK-RUN-TYPE         DESBD420
00274      ELSE                                                         DESBD420
00275         DISPLAY 'INVALID PARM TYPE ' PARM-RUN-TYPE                DESBD420
00276             PERFORM S999-ABEND THRU S999-EXIT.                    DESBD420
00277                                                                   DESBD420
00278      PERFORM I2000-OPEN-FILES               THRU I2000-EXIT.      DESBD420
00279                                                                   DESBD420
00280  I0000-EXIT.                                                      DESBD420
00281      EXIT.                                                        DESBD420
00282                                                                   DESBD420
00283  I2000-OPEN-FILES.                                                DESBD420
00284      PERFORM S1000-OPEN-TDEC-IN             THRU S1000-EXIT.      DESBD420
00285      IF W-ERROR-YES-88                                            DESBD420
00286         GO TO I2000-EXIT                                          DESBD420
00287      END-IF.                                                      DESBD420
00288                                                                   DESBD420
00289      PERFORM S1100-OPEN-TDEC-OUT            THRU S1100-EXIT.      DESBD420
00290      IF W-ERROR-YES-88                                            DESBD420
00291         GO TO I2000-EXIT                                          DESBD420
00292      END-IF.                                                      DESBD420
00293                                                                   DESBD420
00294      PERFORM S910A-OPEN-READ                THRU S910A-EXIT.      DESBD420
00295      PERFORM S921-OPEN-READ                 THRU S921-EXIT.       DESBD420
00296      PERFORM S981A-OPEN-READ                THRU S981A-EXIT.      DESBD420
00297                                                                   DESBD420
00298  I2000-EXIT.                                                      DESBD420
00299      EXIT.                                                        DESBD420
00300                                                                   DESBD420
00301  P0000-PROCESS.                                                   DESBD420
00302      PERFORM S1010-READ-TDEC-IN             THRU S1010-EXIT.      DESBD420
00303      IF TDEC-IN-EOF-88                                            DESBD420
00304         DISPLAY 'WAGE INPUT FILE IS EMPTY '                       DESBD420
00305         MOVE +3   TO WRK-RETURN-CODE                              DESBD420
00306         GO TO P0000-EXIT                                          DESBD420
00307      END-IF.                                                      DESBD420
00308                                                                   DESBD420
00309      PERFORM UNTIL TDEC-IN-EOF-88                                 DESBD420
00310         PERFORM P1000-WAGE-EDIT             THRU P1000-EXIT       DESBD420
00311         IF W-WAGE-REC-ERR-NO-88                                   DESBD420
00312            PERFORM S1120-WRITE-TDEC-OUT     THRU S1120-EXIT       DESBD420
00313         END-IF                                                    DESBD420
00314         PERFORM S1010-READ-TDEC-IN          THRU S1010-EXIT       DESBD420
00315      END-PERFORM.                                                 DESBD420
00316                                                                   DESBD420
00317                                                                   DESBD420
00318  P0000-EXIT.                                                      DESBD420
00319      EXIT.                                                        DESBD420
00320                                                                   DESBD420
00321  P1000-WAGE-EDIT.                                                 DESBD420
00322      SET W-WAGE-REC-ERR-NO-88         TO TRUE.                    DESBD420
00323                                                                   DESBD420
00324      PERFORM P1100-EDIT-EMP-NBR       THRU P1100-EXIT.            DESBD420
00325      PERFORM P1200-EDIT-QTR           THRU P1200-EXIT.            DESBD420
00326      PERFORM P1300-EDIT-SSN           THRU P1300-EXIT.            DESBD420
00327      PERFORM P1400-EDIT-WAGES         THRU P1400-EXIT.            DESBD420
00328      PERFORM P1500-EDIT-BATCH         THRU P1500-EXIT.            DESBD420
00329                                                                   DESBD420
00330 ***  PERFORM P1600-WAGES-ON-FILE      THRU P1600-EXIT.            DESBD420
00331                                                                   DESBD420
00332      IF W-EMP-NBR-ERR-YES-88                                      DESBD420
00333      OR W-QTR-ERR-YES-88                                          DESBD420
00334      OR W-SSN-ERR-YES-88                                          DESBD420
00335      OR W-WAGE-ERR-YES-88                                         DESBD420
00336 **   OR W-WAGE-ON-FILE-YES-88                                     DESBD420
00337         SET W-WAGE-REC-ERR-YES-88     TO TRUE                     DESBD420
00338         ADD +1                        TO W-ERROR-CNT              DESBD420
00339         DISPLAY 'ERROR: ' X154-EMP-NO '  ' X154-QUARTER           DESBD420
00340         MOVE +2   TO WRK-RETURN-CODE                              DESBD420
00341      END-IF.                                                      DESBD420
00342                                                                   DESBD420
00343      IF W-EMP-NBR-ERR-NO-88                                       DESBD420
00344      AND W-QTR-ERR-NO-88                                          DESBD420
00345         IF X154-EMP-NO    = W-EMP-NO                              DESBD420
00346         AND X154-QUARTER  = W-YRQ                                 DESBD420
00347            NEXT SENTENCE                                          DESBD420
00348         ELSE                                                      DESBD420
00349            ADD +1                           TO W-REPORT-CNT       DESBD420
00350            MOVE X154-EMP-NO                 TO W-EMP-NO           DESBD420
00351            MOVE X154-QUARTER                TO W-YRQ              DESBD420
00352         END-IF                                                    DESBD420
00353      END-IF.                                                      DESBD420
00354                                                                   DESBD420
00355  P1000-EXIT.                                                      DESBD420
00356      EXIT.                                                        DESBD420
00357                                                                   DESBD420
00358  P1100-EDIT-EMP-NBR.                                              DESBD420
00359      SET W-EMP-NBR-ERR-NO-88                TO TRUE.              DESBD420
00360                                                                   DESBD420
00361      INSPECT X154-EMP-NO REPLACING ALL SPACES BY ZEROS.           DESBD420
00362                                                                   DESBD420
00363      MOVE X154-EMP-NO                       TO W-ACCT-NBR-IN.     DESBD420
00364                                                                   DESBD420
00365      PERFORM                                                      DESBD420
00366        VARYING SUB2 FROM +1 BY +1                                 DESBD420
00367        UNTIL SUB2 > W-ACCT-NBR-LEN                                DESBD420
00368          IF  W-ACCT-NBR-IN-X (SUB2) < '0'                         DESBD420
00369          OR  W-ACCT-NBR-IN-X (SUB2) > '9'                         DESBD420
00370             SET W-EMP-NBR-ERR-YES-88        TO TRUE               DESBD420
00371             MOVE X154-EARNINGS              TO AMT-DISP1          DESBD420
00372             DISPLAY 'INVALID EMPLOYER NBR: ' X154-EMP-NO          DESBD420
00373                '  ' X154-QUARTER '  ' AMT-DISP1                   DESBD420
00374          END-IF                                                   DESBD420
00375      END-PERFORM.                                                 DESBD420
00376                                                                   DESBD420
00377      IF W-EMP-NBR-ERR-NO-88                                       DESBD420
00378         IF X154-EMP-NO = ZERO                                     DESBD420
00379            PERFORM P1110-FROM-FEIN         THRU P1110-EXIT        DESBD420
00380            MOVE W-FEIN-EMP-NO              TO X154-EMP-NO         DESBD420
00381         ELSE                                                      DESBD420
00382            GO TO P1100-EXIT                                       DESBD420
00383         END-IF                                                    DESBD420
00384      END-IF.                                                      DESBD420
00385                                                                   DESBD420
00386      IF W-FEIN-EMP-NO = ZERO                                      DESBD420
00387         IF X154-ITEM > 0                                          DESBD420
00388            NEXT SENTENCE                                          DESBD420
00389         ELSE                                                      DESBD420
00390 *           SET W-EMP-NBR-ERR-YES-88        TO TRUE               DESBD420
00391             DISPLAY 'NO EMP NBR, NO FEIN, NO ITEM: '              DESBD420
00392                '  ' X154-EMP-NO '  ' X154-FEIN '  ' X154-ITEM     DESBD420
00393         END-IF                                                    DESBD420
00394      END-IF.                                                      DESBD420
00395                                                                   DESBD420
00396  P1100-EXIT.                                                      DESBD420
00397      EXIT.                                                        DESBD420
00398                                                                   DESBD420
00399  P1110-FROM-FEIN.                                                 DESBD420
00400      MOVE +0                   TO W-FEIN-EMP-NO                   DESBD420
00401                                   W-LAST-EMP-NO                   DESBD420
00402                                   W-ESTB-DATE.                    DESBD420
00403                                                                   DESBD420
00404      MOVE LOW-VALUE            TO IEIN-KEY-AREA                   DESBD420
00405      SET IEIN-EIN-88           TO TRUE                            DESBD420
00406      MOVE X154-FEIN            TO IEIN-FEIN                       DESBD420
00407      MOVE +0                   TO IEIN-EMP-NO                     DESBD420
00408      MOVE IEIN-KEY-AREA        TO ISKL-KEY-AREA                   DESBD420
00409      PERFORM S921-START-BROWSE THRU S921-EXIT                     DESBD420
00410      MOVE ISKL-REC             TO IEIN-REC                        DESBD420
00411                                                                   DESBD420
00412      PERFORM                                                      DESBD420
00413        UNTIL L921-NO-REC-88                                       DESBD420
00414        OR W-FEIN-EMP-NO > ZERO                                    DESBD420
00415           IF IEIN-FEIN = X154-FEIN                                DESBD420
00416              PERFORM P1111-FIND-MPRF  THRU P1111-EXIT             DESBD420
00417              IF W-FEIN-EMP-NO = ZERO                              DESBD420
00418                 PERFORM S921-READ-NEXT THRU S921-EXIT             DESBD420
00419                 MOVE ISKL-REC TO IEIN-REC                         DESBD420
00420              END-IF                                               DESBD420
00421           ELSE                                                    DESBD420
00422              SET L921-NO-REC-88       TO TRUE                     DESBD420
00423           END-IF                                                  DESBD420
00424      END-PERFORM.                                                 DESBD420
00425                                                                   DESBD420
00426      IF W-FEIN-EMP-NO = +0                                        DESBD420
00427         IF W-LAST-EMP-NO > ZERO                                   DESBD420
00428            MOVE W-LAST-EMP-NO         TO W-FEIN-EMP-NO            DESBD420
00429         END-IF                                                    DESBD420
00430      END-IF.                                                      DESBD420
00431                                                                   DESBD420
00432  P1110-EXIT.                                                      DESBD420
00433      EXIT.                                                        DESBD420
00434                                                                   DESBD420
00435  P1111-FIND-MPRF.                                                 DESBD420
00436      MOVE LOW-VALUES                   TO MPRF-KEY-AREA.          DESBD420
00437      MOVE IEIN-EMP-NO                  TO MPRF-EMP-NO.            DESBD420
00438      SET MPRF-PRF-88                   TO TRUE.                   DESBD420
00439      MOVE MPRF-KEY-AREA                TO MSKL-KEY-AREA.          DESBD420
00440      PERFORM S910F-READ                THRU S910F-EXIT.           DESBD420
00441      IF L910-OK-88                                                DESBD420
00442         MOVE MSKL-REC                  TO MPRF-REC                DESBD420
00443         IF MPRF-STATUS-ACT-88                                     DESBD420
00444            MOVE MPRF-EMP-NO            TO W-FEIN-EMP-NO           DESBD420
00445         ELSE                                                      DESBD420
00446            IF MPRF-ESTB-DATE > W-ESTB-DATE                        DESBD420
00447               MOVE MPRF-ESTB-DATE      TO W-ESTB-DATE             DESBD420
00448               MOVE MPRF-EMP-NO         TO W-LAST-EMP-NO           DESBD420
00449            END-IF                                                 DESBD420
00450         END-IF                                                    DESBD420
00451      END-IF.                                                      DESBD420
00452                                                                   DESBD420
00453  P1111-EXIT.                                                      DESBD420
00454      EXIT.                                                        DESBD420
00455                                                                   DESBD420
00456  P1200-EDIT-QTR.                                                  DESBD420
00457      SET W-QTR-ERR-NO-88                   TO TRUE.               DESBD420
00458                                                                   DESBD420
00459      MOVE X154-QUARTER                     TO L004-QTR-5-X.       DESBD420
00460      PERFORM S004-FROM-5                   THRU S004-EXIT.        DESBD420
00461      IF L004-INVALID-QTR                                          DESBD420
00462         DISPLAY 'BAD QUARTER       : ' X154-QUARTER               DESBD420
00463         SET W-WAGE-REC-ERR-YES-88          TO TRUE                DESBD420
00464      ELSE                                                         DESBD420
00465         IF L004-QTR-5-9 > W-CURR-YRQ                              DESBD420
00466            MOVE X154-EARNINGS              TO AMT-DISP1           DESBD420
00467            DISPLAY 'FUTURE QUARTER : ' X154-EMP-NO                DESBD420
00468               '  ' X154-QUARTER '  ' AMT-DISP1                    DESBD420
00469            SET W-QTR-ERR-YES-88            TO TRUE                DESBD420
00470 *       ELSE                                                      DESBD420
00471 *       IF PARM-RUN-ONTIME-88 AND                                 DESBD420
00472 *          L004-QTR-5-9 NOT = W-CURR-YRQ                          DESBD420
00473 *          MOVE X154-EARNINGS              TO AMT-DISP1           DESBD420
00474 *          DISPLAY 'NOT ONTIME QUARTER : ' X154-EMP-NO            DESBD420
00475 *             '  ' X154-QUARTER '  ' AMT-DISP1                    DESBD420
00476 *       ELSE                                                      DESBD420
00477 *       IF PARM-RUN-DELINQ-88 AND                                 DESBD420
00478 *          L004-QTR-5-9 = W-CURR-YRQ                              DESBD420
00479 *          MOVE X154-EARNINGS              TO AMT-DISP1           DESBD420
00480 *          DISPLAY 'NOT DELINQ QUARTER : ' X154-EMP-NO            DESBD420
00481 *             '  ' X154-QUARTER '  ' AMT-DISP1                    DESBD420
00482 *       END-IF                                                    DESBD420
00483 *      END-IF                                                     DESBD420
00484       END-IF                                                      DESBD420
00485      END-IF.                                                      DESBD420
00486                                                                   DESBD420
00487  P1200-EXIT.                                                      DESBD420
00488      EXIT.                                                        DESBD420
00489                                                                   DESBD420
00490  P1300-EDIT-SSN.                                                  DESBD420
00491      SET W-SSN-ERR-NO-88                    TO TRUE.              DESBD420
00492                                                                   DESBD420
00493      MOVE X154-SSN                          TO W-SSN-IN.          DESBD420
00494                                                                   DESBD420
00495      PERFORM                                                      DESBD420
00496        VARYING SUB2 FROM +1 BY +1                                 DESBD420
00497        UNTIL SUB2 > W-SSN-LEN                                     DESBD420
00498          IF  W-SSN-IN-X (SUB2) < '0'                              DESBD420
00499          AND W-SSN-IN-X (SUB2) > '9'                              DESBD420
00500             SET W-SSN-ERR-YES-88            TO TRUE               DESBD420
00501             MOVE X154-EARNINGS              TO AMT-DISP1          DESBD420
00502             DISPLAY 'INVALID SSN   : ' X154-EMP-NO                DESBD420
00503               '  ' X154-SSN '  ' AMT-DISP1                        DESBD420
00504          END-IF                                                   DESBD420
00505      END-PERFORM.                                                 DESBD420
00506                                                                   DESBD420
00507      IF X154-SSN = W-ALL-NINES                                    DESBD420
00508        OR X154-SSN = ZERO                                         DESBD420
00509         PERFORM P1310-CHECK-NAME             THRU P1310-EXIT      DESBD420
00510      END-IF.                                                      DESBD420
00511                                                                   DESBD420
00512  P1300-EXIT.                                                      DESBD420
00513      EXIT.                                                        DESBD420
00514                                                                   DESBD420
00515  P1310-CHECK-NAME.                                                DESBD420
00516      IF X154-LAST-NAME NOT > SPACES                               DESBD420
00517         SET W-SSN-ERR-YES-88            TO TRUE                   DESBD420
00518         MOVE X154-EARNINGS              TO AMT-DISP1              DESBD420
00519         DISPLAY 'MISSING SSN - NO NAME: ' X154-EMP-NO             DESBD420
00520            '  ' X154-SSN '  ' X154-LAST-NAME                      DESBD420
00521            '  ' X154-FIRST-NAME  '  ' AMT-DISP1                   DESBD420
00522      END-IF.                                                      DESBD420
00523  P1310-EXIT.                                                      DESBD420
00524      EXIT.                                                        DESBD420
00525                                                                   DESBD420
00526  P1400-EDIT-WAGES.                                                DESBD420
00527      SET W-WAGE-ERR-NO-88                     TO TRUE.            DESBD420
00528                                                                   DESBD420
00529      IF X154-EARNINGS       NOT NUMERIC                           DESBD420
00530         DISPLAY 'NON-NUMERIC EARNINGS: ' X154-EMP-NO              DESBD420
00531            '  ' X154-EARNINGS                                     DESBD420
00532         SET W-WAGE-ERR-YES-88                 TO TRUE             DESBD420
00533      END-IF.                                                      DESBD420
00534                                                                   DESBD420
00535  P1400-EXIT.                                                      DESBD420
00536      EXIT.                                                        DESBD420
00537                                                                   DESBD420
00538  P1500-EDIT-BATCH.                                                DESBD420
00539      SET W-WAGE-ERR-NO-88                     TO TRUE.            DESBD420
00540                                                                   DESBD420
00541      IF X154-BATCH    NOT NUMERIC                                 DESBD420
00542         DISPLAY 'NON-NUMERIC BATCH: ' X154-EMP-NO                 DESBD420
00543            '  ' X154-BATCH                                        DESBD420
00544         SET W-WAGE-ERR-YES-88                 TO TRUE             DESBD420
00545      END-IF.                                                      DESBD420
00546                                                                   DESBD420
00547                                                                   DESBD420
00548  P1500-EXIT.                                                      DESBD420
00549      EXIT.                                                        DESBD420
00550                                                                   DESBD420
00551 *P1700-WAGES-ON-FILE.                                             DESBD420
00552 *    SET W-WAGE-ON-FILE-NO-88          TO TRUE.                   DESBD420
00553 *                                                                 DESBD420
00554 *    MOVE LOW-VALUES                   TO WWGH-KEY-AREA.          DESBD420
00555 *    MOVE W-EMP-NO                     TO WWGH-EMP-NO.            DESBD420
00556 *    MOVE W-YRQ                        TO WWGH-YRQ.               DESBD420
00557 *    MOVE T-IN-SSN                     TO WWGH-SSN.               DESBD420
00558 *                                                                 DESBD420
00559 *    PERFORM S981F-READ                THRU S981F-EXIT.           DESBD420
00560 *                                                                 DESBD420
00561 *    IF L981-OK-88                                                DESBD420
00562 *       SET W-WAGE-ON-FILE-YES-88      TO TRUE                    DESBD420
00563 *       ADD +1                         TO W-SSN-ON-FILE-CNT       DESBD420
00564 *       DISPLAY 'SSN ON FILE ' T-IN-SSN                           DESBD420
00565 *          '  ' W-EMP-NO '  ' W-YRQ                               DESBD420
00566 *          '  ' T-IN-EARNINGS                                     DESBD420
00567 *          '  ' WWGH-EARNINGS                                     DESBD420
00568 *    END-IF.                                                      DESBD420
00569 *                                                                 DESBD420
00570 *P1700-EXIT.                                                      DESBD420
00571 *    EXIT.                                                        DESBD420
00572                                                                   DESBD420
00573  P2000-WRITE-TDEC-OUT.                                            DESBD420
00574      WRITE TDEC-TRAN-OUT-REC          FROM TDEC-TRAN-IN-REC.      DESBD420
00575                                                                   DESBD420
00576  P2000-EXIT.                                                      DESBD420
00577      EXIT.                                                        DESBD420
00578                                                                   DESBD420
00579  T0000-TERMINATE.                                                 DESBD420
00580                                                                   DESBD420
00581      DISPLAY ' '.                                                 DESBD420
00582      DISPLAY ' '.                                                 DESBD420
00583                                                                   DESBD420
00584      DISPLAY '*** DESBD420 TERMINATION STATISTICS ***'.           DESBD420
00585                                                                   DESBD420
00586      DISPLAY '  '.                                                DESBD420
00587                                                                   DESBD420
00588      DISPLAY '  '.                                                DESBD420
00589      DISPLAY 'W4 TRANSACTIONS READ                             : 'DESBD420
00590              W-TDEC-IN-CNT.                                       DESBD420
00591                                                                   DESBD420
00592      DISPLAY '  '.                                                DESBD420
00593      DISPLAY 'ERRORS FOUND                                     : 'DESBD420
00594              W-ERROR-CNT.                                         DESBD420
00595                                                                   DESBD420
00596      DISPLAY '  '.                                                DESBD420
00597      DISPLAY 'TRANSACTIONS WRITTEN                             : 'DESBD420
00598              W-TDEC-OUT-CNT.                                      DESBD420
00599                                                                   DESBD420
00600                                                                   DESBD420
00601      PERFORM S1020-CLOSE-TDEC-IN         THRU S1020-EXIT.         DESBD420
00602      PERFORM S1130-CLOSE-TDEC-OUT        THRU S1130-EXIT.         DESBD420
00603                                                                   DESBD420
00604      PERFORM S910C-CLOSE                 THRU S910C-EXIT.         DESBD420
00605      PERFORM S981C-CLOSE                 THRU S981C-EXIT.         DESBD420
00606      PERFORM S921-CLOSE                  THRU S921-EXIT.          DESBD420
00607                                                                   DESBD420
00608  T0000-EXIT.                                                      DESBD420
00609      EXIT.                                                        DESBD420
00610                                                                   DESBD420
00611   S001-FROM-FED-8.                                                DESBD420
00612       SET L001-FROM-FED-8 TO TRUE.                                DESBD420
00613       GO TO S001-DATE.                                            DESBD420
00614                                                                   DESBD420
00615   S001-FROM-CAL-8.                                                DESBD420
00616       SET L001-FROM-CAL-8 TO TRUE.                                DESBD420
00617       GO TO S001-DATE.                                            DESBD420
00618                                                                   DESBD420
00619   S001-FROM-ABS-DAY.                                              DESBD420
00620       SET L001-FROM-ABS-DAY TO TRUE.                              DESBD420
00621       GO TO S001-DATE.                                            DESBD420
00622                                                                   DESBD420
00623   S001-DATE.                                                      DESBD420
00624       CALL 'DTSBU001' USING L001-LINK-AREA.                       DESBD420
00625   S001-EXIT.                                                      DESBD420
00626       EXIT.                                                       DESBD420
00627                                                                   DESBD420
00628  S004-FROM-DATE.                                                  DESBD420
00629      SET L004-FROM-DATE TO TRUE.                                  DESBD420
00630      GO TO S004-QTR.                                              DESBD420
00631                                                                   DESBD420
00632  S004-FROM-5.                                                     DESBD420
00633      SET L004-FROM-5 TO TRUE.                                     DESBD420
00634      GO TO S004-QTR.                                              DESBD420
00635                                                                   DESBD420
00636  S004-FROM-ABS.                                                   DESBD420
00637      SET L004-FROM-ABS TO TRUE.                                   DESBD420
00638      GO TO S004-QTR.                                              DESBD420
00639                                                                   DESBD420
00640  S004-FROM-3.                                                     DESBD420
00641      SET L004-FROM-3 TO TRUE.                                     DESBD420
00642      GO TO S004-QTR.                                              DESBD420
00643                                                                   DESBD420
00644  S004-QTR.                                                        DESBD420
00645      CALL 'DTSBU004' USING L004-LINK-AREA.                        DESBD420
00646  S004-EXIT.                                                       DESBD420
00647                                                                   DESBD420
00648  S005-FROM-SYS.                                                   DESBD420
00649      SET L005-FROM-SYS       TO TRUE.                             DESBD420
00650      GO TO S005-ABSTIME.                                          DESBD420
00651                                                                   DESBD420
00652  S005-ABSTIME.                                                    DESBD420
00653      CALL 'DTSBU005' USING L005-LINK-AREA.                        DESBD420
00654  S005-EXIT.                                                       DESBD420
00655      EXIT.                                                        DESBD420
00656                                                                   DESBD420
00657  S516-LIABILITY-INFO.                                             DESBD420
00658      CALL 'DTSBU516' USING L516-LINK-AREA                         DESBD420
00659                            MPRF-REC.                              DESBD420
00660  S516-EXIT.                                                       DESBD420
00661      EXIT.                                                        DESBD420
00662                                                                   DESBD420
00663  S910A-OPEN-READ.                                                 DESBD420
00664      SET L910-OPEN-READ-88 TO TRUE.                               DESBD420
00665      PERFORM S910Z-MSTR-I  THRU S910Z-EXIT.                       DESBD420
00666                                                                   DESBD420
00667  S910A-EXIT.                                                      DESBD420
00668      EXIT.                                                        DESBD420
00669                                                                   DESBD420
00670  S910C-CLOSE.                                                     DESBD420
00671      SET L910-CLOSE-88 TO TRUE.                                   DESBD420
00672      PERFORM S910Z-MSTR-I  THRU S910Z-EXIT.                       DESBD420
00673                                                                   DESBD420
00674  S910C-EXIT.                                                      DESBD420
00675      EXIT.                                                        DESBD420
00676                                                                   DESBD420
00677  S910D-START-BROWSE.                                              DESBD420
00678      SET L910-START-BROWSE-88 TO TRUE.                            DESBD420
00679      PERFORM S910Z-MSTR-I  THRU S910Z-EXIT.                       DESBD420
00680                                                                   DESBD420
00681  S910D-EXIT.                                                      DESBD420
00682      EXIT.                                                        DESBD420
00683                                                                   DESBD420
00684  S910E-READ-NEXT.                                                 DESBD420
00685      SET L910-READ-NEXT-88 TO TRUE.                               DESBD420
00686      PERFORM S910Z-MSTR-I  THRU S910Z-EXIT.                       DESBD420
00687                                                                   DESBD420
00688  S910E-EXIT.                                                      DESBD420
00689      EXIT.                                                        DESBD420
00690                                                                   DESBD420
00691  S910F-READ.                                                      DESBD420
00692      SET L910-READ-88      TO TRUE.                               DESBD420
00693      PERFORM S910Z-MSTR-I  THRU S910Z-EXIT.                       DESBD420
00694                                                                   DESBD420
00695  S910F-EXIT.                                                      DESBD420
00696      EXIT.                                                        DESBD420
00697                                                                   DESBD420
00698  S910Z-MSTR-I.                                                    DESBD420
00699      CALL 'DTSBU910' USING L910-LINK-AREA                         DESBD420
00700                            MSKL-REC.                              DESBD420
00701  S910Z-EXIT.                                                      DESBD420
00702      EXIT.                                                        DESBD420
00703                                                                   DESBD420
00704  S921-OPEN-READ.                                                  DESBD420
00705      SET L921-OPEN-READ-88 TO TRUE.                               DESBD420
00706      GO TO S921-AIX-IO.                                           DESBD420
00707                                                                   DESBD420
00708  S921-READ.                                                       DESBD420
00709      SET L921-READ-88 TO TRUE.                                    DESBD420
00710      GO TO S921-AIX-IO.                                           DESBD420
00711                                                                   DESBD420
00712  S921-START-BROWSE.                                               DESBD420
00713      SET L921-START-BROWSE-88 TO TRUE.                            DESBD420
00714      GO TO S921-AIX-IO.                                           DESBD420
00715                                                                   DESBD420
00716  S921-READ-NEXT.                                                  DESBD420
00717      SET L921-READ-NEXT-88 TO TRUE.                               DESBD420
00718      GO TO S921-AIX-IO.                                           DESBD420
00719                                                                   DESBD420
00720  S921-CLOSE.                                                      DESBD420
00721      SET L921-CLOSE-88 TO TRUE.                                   DESBD420
00722      GO TO S921-AIX-IO.                                           DESBD420
00723                                                                   DESBD420
00724  S921-AIX-IO.                                                     DESBD420
00725      CALL 'DTSBU921' USING L921-LINK-AREA                         DESBD420
00726                            ISKL-REC.                              DESBD420
00727  S921-EXIT.                                                       DESBD420
00728      EXIT.                                                        DESBD420
00729                                                                   DESBD420
00730  S923A-OPEN-READ.                                                 DESBD420
00731      SET L923-OPEN-READ-88     TO TRUE.                           DESBD420
00732      PERFORM  S923Z-ATC-IO     THRU S923Z-EXIT.                   DESBD420
00733                                                                   DESBD420
00734  S923A-EXIT.                                                      DESBD420
00735      EXIT.                                                        DESBD420
00736                                                                   DESBD420
00737  S923B-START-BROWSE.                                              DESBD420
00738      SET L923-START-BROWSE-88  TO TRUE.                           DESBD420
00739      PERFORM  S923Z-ATC-IO     THRU S923Z-EXIT.                   DESBD420
00740                                                                   DESBD420
00741  S923B-EXIT.                                                      DESBD420
00742      EXIT.                                                        DESBD420
00743                                                                   DESBD420
00744  S923C-READ-NEXT.                                                 DESBD420
00745      SET L923-READ-NEXT-88     TO TRUE.                           DESBD420
00746      PERFORM  S923Z-ATC-IO     THRU S923Z-EXIT.                   DESBD420
00747                                                                   DESBD420
00748  S923C-EXIT.                                                      DESBD420
00749      EXIT.                                                        DESBD420
00750                                                                   DESBD420
00751  S923D-CLOSE.                                                     DESBD420
00752      SET L923-CLOSE-88         TO TRUE.                           DESBD420
00753      PERFORM  S923Z-ATC-IO      THRU S923Z-EXIT.                  DESBD420
00754                                                                   DESBD420
00755  S923D-EXIT.                                                      DESBD420
00756      EXIT.                                                        DESBD420
00757                                                                   DESBD420
00758                                                                   DESBD420
00759  S923Z-ATC-IO.                                                    DESBD420
00760      CALL 'DTSBU923' USING L923-LINK-AREA                         DESBD420
00761                            ASKL-REC.                              DESBD420
00762  S923Z-EXIT.                                                      DESBD420
00763      EXIT.                                                        DESBD420
00764                                                                   DESBD420
00765  S981A-OPEN-READ.                                                 DESBD420
00766      SET L981-OPEN-READ-88 TO TRUE.                               DESBD420
00767      PERFORM S981Z-WAGE-I  THRU S981Z-EXIT.                       DESBD420
00768                                                                   DESBD420
00769  S981A-EXIT.                                                      DESBD420
00770      EXIT.                                                        DESBD420
00771                                                                   DESBD420
00772  S981C-CLOSE.                                                     DESBD420
00773      SET L981-CLOSE-88 TO TRUE.                                   DESBD420
00774      PERFORM S981Z-WAGE-I  THRU S981Z-EXIT.                       DESBD420
00775                                                                   DESBD420
00776  S981C-EXIT.                                                      DESBD420
00777      EXIT.                                                        DESBD420
00778                                                                   DESBD420
00779  S981D-START-BROWSE.                                              DESBD420
00780      SET L981-START-BROWSE-88 TO TRUE.                            DESBD420
00781      PERFORM S981Z-WAGE-I  THRU S981Z-EXIT.                       DESBD420
00782                                                                   DESBD420
00783  S981D-EXIT.                                                      DESBD420
00784      EXIT.                                                        DESBD420
00785                                                                   DESBD420
00786  S981E-READ-NEXT.                                                 DESBD420
00787      SET L981-READ-NEXT-88 TO TRUE.                               DESBD420
00788      PERFORM S981Z-WAGE-I  THRU S981Z-EXIT.                       DESBD420
00789                                                                   DESBD420
00790  S981E-EXIT.                                                      DESBD420
00791      EXIT.                                                        DESBD420
00792                                                                   DESBD420
00793  S981F-READ.                                                      DESBD420
00794      SET L981-READ-88      TO TRUE.                               DESBD420
00795      PERFORM S981Z-WAGE-I  THRU S981Z-EXIT.                       DESBD420
00796                                                                   DESBD420
00797  S981F-EXIT.                                                      DESBD420
00798      EXIT.                                                        DESBD420
00799                                                                   DESBD420
00800  S981Z-WAGE-I.                                                    DESBD420
00801      CALL 'DTSBU981' USING L981-LINK-AREA                         DESBD420
00802                            WWGH-REC.                              DESBD420
00803  S981Z-EXIT.                                                      DESBD420
00804      EXIT.                                                        DESBD420
00805                                                                   DESBD420
00806  S1000-OPEN-TDEC-IN.                                              DESBD420
00807      OPEN INPUT TDEC-TRAN-IN.                                     DESBD420
00808      IF NOT TDEC-IN-OK-88                                         DESBD420
00809         DISPLAY 'CANNOT OPEN TDEC-TRAN-IN ' TDEC-IN-STATUS        DESBD420
00810         SET W-ERROR-YES-88    TO TRUE                             DESBD420
00811      END-IF.                                                      DESBD420
00812                                                                   DESBD420
00813  S1000-EXIT.                                                      DESBD420
00814      EXIT.                                                        DESBD420
00815                                                                   DESBD420
00816  S1010-READ-TDEC-IN.                                              DESBD420
00817                                                                   DESBD420
00818      READ TDEC-TRAN-IN.                                           DESBD420
00819      IF TDEC-IN-OK-88                                             DESBD420
00820         ADD +1                 TO W-TDEC-IN-CNT                   DESBD420
00821      ELSE                                                         DESBD420
00822         IF TDEC-IN-EOF-88                                         DESBD420
00823            DISPLAY 'EOF'                                          DESBD420
00824         ELSE                                                      DESBD420
00825            DISPLAY 'CANNOT READ TDEC INPUT ' TDEC-IN-STATUS       DESBD420
00826         END-IF                                                    DESBD420
00827      END-IF.                                                      DESBD420
00828                                                                   DESBD420
00829  S1010-EXIT.                                                      DESBD420
00830      EXIT.                                                        DESBD420
00831                                                                   DESBD420
00832  S1020-CLOSE-TDEC-IN.                                             DESBD420
00833      CLOSE TDEC-TRAN-IN.                                          DESBD420
00834                                                                   DESBD420
00835  S1020-EXIT.                                                      DESBD420
00836      EXIT.                                                        DESBD420
00837                                                                   DESBD420
00838  S1100-OPEN-TDEC-OUT.                                             DESBD420
00839      OPEN OUTPUT TDEC-TRAN-OUT                                    DESBD420
00840      IF NOT TDEC-OUT-OK-88                                        DESBD420
00841         DISPLAY 'CANNOT OPEN TDEC-TRAN-OUT ' TDEC-OUT-STATUS      DESBD420
00842         SET W-ERROR-YES-88    TO TRUE                             DESBD420
00843      END-IF.                                                      DESBD420
00844                                                                   DESBD420
00845  S1100-EXIT.                                                      DESBD420
00846      EXIT.                                                        DESBD420
00847                                                                   DESBD420
00848  S1120-WRITE-TDEC-OUT.                                            DESBD420
00849      WRITE TDEC-TRAN-OUT-REC     FROM TDEC-TRAN-IN-REC.           DESBD420
00850      IF NOT TDEC-OUT-OK-88                                        DESBD420
00851         DISPLAY 'CANNOT WRITE TDEC-TRAN-OUT ' TDEC-OUT-STATUS     DESBD420
00852         SET W-ERROR-YES-88    TO TRUE                             DESBD420
00853      ELSE                                                         DESBD420
00854         ADD +1                TO W-TDEC-OUT-CNT                   DESBD420
00855      END-IF.                                                      DESBD420
00856                                                                   DESBD420
00857  S1120-EXIT.                                                      DESBD420
00858      EXIT.                                                        DESBD420
00859                                                                   DESBD420
00860  S1130-CLOSE-TDEC-OUT.                                            DESBD420
00861      CLOSE TDEC-TRAN-OUT.                                         DESBD420
00862                                                                   DESBD420
00863  S1130-EXIT.                                                      DESBD420
00864      EXIT.                                                        DESBD420
00865  S999-ABEND.                                                      DESBD420
00866      CALL 'DTSBU999' USING WRK-ABEND-CD.                          DESBD420
00867  S999-EXIT.                                                       DESBD420
00868      EXIT.                                                        DESBD420
