00001  IDENTIFICATION DIVISION.                                         06/08/12
00002  PROGRAM-ID.             DTSBD555.                                DTSBD555
00003  AUTHOR.                 NGC.                                        LV005
00004  DATE-WRITTEN.           APRIL 2012.                              DTSBD555
00005  DATE-COMPILED.                                                   DTSBD555
00006      SKIP3                                                        DTSBD555
00007 *****                                                             DTSBD555
00008 *                                                                 DTSBD555
00009 *    FUNCTION:  PROCESS WAGE-ONLY FILES UPLOADED FROM SERVER.     DTSBD555
00010 *                                                                 DTSBD555
00011 *    MODIFICATION HISTORY:                                        DTSBD555
00012 *                                                                 DTSBD555
00013 *    04-05-2012 INITIAL DEVELOPMENT                               DTSBD555
00014 *               REFERENCE RFP:                                    DTSBD555
00015 *                                                                 DTSBD555
00016 *    05-24-2012 CORRECTED WAGE EDIT: CANCEL PROCESSING IF ERRORS  DTSBD555
00017 *               ARE FOUND.                                        DTSBD555
00018 *               REFERENCE RFP:                                    DTSBD555
00019 *                                                                 DTSBD555
00020 *                                                                 DTSBD555
00021 *                                                                 DTSBD555
00022 *****                                                             DTSBD555
00023      SKIP3                                                        DTSBD555
00024  ENVIRONMENT DIVISION.                                            DTSBD555
00025      SKIP2                                                        DTSBD555
00026  INPUT-OUTPUT SECTION.                                            DTSBD555
00027                                                                   DTSBD555
00028  FILE-CONTROL.                                                    DTSBD555
00029                                                                   DTSBD555
00030      SELECT REPORT-FILE-IN   ASSIGN TO DTSFRPIN                   DTSBD555
00031         FILE STATUS IS RPT-IN-STATUS.                             DTSBD555
00032                                                                   DTSBD555
00033      SELECT WAGE-FILE-IN     ASSIGN TO DTSFWGIN                   DTSBD555
00034         FILE STATUS IS WAGE-IN-STATUS.                            DTSBD555
00035                                                                   DTSBD555
00036      SELECT TEMP-BTC-FILE    ASSIGN TO BD555BTC                   DTSBD555
00037         FILE STATUS IS TEMP-BTC-STATUS.                           DTSBD555
00038                                                                   DTSBD555
00039      SELECT WAGE-FILE-TEMP ASSIGN TO WAGETEMP                     DTSBD555
00040         FILE STATUS IS WAGE-TEMP-STATUS.                          DTSBD555
00041                                                                   DTSBD555
00042      SELECT WAGE-FILE-OUT  ASSIGN TO WAGEOUT                      DTSBD555
00043         FILE STATUS IS WAGE-OUT-STATUS.                           DTSBD555
00044                                                                   DTSBD555
00045      SELECT CURR-BATCH-NO    ASSIGN TO CURRBTCH                   DTSBD555
00046         FILE STATUS IS BATCH-STATUS.                              DTSBD555
00047                                                                   DTSBD555
00048  DATA DIVISION.                                                   DTSBD555
00049                                                                   DTSBD555
00050  FILE SECTION.                                                    DTSBD555
00051  FD  REPORT-FILE-IN                                               DTSBD555
00052      RECORDING MODE IS F                                          DTSBD555
00053      BLOCK CONTAINS 0 RECORDS                                     DTSBD555
00054      LABEL RECORDS ARE OMITTED.                                   DTSBD555
00055                                                                   DTSBD555
00056  01  REPORT-IN-REC                 PIC X(134).                    DTSBD555
00057                                                                   DTSBD555
00058  FD  WAGE-FILE-IN                                                 DTSBD555
00059      RECORDING MODE IS F                                          DTSBD555
00060      BLOCK CONTAINS 0 RECORDS                                     DTSBD555
00061      LABEL RECORDS ARE OMITTED.                                   DTSBD555
00062                                                                   DTSBD555
00063  01  WAGE-IN-REC                   PIC X(128).                    DTSBD555
00064                                                                   DTSBD555
00065                                                                   DTSBD555
00066  FD  TEMP-BTC-FILE                                                DTSBD555
00067      RECORDING MODE IS V                                          DTSBD555
00068      BLOCK CONTAINS 0 RECORDS.                                    DTSBD555
00069                                                                   DTSBD555
00070  01  TEMP-BTC-REC.                                                DTSBD555
00071  ++INCLUDE DTSIRVAR                                               DTSBD555
00072                                                                   DTSBD555
00073  01  TSKL-REC.                                                    DTSBD555
00074  ++INCLUDE DTSITSKL                                               DTSBD555
00075                                                                   DTSBD555
00076  FD  WAGE-FILE-TEMP                                               DTSBD555
00077      RECORDING MODE IS F                                          DTSBD555
00078      BLOCK CONTAINS 0 RECORDS                                     DTSBD555
00079      LABEL RECORDS ARE OMITTED.                                   DTSBD555
00080                                                                   DTSBD555
00081  01  WAGE-TEMP-REC                 PIC X(128).                    DTSBD555
00082                                                                   DTSBD555
00083  FD  WAGE-FILE-OUT                                                DTSBD555
00084      RECORDING MODE IS F                                          DTSBD555
00085      BLOCK CONTAINS 0 RECORDS                                     DTSBD555
00086      LABEL RECORDS ARE OMITTED.                                   DTSBD555
00087                                                                   DTSBD555
00088  01  WAGE-OUT-REC                  PIC X(128).                    DTSBD555
00089                                                                   DTSBD555
00090  FD  CURR-BATCH-NO                                                DTSBD555
00091      RECORDING MODE IS F                                          DTSBD555
00092      BLOCK CONTAINS 0 RECORDS                                     DTSBD555
00093      LABEL RECORDS ARE OMITTED.                                   DTSBD555
00094                                                                   DTSBD555
00095  01  CURR-BATCH-NO-REC.                                           DTSBD555
00096      05  CURRENT-BATCH-NO              PIC 9(05).                 DTSBD555
00097      05  CURRENT-ITEM-NO               PIC 9(03).                 DTSBD555
00098      05  FILLER                        PIC X(01).                 DTSBD555
00099      05  CURRENT-ARCHIVE-YEAR          PIC 9(04).                 DTSBD555
00100      05  FILLER                        PIC X(01).                 DTSBD555
00101      05  FIRST-ARCHIVE-YEAR            PIC 9(04).                 DTSBD555
00102      05  FILLER                        PIC X(62).                 DTSBD555
00103                                                                   DTSBD555
00104  WORKING-STORAGE SECTION.                                         DTSBD555
001045 77  PAN-VALET PICTURE X(24) VALUE '005DTSBD555  06/08/12'.       DTSBD555
00105      SKIP3                                                        DTSBD555
00106  01  WRK-AREA.                                                    DTSBD555
00107      05  W-ABEND-CD                  PIC S9(04)  COMP  VALUE 555. DTSBD555
00108      05  W-MOD-NAME                  PIC  X(08)  VALUE 'DTSBD555'.DTSBD555
00109                                                                   DTSBD555
00110      05  RPT-IN-STATUS           PIC  X(02).                      DTSBD555
00111          88 RPT-IN-OK-88              VALUE '00'.                 DTSBD555
00112          88 RPT-IN-EOF-88             VALUE '10'.                 DTSBD555
00113                                                                   DTSBD555
00114      05  WAGE-IN-STATUS          PIC  X(02).                      DTSBD555
00115          88 WAGE-IN-OK-88             VALUE '00'.                 DTSBD555
00116          88 WAGE-IN-EOF-88            VALUE '10'.                 DTSBD555
00117                                                                   DTSBD555
00118      05  TEMP-BTC-STATUS         PIC  X(02).                      DTSBD555
00119          88 TEMP-BTC-STATUS-OK-88     VALUE '00'.                 DTSBD555
00120          88 TEMP-BTC-STATUS-EOF-88    VALUE '10'.                 DTSBD555
00121                                                                   DTSBD555
00122      05  WAGE-TEMP-STATUS        PIC  X(02).                      DTSBD555
00123          88 WAGE-TEMP-STATUS-OK-88    VALUE '00'.                 DTSBD555
00124          88 WAGE-TEMP-STATUS-EOF-88   VALUE '10'.                 DTSBD555
00125                                                                   DTSBD555
00126      05  WAGE-OUT-STATUS         PIC  X(02).                      DTSBD555
00127          88 WAGE-OUT-STATUS-OK-88     VALUE '00'.                 DTSBD555
00128                                                                   DTSBD555
00129      05  BATCH-XREF-STATUS       PIC  X(02).                      DTSBD555
00130          88 BATCH-XREF-OK-88          VALUE '00'.                 DTSBD555
00131                                                                   DTSBD555
00132      05  BATCH-STATUS            PIC  X(02).                      DTSBD555
00133          88 BATCH-STATUS-OK-88       VALUE '00'.                  DTSBD555
00134          88 BATCH-STATUS-EOF-88      VALUE '10'.                  DTSBD555
00135                                                                   DTSBD555
00136      05  VAR-CHAR-CNT             PIC S9(04) COMP.                DTSBD555
00137      05  SUB                      PIC S9(04) COMP.                DTSBD555
00138                                                                   DTSBD555
00139      05  W-ERROR-IND                 PIC  X(01) VALUE 'N'.        DTSBD555
00140          88 W-ERROR-YES-88            VALUE 'Y'.                  DTSBD555
00141          88 W-ERROR-NO-88             VALUE 'N'.                  DTSBD555
00142                                                                   DTSBD555
00143      05  W-FATAL-ERROR-IND           PIC  X(01) VALUE 'N'.        DTSBD555
00144          88 W-FATAL-ERROR-YES-88      VALUE 'Y'.                  DTSBD555
00145          88 W-FATAL-ERROR-NO-88       VALUE 'N'.                  DTSBD555
00146                                                                   DTSBD555
00147      05  W-EMP-ERROR-IND             PIC  X(01) VALUE 'N'.        DTSBD555
00148          88 W-EMP-ERROR-YES-88        VALUE 'Y'.                  DTSBD555
00149          88 W-EMP-ERROR-NO-88         VALUE 'N'.                  DTSBD555
00150                                                                   DTSBD555
00151      05  W-EMP-FOUND-IND             PIC  X(01) VALUE 'N'.        DTSBD555
00152          88 W-EMP-FOUND-YES-88        VALUE 'Y'.                  DTSBD555
00153          88 W-EMP-FOUND-NO-88         VALUE 'N'.                  DTSBD555
00154                                                                   DTSBD555
00155      05  W-SSN-ERROR-IND             PIC  X(01) VALUE 'N'.        DTSBD555
00156          88 W-SSN-ERROR-YES-88        VALUE 'Y'.                  DTSBD555
00157          88 W-SSN-ERROR-NO-88         VALUE 'N'.                  DTSBD555
00158                                                                   DTSBD555
00159      05  W-WAGE-COMPLETE-IND         PIC  X(01) VALUE 'N'.        DTSBD555
00160          88 W-WAGE-COMPLETE-YES-88    VALUE 'Y'.                  DTSBD555
00161          88 W-WAGE-COMPLETE-NO-88     VALUE 'N'.                  DTSBD555
00162                                                                   DTSBD555
00163      05  W-EMP-NO                PIC S9(07) COMP-3.               DTSBD555
00164      05  W-EMP-NO-9              PIC  9(06).                      DTSBD555
00165      05  W-EMP-NO-X REDEFINES W-EMP-NO-9                          DTSBD555
00166                                  PIC  X(06).                      DTSBD555
00167      05  W-SSN                   PIC S9(09) COMP-3.               DTSBD555
00168      05  W-SSN-9                 PIC  9(09).                      DTSBD555
00169      05  W-SSN-X    REDEFINES W-SSN-9                             DTSBD555
00170                                  PIC  X(09).                      DTSBD555
00171      05  W-REMIT-AMT             PIC S9(09)V99 COMP-3 VALUE +0.   DTSBD555
00172      05  W-REPORT-QTR            PIC S9(05) COMP-3.               DTSBD555
00173      05  W-TOT-WAGE              PIC S9(11)V99 VALUE +0.          DTSBD555
00174      05  W-TAX-WAGE              PIC S9(11)V99.                   DTSBD555
00175      05  W-REMITTANCE            PIC S9(09)V99.                   DTSBD555
00176      05  W-RECEIVED-DATE         PIC S9(09) COMP-3.               DTSBD555
00177      05  W-ENTERED-DATE          PIC S9(09) COMP-3.               DTSBD555
00178      05  W-DEPOSIT-DATE          PIC S9(09) COMP-3.               DTSBD555
00179      05  W-1ST-MNTH-CNT          PIC S9(07) COMP-3.               DTSBD555
00180      05  W-2ND-MNTH-CNT          PIC S9(07) COMP-3.               DTSBD555
00181      05  W-3RD-MNTH-CNT          PIC S9(07) COMP-3.               DTSBD555
00182      05  W-LOG-NO                PIC S9(09) COMP-3.               DTSBD555
00183      05  W-EARNINGS              PIC S9(09)V99 COMP-3.            DTSBD555
00184      05  W-WORKER-TAX-WAGE       PIC S9(09)V99 COMP-3.            DTSBD555
00185      05  W-WORKER-NAME.                                           DTSBD555
00186          10  W-WRKR-FIRST-NAME   PIC  X(15).                      DTSBD555
00187          10  W-WRKR-MID-INIT     PIC  X(01).                      DTSBD555
00188          10  W-WRKR-LAST-NAME    PIC  X(20).                      DTSBD555
00189                                                                   DTSBD555
00190      05  W-INTEGER               PIC  S9(11) COMP-3.              DTSBD555
00191      05  W-FRACTION              PIC  SV9(11) COMP-3.             DTSBD555
00192      05  W-NUMBER                PIC  S9(11)V9(05) COMP-3.        DTSBD555
00193                                                                   DTSBD555
00194      05  W-PSEUDO-BATCH-NO           PIC  9(05) VALUE ZERO.       DTSBD555
00195                                                                   DTSBD555
00196      05  W-START-BATCH               PIC  9(05) VALUE ZERO.       DTSBD555
00197      05  W-END-BATCH                 PIC  9(05) VALUE ZERO.       DTSBD555
00198                                                                   DTSBD555
00199      05  W-PSEUDO-ITEM-NO            PIC  9(03)  VALUE 0.         DTSBD555
00200                                                                   DTSBD555
00201      05  W-SEQ-NO                    PIC  9(07)  VALUE 0.         DTSBD555
00202                                                                   DTSBD555
00203      05  W-MNTE-SUBJECT          PIC  X(40).                      DTSBD555
00204          88  W-MNTE-NOT-LIAB-88   VALUE                           DTSBD555
00205          'REASON FOR NOT-LIABLE DETERMINATION     '.              DTSBD555
00206          88  W-MNTE-KEY-WORD-88   VALUE                           DTSBD555
00207          'FR-500 INDUSTRY DESCRIPTION - KEY WORD  '.              DTSBD555
00208          88  W-MNTE-DATA-ENTRY-88 VALUE                           DTSBD555
00209          'FR-500 INDUSTRY DESCRIPTION - DATA ENTRY'.              DTSBD555
00210          88  W-MNTE-RELATIONSHIP-88 VALUE                         DTSBD555
00211          'WEB REGISTRATION RELATED EMPLOYER       '.              DTSBD555
00212                                                                   DTSBD555
00213      05  W-MNTE-COMPLETE-IND         PIC  X(01) VALUE 'N'.        DTSBD555
00214          88 W-MNTE-COMPLETE-YES-88    VALUE 'Y'.                  DTSBD555
00215          88 W-MNTE-COMPLETE-NO-88     VALUE 'N'.                  DTSBD555
00216                                                                   DTSBD555
00217      05  TSUB1                   PIC S9(04) COMP.                 DTSBD555
00218      05  TSUB2                   PIC S9(04) COMP.                 DTSBD555
00219      05  W-LAST-SPACE            PIC S9(04) COMP.                 DTSBD555
00220                                                                   DTSBD555
00221      05  W-MNTE-LINE             PIC  X(72).                      DTSBD555
00222                                                                   DTSBD555
00223      05  W-SLASH-DATE            PIC  X(10).                      DTSBD555
00224      05  FILLER REDEFINES W-SLASH-DATE.                           DTSBD555
00225          10  W-SLASH-DT-MM       PIC  X(02).                      DTSBD555
00226          10  FILLER              PIC  X(01).                      DTSBD555
00227          10  W-SLASH-DT-DD       PIC  X(02).                      DTSBD555
00228          10  FILLER              PIC  X(01).                      DTSBD555
00229          10  W-SLASH-DT-CCYY     PIC  X(04).                      DTSBD555
00230                                                                   DTSBD555
00231      05  W-SLASH-QTR             PIC  X(06).                      DTSBD555
00232      05  FILLER REDEFINES W-SLASH-QTR.                            DTSBD555
00233          10  W-SLASH-QTR-CCYY    PIC  X(04).                      DTSBD555
00234          10  FILLER              PIC  X(01).                      DTSBD555
00235          10  W-SLASH-QTR-Q       PIC  X(01).                      DTSBD555
00236                                                                   DTSBD555
00237      05  W-TEMP-WAGE-CNT         PIC S9(07)  COMP-3 VALUE +0.     DTSBD555
00238      05  W-TEMP-T028-CNT         PIC S9(07)  COMP-3 VALUE +0.     DTSBD555
00239 *  REPORT                                                         DTSBD555
00240      05  W-RPT-IN-CNT            PIC S9(07)  COMP-3 VALUE +0.     DTSBD555
00241 *  EMPLOYEE WAGES                                                 DTSBD555
00242      05  W-WAGE-IN-CNT           PIC S9(07)  COMP-3 VALUE +0.     DTSBD555
00243                                                                   DTSBD555
00244      05  W-T028-WRITE-CNT        PIC S9(07)  COMP-3 VALUE +0.     DTSBD555
00245      05  W-WAGE-OUT-CNT          PIC S9(07)  COMP-3 VALUE +0.     DTSBD555
00246                                                                   DTSBD555
00247      05  W-X140-LENGTH           PIC S9(04)  COMP.                DTSBD555
00248                                                                   DTSBD555
00249      05  W-AMT-DISP1             PIC ----------9.99.              DTSBD555
00250      05  W-AMT-DISP2             PIC ----------9.99.              DTSBD555
00251                                                                   DTSBD555
00252      05  WRK-R140-CNT            PIC S9(07) COMP-3 VALUE +0.      DTSBD555
00253      05  DISPLAY-CNT             PIC  Z(06)9.                     DTSBD555
00254      05  WRK-MPRF-EMP-NO         PIC  9(06).                      DTSBD555
00255                                                                   DTSBD555
00256  01  MESSAGE-AREA.                                                DTSBD555
00257 *** FATAL ERRORS MSG-A                                            DTSBD555
00258      05  MSG-A1.                                                  DTSBD555
00259          10  FILLER                            PIC X(32)          DTSBD555
00260              VALUE 'TYPE A REC NOT FIRST IN FILE: '.              DTSBD555
00261          10  MSG-A1-PREV-REC-TYPE              PIC X(01).         DTSBD555
00262                                                                   DTSBD555
00263  01  T003-REC.                                                    DTSBD555
00264  ++INCLUDE DTSIT003                                               DTSBD555
00265                                                                   DTSBD555
00266  01  T025-REC.                                                    DTSBD555
00267  ++INCLUDE DTSIT025                                               DTSBD555
00268                                                                   DTSBD555
00269  01  T028-REC.                                                    DTSBD555
00270  ++INCLUDE DTSIT028                                               DTSBD555
00271                                                                   DTSBD555
00272  01  W001-REC.                                                    DTSBD555
00273  ++INCLUDE DTSIW001                                               DTSBD555
00274                                                                   DTSBD555
00275 *  REPORT                                                         DTSBD555
00276  01  X157-REC.                                                    DTSBD555
00277  ++INCLUDE DTSIX157                                               DTSBD555
00278                                                                   DTSBD555
00279 *  EMPLOYEE WAGES                                                 DTSBD555
00280  01  X144-REC.                                                    DTSBD555
00281  ++INCLUDE DTSIX144                                               DTSBD555
00282                                                                   DTSBD555
00283 *  PARSE CSV FILE                                                 DTSBD555
00284  01  L205-LINK-AREA.                                              DTSBD555
00285  ++INCLUDE DTSIL205                                               DTSBD555
00286                                                                   DTSBD555
00287 *  BATCH - PSEUDO-BATCH XREF                                      DTSBD555
00288  01  X214-REC.                                                    DTSBD555
00289  ++INCLUDE DTSIX214                                               DTSBD555
00290                                                                   DTSBD555
00291 *  ERRORS                                                         DTSBD555
00292 *01  X907-REC.                                                    DTSBD555
00293 ***INCLUDE DTSIX907                                               DTSBD555
00294                                                                   DTSBD555
00295  01  L001-LINK-AREA.                                              DTSBD555
00296  ++INCLUDE DTSIL001                                               DTSBD555
00297                                                                   DTSBD555
00298  01  L003-LINK-AREA.                                              DTSBD555
00299  ++INCLUDE DTSIL003                                               DTSBD555
00300                                                                   DTSBD555
00301  01  L004-LINK-AREA.                                              DTSBD555
00302  ++INCLUDE DTSIL004                                               DTSBD555
00303                                                                   DTSBD555
00304  01  L005-LINK-AREA.                                              DTSBD555
00305  ++INCLUDE DTSIL005                                               DTSBD555
00306                                                                   DTSBD555
00307  01  L032-LINK-AREA.                                              DTSBD555
00308  ++INCLUDE DTSIL032                                               DTSBD555
00309                                                                   DTSBD555
00310  01  L516-LINK-AREA.                                              DTSBD555
00311  ++INCLUDE DTSIL516                                               DTSBD555
00312                                                                   DTSBD555
00313  01  L910-LINK-AREA.                                              DTSBD555
00314  ++INCLUDE DTSIL910                                               DTSBD555
00315  01  MSKL-REC.                                                    DTSBD555
00316  ++INCLUDE DTSIMSKL                                               DTSBD555
00317                                                                   DTSBD555
00318  01  MHDR-REC.                                                    DTSBD555
00319  ++INCLUDE DTSIMHDR                                               DTSBD555
00320                                                                   DTSBD555
00321  01  MPRF-REC.                                                    DTSBD555
00322  ++INCLUDE DTSIMPRF                                               DTSBD555
00323                                                                   DTSBD555
00324  01  MSOL-REC.                                                    DTSBD555
00325  ++INCLUDE DTSIMSOL                                               DTSBD555
00326                                                                   DTSBD555
00327  01  MQTR-REC.                                                    DTSBD555
00328  ++INCLUDE DTSIMQTR                                               DTSBD555
00329                                                                   DTSBD555
00330  01  MRPT-REC.                                                    DTSBD555
00331  ++INCLUDE DTSIMRPT                                               DTSBD555
00332                                                                   DTSBD555
00333  01  MTAD-REC.                                                    DTSBD555
00334  ++INCLUDE DTSIMTAD                                               DTSBD555
00335                                                                   DTSBD555
00336  01  MNTE-REC.                                                    DTSBD555
00337  ++INCLUDE DTSIMNTE                                               DTSBD555
00338                                                                   DTSBD555
00339  01  L921-LINK-AREA.                                              DTSBD555
00340  ++INCLUDE DTSIL921                                               DTSBD555
00341      SKIP3                                                        DTSBD555
00342  01  ISKL-REC.                                                    DTSBD555
00343  ++INCLUDE DTSIISKL                                               DTSBD555
00344      SKIP3                                                        DTSBD555
00345  01  IEIN-REC.                                                    DTSBD555
00346  ++INCLUDE DTSIIEIN                                               DTSBD555
00347                                                                   DTSBD555
00348  01  L923-LINK-AREA.                                              DTSBD555
00349  ++INCLUDE DTSIL923                                               DTSBD555
00350      EJECT                                                        DTSBD555
00351  01  ASKL-REC.                                                    DTSBD555
00352  ++INCLUDE DTSIASKL                                               DTSBD555
00353      EJECT                                                        DTSBD555
00354  01  AHDR-REC.                                                    DTSBD555
00355  ++INCLUDE DTSIAHDR                                               DTSBD555
00356      EJECT                                                        DTSBD555
00357  01  ARPT-REC.                                                    DTSBD555
00358  ++INCLUDE DTSIARPT                                               DTSBD555
00359      EJECT                                                        DTSBD555
00360  01  APAY-REC.                                                    DTSBD555
00361  ++INCLUDE DTSIAPAY                                               DTSBD555
00362                                                                   DTSBD555
00363  01  L927-LINK-AREA.                                              DTSBD555
00364  ++INCLUDE DTSIL927                                               DTSBD555
00365                                                                   DTSBD555
00366  01  L931-LINK-AREA.                                              DTSBD555
00367  ++INCLUDE DTSIL931                                               DTSBD555
00368                                                                   DTSBD555
00369  01  FSKL-REC.                                                    DTSBD555
00370  ++INCLUDE DTSIFSKL                                               DTSBD555
00371                                                                   DTSBD555
00372  01  R140-REC.                                                    DTSBD555
00373  ++INCLUDE DTSIR140                                               DTSBD555
00374                                                                   DTSBD555
00375  PROCEDURE DIVISION.                                              DTSBD555
00376                                                                   DTSBD555
00377  DTSBX422-MAIN.                                                   DTSBD555
00378         PERFORM I0000-INITIATE        THRU I0000-EXIT.            DTSBD555
00379                                                                   DTSBD555
00380         PERFORM P0000-PROCESS         THRU P0000-EXIT.            DTSBD555
00381                                                                   DTSBD555
00382         PERFORM T0000-TERMINATE       THRU T0000-EXIT.            DTSBD555
00383                                                                   DTSBD555
00384                                                                   DTSBD555
00385  DTSBX422-MAIN-EXIT.                                              DTSBD555
00386      GOBACK.                                                      DTSBD555
00387                                                                   DTSBD555
00388  I0000-INITIATE.                                                  DTSBD555
00389      SET W-ERROR-NO-88                 TO TRUE.                   DTSBD555
00390      SET W-FATAL-ERROR-NO-88           TO TRUE.                   DTSBD555
00391                                                                   DTSBD555
00392 *    FOR VARIABLE REPORT FILE.                                    DTSBD555
00393      MOVE LENGTH OF R140-REC           TO R140-LENGTH.            DTSBD555
00394      MOVE '140'                        TO R140-REC-TYPE.          DTSBD555
00395                                                                   DTSBD555
00396      PERFORM S005-FROM-SYS             THRU S005-EXIT.            DTSBD555
00397                                                                   DTSBD555
00398      PERFORM I2000-OPEN-FILES          THRU I2000-EXIT            DTSBD555
00399      IF W-FATAL-ERROR-YES-88                                      DTSBD555
00400         GO TO I0000-EXIT                                          DTSBD555
00401      END-IF.                                                      DTSBD555
00402                                                                   DTSBD555
00403  I0000-EXIT.                                                      DTSBD555
00404      EXIT.                                                        DTSBD555
00405                                                                   DTSBD555
00406  I2000-OPEN-FILES.                                                DTSBD555
00407      PERFORM S1000-OPEN-REPORT-IN    THRU S1000-EXIT.             DTSBD555
00408      IF W-FATAL-ERROR-YES-88                                      DTSBD555
00409         GO TO I2000-EXIT                                          DTSBD555
00410      END-IF.                                                      DTSBD555
00411                                                                   DTSBD555
00412      PERFORM S1020-OPEN-WAGE-IN      THRU S1020-EXIT.             DTSBD555
00413      IF W-FATAL-ERROR-YES-88                                      DTSBD555
00414         GO TO I2000-EXIT                                          DTSBD555
00415      END-IF.                                                      DTSBD555
00416                                                                   DTSBD555
00417      PERFORM S1040-OPEN-TEMP-BTC-OUT THRU S1040-EXIT.             DTSBD555
00418      IF W-FATAL-ERROR-YES-88                                      DTSBD555
00419         GO TO I2000-EXIT                                          DTSBD555
00420      END-IF.                                                      DTSBD555
00421                                                                   DTSBD555
00422      PERFORM S1100-OPEN-WAGE-TEMP-OUT THRU S1100-EXIT.            DTSBD555
00423      IF W-FATAL-ERROR-YES-88                                      DTSBD555
00424         GO TO I2000-EXIT                                          DTSBD555
00425      END-IF.                                                      DTSBD555
00426                                                                   DTSBD555
00427      OPEN I-O      CURR-BATCH-NO.                                 DTSBD555
00428      IF BATCH-STATUS-OK-88                                        DTSBD555
00429         READ CURR-BATCH-NO                                        DTSBD555
00430         IF BATCH-STATUS-OK-88                                     DTSBD555
00431            COMPUTE W-PSEUDO-BATCH-NO = (CURRENT-BATCH-NO + 1)     DTSBD555
00432            MOVE W-PSEUDO-BATCH-NO       TO W-START-BATCH          DTSBD555
00433            MOVE ZERO                    TO W-PSEUDO-ITEM-NO       DTSBD555
00434            DISPLAY 'CURRENT BATCH '        W-PSEUDO-BATCH-NO      DTSBD555
00435            DISPLAY 'CURRENT ITEM  '        W-PSEUDO-ITEM-NO       DTSBD555
00436         ELSE                                                      DTSBD555
00437            SET W-ERROR-YES-88           TO TRUE                   DTSBD555
00438            DISPLAY 'CANNOT OPEN CURR BATCH NUMBER FILE '          DTSBD555
00439               BATCH-STATUS                                        DTSBD555
00440            GO TO I2000-EXIT                                       DTSBD555
00441         END-IF                                                    DTSBD555
00442      ELSE                                                         DTSBD555
00443         SET W-ERROR-YES-88              TO TRUE                   DTSBD555
00444         DISPLAY 'CANNOT OPEN CURR BATCH NUMBER FILE '             DTSBD555
00445            BATCH-STATUS                                           DTSBD555
00446         GO TO I2000-EXIT                                          DTSBD555
00447      END-IF.                                                      DTSBD555
00448                                                                   DTSBD555
00449      PERFORM S910-OPEN-READ            THRU S910-EXIT.            DTSBD555
00450      PERFORM S931-OPEN-READ            THRU S931-EXIT.            DTSBD555
00451                                                                   DTSBD555
00452  I2000-EXIT.                                                      DTSBD555
00453      EXIT.                                                        DTSBD555
00454                                                                   DTSBD555
00455  P0000-PROCESS.                                                   DTSBD555
00456      PERFORM S1005-READ-REPORT-IN      THRU S1005-EXIT.           DTSBD555
00457      PERFORM S1025-READ-WAGE-IN        THRU S1025-EXIT.           DTSBD555
00458                                                                   DTSBD555
00459      DISPLAY 'FIRST READ'                                         DTSBD555
00460      DISPLAY '   RPT: ' REPORT-IN-REC (1:30).                     DTSBD555
00461      DISPLAY '   WAGE: ' WAGE-IN-REC (1:30).                      DTSBD555
00462                                                                   DTSBD555
00463      PERFORM  UNTIL RPT-IN-EOF-88 OR W-ERROR-YES-88               DTSBD555
00464         PERFORM P1000-REPORT           THRU P1000-EXIT            DTSBD555
00465         PERFORM P2000-WAGE             THRU P2000-EXIT            DTSBD555
00466         PERFORM S1005-READ-REPORT-IN   THRU S1005-EXIT            DTSBD555
00467      END-PERFORM.                                                 DTSBD555
00468                                                                   DTSBD555
00469  P0000-EXIT.                                                      DTSBD555
00470      EXIT.                                                        DTSBD555
00471                                                                   DTSBD555
00472  P1000-REPORT.                                                    DTSBD555
00473      MOVE ZERO                         TO W-TOT-WAGE              DTSBD555
00474                                           W-TAX-WAGE              DTSBD555
00475                                           W-REMITTANCE.           DTSBD555
00476                                                                   DTSBD555
00477      PERFORM P1100-PARSE-REPORT        THRU P1100-EXIT.           DTSBD555
00478      IF W-ERROR-NO-88                                             DTSBD555
00479         PERFORM P1200-EDIT-REPORT      THRU P1200-EXIT            DTSBD555
00480         IF W-ERROR-NO-88                                          DTSBD555
00481            PERFORM P1300-SAVE-REPORT   THRU P1300-EXIT            DTSBD555
00482         END-IF                                                    DTSBD555
00483      END-IF.                                                      DTSBD555
00484                                                                   DTSBD555
00485  P1000-EXIT.                                                      DTSBD555
00486      EXIT.                                                        DTSBD555
00487                                                                   DTSBD555
00488  P1100-PARSE-REPORT.                                              DTSBD555
00489      PERFORM P1110-PARSE           THRU P1110-EXIT.               DTSBD555
00490      IF W-ERROR-NO-88                                             DTSBD555
00491         PERFORM P1120-SAVE-DATA    THRU P1120-EXIT                DTSBD555
00492      END-IF.                                                      DTSBD555
00493                                                                   DTSBD555
00494  P1100-EXIT.                                                      DTSBD555
00495      EXIT.                                                        DTSBD555
00496                                                                   DTSBD555
00497  P1110-PARSE.                                                     DTSBD555
00498      PERFORM                                                      DTSBD555
00499        VARYING SUB FROM +1 BY +1                                  DTSBD555
00500        UNTIL SUB > +100                                           DTSBD555
00501        MOVE +0                  TO L205-FIELD-LENGTH (SUB)        DTSBD555
00502                                    L205-INTEGER (SUB)             DTSBD555
00503                                    L205-FRACTION (SUB)            DTSBD555
00504        MOVE SPACES              TO L205-TEXT (SUB)                DTSBD555
00505                                    L205-DATE (SUB)                DTSBD555
00506        SET L205-TYPE-TEXT-88 (SUB)  TO TRUE                       DTSBD555
00507      END-PERFORM.                                                 DTSBD555
00508                                                                   DTSBD555
00509      INITIALIZE X157-REC.                                         DTSBD555
00510      MOVE +17                      TO L205-LAST-FIELD.            DTSBD555
00511      MOVE +10                      TO L205-LAST-FIELD-LEN.        DTSBD555
00512                                                                   DTSBD555
00513 ** RECORD TYPE                                                    DTSBD555
00514      MOVE +3                       TO L205-FIELD-LENGTH (1).      DTSBD555
00515      SET L205-TYPE-TEXT-88 (1)     TO TRUE.                       DTSBD555
00516                                                                   DTSBD555
00517 *** EMPLOYER NUMBER                                               DTSBD555
00518       MOVE +6                       TO L205-FIELD-LENGTH (2).     DTSBD555
00519       SET L205-TYPE-TEXT-88 (2)     TO TRUE.                      DTSBD555
00520                                                                   DTSBD555
00521 *** QUARTER                                                       DTSBD555
00522       MOVE +6                       TO L205-FIELD-LENGTH (3).     DTSBD555
00523       SET L205-TYPE-TEXT-88 (3)     TO TRUE.                      DTSBD555
00524                                                                   DTSBD555
00525 ** RECEIVED DATE                                                  DTSBD555
00526      MOVE +10                      TO L205-FIELD-LENGTH (4).      DTSBD555
00527      SET L205-TYPE-DATE-88 (4)     TO TRUE.                       DTSBD555
00528                                                                   DTSBD555
00529 *** SOURCE                                                        DTSBD555
00530       MOVE +1                       TO L205-FIELD-LENGTH (5).     DTSBD555
00531       SET L205-TYPE-TEXT-88 (5)     TO TRUE.                      DTSBD555
00532                                                                   DTSBD555
00533 ** REPORT TYPE                                                    DTSBD555
00534      MOVE +2                       TO L205-FIELD-LENGTH (6).      DTSBD555
00535      SET L205-TYPE-TEXT-88 (6)     TO TRUE.                       DTSBD555
00536                                                                   DTSBD555
00537 *** TOTAL WAGES                                                   DTSBD555
00538       MOVE +14                      TO L205-FIELD-LENGTH (7).     DTSBD555
00539       SET L205-TYPE-NUMBER-88 (7)   TO TRUE.                      DTSBD555
00540                                                                   DTSBD555
00541 *** TAX WAGES                                                     DTSBD555
00542       MOVE +14                      TO L205-FIELD-LENGTH (8).     DTSBD555
00543       SET L205-TYPE-NUMBER-88 (8)   TO TRUE.                      DTSBD555
00544                                                                   DTSBD555
00545 *** REMITTANCE                                                    DTSBD555
00546       MOVE +12                      TO L205-FIELD-LENGTH (9).     DTSBD555
00547       SET L205-TYPE-NUMBER-88 (9)   TO TRUE.                      DTSBD555
00548                                                                   DTSBD555
00549 *** WORKER COUNT 1                                                DTSBD555
00550       MOVE +7                       TO L205-FIELD-LENGTH (10).    DTSBD555
00551       SET L205-TYPE-NUMBER-88 (10)  TO TRUE.                      DTSBD555
00552                                                                   DTSBD555
00553 *** WORKER COUNT 2                                                DTSBD555
00554       MOVE +7                       TO L205-FIELD-LENGTH (11).    DTSBD555
00555       SET L205-TYPE-NUMBER-88 (11)  TO TRUE.                      DTSBD555
00556                                                                   DTSBD555
00557 *** WORKER COUNT 3                                                DTSBD555
00558       MOVE +7                       TO L205-FIELD-LENGTH (12).    DTSBD555
00559       SET L205-TYPE-NUMBER-88 (12)  TO TRUE.                      DTSBD555
00560                                                                   DTSBD555
00561 *** WAIVE INTEREST                                                DTSBD555
00562       MOVE +1                       TO L205-FIELD-LENGTH (13).    DTSBD555
00563       SET L205-TYPE-TEXT-88 (13)    TO TRUE.                      DTSBD555
00564                                                                   DTSBD555
00565 *** WAIVE PENALTY                                                 DTSBD555
00566       MOVE +1                       TO L205-FIELD-LENGTH (14).    DTSBD555
00567       SET L205-TYPE-TEXT-88 (14)    TO TRUE.                      DTSBD555
00568                                                                   DTSBD555
00569 *** MF OPID                                                       DTSBD555
00570       MOVE +8                       TO L205-FIELD-LENGTH (15).    DTSBD555
00571       SET L205-TYPE-TEXT-88 (15)    TO TRUE.                      DTSBD555
00572                                                                   DTSBD555
00573 *** LOG NUMBER                                                    DTSBD555
00574       MOVE +9                       TO L205-FIELD-LENGTH (16).    DTSBD555
00575       SET L205-TYPE-NUMBER-88 (16)  TO TRUE.                      DTSBD555
00576                                                                   DTSBD555
00577 ** ENTERED DATE                                                   DTSBD555
00578      MOVE +10                      TO L205-FIELD-LENGTH (17).     DTSBD555
00579      SET L205-TYPE-DATE-88 (17)    TO TRUE.                       DTSBD555
00580                                                                   DTSBD555
00581      MOVE REPORT-IN-REC            TO L205-INPUT-DATA.            DTSBD555
00582      CALL 'DTSBU205'               USING L205-LINK-AREA.          DTSBD555
00583                                                                   DTSBD555
00584      IF L205-VALID-NO-88 (7)                                      DTSBD555
00585         DISPLAY 'P1100 INVALID TOT WAGE: ' X157-TOTAL-WAGES       DTSBD555
00586         SET W-ERROR-YES-88          TO TRUE                       DTSBD555
00587      END-IF.                                                      DTSBD555
00588                                                                   DTSBD555
00589      IF L205-VALID-NO-88 (8)                                      DTSBD555
00590         DISPLAY 'P1100 INVALID TAX WAGE: ' X157-TAX-WAGES         DTSBD555
00591         SET W-ERROR-YES-88          TO TRUE                       DTSBD555
00592      END-IF.                                                      DTSBD555
00593                                                                   DTSBD555
00594      IF L205-VALID-NO-88 (9)                                      DTSBD555
00595         DISPLAY 'P1100 INVALID REMIT: ' X157-REMITTANCE           DTSBD555
00596         SET W-ERROR-YES-88          TO TRUE                       DTSBD555
00597      END-IF.                                                      DTSBD555
00598                                                                   DTSBD555
00599      IF L205-VALID-NO-88 (10)                                     DTSBD555
00600         DISPLAY 'P1100 INVALID WRKR CNT 1: '                      DTSBD555
00601            X157-WRKR-CNT-1ST-MNTH                                 DTSBD555
00602         SET W-ERROR-YES-88          TO TRUE                       DTSBD555
00603      END-IF.                                                      DTSBD555
00604                                                                   DTSBD555
00605      IF L205-VALID-NO-88 (11)                                     DTSBD555
00606         DISPLAY 'P1100 INVALID WRKR CNT 2: '                      DTSBD555
00607            X157-WRKR-CNT-2ND-MNTH                                 DTSBD555
00608         SET W-ERROR-YES-88          TO TRUE                       DTSBD555
00609      END-IF.                                                      DTSBD555
00610                                                                   DTSBD555
00611      IF L205-VALID-NO-88 (12)                                     DTSBD555
00612         DISPLAY 'P1100 INVALID WRKR CNT 3: '                      DTSBD555
00613            X157-WRKR-CNT-3RD-MNTH                                 DTSBD555
00614         SET W-ERROR-YES-88          TO TRUE                       DTSBD555
00615      END-IF.                                                      DTSBD555
00616                                                                   DTSBD555
00617      IF L205-VALID-NO-88 (16)                                     DTSBD555
00618         DISPLAY 'P1100 INVALID LOG NBR: '                         DTSBD555
00619            X157-LOG-NO                                            DTSBD555
00620         SET W-ERROR-YES-88          TO TRUE                       DTSBD555
00621      END-IF.                                                      DTSBD555
00622                                                                   DTSBD555
00623  P1110-EXIT.                                                      DTSBD555
00624      EXIT.                                                        DTSBD555
00625                                                                   DTSBD555
00626  P1120-SAVE-DATA.                                                 DTSBD555
00627      MOVE L205-TEXT (2) (1:06)      TO X157-EMP-NO.               DTSBD555
00628                                                                   DTSBD555
00629      MOVE L205-TEXT (3) (1:06)      TO X157-QUARTER.              DTSBD555
00630                                                                   DTSBD555
00631      MOVE L205-DATE (4)             TO X157-RECEIVED-DATE.        DTSBD555
00632                                                                   DTSBD555
00633      MOVE L205-TEXT (5) (1:01)      TO X157-SOURCE.               DTSBD555
00634                                                                   DTSBD555
00635      MOVE L205-TEXT (6) (1:02)      TO X157-REPORT-TYPE.          DTSBD555
00636                                                                   DTSBD555
00637      MOVE L205-INTEGER (7)          TO W-INTEGER.                 DTSBD555
00638      MOVE L205-FRACTION (7)         TO W-FRACTION.                DTSBD555
00639      COMPUTE W-NUMBER = W-INTEGER + W-FRACTION.                   DTSBD555
00640      MOVE W-NUMBER                  TO W-TOT-WAGE.                DTSBD555
00641                                                                   DTSBD555
00642      MOVE L205-INTEGER (8)          TO W-INTEGER.                 DTSBD555
00643      MOVE L205-FRACTION (8)         TO W-FRACTION.                DTSBD555
00644      COMPUTE W-NUMBER = W-INTEGER + W-FRACTION.                   DTSBD555
00645      MOVE W-NUMBER                  TO W-TAX-WAGE.                DTSBD555
00646                                                                   DTSBD555
00647      MOVE L205-INTEGER (9)          TO W-INTEGER.                 DTSBD555
00648      MOVE L205-FRACTION (9)         TO W-FRACTION.                DTSBD555
00649      COMPUTE W-NUMBER = W-INTEGER + W-FRACTION.                   DTSBD555
00650      MOVE W-NUMBER                  TO W-REMITTANCE.              DTSBD555
00651                                                                   DTSBD555
00652      MOVE L205-INTEGER (10)         TO W-INTEGER.                 DTSBD555
00653      MOVE W-INTEGER                 TO W-1ST-MNTH-CNT.            DTSBD555
00654                                                                   DTSBD555
00655      MOVE L205-INTEGER (11)         TO W-INTEGER.                 DTSBD555
00656      MOVE W-INTEGER                 TO W-2ND-MNTH-CNT.            DTSBD555
00657                                                                   DTSBD555
00658      MOVE L205-INTEGER (12)         TO W-INTEGER.                 DTSBD555
00659      MOVE W-INTEGER                 TO W-3RD-MNTH-CNT.            DTSBD555
00660                                                                   DTSBD555
00661      MOVE L205-TEXT (13) (1:01)     TO X157-WAIVE-INTEREST.       DTSBD555
00662                                                                   DTSBD555
00663      MOVE L205-TEXT (14) (1:01)     TO X157-WAIVE-PENALTY.        DTSBD555
00664                                                                   DTSBD555
00665      MOVE L205-TEXT (15) (1:08)     TO X157-MF-OPID.              DTSBD555
00666                                                                   DTSBD555
00667      MOVE L205-INTEGER (16)         TO W-INTEGER.                 DTSBD555
00668      MOVE W-INTEGER                 TO W-LOG-NO.                  DTSBD555
00669                                                                   DTSBD555
00670      MOVE L205-DATE (17)            TO X157-ENTERED-DATE.         DTSBD555
00671                                                                   DTSBD555
00672  P1120-EXIT.                                                      DTSBD555
00673      EXIT.                                                        DTSBD555
00674                                                                   DTSBD555
00675  P1200-EDIT-REPORT.                                               DTSBD555
00676      PERFORM P1210-EDIT-DATA           THRU P1210-EXIT.           DTSBD555
00677      IF W-ERROR-NO-88                                             DTSBD555
00678         PERFORM P1220-CHECK-DATABASE   THRU P1220-EXIT            DTSBD555
00679      END-IF.                                                      DTSBD555
00680                                                                   DTSBD555
00681 *&                                                                DTSBD555
00682      DISPLAY 'P1210: ' W-EMP-NO '  ' W-TOT-WAGE                   DTSBD555
00683         '  ' W-TAX-WAGE '  ' W-LOG-NO.                            DTSBD555
00684      DISPLAY SPACE.                                               DTSBD555
00685 *&                                                                DTSBD555
00686                                                                   DTSBD555
00687  P1200-EXIT.                                                      DTSBD555
00688      EXIT.                                                        DTSBD555
00689                                                                   DTSBD555
00690  P1210-EDIT-DATA.                                                 DTSBD555
00691      MOVE X157-EMP-NO               TO W-EMP-NO-9.                DTSBD555
00692      SET W-EMP-ERROR-NO-88          TO TRUE.                      DTSBD555
00693      PERFORM                                                      DTSBD555
00694        VARYING SUB FROM +1 BY +1                                  DTSBD555
00695        UNTIL SUB > +6                                             DTSBD555
00696          IF W-EMP-NO-X (SUB:1) < '0' OR > '9'                     DTSBD555
00697             SET W-ERROR-YES-88      TO TRUE                       DTSBD555
00698             SET W-EMP-ERROR-YES-88  TO TRUE                       DTSBD555
00699             MOVE SPACES             TO R140-MESSAGE               DTSBD555
00700             MOVE W-EMP-NO           TO R140-EMP-NO                DTSBD555
00701             STRING                                                DTSBD555
00702                'REPORT: INVALID EMPLOYER NUMBER: '                DTSBD555
00703                   X157-EMP-NO                                     DTSBD555
00704                 DELIMITED BY SIZE                                 DTSBD555
00705                 INTO R140-MESSAGE                                 DTSBD555
00706             END-STRING                                            DTSBD555
00707             PERFORM S946-WRITE-R140     THRU S946-EXIT            DTSBD555
00708             DISPLAY R140-MESSAGE                                  DTSBD555
00709          END-IF                                                   DTSBD555
00710      END-PERFORM.                                                 DTSBD555
00711      IF W-EMP-ERROR-NO-88                                         DTSBD555
00712         MOVE W-EMP-NO-9             TO W-EMP-NO                   DTSBD555
00713      ELSE                                                         DTSBD555
00714         MOVE ZERO                   TO W-EMP-NO                   DTSBD555
00715      END-IF.                                                      DTSBD555
00716                                                                   DTSBD555
00717      MOVE X157-QUARTER              TO W-SLASH-QTR.               DTSBD555
00718      MOVE W-SLASH-QTR-CCYY          TO L004-QTR-5-YR.             DTSBD555
00719      MOVE W-SLASH-QTR-Q             TO L004-QTR-5-Q.              DTSBD555
00720      PERFORM S004-FROM-5            THRU S004-EXIT.               DTSBD555
00721      IF NOT L004-VALID-QTR                                        DTSBD555
00722         SET W-ERROR-YES-88          TO TRUE                       DTSBD555
00723         MOVE SPACES TO R140-MESSAGE                               DTSBD555
00724         MOVE W-EMP-NO               TO R140-EMP-NO                DTSBD555
00725         STRING                                                    DTSBD555
00726            'REPORT: INVALID QUARTER: '                            DTSBD555
00727               X157-QUARTER                                        DTSBD555
00728             DELIMITED BY SIZE                                     DTSBD555
00729             INTO R140-MESSAGE                                     DTSBD555
00730         END-STRING                                                DTSBD555
00731         PERFORM S946-WRITE-R140     THRU S946-EXIT                DTSBD555
00732         DISPLAY R140-MESSAGE                                      DTSBD555
00733      ELSE                                                         DTSBD555
00734         MOVE L004-QTR-5-9           TO W-REPORT-QTR               DTSBD555
00735      END-IF.                                                      DTSBD555
00736                                                                   DTSBD555
00737 *&                                                                DTSBD555
00738 *    MOVE X157-ENTERED-DATE   TO X157-RECEIVED-DATE.              DTSBD555
00739 *&                                                                DTSBD555
00740      MOVE X157-RECEIVED-DATE        TO W-SLASH-DATE.              DTSBD555
00741      MOVE W-SLASH-DT-MM             TO L001-FED-8-MO.             DTSBD555
00742      MOVE W-SLASH-DT-DD             TO L001-FED-8-DA.             DTSBD555
00743      MOVE W-SLASH-DT-CCYY           TO L001-FED-8-YR.             DTSBD555
00744      PERFORM S001-FROM-FED-8        THRU S001-EXIT.               DTSBD555
00745      IF NOT L001-VALID-DATE                                       DTSBD555
00746         SET W-ERROR-YES-88          TO TRUE                       DTSBD555
00747         MOVE SPACES TO R140-MESSAGE                               DTSBD555
00748         MOVE W-EMP-NO               TO R140-EMP-NO                DTSBD555
00749         STRING                                                    DTSBD555
00750            'REPORT: INVALID RECEIVED DATE: '                      DTSBD555
00751               X157-RECEIVED-DATE                                  DTSBD555
00752             DELIMITED BY SIZE                                     DTSBD555
00753             INTO R140-MESSAGE                                     DTSBD555
00754         END-STRING                                                DTSBD555
00755         PERFORM S946-WRITE-R140     THRU S946-EXIT                DTSBD555
00756         DISPLAY R140-MESSAGE                                      DTSBD555
00757      ELSE                                                         DTSBD555
00758         MOVE L001-FED-8-DATE-9      TO W-RECEIVED-DATE            DTSBD555
00759      END-IF.                                                      DTSBD555
00760                                                                   DTSBD555
00761      MOVE X157-REPORT-TYPE             TO L032-CD-2.              DTSBD555
00762      PERFORM S032-RPT-TYPE          THRU S032-EXIT.               DTSBD555
00763      IF NOT L032-VALID                                            DTSBD555
00764         SET W-ERROR-YES-88          TO TRUE                       DTSBD555
00765         MOVE SPACES                 TO R140-MESSAGE               DTSBD555
00766         MOVE W-EMP-NO               TO R140-EMP-NO                DTSBD555
00767         STRING                                                    DTSBD555
00768            'REPORT: INVALID RPT TYPE: '                           DTSBD555
00769               X157-REPORT-TYPE                                    DTSBD555
00770             DELIMITED BY SIZE                                     DTSBD555
00771             INTO R140-MESSAGE                                     DTSBD555
00772         END-STRING                                                DTSBD555
00773         PERFORM S946-WRITE-R140     THRU S946-EXIT                DTSBD555
00774         DISPLAY R140-MESSAGE                                      DTSBD555
00775      END-IF.                                                      DTSBD555
00776                                                                   DTSBD555
00777      MOVE X157-ENTERED-DATE         TO W-SLASH-DATE.              DTSBD555
00778      MOVE W-SLASH-DT-MM             TO L001-FED-8-MO.             DTSBD555
00779      MOVE W-SLASH-DT-DD             TO L001-FED-8-DA.             DTSBD555
00780      MOVE W-SLASH-DT-CCYY           TO L001-FED-8-YR.             DTSBD555
00781      PERFORM S001-FROM-FED-8        THRU S001-EXIT.               DTSBD555
00782      IF NOT L001-VALID-DATE                                       DTSBD555
00783         SET W-ERROR-YES-88          TO TRUE                       DTSBD555
00784         MOVE SPACES TO R140-MESSAGE                               DTSBD555
00785         MOVE W-EMP-NO               TO R140-EMP-NO                DTSBD555
00786         STRING                                                    DTSBD555
00787            'REPORT: INVALID ENTERED DATE: '                       DTSBD555
00788               X157-ENTERED-DATE                                   DTSBD555
00789             DELIMITED BY SIZE                                     DTSBD555
00790             INTO R140-MESSAGE                                     DTSBD555
00791         END-STRING                                                DTSBD555
00792         PERFORM S946-WRITE-R140     THRU S946-EXIT                DTSBD555
00793         DISPLAY R140-MESSAGE                                      DTSBD555
00794      ELSE                                                         DTSBD555
00795         MOVE L001-FED-8-DATE-9      TO W-ENTERED-DATE             DTSBD555
00796      END-IF.                                                      DTSBD555
00797                                                                   DTSBD555
00798  P1210-EXIT.                                                      DTSBD555
00799      EXIT.                                                        DTSBD555
00800                                                                   DTSBD555
00801  P1220-CHECK-DATABASE.                                            DTSBD555
00802      MOVE LOW-VALUE                  TO MPRF-KEY-AREA.            DTSBD555
00803      MOVE W-EMP-NO                   TO MPRF-EMP-NO.              DTSBD555
00804      SET MPRF-PRF-88                 TO TRUE.                     DTSBD555
00805      MOVE MPRF-KEY-AREA              TO MSKL-KEY-AREA.            DTSBD555
00806                                                                   DTSBD555
00807      PERFORM S910-READ               THRU S910-EXIT.              DTSBD555
00808      IF L910-NO-REC-88                                            DTSBD555
00809         SET W-EMP-FOUND-NO-88        TO TRUE                      DTSBD555
00810         DISPLAY 'EMPLOYER NOT ON FILE ' X157-EMP-NO               DTSBD555
00811      ELSE                                                         DTSBD555
00812         MOVE MSKL-REC                TO MPRF-REC                  DTSBD555
00813         SET W-EMP-FOUND-YES-88       TO TRUE                      DTSBD555
00814         MOVE W-REPORT-QTR            TO L516-YRQ                  DTSBD555
00815         PERFORM S516-LIABILITY-INFO  THRU S516-EXIT               DTSBD555
00816      END-IF.                                                      DTSBD555
00817                                                                   DTSBD555
00818      IF W-EMP-FOUND-YES-88                                        DTSBD555
00819         PERFORM P1221-CHECK-QTR      THRU P1221-EXIT              DTSBD555
00820      END-IF.                                                      DTSBD555
00821                                                                   DTSBD555
00822  P1220-EXIT.                                                      DTSBD555
00823      EXIT.                                                        DTSBD555
00824                                                                   DTSBD555
00825  P1221-CHECK-QTR.                                                 DTSBD555
00826      MOVE LOW-VALUE                  TO MQTR-KEY-AREA.            DTSBD555
00827      MOVE W-EMP-NO                   TO MQTR-EMP-NO.              DTSBD555
00828      MOVE W-REPORT-QTR               TO MQTR-YRQ                  DTSBD555
00829      SET MQTR-QTR-88                 TO TRUE.                     DTSBD555
00830      MOVE MQTR-KEY-AREA              TO MSKL-KEY-AREA.            DTSBD555
00831                                                                   DTSBD555
00832      PERFORM S910-READ               THRU S910-EXIT.              DTSBD555
00833      IF L910-OK-88                                                DTSBD555
00834         IF MQTR-CURR-RCVD-88                                      DTSBD555
00835            SET W-ERROR-YES-88        TO TRUE                      DTSBD555
00836            DISPLAY 'REPORT ON FILE: ' W-EMP-NO                    DTSBD555
00837               '  ' W-REPORT-QTR                                   DTSBD555
00838         END-IF                                                    DTSBD555
00839      END-IF.                                                      DTSBD555
00840                                                                   DTSBD555
00841  P1221-EXIT.                                                      DTSBD555
00842      EXIT.                                                        DTSBD555
00843                                                                   DTSBD555
00844  P1300-SAVE-REPORT.                                               DTSBD555
00845      IF W-PSEUDO-ITEM-NO < 999                                    DTSBD555
00846         ADD 1                       TO W-PSEUDO-ITEM-NO           DTSBD555
00847      ELSE                                                         DTSBD555
00848         ADD 1                       TO W-PSEUDO-BATCH-NO          DTSBD555
00849         MOVE 1                      TO W-PSEUDO-ITEM-NO           DTSBD555
00850      END-IF.                                                      DTSBD555
00851      MOVE LENGTH OF T028-REC        TO T028-LENGTH                DTSBD555
00852      MOVE '028'                     TO T028-REC-TYPE.             DTSBD555
00853                                                                   DTSBD555
00854      MOVE W-LOG-NO                  TO T028-LOG-NBR.              DTSBD555
00855      MOVE W-EMP-NO                  TO T028-EMP-NO.               DTSBD555
00856      MOVE 'WAGEONLY'                TO T028-ORIGIN.               DTSBD555
00857      MOVE L005-DATE                 TO T028-SYS-DATE.             DTSBD555
00858      MOVE L005-TIME                 TO T028-SYS-TIME.             DTSBD555
00859      SET  T028-WAGE-ONLY-DISK-88    TO TRUE.                      DTSBD555
00860                                                                   DTSBD555
00861      MOVE W-PSEUDO-BATCH-NO         TO T028-PSEUDO-BATCH-NO.      DTSBD555
00862      MOVE W-PSEUDO-ITEM-NO          TO T028-PSEUDO-ITEM-NO.       DTSBD555
00863                                                                   DTSBD555
00864      MOVE W-REPORT-QTR              TO T028-YRQ.                  DTSBD555
00865      IF W-EMP-FOUND-YES-88                                        DTSBD555
00866         MOVE MPRF-PRIMARY-NAME (1:4)                              DTSBD555
00867                                     TO T028-NAME-CHECK            DTSBD555
00868      ELSE                                                         DTSBD555
00869         MOVE SPACES                 TO T028-NAME-CHECK            DTSBD555
00870      END-IF.                                                      DTSBD555
00871                                                                   DTSBD555
00872      MOVE X157-REPORT-TYPE          TO T028-RPT-TYPE.             DTSBD555
00873                                                                   DTSBD555
00874      SET T028-WAIVE-BOTH-NO-88      TO TRUE.                      DTSBD555
00875      SET T028-WAIVE-INT-NO-88       TO TRUE.                      DTSBD555
00876      SET T028-WAIVE-LATE-PEN-NO-88  TO TRUE.                      DTSBD555
00877      MOVE W-RECEIVED-DATE           TO T028-RECEIVED-DATE         DTSBD555
00878                                        T028-DEPOSIT-DATE.         DTSBD555
00879                                                                   DTSBD555
00880      MOVE W-TOT-WAGE                TO T028-TOT-WAGE.             DTSBD555
00881                                                                   DTSBD555
00882      IF W-EMP-FOUND-NO-88                                         DTSBD555
00883         MOVE W-TAX-WAGE             TO T028-TAX-WAGE              DTSBD555
00884         COMPUTE T028-EXCESS-WAGE =                                DTSBD555
00885            (T028-TOT-WAGE - T028-TAX-WAGE)                        DTSBD555
00886      ELSE                                                         DTSBD555
00887         IF MPRF-CLASS-SELF-INS-88                                 DTSBD555
00888            MOVE ZERO                TO T028-TAX-WAGE              DTSBD555
00889                                        T028-EXCESS-WAGE           DTSBD555
00890         ELSE                                                      DTSBD555
00891            MOVE W-TAX-WAGE          TO T028-TAX-WAGE              DTSBD555
00892            COMPUTE T028-EXCESS-WAGE =                             DTSBD555
00893               (T028-TOT-WAGE - T028-TAX-WAGE)                     DTSBD555
00894         END-IF                                                    DTSBD555
00895      END-IF.                                                      DTSBD555
00896                                                                   DTSBD555
00897      MOVE ZERO                      TO T028-TOTAL-EMPL-CNT.       DTSBD555
00898      MOVE W-1ST-MNTH-CNT            TO T028-1ST-MTH-EMPL-CNT.     DTSBD555
00899      MOVE W-2ND-MNTH-CNT            TO T028-2ND-MTH-EMPL-CNT.     DTSBD555
00900      MOVE W-3RD-MNTH-CNT            TO T028-3RD-MTH-EMPL-CNT.     DTSBD555
00901                                                                   DTSBD555
00902      MOVE W-REMITTANCE              TO T028-REMIT-AMT.            DTSBD555
00903                                                                   DTSBD555
00904      IF W-EMP-FOUND-NO-88                                         DTSBD555
00905      OR L516-NOT-LIABLE-88                                        DTSBD555
00906         SET T028-PASSED-FULL-EDITS-NO-88   TO TRUE                DTSBD555
00907      ELSE                                                         DTSBD555
00908         SET T028-PASSED-FULL-EDITS-YES-88  TO TRUE                DTSBD555
00909      END-IF.                                                      DTSBD555
00910                                                                   DTSBD555
00911      MOVE ZERO                      TO T028-TRACE-NO.             DTSBD555
00912                                                                   DTSBD555
00913      MOVE 'VOL'                     TO T028-RESPONSIBLE-ACTIVITY. DTSBD555
00914      MOVE X157-MF-OPID              TO T028-RESPONSIBLE-OP-ID.    DTSBD555
00915                                                                   DTSBD555
00916      PERFORM S1032-WRITE-TEMP-T028  THRU S1032-EXIT.              DTSBD555
00917                                                                   DTSBD555
00918  P1300-EXIT.                                                      DTSBD555
00919      EXIT.                                                        DTSBD555
00920                                                                   DTSBD555
00921                                                                   DTSBD555
00922  P2000-WAGE.                                                      DTSBD555
00923      SET W-WAGE-COMPLETE-NO-88        TO TRUE.                    DTSBD555
00924                                                                   DTSBD555
00925      IF W-TOT-WAGE = ZERO                                         DTSBD555
00926         IF X144-EMP-NO = X157-EMP-NO                              DTSBD555
00927         AND X144-QUARTER = X157-QUARTER                           DTSBD555
00928            SET W-ERROR-YES-88             TO TRUE                 DTSBD555
00929            DISPLAY 'WAGES FOUND WHEN TOT WAGE = 0: '              DTSBD555
00930               W-EMP-NO '  ' W-REPORT-QTR                          DTSBD555
00931            GO TO P2000-EXIT                                       DTSBD555
00932         ELSE                                                      DTSBD555
00933            GO TO P2000-EXIT                                       DTSBD555
00934         END-IF                                                    DTSBD555
00935      END-IF.                                                      DTSBD555
00936                                                                   DTSBD555
00937      PERFORM UNTIL W-WAGE-COMPLETE-YES-88                         DTSBD555
00938         PERFORM P2100-PARSE-WAGES          THRU P2100-EXIT        DTSBD555
00939         IF X144-EMP-NO NOT = X157-EMP-NO                          DTSBD555
00940         OR X144-QUARTER NOT = X157-QUARTER                        DTSBD555
00941            SET W-WAGE-COMPLETE-YES-88      TO TRUE                DTSBD555
00942         ELSE                                                      DTSBD555
00943            IF W-ERROR-NO-88                                       DTSBD555
00944               PERFORM P2200-EDIT-WAGES     THRU P2200-EXIT        DTSBD555
00945               IF W-ERROR-NO-88                                    DTSBD555
00946                  PERFORM P2300-SAVE-WAGES  THRU P2300-EXIT        DTSBD555
00947               END-IF                                              DTSBD555
00948            END-IF                                                 DTSBD555
00949         END-IF                                                    DTSBD555
00950         IF W-WAGE-COMPLETE-NO-88                                  DTSBD555
00951            PERFORM S1025-READ-WAGE-IN     THRU S1025-EXIT         DTSBD555
00952         END-IF                                                    DTSBD555
00953      END-PERFORM.                                                 DTSBD555
00954                                                                   DTSBD555
00955  P2000-EXIT.                                                      DTSBD555
00956      EXIT.                                                        DTSBD555
00957                                                                   DTSBD555
00958  P2100-PARSE-WAGES.                                               DTSBD555
00959      PERFORM P2110-PARSE           THRU P2110-EXIT.               DTSBD555
00960      IF W-ERROR-NO-88                                             DTSBD555
00961         PERFORM P2120-SAVE-DATA    THRU P2120-EXIT                DTSBD555
00962      END-IF.                                                      DTSBD555
00963                                                                   DTSBD555
00964  P2100-EXIT.                                                      DTSBD555
00965      EXIT.                                                        DTSBD555
00966                                                                   DTSBD555
00967  P2110-PARSE.                                                     DTSBD555
00968      PERFORM                                                      DTSBD555
00969        VARYING SUB FROM +1 BY +1                                  DTSBD555
00970        UNTIL SUB > +100                                           DTSBD555
00971        MOVE +0                  TO L205-FIELD-LENGTH (SUB)        DTSBD555
00972                                    L205-INTEGER (SUB)             DTSBD555
00973                                    L205-FRACTION (SUB)            DTSBD555
00974        MOVE SPACES              TO L205-TEXT (SUB)                DTSBD555
00975                                    L205-DATE (SUB)                DTSBD555
00976        SET L205-TYPE-TEXT-88 (SUB)  TO TRUE                       DTSBD555
00977      END-PERFORM.                                                 DTSBD555
00978                                                                   DTSBD555
00979      INITIALIZE X144-REC                                          DTSBD555
00980      MOVE +9                       TO L205-LAST-FIELD             DTSBD555
00981      MOVE +1                       TO L205-LAST-FIELD-LEN         DTSBD555
00982                                                                   DTSBD555
00983 ** RECORD TYPE                                                    DTSBD555
00984      MOVE +3                       TO L205-FIELD-LENGTH (1).      DTSBD555
00985      SET L205-TYPE-TEXT-88 (1)     TO TRUE.                       DTSBD555
00986                                                                   DTSBD555
00987 ** EMPLOYER NUMBER                                                DTSBD555
00988      MOVE +6                       TO L205-FIELD-LENGTH (2).      DTSBD555
00989      SET L205-TYPE-TEXT-88 (2)     TO TRUE.                       DTSBD555
00990                                                                   DTSBD555
00991 ** QUARTER                                                        DTSBD555
00992      MOVE +6                       TO L205-FIELD-LENGTH (3).      DTSBD555
00993      SET L205-TYPE-TEXT-88 (3)     TO TRUE.                       DTSBD555
00994                                                                   DTSBD555
00995 ** SSN                                                            DTSBD555
00996      MOVE +9                       TO L205-FIELD-LENGTH (4).      DTSBD555
00997      SET L205-TYPE-TEXT-88 (4)     TO TRUE.                       DTSBD555
00998                                                                   DTSBD555
00999 ** SOURCE                                                         DTSBD555
01000      MOVE +1                       TO L205-FIELD-LENGTH (5).      DTSBD555
01001      SET L205-TYPE-TEXT-88 (5)     TO TRUE.                       DTSBD555
01002                                                                   DTSBD555
01003 ** EARNINGS                                                       DTSBD555
01004      MOVE +12                      TO L205-FIELD-LENGTH (6).      DTSBD555
01005      SET L205-TYPE-NUMBER-88 (6)   TO TRUE.                       DTSBD555
01006                                                                   DTSBD555
01007 ** TAX WAGE                                                       DTSBD555
01008 **   MOVE +12                      TO L205-FIELD-LENGTH (7).      DTSBD555
01009 **   SET L205-TYPE-NUMBER-88 (7)   TO TRUE.                       DTSBD555
01010                                                                   DTSBD555
01011 ** LAST NAME                                                      DTSBD555
01012      MOVE +20                      TO L205-FIELD-LENGTH (7).      DTSBD555
01013      SET L205-TYPE-TEXT-88 (7)     TO TRUE.                       DTSBD555
01014                                                                   DTSBD555
01015 ** FIRST NAME                                                     DTSBD555
01016      MOVE +15                      TO L205-FIELD-LENGTH (8).      DTSBD555
01017      SET L205-TYPE-TEXT-88 (8)     TO TRUE.                       DTSBD555
01018                                                                   DTSBD555
01019 ** MIDDLE INITIAL                                                 DTSBD555
01020      MOVE +1                       TO L205-FIELD-LENGTH (09).     DTSBD555
01021      SET L205-TYPE-TEXT-88 (09)     TO TRUE.                      DTSBD555
01022                                                                   DTSBD555
01023      MOVE WAGE-IN-REC              TO L205-INPUT-DATA.            DTSBD555
01024      CALL 'DTSBU205'               USING L205-LINK-AREA.          DTSBD555
01025                                                                   DTSBD555
01026      IF L205-VALID-NO-88 (6)                                      DTSBD555
01027         DISPLAY 'P2110 INVALID EARNINGS: '                        DTSBD555
01028            X144-EARNINGS                                          DTSBD555
01029         SET W-ERROR-YES-88          TO TRUE                       DTSBD555
01030      END-IF.                                                      DTSBD555
01031                                                                   DTSBD555
01032 ***  IF L205-VALID-NO-88 (7)                                      DTSBD555
01033 **      DISPLAY 'P2110 INVALID TAX WAGE: '                        DTSBD555
01034 **         X144-TAXABLE-WAGES                                     DTSBD555
01035 **      SET W-ERROR-YES-88          TO TRUE                       DTSBD555
01036 ***  END-IF.                                                      DTSBD555
01037                                                                   DTSBD555
01038  P2110-EXIT.                                                      DTSBD555
01039      EXIT.                                                        DTSBD555
01040                                                                   DTSBD555
01041  P2120-SAVE-DATA.                                                 DTSBD555
01042 *&   MOVE L205-TEXT (1) (1:03)   TO X144-REC-TYPE.                DTSBD555
01043                                                                   DTSBD555
01044      MOVE L205-TEXT (2) (1:06)   TO X144-EMP-NO.                  DTSBD555
01045                                                                   DTSBD555
01046      MOVE L205-TEXT (3)  (1:06)  TO X144-QUARTER.                 DTSBD555
01047                                                                   DTSBD555
01048      MOVE L205-TEXT (4) (1:09)   TO X144-SSN.                     DTSBD555
01049                                                                   DTSBD555
01050      MOVE L205-TEXT (5) (1:01)   TO X144-WAGE-STATUS.             DTSBD555
01051                                                                   DTSBD555
01052      MOVE L205-INTEGER (6)       TO W-INTEGER.                    DTSBD555
01053      MOVE L205-FRACTION (6)      TO W-FRACTION.                   DTSBD555
01054      COMPUTE W-NUMBER = W-INTEGER + W-FRACTION.                   DTSBD555
01055      MOVE W-NUMBER               TO W-EARNINGS.                   DTSBD555
01056                                                                   DTSBD555
01057 **   MOVE L205-INTEGER (7)       TO W-INTEGER.                    DTSBD555
01058 *    MOVE L205-FRACTION (7)      TO W-FRACTION.                   DTSBD555
01059 *    COMPUTE W-NUMBER = W-INTEGER + W-FRACTION.                   DTSBD555
01060 *    MOVE W-NUMBER               TO W-WORKER-TAX-WAGES.           DTSBD555
01061 *                                                                 DTSBD555
01062 *    MOVE L205-TEXT (8) (1:20)   TO W-LAST-NAME.                  DTSBD555
01063 *                                                                 DTSBD555
01064 *    MOVE L205-TEXT (9) (1:15)   TO W-FIRST-NAME.                 DTSBD555
01065 *                                                                 DTSBD555
01066 **   MOVE L205-TEXT (10) (1:01)  TO W-MID-INIT.                   DTSBD555
01067                                                                   DTSBD555
01068  P2120-EXIT.                                                      DTSBD555
01069      EXIT.                                                        DTSBD555
01070                                                                   DTSBD555
01071  P2200-EDIT-WAGES.                                                DTSBD555
01072      IF X144-EMP-NO = X157-EMP-NO                                 DTSBD555
01073      AND X144-QUARTER = X157-QUARTER                              DTSBD555
01074         NEXT SENTENCE                                             DTSBD555
01075      ELSE                                                         DTSBD555
01076         DISPLAY 'WAGE DATA DOES NOT MATCH REPORT'                 DTSBD555
01077         DISPLAY '   REPORT: ' X157-EMP-NO '  ' X157-QUARTER       DTSBD555
01078            '  WAGE: ' X144-EMP-NO '  ' X144-QUARTER               DTSBD555
01079         SET W-ERROR-YES-88             TO TRUE                    DTSBD555
01080         GO TO P2200-EXIT                                          DTSBD555
01081      END-IF.                                                      DTSBD555
01082                                                                   DTSBD555
01083      MOVE X144-QUARTER          TO W-SLASH-QTR.                   DTSBD555
01084      MOVE W-SLASH-QTR-CCYY      TO L004-QTR-5-YR.                 DTSBD555
01085      MOVE W-SLASH-QTR-Q         TO L004-QTR-5-Q.                  DTSBD555
01086      PERFORM S004-FROM-5        THRU S004-EXIT.                   DTSBD555
01087      IF NOT L004-VALID-QTR                                        DTSBD555
01088         SET W-ERROR-YES-88      TO TRUE                           DTSBD555
01089         MOVE SPACES             TO R140-MESSAGE                   DTSBD555
01090         MOVE W-EMP-NO           TO R140-EMP-NO                    DTSBD555
01091         STRING                                                    DTSBD555
01092            'WAGE: INVALID QUARTER '                               DTSBD555
01093               X144-QUARTER                                        DTSBD555
01094             DELIMITED BY SIZE                                     DTSBD555
01095             INTO R140-MESSAGE                                     DTSBD555
01096         END-STRING                                                DTSBD555
01097         PERFORM S946-WRITE-R140 THRU S946-EXIT                    DTSBD555
01098         DISPLAY R140-MESSAGE                                      DTSBD555
01099      ELSE                                                         DTSBD555
01100         IF L004-QTR-5-9 NOT = W-REPORT-QTR                        DTSBD555
01101            SET W-ERROR-YES-88   TO TRUE                           DTSBD555
01102            MOVE SPACES          TO R140-MESSAGE                   DTSBD555
01103            MOVE W-EMP-NO        TO R140-EMP-NO                    DTSBD555
01104            STRING                                                 DTSBD555
01105               'WAGE       WAGE QTR NOT = RPT QTR '                DTSBD555
01106                  X144-QUARTER                                     DTSBD555
01107                DELIMITED BY SIZE                                  DTSBD555
01108                INTO R140-MESSAGE                                  DTSBD555
01109            END-STRING                                             DTSBD555
01110            PERFORM S946-WRITE-R140 THRU S946-EXIT                 DTSBD555
01111            DISPLAY R140-MESSAGE                                   DTSBD555
01112         END-IF                                                    DTSBD555
01113      END-IF.                                                      DTSBD555
01114                                                                   DTSBD555
01115      MOVE X144-SSN                  TO W-SSN-X.                   DTSBD555
01116      SET W-SSN-ERROR-NO-88          TO TRUE.                      DTSBD555
01117      PERFORM                                                      DTSBD555
01118        VARYING SUB FROM +1 BY +1                                  DTSBD555
01119        UNTIL SUB > +9                                             DTSBD555
01120          IF W-SSN-X (SUB:1) < '0' OR > '9'                        DTSBD555
01121             SET W-ERROR-YES-88      TO TRUE                       DTSBD555
01122             DISPLAY 'P2200 SSN ERR: ' SUB                         DTSBD555
01123                '  ' W-SSN-X (SUB:1)                               DTSBD555
01124             MOVE SPACES             TO R140-MESSAGE               DTSBD555
01125            MOVE X144-SSN            TO R140-EMP-NO                DTSBD555
01126            STRING                                                 DTSBD555
01127               'WAGE: NON-NUMERIC SSN: '                           DTSBD555
01128                  X144-SSN                                         DTSBD555
01129                DELIMITED BY SIZE                                  DTSBD555
01130                INTO R140-MESSAGE                                  DTSBD555
01131            END-STRING                                             DTSBD555
01132            PERFORM S946-WRITE-R140  THRU S946-EXIT                DTSBD555
01133            DISPLAY R140-MESSAGE                                   DTSBD555
01134         END-IF                                                    DTSBD555
01135      END-PERFORM                                                  DTSBD555
01136      IF W-SSN-ERROR-NO-88                                         DTSBD555
01137         MOVE X144-SSN               TO W-SSN                      DTSBD555
01138      END-IF.                                                      DTSBD555
01139                                                                   DTSBD555
01140      MOVE X144-LAST-NAME            TO W-WRKR-LAST-NAME.          DTSBD555
01141      MOVE X144-FIRST-NAME           TO W-WRKR-FIRST-NAME.         DTSBD555
01142      MOVE X144-MID-INIT             TO W-WRKR-MID-INIT.           DTSBD555
01143                                                                   DTSBD555
01144  P2200-EXIT.                                                      DTSBD555
01145      EXIT.                                                        DTSBD555
01146                                                                   DTSBD555
01147  P2300-SAVE-WAGES.                                                DTSBD555
01148 **   DISPLAY 'WRITE WAGES: ' W-EMP-NO '  ' W-REPORT-QTR           DTSBD555
01149 **      '  ' X144-SSN '  ' X144-EARNINGS.                         DTSBD555
01150      MOVE W-PSEUDO-BATCH-NO         TO W001-BATCH-NO.             DTSBD555
01151      MOVE W-PSEUDO-ITEM-NO          TO W001-ITEM-NO.              DTSBD555
01152      ADD 1                          TO W-SEQ-NO.                  DTSBD555
01153      MOVE W-SEQ-NO                  TO W001-SEQ-NO.               DTSBD555
01154      MOVE W-EMP-NO                  TO W001-EMP-NO.               DTSBD555
01155      MOVE W-SSN                     TO W001-SSN.                  DTSBD555
01156      SET W001-SSN-VALID-88          TO TRUE.                      DTSBD555
01157                                                                   DTSBD555
01158 *    MOVE W-WRKR-FIRST-NAME         TO W001-FIRST-NAME.           DTSBD555
01159 *    MOVE W-WRKR-MID-INIT           TO W001-MID-INIT.             DTSBD555
01160 *    MOVE W-WRKR-LAST-NAME          TO W001-LAST-NAME.            DTSBD555
01161      MOVE SPACES                    TO W001-FIRST-NAME            DTSBD555
01162                                        W001-MID-INIT              DTSBD555
01163                                        W001-LAST-NAME.            DTSBD555
01164      SET W001-NAME-VALID-88         TO TRUE.                      DTSBD555
01165                                                                   DTSBD555
01166      MOVE W-REPORT-QTR              TO W001-YRQ.                  DTSBD555
01167      MOVE W-EARNINGS                TO W001-WAGE-CHNG.            DTSBD555
01168      MOVE ZERO                      TO W001-TAX-WAGE.             DTSBD555
01169      SET W001-WAGE-VALID-88         TO TRUE.                      DTSBD555
01170      MOVE ZERO                      TO W001-CURR-WAGE             DTSBD555
01171                                        W001-PRIOR-WAGE.           DTSBD555
01172      MOVE L005-DATE                 TO W001-RECEIVED-DATE.        DTSBD555
01173      MOVE L005-TIME                 TO W001-RECEIVED-TIME.        DTSBD555
01174      MOVE X157-MF-OPID              TO W001-RESPONSIBLE-OP-ID.    DTSBD555
01175      SET W001-WAGE-ONLY-DISK-88     TO TRUE.                      DTSBD555
01176                                                                   DTSBD555
01177      PERFORM S1120-WRITE-WAGE-TEMP  THRU S1120-EXIT.              DTSBD555
01178                                                                   DTSBD555
01179  P2300-EXIT.                                                      DTSBD555
01180      EXIT.                                                        DTSBD555
01181                                                                   DTSBD555
01182                                                                   DTSBD555
01183  T0000-TERMINATE.                                                 DTSBD555
01184                                                                   DTSBD555
01185      IF W-ERROR-NO-88                                             DTSBD555
01186         PERFORM T1000-WRITE-REPORT        THRU T1000-EXIT         DTSBD555
01187         PERFORM T2000-WRITE-WAGES         THRU T2000-EXIT         DTSBD555
01188         PERFORM T3000-UPDATE-CURR-BATCH   THRU T3000-EXIT         DTSBD555
01189      ELSE                                                         DTSBD555
01190         DISPLAY '>>>  DTSBD555: ERRORS FOUND  <<<'                DTSBD555
01191         DISPLAY '>>>  NO OUTPUT FILE WRITTEN  <<<'                DTSBD555
01192      END-IF.                                                      DTSBD555
01193                                                                   DTSBD555
01194      DISPLAY ' '.                                                 DTSBD555
01195                                                                   DTSBD555
01196      DISPLAY '*** DTSBD555 TERMINATION STATISTICS ***'.           DTSBD555
01197                                                                   DTSBD555
01198      DISPLAY ' '.                                                 DTSBD555
01199                                                                   DTSBD555
01200      DISPLAY 'REPORT RECORDS INPUT:     '                         DTSBD555
01201              W-RPT-IN-CNT.                                        DTSBD555
01202                                                                   DTSBD555
01203      DISPLAY 'WAGE RECORDS INPUT:       '                         DTSBD555
01204              W-WAGE-IN-CNT.                                       DTSBD555
01205                                                                   DTSBD555
01206      DISPLAY 'TEMP RPT RECS WRITTEN:    '                         DTSBD555
01207              W-TEMP-T028-CNT.                                     DTSBD555
01208                                                                   DTSBD555
01209      DISPLAY 'TEMP WAGE RECS WRITTEN:   '                         DTSBD555
01210              W-TEMP-WAGE-CNT.                                     DTSBD555
01211                                                                   DTSBD555
01212      DISPLAY 'REPORT RECORDS WRITTEN:   '                         DTSBD555
01213              W-T028-WRITE-CNT.                                    DTSBD555
01214                                                                   DTSBD555
01215      DISPLAY 'WAGE RECORDS WRITTEN:     '                         DTSBD555
01216              W-WAGE-OUT-CNT.                                      DTSBD555
01217                                                                   DTSBD555
01218      DISPLAY '  '.                                                DTSBD555
01219                                                                   DTSBD555
01220                                                                   DTSBD555
01221      DISPLAY '***************************************'.           DTSBD555
01222                                                                   DTSBD555
01223      PERFORM S1010-CLOSE-REPORT-IN          THRU S1010-EXIT.      DTSBD555
01224      PERFORM S1030-CLOSE-WAGE-IN            THRU S1030-EXIT.      DTSBD555
01225      CLOSE   CURR-BATCH-NO.                                       DTSBD555
01226      PERFORM S910-CLOSE                     THRU S910-EXIT.       DTSBD555
01227      PERFORM S931-CLOSE                     THRU S931-EXIT.       DTSBD555
01228                                                                   DTSBD555
01229  T0000-EXIT.                                                      DTSBD555
01230      EXIT.                                                        DTSBD555
01231                                                                   DTSBD555
01232  T1000-WRITE-REPORT.                                              DTSBD555
01233      PERFORM S1060-CLOSE-TEMP-BTC           THRU S1060-EXIT.      DTSBD555
01234      IF W-FATAL-ERROR-NO-88                                       DTSBD555
01235         PERFORM T1100-COPY-TO-BTC           THRU T1100-EXIT       DTSBD555
01236      ELSE                                                         DTSBD555
01237         DISPLAY 'T1000 FATAL ERR ON CLOSE'                        DTSBD555
01238         GO TO T1000-EXIT                                          DTSBD555
01239      END-IF.                                                      DTSBD555
01240                                                                   DTSBD555
01241  T1000-EXIT.                                                      DTSBD555
01242      EXIT.                                                        DTSBD555
01243                                                                   DTSBD555
01244  T1100-COPY-TO-BTC.                                               DTSBD555
01245      PERFORM S1050-OPEN-TEMP-BTC-IN     THRU S1050-EXIT           DTSBD555
01246      IF W-FATAL-ERROR-YES-88                                      DTSBD555
01247         GO TO T1100-EXIT                                          DTSBD555
01248      END-IF.                                                      DTSBD555
01249      PERFORM S927A-OPEN                 THRU S927A-EXIT.          DTSBD555
01250                                                                   DTSBD555
01251      PERFORM S1070-READ-TEMP-BTC        THRU S1070-EXIT.          DTSBD555
01252                                                                   DTSBD555
01253      PERFORM                                                      DTSBD555
01254        UNTIL TEMP-BTC-STATUS-EOF-88                               DTSBD555
01255        OR W-FATAL-ERROR-YES-88                                    DTSBD555
01256           PERFORM S927B-WRITE           THRU S927B-EXIT           DTSBD555
01257           ADD +1                        TO W-T028-WRITE-CNT       DTSBD555
01258           PERFORM S1070-READ-TEMP-BTC   THRU S1070-EXIT           DTSBD555
01259      END-PERFORM.                                                 DTSBD555
01260                                                                   DTSBD555
01261      PERFORM S1060-CLOSE-TEMP-BTC       THRU S1060-EXIT.          DTSBD555
01262      PERFORM S927C-CLOSE                THRU S927C-EXIT.          DTSBD555
01263                                                                   DTSBD555
01264  T1100-EXIT.                                                      DTSBD555
01265      EXIT.                                                        DTSBD555
01266                                                                   DTSBD555
01267  T2000-WRITE-WAGES.                                               DTSBD555
01268      PERFORM S1110-CLOSE-WAGE-TEMP          THRU S1110-EXIT.      DTSBD555
01269      IF W-FATAL-ERROR-NO-88                                       DTSBD555
01270         PERFORM T2100-COPY                   THRU T2100-EXIT      DTSBD555
01271      ELSE                                                         DTSBD555
01272         DISPLAY 'T2000 FATAL ERR ON CLOSE'                        DTSBD555
01273         GO TO T2000-EXIT                                          DTSBD555
01274      END-IF.                                                      DTSBD555
01275                                                                   DTSBD555
01276  T2000-EXIT.                                                      DTSBD555
01277      EXIT.                                                        DTSBD555
01278                                                                   DTSBD555
01279  T2100-COPY.                                                      DTSBD555
01280      PERFORM S1130-OPEN-WAGE-TEMP-IN  THRU S1130-EXIT             DTSBD555
01281      IF W-FATAL-ERROR-YES-88                                      DTSBD555
01282         GO TO T2100-EXIT                                          DTSBD555
01283      END-IF.                                                      DTSBD555
01284                                                                   DTSBD555
01285      PERFORM S1150-OPEN-WAGE-FILE-OUT THRU S1150-EXIT.            DTSBD555
01286      IF W-FATAL-ERROR-YES-88                                      DTSBD555
01287         GO TO T2100-EXIT                                          DTSBD555
01288      END-IF.                                                      DTSBD555
01289                                                                   DTSBD555
01290      PERFORM S1140-READ-WAGE-TEMP       THRU S1140-EXIT.          DTSBD555
01291                                                                   DTSBD555
01292      PERFORM                                                      DTSBD555
01293        UNTIL WAGE-TEMP-STATUS-EOF-88                              DTSBD555
01294        OR W-FATAL-ERROR-YES-88                                    DTSBD555
01295           PERFORM S1170-WRITE-WAGE-OUT  THRU S1170-EXIT           DTSBD555
01296           PERFORM S1140-READ-WAGE-TEMP  THRU S1140-EXIT           DTSBD555
01297      END-PERFORM.                                                 DTSBD555
01298                                                                   DTSBD555
01299      PERFORM S1110-CLOSE-WAGE-TEMP      THRU S1110-EXIT.          DTSBD555
01300      PERFORM S1160-CLOSE-WAGE-OUT       THRU S1160-EXIT.          DTSBD555
01301                                                                   DTSBD555
01302  T2100-EXIT.                                                      DTSBD555
01303      EXIT.                                                        DTSBD555
01304                                                                   DTSBD555
01305                                                                   DTSBD555
01306  T3000-UPDATE-CURR-BATCH.                                         DTSBD555
01307      MOVE W-PSEUDO-BATCH-NO    TO CURRENT-BATCH-NO                DTSBD555
01308                                   W-END-BATCH.                    DTSBD555
01309      MOVE W-PSEUDO-ITEM-NO     TO CURRENT-ITEM-NO.                DTSBD555
01310      REWRITE CURR-BATCH-NO-REC.                                   DTSBD555
01311      IF BATCH-STATUS-OK-88                                        DTSBD555
01312         NEXT SENTENCE                                             DTSBD555
01313      ELSE                                                         DTSBD555
01314         DISPLAY 'T3000 - CANNOT REWRITE BATCH NUMBER FILE '       DTSBD555
01315            BATCH-STATUS                                           DTSBD555
01316      END-IF.                                                      DTSBD555
01317                                                                   DTSBD555
01318  T3000-EXIT.                                                      DTSBD555
01319      EXIT.                                                        DTSBD555
01320                                                                   DTSBD555
01321  S001-FROM-FED-8.                                                 DTSBD555
01322      SET L001-FROM-FED-8 TO TRUE.                                 DTSBD555
01323      GO TO S001-DATE.                                             DTSBD555
01324                                                                   DTSBD555
01325  S001-FROM-CAL-8.                                                 DTSBD555
01326      SET L001-FROM-CAL-8 TO TRUE.                                 DTSBD555
01327      GO TO S001-DATE.                                             DTSBD555
01328                                                                   DTSBD555
01329  S001-FROM-ABS-DAY.                                               DTSBD555
01330      SET L001-FROM-ABS-DAY TO TRUE.                               DTSBD555
01331      GO TO S001-DATE.                                             DTSBD555
01332                                                                   DTSBD555
01333  S001-DATE.                                                       DTSBD555
01334      CALL 'DTSBU001' USING L001-LINK-AREA.                        DTSBD555
01335  S001-EXIT.                                                       DTSBD555
01336      EXIT.                                                        DTSBD555
01337                                                                   DTSBD555
01338  S003-AGENCY-DAY.                                                 DTSBD555
01339      SET L003-AGENCY-DAY TO TRUE.                                 DTSBD555
01340      GO TO S003-WORK-DAY.                                         DTSBD555
01341                                                                   DTSBD555
01342  S003-WORK-DAY.                                                   DTSBD555
01343      CALL 'DTSBU003' USING L003-LINK-AREA.                        DTSBD555
01344  S003-EXIT.                                                       DTSBD555
01345      EXIT.                                                        DTSBD555
01346                                                                   DTSBD555
01347  S004-FROM-5.                                                     DTSBD555
01348      SET L004-FROM-5        TO TRUE.                              DTSBD555
01349      GO TO S004-YRQ.                                              DTSBD555
01350                                                                   DTSBD555
01351  S004-FROM-DATE.                                                  DTSBD555
01352      SET L004-FROM-DATE     TO TRUE.                              DTSBD555
01353      GO TO S004-YRQ.                                              DTSBD555
01354                                                                   DTSBD555
01355  S004-FROM-ABS.                                                   DTSBD555
01356      SET L004-FROM-ABS      TO TRUE.                              DTSBD555
01357      GO TO S004-YRQ.                                              DTSBD555
01358                                                                   DTSBD555
01359  S004-YRQ.                                                        DTSBD555
01360      CALL 'DTSBU004' USING L004-LINK-AREA.                        DTSBD555
01361                                                                   DTSBD555
01362  S004-EXIT.                                                       DTSBD555
01363      EXIT.                                                        DTSBD555
01364                                                                   DTSBD555
01365  S005-FROM-SYS.                                                   DTSBD555
01366      SET L005-FROM-SYS       TO TRUE.                             DTSBD555
01367      GO TO S005-ABSTIME.                                          DTSBD555
01368                                                                   DTSBD555
01369  S005-ABSTIME.                                                    DTSBD555
01370      CALL 'DTSBU005' USING L005-LINK-AREA.                        DTSBD555
01371  S005-EXIT.                                                       DTSBD555
01372      EXIT.                                                        DTSBD555
01373                                                                   DTSBD555
01374  S032-RPT-TYPE.                                                   DTSBD555
01375      SET L032-MRPT-RPT-TYPE             TO TRUE.                  DTSBD555
01376      CALL 'DTSBU032' USING L032-LINK-AREA.                        DTSBD555
01377                                                                   DTSBD555
01378  S032-EXIT.                                                       DTSBD555
01379      EXIT.                                                        DTSBD555
01380                                                                   DTSBD555
01381  S516-LIABILITY-INFO.                                             DTSBD555
01382      CALL 'DTSBU516' USING L516-LINK-AREA                         DTSBD555
01383                            MPRF-REC.                              DTSBD555
01384  S516-EXIT.                                                       DTSBD555
01385      EXIT.                                                        DTSBD555
01386                                                                   DTSBD555
01387  S910-OPEN-READ.                                                  DTSBD555
01388      SET L910-OPEN-READ-88 TO TRUE.                               DTSBD555
01389      GO TO S910-MSTR-IO.                                          DTSBD555
01390                                                                   DTSBD555
01391  S910-READ.                                                       DTSBD555
01392      SET L910-READ-88 TO TRUE.                                    DTSBD555
01393      GO TO S910-MSTR-IO.                                          DTSBD555
01394                                                                   DTSBD555
01395  S910-START-BROWSE.                                               DTSBD555
01396      SET L910-START-BROWSE-88 TO TRUE.                            DTSBD555
01397      GO TO S910-MSTR-IO.                                          DTSBD555
01398                                                                   DTSBD555
01399  S910-READ-NEXT.                                                  DTSBD555
01400      SET L910-READ-NEXT-88 TO TRUE.                               DTSBD555
01401      GO TO S910-MSTR-IO.                                          DTSBD555
01402                                                                   DTSBD555
01403  S910-CLOSE.                                                      DTSBD555
01404      SET L910-CLOSE-88     TO TRUE.                               DTSBD555
01405      GO TO S910-MSTR-IO.                                          DTSBD555
01406                                                                   DTSBD555
01407  S910-MSTR-IO.                                                    DTSBD555
01408      CALL 'DTSBU910' USING L910-LINK-AREA                         DTSBD555
01409                            MSKL-REC.                              DTSBD555
01410  S910-EXIT.                                                       DTSBD555
01411      EXIT.                                                        DTSBD555
01412                                                                   DTSBD555
01413  S921-OPEN-READ.                                                  DTSBD555
01414      SET L921-OPEN-READ-88 TO TRUE.                               DTSBD555
01415      GO TO S921-AIX-IO.                                           DTSBD555
01416                                                                   DTSBD555
01417  S921-READ.                                                       DTSBD555
01418      SET L921-READ-88 TO TRUE.                                    DTSBD555
01419      GO TO S921-AIX-IO.                                           DTSBD555
01420                                                                   DTSBD555
01421  S921-START-BROWSE.                                               DTSBD555
01422      SET L921-START-BROWSE-88 TO TRUE.                            DTSBD555
01423      GO TO S921-AIX-IO.                                           DTSBD555
01424                                                                   DTSBD555
01425  S921-READ-NEXT.                                                  DTSBD555
01426      SET L921-READ-NEXT-88 TO TRUE.                               DTSBD555
01427      GO TO S921-AIX-IO.                                           DTSBD555
01428                                                                   DTSBD555
01429  S921-CLOSE.                                                      DTSBD555
01430      SET L921-CLOSE-88 TO TRUE.                                   DTSBD555
01431      GO TO S921-AIX-IO.                                           DTSBD555
01432                                                                   DTSBD555
01433  S921-AIX-IO.                                                     DTSBD555
01434      CALL 'DTSBU921' USING L921-LINK-AREA                         DTSBD555
01435                            ISKL-REC.                              DTSBD555
01436  S921-EXIT.                                                       DTSBD555
01437      EXIT.                                                        DTSBD555
01438                                                                   DTSBD555
01439  S923-OPEN-UPDATE.                                                DTSBD555
01440      SET L923-OPEN-UPDATE-88 TO TRUE.                             DTSBD555
01441      GO TO S923-ATC-CALL.                                         DTSBD555
01442                                                                   DTSBD555
01443  S923-WRITE.                                                      DTSBD555
01444      SET L923-WRITE-88 TO TRUE.                                   DTSBD555
01445      GO TO S923-ATC-CALL.                                         DTSBD555
01446                                                                   DTSBD555
01447  S923-CLOSE.                                                      DTSBD555
01448      SET L923-CLOSE-88 TO TRUE.                                   DTSBD555
01449      GO TO S923-ATC-CALL.                                         DTSBD555
01450                                                                   DTSBD555
01451  S923-ATC-CALL.                                                   DTSBD555
01452      CALL 'DTSBU923' USING L923-LINK-AREA                         DTSBD555
01453                            ASKL-REC.                              DTSBD555
01454  S923-EXIT.                                                       DTSBD555
01455      EXIT.                                                        DTSBD555
01456                                                                   DTSBD555
01457  S927A-OPEN.                                                      DTSBD555
01458      SET L927-OPEN-UPDATE-88  TO TRUE.                            DTSBD555
01459      PERFORM S927Z-IO   THRU S927Z-EXIT.                          DTSBD555
01460                                                                   DTSBD555
01461  S927A-EXIT.                                                      DTSBD555
01462      EXIT.                                                        DTSBD555
01463                                                                   DTSBD555
01464  S927B-WRITE.                                                     DTSBD555
01465      SET L927-WRITE-88 TO TRUE.                                   DTSBD555
01466      PERFORM S927Z-IO   THRU S927Z-EXIT.                          DTSBD555
01467                                                                   DTSBD555
01468  S927B-EXIT.                                                      DTSBD555
01469      EXIT.                                                        DTSBD555
01470                                                                   DTSBD555
01471  S927C-CLOSE.                                                     DTSBD555
01472      SET L927-CLOSE-88        TO TRUE.                            DTSBD555
01473      PERFORM S927Z-IO   THRU S927Z-EXIT.                          DTSBD555
01474                                                                   DTSBD555
01475  S927C-EXIT.                                                      DTSBD555
01476      EXIT.                                                        DTSBD555
01477                                                                   DTSBD555
01478  S927Z-IO.                                                        DTSBD555
01479      CALL 'DTSBU927' USING L927-LINK-AREA                         DTSBD555
01480                            TSKL-REC.                              DTSBD555
01481  S927Z-EXIT.                                                      DTSBD555
01482      EXIT.                                                        DTSBD555
01483                                                                   DTSBD555
01484  S931-OPEN-READ.                                                  DTSBD555
01485      SET L931-OPEN-READ-88 TO TRUE.                               DTSBD555
01486      GO TO S931-REF-IO.                                           DTSBD555
01487                                                                   DTSBD555
01488  S931-CLOSE.                                                      DTSBD555
01489      SET L931-CLOSE-88 TO TRUE.                                   DTSBD555
01490      GO TO S931-REF-IO.                                           DTSBD555
01491                                                                   DTSBD555
01492  S931-REF-IO.                                                     DTSBD555
01493      CALL 'DTSBU931' USING L931-LINK-AREA                         DTSBD555
01494                            FSKL-REC.                              DTSBD555
01495  S931-EXIT.                                                       DTSBD555
01496      EXIT.                                                        DTSBD555
01497                                                                   DTSBD555
01498  S1000-OPEN-REPORT-IN.                                            DTSBD555
01499      OPEN INPUT    REPORT-FILE-IN.                                DTSBD555
01500      IF RPT-IN-OK-88                                              DTSBD555
01501         NEXT SENTENCE                                             DTSBD555
01502      ELSE                                                         DTSBD555
01503         SET W-FATAL-ERROR-YES-88 TO TRUE                          DTSBD555
01504         DISPLAY 'CANNOT OPEN REPORT FILE IN: '                    DTSBD555
01505            RPT-IN-STATUS                                          DTSBD555
01506      END-IF.                                                      DTSBD555
01507                                                                   DTSBD555
01508  S1000-EXIT.                                                      DTSBD555
01509      EXIT.                                                        DTSBD555
01510                                                                   DTSBD555
01511  S1005-READ-REPORT-IN.                                            DTSBD555
01512      READ REPORT-FILE-IN.                                         DTSBD555
01513      IF RPT-IN-OK-88                                              DTSBD555
01514         ADD +1                      TO W-RPT-IN-CNT               DTSBD555
01515      ELSE                                                         DTSBD555
01516         IF RPT-IN-EOF-88                                          DTSBD555
01517            NEXT SENTENCE                                          DTSBD555
01518         ELSE                                                      DTSBD555
01519            DISPLAY 'CANNOT READ REPORT FILE '                     DTSBD555
01520               RPT-IN-STATUS                                       DTSBD555
01521            SET W-FATAL-ERROR-YES-88 TO TRUE                       DTSBD555
01522         END-IF                                                    DTSBD555
01523      END-IF.                                                      DTSBD555
01524                                                                   DTSBD555
01525  S1005-EXIT.                                                      DTSBD555
01526      EXIT.                                                        DTSBD555
01527                                                                   DTSBD555
01528  S1010-CLOSE-REPORT-IN.                                           DTSBD555
01529      CLOSE REPORT-FILE-IN.                                        DTSBD555
01530                                                                   DTSBD555
01531  S1010-EXIT.                                                      DTSBD555
01532      EXIT.                                                        DTSBD555
01533                                                                   DTSBD555
01534  S1020-OPEN-WAGE-IN.                                              DTSBD555
01535      OPEN INPUT    WAGE-FILE-IN.                                  DTSBD555
01536      IF WAGE-IN-OK-88                                             DTSBD555
01537         NEXT SENTENCE                                             DTSBD555
01538      ELSE                                                         DTSBD555
01539         SET W-FATAL-ERROR-YES-88 TO TRUE                          DTSBD555
01540         DISPLAY 'CANNOT OPEN WAGE FILE IN: '                      DTSBD555
01541            WAGE-IN-STATUS                                         DTSBD555
01542      END-IF.                                                      DTSBD555
01543                                                                   DTSBD555
01544  S1020-EXIT.                                                      DTSBD555
01545      EXIT.                                                        DTSBD555
01546                                                                   DTSBD555
01547  S1025-READ-WAGE-IN.                                              DTSBD555
01548      READ WAGE-FILE-IN.                                           DTSBD555
01549      IF WAGE-IN-OK-88                                             DTSBD555
01550         ADD +1                         TO W-WAGE-IN-CNT           DTSBD555
01551      ELSE                                                         DTSBD555
01552         IF WAGE-IN-EOF-88                                         DTSBD555
01553            SET W-WAGE-COMPLETE-YES-88  TO TRUE                    DTSBD555
01554         ELSE                                                      DTSBD555
01555            DISPLAY 'CANNOT READ WAGE FILE '                       DTSBD555
01556               WAGE-IN-STATUS                                      DTSBD555
01557            SET W-FATAL-ERROR-YES-88    TO TRUE                    DTSBD555
01558         END-IF                                                    DTSBD555
01559      END-IF.                                                      DTSBD555
01560                                                                   DTSBD555
01561  S1025-EXIT.                                                      DTSBD555
01562      EXIT.                                                        DTSBD555
01563                                                                   DTSBD555
01564  S1030-CLOSE-WAGE-IN.                                             DTSBD555
01565      CLOSE WAGE-FILE-IN.                                          DTSBD555
01566                                                                   DTSBD555
01567  S1030-EXIT.                                                      DTSBD555
01568      EXIT.                                                        DTSBD555
01569                                                                   DTSBD555
01570  S1032-WRITE-TEMP-T028.                                           DTSBD555
01571      MOVE T028-LENGTH     TO VAR-CHAR-CNT.                        DTSBD555
01572      MOVE T028-REC        TO TEMP-BTC-REC.                        DTSBD555
01573      WRITE TEMP-BTC-REC.                                          DTSBD555
01574      IF TEMP-BTC-STATUS-OK-88                                     DTSBD555
01575         ADD +1            TO W-TEMP-T028-CNT                      DTSBD555
01576      ELSE                                                         DTSBD555
01577         SET W-ERROR-YES-88 TO TRUE                                DTSBD555
01578         DISPLAY 'CANNOT WRITE TEMP T028: '                        DTSBD555
01579            TEMP-BTC-STATUS                                        DTSBD555
01580      END-IF.                                                      DTSBD555
01581                                                                   DTSBD555
01582  S1032-EXIT.                                                      DTSBD555
01583      EXIT.                                                        DTSBD555
01584                                                                   DTSBD555
01585  S1040-OPEN-TEMP-BTC-OUT.                                         DTSBD555
01586      OPEN OUTPUT   TEMP-BTC-FILE.                                 DTSBD555
01587      IF TEMP-BTC-STATUS-OK-88                                     DTSBD555
01588         NEXT SENTENCE                                             DTSBD555
01589      ELSE                                                         DTSBD555
01590         SET W-FATAL-ERROR-YES-88 TO TRUE                          DTSBD555
01591         DISPLAY 'CANNOT OPEN TEMP BTC FILE OUTPUT: '              DTSBD555
01592            TEMP-BTC-STATUS                                        DTSBD555
01593      END-IF.                                                      DTSBD555
01594                                                                   DTSBD555
01595  S1040-EXIT.                                                      DTSBD555
01596      EXIT.                                                        DTSBD555
01597                                                                   DTSBD555
01598  S1050-OPEN-TEMP-BTC-IN.                                          DTSBD555
01599      OPEN INPUT    TEMP-BTC-FILE.                                 DTSBD555
01600      IF TEMP-BTC-STATUS-OK-88                                     DTSBD555
01601         NEXT SENTENCE                                             DTSBD555
01602      ELSE                                                         DTSBD555
01603         SET W-FATAL-ERROR-YES-88 TO TRUE                          DTSBD555
01604         DISPLAY 'CANNOT OPEN TEMP BTC FILE INPUT: '               DTSBD555
01605            TEMP-BTC-STATUS                                        DTSBD555
01606      END-IF.                                                      DTSBD555
01607                                                                   DTSBD555
01608  S1050-EXIT.                                                      DTSBD555
01609      EXIT.                                                        DTSBD555
01610                                                                   DTSBD555
01611  S1060-CLOSE-TEMP-BTC.                                            DTSBD555
01612      CLOSE    TEMP-BTC-FILE.                                      DTSBD555
01613      IF TEMP-BTC-STATUS-OK-88                                     DTSBD555
01614         NEXT SENTENCE                                             DTSBD555
01615      ELSE                                                         DTSBD555
01616         SET W-FATAL-ERROR-YES-88 TO TRUE                          DTSBD555
01617         DISPLAY 'CANNOT CLOSE TEMP BTC FILE: '                    DTSBD555
01618            TEMP-BTC-STATUS                                        DTSBD555
01619      END-IF.                                                      DTSBD555
01620                                                                   DTSBD555
01621  S1060-EXIT.                                                      DTSBD555
01622      EXIT.                                                        DTSBD555
01623                                                                   DTSBD555
01624  S1070-READ-TEMP-BTC.                                             DTSBD555
01625      READ TEMP-BTC-FILE.                                          DTSBD555
01626      IF TEMP-BTC-STATUS-OK-88                                     DTSBD555
01627         COMPUTE VAR-CHAR-CNT = (RVAR-LENGTH - 2)                  DTSBD555
01628      ELSE                                                         DTSBD555
01629         IF TEMP-BTC-STATUS-EOF-88                                 DTSBD555
01630            NEXT SENTENCE                                          DTSBD555
01631         ELSE                                                      DTSBD555
01632            DISPLAY 'CANNOT READ TEMP-BTC FILE '                   DTSBD555
01633               TEMP-BTC-STATUS                                     DTSBD555
01634            SET W-FATAL-ERROR-YES-88 TO TRUE                       DTSBD555
01635         END-IF                                                    DTSBD555
01636      END-IF.                                                      DTSBD555
01637                                                                   DTSBD555
01638  S1070-EXIT.                                                      DTSBD555
01639      EXIT.                                                        DTSBD555
01640                                                                   DTSBD555
01641  S1100-OPEN-WAGE-TEMP-OUT.                                        DTSBD555
01642      OPEN OUTPUT   WAGE-FILE-TEMP.                                DTSBD555
01643      IF NOT WAGE-TEMP-STATUS-OK-88                                DTSBD555
01644         SET W-FATAL-ERROR-YES-88 TO TRUE                          DTSBD555
01645         DISPLAY 'CANNOT OPEN WAGE TEMP FILE OUTPUT: '             DTSBD555
01646            WAGE-TEMP-STATUS                                       DTSBD555
01647      END-IF.                                                      DTSBD555
01648                                                                   DTSBD555
01649  S1100-EXIT.                                                      DTSBD555
01650      EXIT.                                                        DTSBD555
01651                                                                   DTSBD555
01652  S1110-CLOSE-WAGE-TEMP.                                           DTSBD555
01653      CLOSE   WAGE-FILE-TEMP.                                      DTSBD555
01654      IF NOT WAGE-TEMP-STATUS-OK-88                                DTSBD555
01655         SET W-FATAL-ERROR-YES-88 TO TRUE                          DTSBD555
01656         DISPLAY 'CANNOT CLOSE WAGE TEMP FILE: '                   DTSBD555
01657            WAGE-TEMP-STATUS                                       DTSBD555
01658      END-IF.                                                      DTSBD555
01659                                                                   DTSBD555
01660  S1110-EXIT.                                                      DTSBD555
01661      EXIT.                                                        DTSBD555
01662                                                                   DTSBD555
01663  S1120-WRITE-WAGE-TEMP.                                           DTSBD555
01664      WRITE WAGE-TEMP-REC FROM W001-REC.                           DTSBD555
01665      IF NOT WAGE-TEMP-STATUS-OK-88                                DTSBD555
01666         SET W-FATAL-ERROR-YES-88 TO TRUE                          DTSBD555
01667         DISPLAY 'CANNOT WRITE WAGE TEMP FILE: '                   DTSBD555
01668            WAGE-TEMP-STATUS                                       DTSBD555
01669      ELSE                                                         DTSBD555
01670         ADD +1                       TO W-TEMP-WAGE-CNT           DTSBD555
01671      END-IF.                                                      DTSBD555
01672                                                                   DTSBD555
01673  S1120-EXIT.                                                      DTSBD555
01674      EXIT.                                                        DTSBD555
01675                                                                   DTSBD555
01676  S1130-OPEN-WAGE-TEMP-IN.                                         DTSBD555
01677      OPEN INPUT    WAGE-FILE-TEMP.                                DTSBD555
01678      IF NOT WAGE-TEMP-STATUS-OK-88                                DTSBD555
01679         SET W-FATAL-ERROR-YES-88 TO TRUE                          DTSBD555
01680         DISPLAY 'CANNOT OPEN WAGE TEMP FILE INPUT: '              DTSBD555
01681            WAGE-TEMP-STATUS                                       DTSBD555
01682      END-IF.                                                      DTSBD555
01683                                                                   DTSBD555
01684  S1130-EXIT.                                                      DTSBD555
01685      EXIT.                                                        DTSBD555
01686                                                                   DTSBD555
01687  S1140-READ-WAGE-TEMP.                                            DTSBD555
01688      READ WAGE-FILE-TEMP INTO W001-REC.                           DTSBD555
01689      IF WAGE-TEMP-STATUS-EOF-88                                   DTSBD555
01690         NEXT SENTENCE                                             DTSBD555
01691      ELSE                                                         DTSBD555
01692         IF NOT WAGE-TEMP-STATUS-OK-88                             DTSBD555
01693            SET W-FATAL-ERROR-YES-88 TO TRUE                       DTSBD555
01694            DISPLAY 'READ ERROR ON WAGE TEMP FILE: '               DTSBD555
01695               WAGE-TEMP-STATUS                                    DTSBD555
01696         END-IF                                                    DTSBD555
01697      END-IF.                                                      DTSBD555
01698                                                                   DTSBD555
01699  S1140-EXIT.                                                      DTSBD555
01700      EXIT.                                                        DTSBD555
01701                                                                   DTSBD555
01702  S1150-OPEN-WAGE-FILE-OUT.                                        DTSBD555
01703      OPEN OUTPUT   WAGE-FILE-OUT.                                 DTSBD555
01704      IF NOT WAGE-OUT-STATUS-OK-88                                 DTSBD555
01705         SET W-FATAL-ERROR-YES-88 TO TRUE                          DTSBD555
01706         DISPLAY 'CANNOT OPEN WAGE FILE OUTPUT: '                  DTSBD555
01707            WAGE-OUT-STATUS                                        DTSBD555
01708      END-IF.                                                      DTSBD555
01709                                                                   DTSBD555
01710  S1150-EXIT.                                                      DTSBD555
01711      EXIT.                                                        DTSBD555
01712                                                                   DTSBD555
01713  S1160-CLOSE-WAGE-OUT.                                            DTSBD555
01714      CLOSE   WAGE-FILE-OUT.                                       DTSBD555
01715      IF NOT WAGE-OUT-STATUS-OK-88                                 DTSBD555
01716         SET W-FATAL-ERROR-YES-88 TO TRUE                          DTSBD555
01717         DISPLAY 'CANNOT CLOSE WAGE FILE: '                        DTSBD555
01718            WAGE-OUT-STATUS                                        DTSBD555
01719      END-IF.                                                      DTSBD555
01720                                                                   DTSBD555
01721  S1160-EXIT.                                                      DTSBD555
01722      EXIT.                                                        DTSBD555
01723                                                                   DTSBD555
01724  S1170-WRITE-WAGE-OUT.                                            DTSBD555
01725      WRITE WAGE-OUT-REC  FROM WAGE-TEMP-REC.                      DTSBD555
01726      IF NOT WAGE-OUT-STATUS-OK-88                                 DTSBD555
01727         SET W-FATAL-ERROR-YES-88 TO TRUE                          DTSBD555
01728         DISPLAY 'CANNOT WRITE WAGE OUT FILE: '                    DTSBD555
01729            WAGE-OUT-STATUS                                        DTSBD555
01730      ELSE                                                         DTSBD555
01731         ADD +1                         TO W-WAGE-OUT-CNT          DTSBD555
01732      END-IF.                                                      DTSBD555
01733                                                                   DTSBD555
01734  S1170-EXIT.                                                      DTSBD555
01735      EXIT.                                                        DTSBD555
01736                                                                   DTSBD555
01737  S946-WRITE-R140.                                                 DTSBD555
01738      CALL 'DTSBU946' USING R140-REC.                              DTSBD555
01739                                                                   DTSBD555
01740  S946-EXIT.                                                       DTSBD555
01741      EXIT.                                                        DTSBD555
01742                                                                   DTSBD555
01743  S999-ABEND.                                                      DTSBD555
01744      CALL 'DTSBU999' USING W-ABEND-CD.                            DTSBD555
01745  S999-EXIT.                                                       DTSBD555
01746      EXIT.                                                        DTSBD555
01747                                                                   DTSBD555
