00001  IDENTIFICATION DIVISION.                                         03/10/25
00002  PROGRAM-ID.             DTSBX430.                                DTSBX430
00003  AUTHOR.                 NGC.                                        LV253
00004  DATE-WRITTEN.           APRIL 2005.                              DTSBX430
00005  DATE-COMPILED.                                                   DTSBX430
00006      SKIP3                                                        DTSBX430
00007 *****                                                             DTSBX430
00008 *                                                                 DTSBX430
00009 *    >>>  PROCESSING FOR WEB REPORTS AND WAGES NEEDS TO BE        DTSBX430
00010 *    >>>  MODIFIED TO CREATE BATCH AND ITEM NUMBERS.  THEY        DTSBX430
00011 *    >>>  WILL EITHER BE GROUPED INTO ACCOUNTING BATCHES          DTSBX430
00012 *    >>>  IN THE WEB APPLICATION, OR CONTINUE TO GO THROUGH       DTSBX430
00013 *    >>>  DTSBD140.                                               DTSBX430
00014 *                                                                 DTSBX430
00015 *    FUNCTION:  EDIT REPORT DATA FROM WEB APPLICATION.            DTSBX430
00016 *                                                                 DTSBX430
00017 *    MODIFICATION HISTORY:                                        DTSBX430
00018 *                                                                 DTSBX430
00019 *    04-05-2005 INITIAL DEVELOPMENT                               DTSBX430
00020 *               REFERENCE RFP: WEB REPORTING                      DTSBX430
00021 *                                                                 DTSBX430
00022 *    10-21-2008 MODIFIED FOR NEW VERSION OF DTSIX144.             DTSBX430
00023 *               NEW RECORD INCLUDES EMPLOYEE NAME.                DTSBX430
00024 *               REFERENCE RFP: WEB REPORTING.                     DTSBX430
00025 *                                                                 DTSBX430
00026 *                                                                 DTSBX430
00027 *    10-21-2009 MODIFIED TO SEPARATE REPORT PROCESSING FROM       DTSBX430
00028 *               NEW WAGE-ONLY PROCESSING. P5000 CHANGED TO        DTSBX430
00029 *               DETERMINE WHETHER ONLY WAGES OR WAGES             DTSBX430
00030 *               ASSOCIATED WITH A REPORT ARE PRESENT.             DTSBX430
00031 *               IF ONLY WAGES ARE PRESENT, COPY THE               DTSBX430
00032 *               TEMPORARY WAGE FILE TO THE OUTPUT WAGE FILE.      DTSBX430
00033 *               IF PROCESSING A REPORT, VERIFY THAT THE REPORTED  DTSBX430
00034 *               AMOUNTS MATCH THE CALCULATED AMOUNTS, AND COPY    DTSBX430
00035 *               BOTH THE REPORT AND WAGE TEMPORARY FILES          DTSBX430
00036 *               TO THE OUTPUT.                                    DTSBX430
00037 *               REFERENCE RFP: MAG MEDIA WAGE ONLY       GD       DTSBX430
00038 *                                                                 DTSBX430
00039 *    06-09-2010 MODIFIED FOR IN-HOUSE CASHIERING.                 DTSBX430
00040 *               REFERENCE RFP: IN-HOUSE CASHIERING       GD       DTSBX430
00041 *                                                                 DTSBX430
00042 *    11-10-2010 MODIFIED FOR WEB REPORTING.              GD       DTSBX430
00043 *                                                                 DTSBX430
00044 *                                                                 DTSBX430
00045 *                                                                    CL**9
00046 *    10-15-2014 MODIFIED PROGRAM TO WRITE T28 RECORDS ONLY           CL**9
00047 *               TO X430BTC FILE. ALSO NO WAGE RECORDS ARE            CL*47
00048 *               WRITTEN TO TO THE WAGE BTC FILE DUE TO NO            CL**9
00049 *               BATCH NUMBERS, WAGE RECORDS ARE NOW WRITTEN          CL**9
00050 *               TO THE WAGE NAME FILE.                               CL**9
00051 *****                                                             DTSBX430
00052      SKIP3                                                        DTSBX430
00053  ENVIRONMENT DIVISION.                                            DTSBX430
00054                                                                      CL122
00055  CONFIGURATION SECTION.                                              CL122
00056  SPECIAL-NAMES. C01 IS TOP-OF-PAGE.                                  CL122
00057                                                                      CL122
00058  INPUT-OUTPUT SECTION.                                            DTSBX430
00059                                                                   DTSBX430
00060  FILE-CONTROL.                                                    DTSBX430
00061                                                                   DTSBX430
00062      SELECT TEMP-BTC-FILE    ASSIGN TO X430BTC                       CL*47
00063         FILE STATUS IS TEMP-BTC-STATUS.                           DTSBX430
00064                                                                      CL*59
00065      SELECT PEND-X140-FILE    ASSIGN TO PENDX140                     CL*59
00066         FILE STATUS IS REPT-140-STATUS.                              CL*63
00067                                                                      CL*59
00068      SELECT PEND-X144-FILE    ASSIGN TO PENDX144                     CL*59
00069         FILE STATUS IS WAGE-144-STATUS.                              CL*63
00070                                                                      CL*59
00071      SELECT PEND-X145-FILE    ASSIGN TO PENDX145                     CL*59
00072         FILE STATUS IS PAYT-145-STATUS.                              CL*63
00073                                                                      CL*59
00074      SELECT WAGE-FILE-TEMP ASSIGN TO WAGETEMP                     DTSBX430
00075         FILE STATUS IS WAGE-TEMP-STATUS.                          DTSBX430
00076                                                                   DTSBX430
00077      SELECT WAGE-FILE-OUT  ASSIGN TO DTSFW4GE                        CL*22
00078         FILE STATUS IS WAGE-OUT-STATUS.                              CL*20
00079                                                                   DTSBX430
00080      SELECT BATCH-XREF-FILE ASSIGN TO BX214422                    DTSBX430
00081         FILE STATUS IS BATCH-XREF-STATUS.                         DTSBX430
00082                                                                      CL119
00083      SELECT X430-PAID-FILE    ASSIGN TO X430RPT1                     CL203
00084         FILE STATUS IS REPT-STATUS.                                  CL119
00085                                                                      CL119
00086      SELECT X430-PEND-FILE    ASSIGN TO X430RPT2                     CL203
00087         FILE STATUS IS REPT-STATUS.                                  CL119
00088                                                                      CL119
00089                                                                   DTSBX430
00090  DATA DIVISION.                                                   DTSBX430
00091                                                                   DTSBX430
00092  FILE SECTION.                                                    DTSBX430
00093                                                                   DTSBX430
00094  FD  TEMP-BTC-FILE                                                DTSBX430
00095      RECORDING MODE IS V                                          DTSBX430
00096      BLOCK CONTAINS 0 RECORDS.                                    DTSBX430
00097                                                                   DTSBX430
00098  01  TEMP-BTC-REC.                                                DTSBX430
00099  ++INCLUDE DTSIRVAR                                               DTSBX430
00100                                                                   DTSBX430
00101  01  TSKL-REC.                                                    DTSBX430
00102  ++INCLUDE DTSITSKL                                               DTSBX430
00103                                                                   DTSBX430
00104  FD  WAGE-FILE-TEMP                                               DTSBX430
00105      RECORDING MODE IS F                                          DTSBX430
00106      BLOCK CONTAINS 0 RECORDS                                     DTSBX430
00107      LABEL RECORDS ARE OMITTED.                                   DTSBX430
00108                                                                   DTSBX430
00109  01  WAGE-TEMP-REC                 PIC X(128).                    DTSBX430
00110                                                                   DTSBX430
00111  FD  WAGE-FILE-OUT                                                   CL*20
00112      RECORDING MODE IS F                                             CL*20
00113      BLOCK CONTAINS 0 RECORDS                                        CL*20
00114      LABEL RECORDS ARE OMITTED.                                      CL*20
00115                                                                   DTSBX430
00116  01  WAGE-OUT-REC                  PIC X(80).                        CL*20
00117                                                                   DTSBX430
00118  FD  BATCH-XREF-FILE                                              DTSBX430
00119      RECORDING MODE IS F                                          DTSBX430
00120      BLOCK CONTAINS 0 RECORDS                                     DTSBX430
00121      LABEL RECORDS ARE OMITTED.                                   DTSBX430
00122                                                                   DTSBX430
00123  01  BATCH-XREF-REC           PIC X(30).                          DTSBX430
00124                                                                      CL*11
00125                                                                      CL*59
00126  FD  PEND-X140-FILE                                                  CL*59
00127      RECORDING MODE IS F                                             CL*59
00128      BLOCK CONTAINS 0 RECORDS                                        CL*59
00129      LABEL RECORDS ARE OMITTED.                                      CL*59
00130                                                                      CL*59
00131  01  PEND-X140-REC                 PIC X(512).                       CL*59
00132                                                                   DTSBX430
00133  FD  PEND-X144-FILE                                                  CL*59
00134      RECORDING MODE IS F                                             CL*59
00135      BLOCK CONTAINS 0 RECORDS                                        CL*59
00136      LABEL RECORDS ARE OMITTED.                                      CL*59
00137                                                                      CL*59
00138  01  PEND-X144-REC                 PIC X(512).                       CL*59
00139                                                                      CL*59
00140  FD  PEND-X145-FILE                                                  CL*59
00141      RECORDING MODE IS F                                             CL*59
00142      BLOCK CONTAINS 0 RECORDS                                        CL*59
00143      LABEL RECORDS ARE OMITTED.                                      CL*59
00144                                                                      CL*59
00145  01  PEND-X145-REC                 PIC X(512).                       CL*59
00146                                                                      CL119
00147  FD  X430-PAID-FILE                                                  CL200
00148      RECORDING MODE IS F                                             CL119
00149      BLOCK CONTAINS 0 RECORDS                                        CL119
00150      LABEL RECORDS ARE OMITTED.                                      CL119
00151                                                                      CL119
00152  01  REPT-PAID-REC           PIC X(133).                             CL121
00153                                                                      CL119
00154                                                                      CL119
00155  FD  X430-PEND-FILE                                                  CL200
00156      RECORDING MODE IS F                                             CL119
00157      BLOCK CONTAINS 0 RECORDS                                        CL119
00158      LABEL RECORDS ARE OMITTED.                                      CL119
00159                                                                      CL119
00160  01  REPT-PEND-REC           PIC X(133).                             CL119
00161                                                                      CL119
00162                                                                      CL*59
00163  WORKING-STORAGE SECTION.                                         DTSBX430
001635 77  PAN-VALET PICTURE X(24) VALUE '253DTSBX430  03/10/25'.       DTSBX430
00164  77  PAN-VALET PICTURE X(24) VALUE '015DTSBX422  10/07/14'.       DTSBX430
00165  77  PAN-VALET PICTURE X(24) VALUE '047DTSBX422  09/27/14'.       DTSBX430
00166      SKIP3                                                        DTSBX430
00167  01  WRK-AREA.                                                    DTSBX430
00168      05  W-ABEND-CD                  PIC S9(04)  COMP  VALUE 430.    CL*47
00169      05  W-MOD-NAME                  PIC  X(08)  VALUE 'DTSBX430'.   CL*47
00170      05  WS-NUMBER-ONE               PIC S9(05)  COMP-3 VALUE +0.    CL121
00171                                                                      CL121
00172      05  WS-LINE-CNT                 PIC S9(02) COMP-3 VALUE 60.     CL121
00173      05  WS-LINE-CNT2                PIC S9(02) COMP-3 VALUE +0.     CL121
00174      05  WS-PAGE-CNT                 PIC S9(03) COMP-3 VALUE +0.     CL121
00175                                                                      CL133
00176      05  WSP-LINE-CNT                 PIC S9(02) COMP-3 VALUE 60.    CL133
00177      05  WSP-LINE-CNT2                PIC S9(02) COMP-3 VALUE +0.    CL133
00178      05  WSP-PAGE-CNT                 PIC S9(03) COMP-3 VALUE +0.    CL133
00179      05  WRK-CURR-DATE                PIC 9(08)  VALUE 0.            CL248
00180                                                                      CL121
00181      05  W-PREV-REC-TYPE         PIC  X(03) VALUE SPACES.         DTSBX430
00182          88 W-PREV-REC-NULL-88    VALUE 'XXX'.                       CL*87
00183          88 W-PREV-RPT-NULL-88    VALUE 'XXX'.                       CL*87
00184          88 W-PREV-REC-PRF-88     VALUE '102'.                    DTSBX430
00185          88 W-PREV-REC-DETERM-88  VALUE '104'.                    DTSBX430
00186          88 W-PREV-REC-NAME-88    VALUE '106'.                    DTSBX430
00187          88 W-PREV-REC-RATE-88    VALUE '108'.                    DTSBX430
00188          88 W-PREV-REC-ADDR-88    VALUE '110'.                    DTSBX430
00189          88 W-PREV-REC-OPO-88     VALUE '120'.                    DTSBX430
00190          88 W-PREV-REC-REL-88     VALUE '130'.                    DTSBX430
00191          88 W-PREV-REC-IND-88     VALUE '132'.                    DTSBX430
00192          88 W-PREV-REC-RPT-88     VALUE '140'.                    DTSBX430
00193          88 W-PREV-RPT-RPT-88     VALUE '140'.                       CL*86
00194          88 W-PREV-REC-WAGE-88    VALUE '144'.                    DTSBX430
00195          88 W-PREV-RPT-WAGE-88    VALUE '144'.                       CL*86
00196          88 W-PREV-REC-PAY-88     VALUE '145'.                    DTSBX430
00197          88 W-PREV-RPT-PAY-88     VALUE '145'.                       CL*86
00198          88 W-PREV-REC-BHDR-88    VALUE '149'.                    DTSBX430
00199                                                                   DTSBX430
00200      05  TEMP-BTC-STATUS         PIC  X(02).                      DTSBX430
00201          88 TEMP-BTC-STATUS-OK-88     VALUE '00'.                 DTSBX430
00202          88 TEMP-BTC-STATUS-EOF-88    VALUE '10'.                 DTSBX430
00203                                                                   DTSBX430
00204      05  WAGE-TEMP-STATUS        PIC  X(02).                      DTSBX430
00205          88 WAGE-TEMP-STATUS-OK-88    VALUE '00'.                 DTSBX430
00206          88 WAGE-TEMP-STATUS-EOF-88   VALUE '10'.                 DTSBX430
00207                                                                   DTSBX430
00208      05  WAGE-OUT-STATUS         PIC  X(02).                      DTSBX430
00209          88 WAGE-OUT-STATUS-OK-88     VALUE '00'.                 DTSBX430
00210                                                                   DTSBX430
00211      05  BATCH-XREF-STATUS       PIC  X(02).                      DTSBX430
00212          88 BATCH-XREF-OK-88          VALUE '00'.                 DTSBX430
00213                                                                   DTSBX430
00214      05  VAR-CHAR-CNT             PIC S9(04) COMP.                DTSBX430
00215                                                                      CL*12
00216      05  WAGE-TRANS-STATUS          PIC  X(02).                      CL*12
00217           88  WAGE-TRANS-FILE-OK-88       VALUE '00' '97'.           CL*12
00218           88  WAGE-TRANS-FILE-NO-REC-88   VALUE '10' '23'.           CL*12
00219           88  WAGE-TRANS-FILE-VERIFY-88   VALUE '97'.                CL*12
00220                                                                      CL*12
00221      05  REPT-140-STATUS          PIC  X(02).                        CL*63
00222           88  REPT-140-OK-88       VALUE '00' '97'.                  CL*63
00223           88  REPT-140--NO-REC-88   VALUE '10' '23'.                 CL*63
00224                                                                      CL*61
00225      05  WAGE-144-STATUS          PIC  X(02).                        CL*63
00226           88  WAGE-144-OK-88       VALUE '00' '97'.                  CL*63
00227           88  WAGE-144--NO-REC-88   VALUE '10' '23'.                 CL*63
00228                                                                      CL*61
00229      05  PAYT-145-STATUS          PIC  X(02).                        CL*63
00230           88  PAYT-145-OK-88       VALUE '00' '97'.                  CL*64
00231           88  PAYT-145-NO-REC-88   VALUE '10' '23'.                  CL*64
00232                                                                   DTSBX430
00233                                                                      CL119
00234      05  REPT-STATUS             PIC  X(02).                         CL119
00235          88 REPT-STATUS-OK-88         VALUE '00'.                    CL119
00236          88 REPT-STATUS-EOF-88        VALUE '10'.                    CL119
00237                                                                      CL119
00238      05  W-RPT-ERROR-IND              PIC  X(01) VALUE 'N'.          CL*80
00239          88 W-RPT-ERROR-YES-88            VALUE 'Y'.                 CL*81
00240          88 W-RPT-ERROR-NO-88             VALUE 'N'.                 CL*81
00241                                                                   DTSBX430
00242      05  W-FATAL-ERROR-IND           PIC  X(01) VALUE 'N'.        DTSBX430
00243          88 W-FATAL-ERROR-YES-88      VALUE 'Y'.                  DTSBX430
00244          88 W-FATAL-ERROR-NO-88       VALUE 'N'.                  DTSBX430
00245                                                                   DTSBX430
00246      05  W-X145-PAYMENT-FOUND-IND         PIC  X(01) VALUE 'N'.      CL*54
00247          88 W-X145-PAYMENT-YES-88      VALUE 'Y'.                    CL*54
00248          88 W-X145-PAYMENT-NO-88       VALUE 'N'.                    CL*54
00249                                                                      CL*54
00250      05  W-X145-PAYMENT-DUPLIC-IND         PIC  X(01) VALUE 'N'.     CL170
00251          88 X145-PAYMENT-DUP-YES-88      VALUE 'Y'.                  CL170
00252          88 X145-PAYMENT-DUP-NO-88       VALUE 'N'.                  CL170
00253                                                                      CL170
00254      05  W-WRITE-T025-TRAN             PIC  X(01) VALUE 'N'.         CL*73
00255          88 W-WRITE-T025-TRAN-YES-88      VALUE 'Y'.                 CL*73
00256          88 W-WRITE-T025-TRAN-NO-88       VALUE 'N'.                 CL*73
00257                                                                      CL*73
00258      05  W-EMP-FOUND-IND             PIC  X(01) VALUE 'N'.        DTSBX430
00259          88 W-EMP-FOUND-YES-88        VALUE 'Y'.                  DTSBX430
00260          88 W-EMP-FOUND-NO-88         VALUE 'N'.                  DTSBX430
00261                                                                   DTSBX430
00262      05  W-RPT-IN-PROGRESS-IND       PIC  X(01) VALUE 'N'.        DTSBX430
00263          88 W-RPT-IN-PROGRESS-YES-88  VALUE 'Y'.                  DTSBX430
00264          88 W-RPT-IN-PROGRESS-NO-88   VALUE 'N'.                  DTSBX430
00265                                                                   DTSBX430
00266      05  W-WAGE-IN-PROGRESS-IND      PIC  X(01) VALUE 'N'.        DTSBX430
00267          88 W-WAGE-IN-PROGRESS-YES-88 VALUE 'Y'.                  DTSBX430
00268          88 W-WAGE-IN-PROGRESS-NO-88  VALUE 'N'.                  DTSBX430
00269                                                                   DTSBX430
00270      05  W-ARPT-MAX              PIC S9(04) COMP VALUE +100.      DTSBX430
00271      05  W-ARPT-LAST             PIC S9(04) COMP VALUE +0.        DTSBX430
00272      05  RSUB                    PIC S9(04) COMP VALUE +0.        DTSBX430
00273      05  W-ARPT-TABLE.                                            DTSBX430
00274          10  W-ARPT-ENTRY OCCURS 100 TIMES PIC X(128).            DTSBX430
00275                                                                   DTSBX430
00276      05  W-EMP-NO                PIC S9(07) COMP-3.               DTSBX430
00277      05  W-EMP-X140-NO          PIC S9(07) COMP-3.                   CL189
00278      05  W-EMP-X144-NO          PIC S9(07) COMP-3.                   CL191
00279      05  W-PAY-QTR               PIC  X(06) VALUE SPACES.            CL166
00280      05  W-X140-DUP              PIC S9(03) COMP-3 VALUE +0.         CL*41
00281      05  W-TRAN-CNT              PIC S9(03) COMP-3 VALUE +0.         CL*41
00282      05  W-REMIT-AMT             PIC S9(09)V99 COMP-3 VALUE +0.   DTSBX430
00283      05  W-T025-REMIT-AMT        PIC S9(09)V99 COMP-3 VALUE +0.      CL*73
00284      05  W-CURR-RPT-QTR          PIC S9(05) COMP-3 VALUE +0.      DTSBX430
00285      05  W-CURR-WAGE-QTR         PIC S9(05) COMP-3 VALUE +0.      DTSBX430
00286      05  W-WAIVER-QTR            PIC S9(05) COMP-3 VALUE +0.      DTSBX430
00287      05  W-X140-REPORT-QTR       PIC S9(05) COMP-3.                  CL*54
00288      05  W-X145-PAYMENT-QTR      PIC S9(05) COMP-3.                  CL*54
00289      05  W-X144-WAGE-QTR         PIC S9(05) COMP-3.                  CL*54
00290      05  WRK-REPORT-QTR          PIC 9(05).                       DTSBX430
00291      05  W-X145-TRACE-NO         PIC X(13)  VALUE SPACES.            CL158
00292      05  W-X145-TRACE-NO-N REDEFINES W-X145-TRACE-NO.                CL157
00293          10  W-X145-TRACE-NO-A   PIC 9(08).                          CL158
00294          10  W-X145-TRACE-NO-B   PIC 9(05).                          CL158
00295      05  W-EXCESS-WAGE           PIC S9(11)V99 VALUE +0.             CL252
00296      05  W-TOT-WAGE              PIC S9(11)V99 VALUE +0.             CL194
00297      05  W-TOT-X144-WAGE         PIC S9(11)V99 VALUE +0.             CL189
00298      05  W-TAX-WAGE              PIC S9(11)V99 VALUE +0.             CL123
00299      05  W-WRKR-TOT-WAGE         PIC S9(11)V99 VALUE +0.          DTSBX430
00300      05  W-WRKR-TAX-WAGE         PIC S9(11)V99 VALUE +0.             CL123
00301      05  WS-X140-REMITTANCE       PIC S9(09)V99 VALUE +0.            CL149
00302      05  W-X140-REMITTANCE       PIC S9(09)V99 VALUE +0.             CL149
00303      05  W-X145-REMITTANCE       PIC S9(09)V99 VALUE +0.             CL123
00304      05  W-TOT-REMIT-AMT         PIC S9(09)V99 VALUE +0.             CL123
00305      05  W-X145-TOT-REMIT-AMT    PIC S9(09)V99 VALUE +0.             CL123
00306      05  W-X145-RECEIVED-DATE    PIC S9(09) COMP-3.                  CL*72
00307      05  W-X140-RECEIVED-DATE    PIC S9(09) COMP-3.                  CL*72
00308      05  W-ESTB-DATE             PIC S9(09) COMP-3.               DTSBX430
00309      05  W-X145-DEPOSIT-DATE     PIC S9(09) COMP-3.                  CL*72
00310      05  W-CHK-SCAN-DATE         PIC S9(09) COMP-3.               DTSBX430
00311      05  W-1ST-MNTH-CNT          PIC S9(07) COMP-3.               DTSBX430
00312      05  W-2ND-MNTH-CNT          PIC S9(07) COMP-3.               DTSBX430
00313      05  W-3RD-MNTH-CNT          PIC S9(07) COMP-3.               DTSBX430
00314      05  W-WAGE-QTR              PIC S9(05) COMP-3.               DTSBX430
00315      05  W-SSN                   PIC S9(09) COMP-3.               DTSBX430
00316      05  W-EARNINGS-X            PIC  X(12).                      DTSBX430
00317      05  W-EARNINGS-9   REDEFINES W-EARNINGS-X                    DTSBX430
00318                                  PIC  9(09).99.                   DTSBX430
00319      05  W-EARNINGS              PIC S9(09)V99.                   DTSBX430
00320                                                                      CL180
00321      05  WS-Z145-DUP-REC          PIC X(50) VALUE SPACES.            CL181
00322      05  W-WORKER-NAME.                                           DTSBX430
00323          10  W-WRKR-FIRST-NAME   PIC  X(15).                      DTSBX430
00324          10  W-WRKR-MID-INIT     PIC  X(01).                      DTSBX430
00325          10  W-WRKR-LAST-NAME    PIC  X(20).                      DTSBX430
00326                                                                   DTSBX430
00327      05  W-RPT-TYPE              PIC  X(02).                      DTSBX430
00328          88  W-ORIG-88               VALUE 'OR'.                  DTSBX430
00329          88  W-EMP-AMEND-88          VALUE 'EA'.                  DTSBX430
00330          88  W-AUDIT-88              VALUE 'AU'.                  DTSBX430
00331          88  W-FLD-SUP-88            VALUE 'FS'.                  DTSBX430
00332          88  W-ADMIN-CORR-88         VALUE 'AC'.                  DTSBX430
00333          88  W-ESTIM-88              VALUE 'ES'.                  DTSBX430
00334          88  W-WITHDRW-88            VALUE 'WD'.                  DTSBX430
00335          88  W-SUPPLEM-88            VALUE 'EA' 'AU'              DTSBX430
00336                                            'FS' 'AC'.             DTSBX430
00337          88  W-RPT-TYPE-VALID-88     VALUE 'OR' 'EA' 'AU'         DTSBX430
00338                                            'FS' 'AC' 'ES'.           CL*55
00339      05  WS-HOLD-X145-REC            PIC X(512) VALUE SPACES.        CL170
00340                                                                      CL*55
00341      05  W-PAY-TYPE              PIC  X(02).                         CL*54
00342          88  W-PAY-ORIG-88            VALUE 'OR'.                    CL*54
00343          88  W-PAY-REG-88             VALUE 'PA'.                    CL*54
00344          88  W-VALID-PAY-88     VALUE 'OR' 'PA'.                     CL*54
00345                                                                      CL*54
00346                                                                   DTSBX430
00347      05  W-SEQ-NO                PIC  9(07)  VALUE 0.             DTSBX430
00348                                                                   DTSBX430
00349      05  W-MNTE-SUBJECT          PIC  X(40).                      DTSBX430
00350          88  W-MNTE-NOT-LIAB-88   VALUE                           DTSBX430
00351          'REASON FOR NOT-LIABLE DETERMINATION     '.              DTSBX430
00352          88  W-MNTE-KEY-WORD-88   VALUE                           DTSBX430
00353          'FR-500 INDUSTRY DESCRIPTION - KEY WORD  '.              DTSBX430
00354          88  W-MNTE-DATA-ENTRY-88 VALUE                           DTSBX430
00355          'FR-500 INDUSTRY DESCRIPTION - DATA ENTRY'.              DTSBX430
00356          88  W-MNTE-RELATIONSHIP-88 VALUE                         DTSBX430
00357          'WEB REGISTRATION RELATED EMPLOYER       '.              DTSBX430
00358                                                                   DTSBX430
00359      05  W-MNTE-COMPLETE-IND         PIC  X(01) VALUE 'N'.        DTSBX430
00360          88 W-MNTE-COMPLETE-YES-88    VALUE 'Y'.                  DTSBX430
00361          88 W-MNTE-COMPLETE-NO-88     VALUE 'N'.                  DTSBX430
00362                                                                   DTSBX430
00363      05  TSUB1                   PIC S9(04) COMP.                 DTSBX430
00364      05  TSUB2                   PIC S9(04) COMP.                 DTSBX430
00365      05  W-LAST-SPACE            PIC S9(04) COMP.                 DTSBX430
00366                                                                   DTSBX430
00367      05  W-MNTE-LINE             PIC  X(72).                      DTSBX430
00368                                                                   DTSBX430
00369      05  W-SLASH-DATE            PIC  X(10).                      DTSBX430
00370      05  FILLER REDEFINES W-SLASH-DATE.                           DTSBX430
00371          10  W-SLASH-DT-MM       PIC  X(02).                      DTSBX430
00372          10  FILLER              PIC  X(01).                      DTSBX430
00373          10  W-SLASH-DT-DD       PIC  X(02).                      DTSBX430
00374          10  FILLER              PIC  X(01).                      DTSBX430
00375          10  W-SLASH-DT-CCYY     PIC  X(04).                      DTSBX430
00376                                                                   DTSBX430
00377      05  W-SLASH-QTR             PIC  X(06).                      DTSBX430
00378      05  FILLER REDEFINES W-SLASH-QTR.                            DTSBX430
00379          10  W-SLASH-QTR-CCYY    PIC  X(04).                      DTSBX430
00380          10  FILLER              PIC  X(01).                      DTSBX430
00381          10  W-SLASH-QTR-Q       PIC  X(01).                      DTSBX430
00382                                                                   DTSBX430
00383      05  W-EMP-WAGE-CNT          PIC S9(07)  COMP-3 VALUE +0.     DTSBX430
00384 *  BATCH HEADER                                                   DTSBX430
00385      05  W-X149-CNT              PIC S9(07)  COMP-3 VALUE +0.     DTSBX430
00386 *  REPORT                                                         DTSBX430
00387      05  W-X140-RED-CNT          PIC S9(07)  COMP-3 VALUE +0.        CL*54
00388      05  W-X140-DUP-CNT          PIC S9(07)  COMP-3 VALUE +0.        CL*54
00389      05  W-X140-ERR-CNT          PIC S9(07)  COMP-3 VALUE +0.        CL*54
00390      05  W-X140-PEN-CNT          PIC S9(07)  COMP-3 VALUE +0.        CL*94
00391      05  W-X140-PRO-CNT          PIC S9(07)  COMP-3 VALUE +0.        CL*95
00392      05  W-X140-SAV-CNT          PIC S9(07)  COMP-3 VALUE +0.        CL*95
00393 *  EMPLOYEE WAGES                                                 DTSBX430
00394      05  W-X144-RED-CNT          PIC S9(07)  COMP-3 VALUE +0.        CL*54
00395      05  W-X144-DUP-CNT          PIC S9(07)  COMP-3 VALUE +0.        CL*54
00396      05  W-X144-ERR-CNT          PIC S9(07)  COMP-3 VALUE +0.        CL*54
00397      05  W-X144-PEN-CNT          PIC S9(07)  COMP-3 VALUE +0.        CL*94
00398      05  W-X144-PRO-CNT          PIC S9(07)  COMP-3 VALUE +0.        CL*95
00399      05  W-X144-SAV-CNT          PIC S9(07)  COMP-3 VALUE +0.        CL*55
00400                                                                   DTSBX430
00401 *  EMPLOYER PAYMENT                                                  CL*54
00402      05  W-X145-RED-CNT          PIC S9(07)  COMP-3 VALUE +0.        CL*54
00403      05  W-X145-DUP-CNT          PIC S9(07)  COMP-3 VALUE +0.        CL*54
00404      05  W-X145-ERR-CNT          PIC S9(07)  COMP-3 VALUE +0.        CL*54
00405      05  W-X145-PEN-CNT          PIC S9(07)  COMP-3 VALUE +0.        CL*94
00406      05  W-X145-PRO-CNT          PIC S9(07)  COMP-3 VALUE +0.        CL*95
00407      05  W-X145-SAV-CNT          PIC S9(07)  COMP-3 VALUE +0.        CL*55
00408 *  EMPLOYEE W4 COUNT                                                 CL*13
00409      05  W-W4-CNT                PIC S9(07)  COMP-3 VALUE +0.        CL*13
00410                                                                      CL*13
00411 **   05  W-T027-WRITE-CNT        PIC S9(07)  COMP-3 VALUE +0.     DTSBX430
00412      05  W-T028-WRITE-CNT        PIC S9(07)  COMP-3 VALUE +0.     DTSBX430
00413      05  W-T028-WRITEO-CNT       PIC S9(07)  COMP-3 VALUE +0.        CL100
00414      05  W-T028-WRITEE-CNT       PIC S9(07)  COMP-3 VALUE +0.        CL102
00415      05  W-T025-WRITE-CNT        PIC S9(07)  COMP-3 VALUE +0.     DTSBX430
00416      05  W-T025-WRITEO-CNT       PIC S9(07)  COMP-3 VALUE +0.        CL100
00417      05  W-W001-WRITE-CNT        PIC S9(07)  COMP-3 VALUE +0.     DTSBX430
00418      05  W-ARPT-WRITE-CNT        PIC S9(07)  COMP-3 VALUE +0.     DTSBX430
00419      05  W-BX214-CNT             PIC S9(07)  COMP-3 VALUE +0.     DTSBX430
00420                                                                   DTSBX430
00421      05  W-X140-LENGTH           PIC S9(04)  COMP.                DTSBX430
00422      05  W-X144-LENGTH           PIC S9(04)  COMP.                DTSBX430
00423      05  W-X145-LENGTH           PIC S9(04)  COMP.                   CL*54
00424                                                                   DTSBX430
00425      05  W-AMT-DISP1             PIC ----------9.99.              DTSBX430
00426      05  W-AMT-DISP2             PIC ----------9.99.              DTSBX430
00427 *RW1                                                              DTSBX430
00428      05  WRK-R140-CNT            PIC S9(07) COMP-3 VALUE +0.      DTSBX430
00429      05  DISPLAY-CNT             PIC  Z(06)9.                     DTSBX430
00430      05  WRK-MPRF-EMP-NO         PIC  9(06).                      DTSBX430
00431 *RW2                                                              DTSBX430
00432                                                                   DTSBX430
00433  01  MESSAGE-AREA.                                                DTSBX430
00434 *** FATAL ERRORS MSG-A                                            DTSBX430
00435      05  MSG-A1.                                                  DTSBX430
00436          10  FILLER                            PIC X(32)          DTSBX430
00437              VALUE 'TYPE A REC NOT FIRST IN FILE: '.              DTSBX430
00438          10  MSG-A1-PREV-REC-TYPE              PIC X(01).         DTSBX430
00439  01  HEADER-1.                                                       CL119
00440      05  FILLER                   PIC X(01) VALUE SPACES.            CL119
00441      05  FILLER                   PIC X(49) VALUE '140R1'.           CL119
00442      05  FILLER                   PIC X(60) VALUE                    CL119
00443          'DISTRICT OF COLUMBIA'.                                     CL119
00444      05  FILLER                   PIC X(06) VALUE 'DATE:'.           CL119
00445      05  HDR1-LRCM-SYS-DATE       PIC X(10).                         CL248
00446  01  HEADER-2.                                                       CL119
00447      05  FILLER                   PIC X(54) VALUE SPACES.            CL119
00448      05  FILLER                   PIC X(56) VALUE                    CL119
00449          'TAX DIVISION'.                                             CL119
00450      05  FILLER                   PIC X(06) VALUE 'TIME:'.           CL119
00451      05  HDR2-LRCM-SYS-TIME       PIC X(08).                         CL119
00452                                                                      CL119
00453  01  HEADER-3.                                                       CL119
00454      05  FILLER                   PIC X(01) VALUE SPACES.            CL119
00455      05  FILLER                   PIC X(38) VALUE                    CL119
00456          'ROUTE TO:  TAX ACCOUNTING STAFF'.                          CL119
00457      05  HDR3-LITERAL             PIC X(43) VALUE                    CL119
00458          '  ESSP DAILY REPORTS SUBMITTED TO DUTAS   '.               CL205
00459      05  FILLER                   PIC X(28) VALUE SPACES.            CL119
00460      05  FILLER                   PIC X(06) VALUE 'PAGE:'.           CL119
00461      05  HDR3-PAGE                PIC ZZ,ZZ9.                        CL119
00462                                                                      CL119
00463  01  HEADER-31.                                                      CL131
00464      05  FILLER                   PIC X(01) VALUE SPACES.            CL131
00465      05  FILLER                   PIC X(38) VALUE                    CL131
00466          'ROUTE TO:  TAX ACCOUNTING STAFF'.                          CL131
00467      05  HDR3-LITERAL             PIC X(43) VALUE                    CL131
00468          '  ESSP DAILY REPORT  MISSING WAGES        '.               CL209
00469      05  FILLER                   PIC X(28) VALUE SPACES.            CL131
00470      05  FILLER                   PIC X(06) VALUE 'PAGE:'.           CL131
00471      05  HDR31-PAGE               PIC ZZ,ZZ9.                        CL131
00472                                                                      CL131
00473  01  HEADER-4.                                                       CL119
00474      05  FILLER                   PIC X(01)  VALUE SPACES.           CL119
00475      05  FILLER                   PIC X(132) VALUE SPACES.           CL119
00476  01  HEADER-42.                                                      CL144
00477      05  FILLER                   PIC X(02)  VALUE SPACES.           CL144
00478      05  FILLER                   PIC X(34)  VALUE                   CL144
00479          '                                 '.                        CL144
00480      05  FILLER                   PIC X(02)  VALUE SPACES.           CL144
00481      05  FILLER                   PIC X(25)  VALUE                   CL144
00482             '                        '.                              CL144
00483      05  FILLER                   PIC X(12)  VALUE SPACES.           CL205
00484      05  FILLER                   PIC X(25)  VALUE                   CL204
00485             '    -MONTHLY COUNTS-'.                                  CL206
00486      05  FILLER                   PIC X(30)  VALUE                   CL152
00487             '                           '.                           CL204
00488                                                                      CL119
00489  01  HEADER-5.                                                       CL119
00490      05  FILLER                   PIC X(02)  VALUE SPACES.           CL126
00491      05  FILLER                   PIC X(34)  VALUE                   CL119
00492          'EMP NO  NAME  QTR   RECV-DATE   '.                         CL204
00493      05  FILLER                   PIC X(25)  VALUE                   CL126
00494             'TOTAL-AMT   EXCESS-AMT '.                               CL204
00495      05  FILLER                   PIC X(03)  VALUE SPACES.           CL119
00496      05  FILLER                   PIC X(41)  VALUE                   CL245
00497             'TAX-AMT    X144-DIFF     M1     M2     M3'.             CL245
00498      05  FILLER                   PIC X(02)  VALUE SPACES.           CL127
00499      05  HDR5-NAME                PIC X(36)  VALUE SPACES.           CL206
00500                                                                      CL119
00501  01  HEADER-6.                                                       CL119
00502      05  FILLER                   PIC X(01)  VALUE SPACES.           CL119
00503      05  FILLER                   PIC X(132) VALUE SPACES.           CL119
00504  01  DETAIL-LINE-1.                                                  CL119
00505      15  FILLER                     PIC  X(02) VALUE SPACES.         CL119
00506      15  X434-EMP-NO                PIC  999B999 BLANK WHEN ZERO.    CL119
00507      15  FILLER                     PIC  X(01) VALUE SPACES.         CL188
00508      15  X434-NAME-CHECK            PIC  X(04) VALUE SPACES.         CL119
00509      15  FILLER                     PIC  X(01) VALUE SPACES.         CL188
00510      15  X434-QTR                   PIC  X(06).                      CL119
00511      15  FILLER                     PIC  X(01) VALUE SPACES.         CL188
00512      15  X434-RCVD-DATE             PIC  X(10).                      CL119
00513      15  FILLER                     PIC  X(01) VALUE SPACES.         CL119
00514      15  X434-TOT-WAGE              PIC  --------9.99.               CL119
00515      15  FILLER                     PIC  X(01) VALUE SPACES.         CL119
00516      15  X434-EXC-WAGE              PIC  --------9.99.               CL119
00517      15  FILLER                     PIC  X(01) VALUE SPACES.         CL119
00518      15  X434-TAX-WAGE              PIC  --------9.99.               CL119
00519      15  FILLER                     PIC  X(01) VALUE SPACES.         CL119
00520 *    15  X434-X140-REMIT            PIC  --------9.99.               CL187
00521      15  FILLER                     PIC  X(01) VALUE SPACES.         CL119
00522      15  X434-X144-WAGE             PIC  --------9.99.               CL243
00523      15  FILLER                     PIC  X(01) VALUE SPACES.         CL148
00524 *    15  X434-DIFF                  PIC  ----9.99.                   CL187
00525      15  X434-M1-CNT                PIC  ZZZZZZ9.                    CL129
00526      15  X434-M2-CNT                PIC  ZZZZZZ9.                    CL129
00527      15  X434-M3-CNT                PIC  ZZZZZZ9.                    CL129
00528      15  FILLER                     PIC  X(01) VALUE SPACES.         CL188
00529      15  X434-MESSAGE               PIC  X(35).                      CL206
00530                                                                      CL119
00531  01  DETAIL-PEND-1.                                                  CL131
00532      15  FILLER                     PIC  X(02) VALUE SPACES.         CL131
00533      15  P434-EMP-NO                PIC  999B999 BLANK WHEN ZERO.    CL131
00534      15  FILLER                     PIC  X(02) VALUE SPACES.         CL131
00535      15  P434-NAME-CHECK            PIC  X(04) VALUE SPACES.         CL131
00536      15  FILLER                     PIC  X(02) VALUE SPACES.         CL131
00537      15  P434-QTR                   PIC  X(06).                      CL131
00538      15  FILLER                     PIC  X(02) VALUE SPACES.         CL131
00539      15  P434-RCVD-DATE             PIC  X(10).                      CL131
00540      15  FILLER                     PIC  X(01) VALUE SPACES.         CL131
00541      15  P434-TOT-WAGE              PIC  --------9.99.               CL131
00542      15  FILLER                     PIC  X(01) VALUE SPACES.         CL131
00543      15  P434-EXC-WAGE              PIC  --------9.99.               CL131
00544      15  FILLER                     PIC  X(01) VALUE SPACES.         CL131
00545      15  P434-TAX-WAGE              PIC  --------9.99.               CL131
00546      15  FILLER                     PIC  X(01) VALUE SPACES.         CL131
00547      15  P434-X140-REMIT            PIC  --------9.99.               CL131
00548      15  FILLER                     PIC  X(01) VALUE SPACES.         CL131
00549      15  P434-X145-REMIT            PIC  --------9.99.               CL131
00550      15  FILLER                     PIC  X(02) VALUE SPACES.         CL138
00551      15  P434-MESSAGE               PIC  X(35).                      CL206
00552                                                                      CL131
00553  01  FOOTING-LINE-1               PIC X(133) VALUE SPACES.           CL119
00554  01  FOOTING-LINE-2               PIC X(133) VALUE SPACES.           CL119
00555                                                                      CL119
00556  01  FOOTING-LINE-3.                                                 CL119
00557      05  FILLER                   PIC  X(25)  VALUE SPACES.          CL119
00558      05  WS-FOOTING-CNT           PIC  ZZ,ZZ9.                       CL119
00559      05  FILLER                   PIC  X(02)  VALUE SPACES.          CL119
00560      05  FILLER                   PIC  X(34) VALUE                   CL119
00561                       'TOTAL CHECK PAYMENT RECEIVED'.                CL128
00562      05  FILLER                   PIC  X(32)  VALUE SPACES.          CL119
00563                                                                      CL119
00564  01  FOOTING-LINE-4.                                                 CL153
00565      05  FILLER                   PIC  X(25)  VALUE SPACES.          CL119
00566      05  WS-X145-ERR-CNT           PIC  ZZ,ZZ9.                      CL119
00567      05  FILLER                   PIC  X(02)  VALUE SPACES.          CL119
00568      05  FILLER                   PIC  X(34) VALUE                   CL119
00569                       ' # OF  PAYMENTS HAD ERRORS       '.           CL119
00570      05  FILLER                   PIC  X(32)  VALUE SPACES.          CL119
00571                                                                      CL119
00572  01  FOOTING-LINE-5.                                                 CL153
00573      05  FILLER                   PIC  X(25)  VALUE SPACES.          CL119
00574      05  WS-X145-PEN-CNT           PIC  ZZ,ZZ9.                      CL119
00575      05  FILLER                   PIC  X(02)  VALUE SPACES.          CL119
00576      05  FILLER                   PIC  X(40) VALUE                   CL130
00577                       ' # OF  PAYMENTS WENT TO PENDING STATUS'.      CL130
00578      05  FILLER                   PIC  X(32)  VALUE SPACES.          CL119
00579  01  FOOTING-LINE-6.                                                 CL153
00580      05  FILLER                   PIC  X(25)  VALUE SPACES.          CL130
00581      05  WS-X140-RED-CNT           PIC  ZZ,ZZ9.                      CL130
00582      05  FILLER                   PIC  X(02)  VALUE SPACES.          CL130
00583      05  FILLER                   PIC  X(34) VALUE                   CL130
00584                       'TOTAL REPORT RECEIVED FROM ESSP  '.           CL130
00585      05  FILLER                   PIC  X(32)  VALUE SPACES.          CL130
00586  01  FOOTING-LINE-7.                                                 CL153
00587      05  FILLER                   PIC  X(25)  VALUE SPACES.          CL130
00588      05  WS-X140-ERR-CNT           PIC  ZZ,ZZ9.                      CL130
00589      05  FILLER                   PIC  X(02)  VALUE SPACES.          CL130
00590      05  FILLER                   PIC  X(34) VALUE                   CL130
00591                       ' # OF REPORTS HAD ERRORS       '.             CL130
00592      05  FILLER                   PIC  X(32)  VALUE SPACES.          CL130
00593                                                                      CL130
00594  01  FOOTING-LINE-8.                                                 CL153
00595      05  FILLER                   PIC  X(25)  VALUE SPACES.          CL130
00596      05  WS-X140-PEN-CNT           PIC  ZZ,ZZ9.                      CL130
00597      05  FILLER                   PIC  X(02)  VALUE SPACES.          CL130
00598      05  FILLER                   PIC  X(40) VALUE                   CL130
00599                       ' # OF REPORTS WENT TO PENDING STATUS'.        CL130
00600      05  FILLER                   PIC  X(32)  VALUE SPACES.          CL130
00601                                                                      CL119
00602  01  FOOTING-LINE-9.                                                 CL153
00603      05  FILLER                   PIC  X(24)  VALUE SPACES.          CL153
00604      05  WS-X144-RED-CNT           PIC  ZZZ,ZZ9.                     CL153
00605      05  FILLER                   PIC  X(02)  VALUE SPACES.          CL153
00606      05  FILLER                   PIC  X(34) VALUE                   CL153
00607                       'TOTAL WAGES  RECEIVED FROM ESSP  '.           CL153
00608      05  FILLER                   PIC  X(32)  VALUE SPACES.          CL153
00609  01  FOOTING-LINE-10.                                                CL153
00610      05  FILLER                   PIC  X(24)  VALUE SPACES.          CL153
00611      05  WS-X144-ERR-CNT           PIC  ZZZ,ZZ9.                     CL153
00612      05  FILLER                   PIC  X(02)  VALUE SPACES.          CL153
00613      05  FILLER                   PIC  X(34) VALUE                   CL153
00614                       ' # OF WAGES   HAD ERRORS       '.             CL153
00615      05  FILLER                   PIC  X(32)  VALUE SPACES.          CL153
00616                                                                      CL153
00617  01  FOOTING-LINE-11.                                                CL153
00618      05  FILLER                   PIC  X(24)  VALUE SPACES.          CL153
00619      05  WS-X144-PEN-CNT           PIC  ZZZ,ZZ9.                     CL153
00620      05  FILLER                   PIC  X(02)  VALUE SPACES.          CL153
00621      05  FILLER                   PIC  X(40) VALUE                   CL153
00622                       ' # OF WAGES WENT TO PENDING STATUS'.          CL207
00623      05  FILLER                   PIC  X(32)  VALUE SPACES.          CL153
00624  01  FOOTING-LINE-12.                                                CL153
00625      05  FILLER                   PIC  X(19)  VALUE SPACES.          CL119
00626      05  WS-TOT-REMIT             PIC  $$$$$$$$9.99.                 CL119
00627      05  FILLER                   PIC  X(02)  VALUE SPACES.          CL119
00628      05  FILLER                   PIC  X(36) VALUE                   CL119
00629                       ' TOTAL REMIT AMOUNT APPLIED TO DUTAS'.        CL119
00630      05  FILLER                   PIC  X(32)  VALUE SPACES.          CL119
00631                                                                      CL119
00632  01  FOOTING-LINE-13.                                                CL153
00633      05  FILLER                   PIC X(25)  VALUE SPACES.           CL119
00634      05  FILLER                   PIC  X(67) VALUE                   CL153
00635           '*** END ESSP/DUTAS DAILY REPORT/WAGE PROCESSING ***'.     CL207
00636  01  FOOTING-LINE-14              PIC  X(133) VALUE SPACES.          CL154
00637                                                                   DTSBX430
00638  01  T003-REC.                                                    DTSBX430
00639  ++INCLUDE DTSIT003                                               DTSBX430
00640                                                                   DTSBX430
00641  01  T025-REC.                                                    DTSBX430
00642  ++INCLUDE DTSIT025                                               DTSBX430
00643                                                                   DTSBX430
00644 *01  T027-REC.                                                    DTSBX430
00645 *++INCLUDE DTSIT027                                               DTSBX430
00646                                                                   DTSBX430
00647  01  T028-REC.                                                    DTSBX430
00648  ++INCLUDE DTSIT028                                               DTSBX430
00649                                                                   DTSBX430
00650                                                                      CL*11
00651  01  W001-REC.                                                    DTSBX430
00652  ++INCLUDE DTSIW001                                               DTSBX430
00653                                                                      CL*11
00654  01  WAGE-TRANS-AREA.                                                CL*11
00655      05  ESP-TRANSACTION-AREA      PIC  X(80).                       CL*11
00656  ++INCLUDE EWGTRNW4                                                  CL*11
00657                                                                      CL*11
00658                                                                   DTSBX430
00659 *  ACCOUNTING BATCH HEADER                                        DTSBX430
00660  01  X149-REC.                                                    DTSBX430
00661  ++INCLUDE DTSIX149                                               DTSBX430
00662                                                                   DTSBX430
00663 *  REPORT                                                         DTSBX430
00664  01  X140-REC.                                                    DTSBX430
00665  ++INCLUDE DTSIX140                                               DTSBX430
00666                                                                   DTSBX430
00667 *  EMPLOYEE WAGES                                                 DTSBX430
00668  01  X144-REC.                                                    DTSBX430
00669  ++INCLUDE DTSIX144                                               DTSBX430
00670                                                                   DTSBX430
00671 *  PAYMENTS                                                          CL*47
00672  01  X145-REC.                                                       CL*47
00673  ++INCLUDE DTSIX145                                                  CL*47
00674                                                                      CL*47
00675 *  BATCH - PSEUDO-BATCH XREF                                      DTSBX430
00676  01  X214-REC.                                                    DTSBX430
00677  ++INCLUDE DTSIX214                                               DTSBX430
00678                                                                   DTSBX430
00679 *  ERRORS                                                         DTSBX430
00680 *01  X907-REC.                                                    DTSBX430
00681 ***INCLUDE DTSIX907                                               DTSBX430
00682                                                                   DTSBX430
00683  01  L001-LINK-AREA.                                              DTSBX430
00684  ++INCLUDE DTSIL001                                               DTSBX430
00685                                                                   DTSBX430
00686  01  L003-LINK-AREA.                                              DTSBX430
00687  ++INCLUDE DTSIL003                                               DTSBX430
00688                                                                   DTSBX430
00689  01  L004-LINK-AREA.                                              DTSBX430
00690  ++INCLUDE DTSIL004                                               DTSBX430
00691                                                                   DTSBX430
00692  01  L516-LINK-AREA.                                              DTSBX430
00693  ++INCLUDE DTSIL516                                               DTSBX430
00694                                                                   DTSBX430
00695  01  L910-LINK-AREA.                                              DTSBX430
00696  ++INCLUDE DTSIL910                                               DTSBX430
00697  01  MSKL-REC.                                                    DTSBX430
00698  ++INCLUDE DTSIMSKL                                               DTSBX430
00699                                                                   DTSBX430
00700  01  MHDR-REC.                                                    DTSBX430
00701  ++INCLUDE DTSIMHDR                                               DTSBX430
00702                                                                   DTSBX430
00703  01  MPRF-REC.                                                    DTSBX430
00704  ++INCLUDE DTSIMPRF                                               DTSBX430
00705                                                                   DTSBX430
00706  01  MSOL-REC.                                                    DTSBX430
00707  ++INCLUDE DTSIMSOL                                               DTSBX430
00708                                                                   DTSBX430
00709  01  MQTR-REC.                                                    DTSBX430
00710  ++INCLUDE DTSIMQTR                                               DTSBX430
00711                                                                   DTSBX430
00712  01  MRPT-REC.                                                       CL178
00713  ++INCLUDE DTSIMRPT                                                  CL178
00714                                                                      CL178
00715  01  MOPO-REC.                                                    DTSBX430
00716  ++INCLUDE DTSIMOPO                                               DTSBX430
00717                                                                   DTSBX430
00718  01  MTAD-REC.                                                    DTSBX430
00719  ++INCLUDE DTSIMTAD                                               DTSBX430
00720                                                                   DTSBX430
00721  01  MNTE-REC.                                                    DTSBX430
00722  ++INCLUDE DTSIMNTE                                               DTSBX430
00723                                                                   DTSBX430
00724  01  L921-LINK-AREA.                                              DTSBX430
00725  ++INCLUDE DTSIL921                                               DTSBX430
00726      SKIP3                                                        DTSBX430
00727  01  ISKL-REC.                                                    DTSBX430
00728  ++INCLUDE DTSIISKL                                               DTSBX430
00729      SKIP3                                                        DTSBX430
00730  01  IEIN-REC.                                                    DTSBX430
00731  ++INCLUDE DTSIIEIN                                               DTSBX430
00732                                                                   DTSBX430
00733  01  L923-LINK-AREA.                                              DTSBX430
00734  ++INCLUDE DTSIL923                                               DTSBX430
00735      EJECT                                                        DTSBX430
00736  01  ASKL-REC.                                                    DTSBX430
00737  ++INCLUDE DTSIASKL                                               DTSBX430
00738      EJECT                                                        DTSBX430
00739  01  AHDR-REC.                                                    DTSBX430
00740  ++INCLUDE DTSIAHDR                                               DTSBX430
00741      EJECT                                                        DTSBX430
00742  01  ARPT-REC.                                                    DTSBX430
00743  ++INCLUDE DTSIARPT                                               DTSBX430
00744      EJECT                                                        DTSBX430
00745  01  APAY-REC.                                                    DTSBX430
00746  ++INCLUDE DTSIAPAY                                               DTSBX430
00747                                                                   DTSBX430
00748  01  L927-LINK-AREA.                                              DTSBX430
00749  ++INCLUDE DTSIL927                                               DTSBX430
00750                                                                   DTSBX430
00751  01  L931-LINK-AREA.                                              DTSBX430
00752  ++INCLUDE DTSIL931                                               DTSBX430
00753                                                                   DTSBX430
00754  01  FSKL-REC.                                                    DTSBX430
00755  ++INCLUDE DTSIFSKL                                               DTSBX430
00756                                                                   DTSBX430
00757  01  R140-REC.                                                    DTSBX430
00758  ++INCLUDE DTSIR140                                               DTSBX430
00759                                                                   DTSBX430
00760  LINKAGE                                                          DTSBX430
00761  SECTION.                                                         DTSBX430
00762                                                                   DTSBX430
00763  01  LX42-LINK-AREA.                                              DTSBX430
00764  ++INCLUDE DTSILX42                                                  CL112
00765                                                                   DTSBX430
00766  PROCEDURE DIVISION USING LX42-LINK-AREA.                            CL253
00767                                                                   DTSBX430
00768  DTSBX430-MAIN.                                                      CL*47
00769 *    DISPLAY 'LX42-LINK-AREA'  LX42-LINK-AREA                        CL*80
00770      MOVE LX42-RPT-ERROR-IND     TO W-RPT-ERROR-IND.                 CL*80
00771                                                                      CL*80
00772      IF W-RPT-ERROR-YES-88                                           CL*80
00773         DISPLAY '1:BX430 LX42 EMP REC HAS ERROR ' LX42-EMP-NO        CL235
00774           '  ' LX42-RPT-ERROR-IND '  ' W-RPT-ERROR-IND               CL*80
00775 *    ELSE                                                            CL236
00776 *       DISPLAY '1:BX430 EMP REC HAS NO ERROR ' W-RPT-ERROR-IND      CL236
00777      END-IF.                                                         CL*80
00778      EVALUATE TRUE                                                DTSBX430
00779         WHEN LX42-INITIALIZE-88                                   DTSBX430
00780            PERFORM I0000-INITIATE        THRU I0000-EXIT          DTSBX430
00781                                                                   DTSBX430
00782         WHEN LX42-NEW-EMPLOYER-88                                 DTSBX430
00783          PERFORM P6000-WRITE-PEND-X140 THRU P6000-EXIT               CL231
00784                                                                      CL231
00785          PERFORM P5000-NEW-EMP         THRU P5000-EXIT               CL235
00786                                                                   DTSBX430
00787         WHEN LX42-PROCESS-88                                      DTSBX430
00788            PERFORM P0000-PROCESS         THRU P0000-EXIT          DTSBX430
00789                                                                   DTSBX430
00790         WHEN LX42-TERMINATE-88                                    DTSBX430
00791          DISPLAY ' TERMINATE 430'                                    CL*47
00792            PERFORM P5000-NEW-EMP         THRU P5000-EXIT          DTSBX430
00793            PERFORM P6000-WRITE-PEND-X140  THRU P6000-EXIT            CL220
00794            PERFORM T0000-TERMINATE       THRU T0000-EXIT          DTSBX430
00795                                                                   DTSBX430
00796      END-EVALUATE.                                                DTSBX430
00797                                                                      CL*80
00798 *    IF LX42-PROCESS-88                                              CL246
00799 *       MOVE W-RPT-ERROR-IND              TO LX42-RPT-ERROR-IND      CL246
00800 *    END-IF.                                                         CL246
00801                                                                   DTSBX430
00802  DTSBX430-MAIN-EXIT.                                                 CL*47
00803      GOBACK.                                                      DTSBX430
00804                                                                   DTSBX430
00805  I0000-INITIATE.                                                  DTSBX430
00806      SET W-RPT-ERROR-NO-88                 TO TRUE.                  CL*81
00807      SET W-FATAL-ERROR-NO-88           TO TRUE.                   DTSBX430
00808      SET X145-PAYMENT-DUP-NO-88        TO TRUE.                      CL171
00809                                                                   DTSBX430
00810      MOVE LENGTH OF X140-REC           TO W-X140-LENGTH.          DTSBX430
00811      MOVE LENGTH OF X144-REC           TO W-X144-LENGTH.          DTSBX430
00812      MOVE LENGTH OF X145-REC           TO W-X145-LENGTH.             CL*47
00813                                                                   DTSBX430
00814 *    FOR VARIABLE REPORT FILE.                                    DTSBX430
00815      MOVE LENGTH OF R140-REC           TO R140-LENGTH.            DTSBX430
00816      MOVE '140'                        TO R140-REC-TYPE.          DTSBX430
00817                                                                   DTSBX430
00818      MOVE LX42-CURR-RUN-DATE           TO L004-DATE.              DTSBX430
00819      PERFORM S004-FROM-DATE            THRU S004-EXIT.            DTSBX430
00820      SUBTRACT +5                       FROM L004-ABS-QTR.         DTSBX430
00821      PERFORM S004-FROM-ABS             THRU S004-EXIT.            DTSBX430
00822      MOVE L004-QTR-5-9                 TO W-WAIVER-QTR.           DTSBX430
00823      DISPLAY 'BX430 CURR RUN DATE ' LX42-CURR-RUN-DATE.              CL*47
00824      DISPLAY 'BX430 WAIVE QTR     ' W-WAIVER-QTR.                    CL*47
00825                                                                   DTSBX430
00826      MOVE LX42-CURR-RUN-DATE           TO WRK-CURR-DATE.             CL249
00827      MOVE WRK-CURR-DATE                TO L001-DATE-8-AREA.          CL248
00828      PERFORM S001-FROM-FED-8  THRU S001-EXIT                         CL150
00829      DISPLAY 'RPT   CURR RUN DATE ' L001-SLASH-DATE.                 CL151
00830      MOVE L001-SLASH-8-DATE  TO HDR1-LRCM-SYS-DATE.                  CL248
00831                                                                      CL150
00832      PERFORM I2000-OPEN-FILES          THRU I2000-EXIT            DTSBX430
00833      IF W-FATAL-ERROR-YES-88                                      DTSBX430
00834         GO TO I0000-EXIT                                          DTSBX430
00835      END-IF.                                                      DTSBX430
00836                                                                   DTSBX430
00837      MOVE +0                           TO W-ARPT-LAST.            DTSBX430
00838      PERFORM                                                      DTSBX430
00839        VARYING RSUB FROM +1 BY +1                                 DTSBX430
00840        UNTIL RSUB > W-ARPT-MAX                                    DTSBX430
00841           MOVE LOW-VALUES              TO W-ARPT-ENTRY (RSUB)     DTSBX430
00842      END-PERFORM.                                                 DTSBX430
00843                                                                   DTSBX430
00844  I0000-EXIT.                                                      DTSBX430
00845      EXIT.                                                        DTSBX430
00846                                                                   DTSBX430
00847  I2000-OPEN-FILES.                                                DTSBX430
00848      PERFORM S1040-OPEN-TEMP-BTC-OUT THRU S1040-EXIT.             DTSBX430
00849      IF W-FATAL-ERROR-YES-88                                      DTSBX430
00850         DISPLAY 'CANNOT OPEN TEMP XXX530 BTC FILE '                  CL224
00851            TEMP-BTC-STATUS                                        DTSBX430
00852         PERFORM S999-ABEND THRU S999-EXIT                            CL*15
00853      END-IF.                                                      DTSBX430
00854                                                                   DTSBX430
00855      PERFORM S1100-OPEN-WAGE-TEMP-OUT THRU S1100-EXIT.            DTSBX430
00856      IF W-FATAL-ERROR-YES-88                                      DTSBX430
00857         DISPLAY 'CANNOT OPEN MAGE TEMP FILE '                        CL234
00858            WAGE-TEMP-STATUS                                       DTSBX430
00859         PERFORM S999-ABEND THRU S999-EXIT                            CL*15
00860      END-IF.                                                      DTSBX430
00861                                                                   DTSBX430
00862      PERFORM S1150-OPEN-WAGE-FILE-OUT THRU S1150-EXIT.               CL*20
00863      IF W-FATAL-ERROR-YES-88                                         CL*20
00864         DISPLAY 'CANNOT OPEN WAGE OUT FILE '                         CL*20
00865            WAGE-OUT-STATUS                                           CL*20
00866         PERFORM S999-ABEND THRU S999-EXIT                            CL*20
00867      END-IF.                                                         CL*20
00868                                                                   DTSBX430
00869      OPEN OUTPUT   BATCH-XREF-FILE.                               DTSBX430
00870      IF BATCH-XREF-OK-88                                          DTSBX430
00871         NEXT SENTENCE                                             DTSBX430
00872      ELSE                                                         DTSBX430
00873         DISPLAY 'CANNOT OPEN BATCH XREF FILE '                    DTSBX430
00874            BATCH-XREF-STATUS                                      DTSBX430
00875         PERFORM S999-ABEND THRU S999-EXIT                         DTSBX430
00876      END-IF.                                                      DTSBX430
00877                                                                      CL*12
00878                                                                      CL*59
00879      OPEN OUTPUT   PEND-X140-FILE.                                   CL*59
00880      IF REPT-140-OK-88                                               CL*62
00881         NEXT SENTENCE                                                CL*59
00882      ELSE                                                            CL*59
00883         DISPLAY 'CANNOT OPEN PENDING X140 FILE'                      CL*59
00884            REPT-140-STATUS                                           CL*62
00885         PERFORM S999-ABEND THRU S999-EXIT                            CL*59
00886      END-IF.                                                         CL*59
00887                                                                      CL*59
00888      OPEN OUTPUT   PEND-X144-FILE.                                   CL*59
00889      IF WAGE-144-OK-88                                               CL*62
00890         NEXT SENTENCE                                                CL*59
00891      ELSE                                                            CL*59
00892         DISPLAY 'CANNOT OPEN PENDING X144 FILE'                      CL*59
00893            WAGE-144-STATUS                                           CL*62
00894         PERFORM S999-ABEND THRU S999-EXIT                            CL*59
00895      END-IF.                                                         CL*59
00896                                                                      CL*59
00897      OPEN OUTPUT   PEND-X145-FILE.                                   CL*59
00898      IF PAYT-145-OK-88                                               CL*62
00899         NEXT SENTENCE                                                CL*59
00900      ELSE                                                            CL*59
00901         DISPLAY 'CANNOT OPEN PENDING X145 FILE'                      CL*59
00902            PAYT-145-STATUS                                           CL*62
00903         PERFORM S999-ABEND THRU S999-EXIT                            CL*59
00904      END-IF.                                                         CL*59
00905                                                                      CL119
00906                                                                      CL119
00907      OPEN OUTPUT   X430-PEND-FILE.                                   CL200
00908      IF REPT-STATUS-OK-88                                            CL119
00909         NEXT SENTENCE                                                CL119
00910      ELSE                                                            CL119
00911         DISPLAY 'CANNOT OPEN X430XXX   PENDING FILE '                CL202
00912            REPT-STATUS                                               CL119
00913         PERFORM S999-ABEND THRU S999-EXIT                            CL119
00914      END-IF.                                                         CL119
00915                                                                   DTSBX430
00916      OPEN OUTPUT   X430-PAID-FILE.                                   CL200
00917      IF REPT-STATUS-OK-88                                            CL119
00918         NEXT SENTENCE                                                CL119
00919      ELSE                                                            CL119
00920         DISPLAY 'CANNOT OPEN X430   PAID  FILE '                     CL198
00921            REPT-STATUS                                               CL119
00922         PERFORM S999-ABEND THRU S999-EXIT                            CL119
00923      END-IF.                                                         CL119
00924                                                                      CL119
00925  I2000-EXIT.                                                      DTSBX430
00926      EXIT.                                                        DTSBX430
00927                                                                   DTSBX430
00928  P0000-PROCESS.                                                   DTSBX430
00929                                                                      CL**2
00930      EVALUATE TRUE                                                DTSBX430
00931 *      WHEN LX42-REC-TYPE-PAY-88                                     CL187
00932 *        PERFORM P1000-PAYMENT            THRU P1000-EXIT            CL187
00933                                                                   DTSBX430
00934        WHEN LX42-REC-TYPE-RPT-88                                     CL*47
00935          PERFORM P2000-REPORT             THRU P2000-EXIT            CL*47
00936                                                                      CL*47
00937        WHEN LX42-REC-TYPE-WAGE-88                                    CL196
00938          PERFORM P3000-WAGES              THRU P3000-EXIT            CL196
00939                                                                      CL*47
00940        WHEN OTHER                                                    CL196
00941           DISPLAY 'DTSBX430 ******** - INVALID RECORD TYPE '         CL226
00942              LX42-REC-TYPE                                           CL196
00943 *         PERFORM S999-ABEND              THRU S999-EXIT             CL195
00944                                                                      CL*47
00945      END-EVALUATE.                                                DTSBX430
00946                                                                   DTSBX430
00947  P0000-EXIT.                                                      DTSBX430
00948      EXIT.                                                        DTSBX430
00949  P1000-PAYMENT.                                                      CL*47
00950 *    SET W-EMP-IN-PROGRESS-YES-88      TO TRUE.                      CL*57
00951      MOVE LX42-DATA-AREA               TO X145-REC.                  CL*50
00952 *&                                                                   CL*50
00953      MOVE X145-EMP-NO                 TO W-EMP-NO.                   CL*50
00954      MOVE X145-QTR                    TO W-PAY-QTR.                  CL166
00955      SET W-EMP-FOUND-NO-88            TO TRUE.                       CL*50
00956                                                                      CL*50
00957       ADD +1        TO W-X145-RED-CNT                                CL*50
00958       DISPLAY SPACE.                                                 CL*50
00959       DISPLAY 'BX430- NEW EMPLOYER PAYMENT ' X145-EMP-NO.            CL*50
00960       DISPLAY ' X145-KEY ' X145-EMP-NO.                              CL*50
00961       DISPLAY 'LX145-KEY ' LX42-X145-KEY-AREA.                       CL*50
00962                                                                      CL*51
00963      IF LX42-X145-EMP-NO = '999999'                                  CL*51
00964         SET W-RPT-ERROR-YES-88 TO TRUE                               CL*81
00965         MOVE SPACES TO R140-MESSAGE                                  CL*51
00966         MOVE W-EMP-NO     TO R140-EMP-NO                             CL*51
00967         STRING                                                       CL*51
00968          'PAYMENT CONTAINS ERRORS CANNOT PROCESS - PYMTS '           CL144
00969             DELIMITED BY SIZE                                        CL*51
00970             INTO R140-MESSAGE                                        CL*51
00971         END-STRING                                                   CL*51
00972         MOVE R140-MESSAGE TO P434-MESSAGE                            CL136
00973         PERFORM S946-WRITE-R140 THRU S946-EXIT                       CL*51
00974         MOVE '999999' TO LX42-X145-EMP-NO                            CL*51
00975         ADD +1        TO W-X145-ERR-CNT                              CL*92
00976         ADD +1        TO W-X145-PEN-CNT                              CL*92
00977         WRITE PEND-X145-REC FROM X145-REC                            CL*93
00978         PERFORM P6000-WRITE-PEND-X145  THRU P6000-EXIT               CL131
00979         GO TO P1000-EXIT.                                            CL*51
00980                                                                      CL*51
00981                                                                      CL*51
00982 *      IF LX42-REC-TYPE-PAY-88                                       CL183
00983 *         IF LX42-X145-KEY-AREA = X145-EMP-NO AND                    CL183
00984 *            LX42-X145-QTR-AREA = X145-QTR                           CL183
00985 *         SET W-PREV-RPT-NULL-88          TO TRUE                    CL183
00986 *           ADD +1        TO W-X145-DUP-CNT                          CL183
00987 *           DISPLAY 'X145  DUPLICATE PAYMENT RECORD  ' W-EMP-NO      CL183
00988 *             ' ERR IND ' W-RPT-ERROR-IND                            CL183
00989 *           MOVE SPACES TO R140-MESSAGE                              CL183
00990 *           MOVE W-EMP-NO TO R140-EMP-NO                             CL183
00991 *           MOVE SPACES TO R140-MESSAGE                              CL183
00992 *           MOVE W-EMP-NO TO R140-EMP-NO                             CL183
00993 *           STRING                                                   CL183
00994 *           ': POSSIBLE DUPLICATE PAYMENT RECORD ----PROCESS     '   CL183
00995 *             DELIMITED BY SIZE                                      CL183
00996 *             INTO R140-MESSAGE                                      CL183
00997 *           END-STRING                                               CL183
00998 *           SET X145-PAYMENT-DUP-YES-88        TO TRUE               CL183
00999 *           WRITE PEND-X145-REC FROM WS-HOLD-X145-REC                CL183
01000 *           MOVE R140-MESSAGE TO P434-MESSAGE                        CL183
01001 *           PERFORM S946-WRITE-R140 THRU S946-EXIT                   CL183
01002 *       PERFORM P6000-WRITE-PEND-X145  THRU P6000-EXIT               CL183
01003 *         ELSE                                                       CL183
01004             MOVE X145-EMP-NO TO LX42-X145-KEY-AREA                   CL107
01005 *         END-IF                                                     CL183
01006 *      END-IF.                                                       CL183
01007                                                                      CL*51
01008                                                                      CL*51
01009       MOVE X145-EMP-NO                  TO LX42-X145-EMP-NO.         CL*51
01010       MOVE X145-QTR                     TO LX42-X145-QTR-AREA        CL*83
01011                                                                      CL*50
01012      DISPLAY ' PREV REC TYPE ' W-PREV-REC-TYPE.                      CL*49
01013      IF W-PREV-RPT-NULL-88 OR                                        CL*84
01014         LX42-REC-TYPE-PAY-88                                         CL*84
01015         SET W-PREV-RPT-PAY-88          TO TRUE                       CL*84
01016 *       SET W-PREV-REC-PAY-88          TO TRUE                       CL107
01017         ADD +1                         TO W-X145-PRO-CNT             CL*50
01018         PERFORM P1110-EDIT-PAYMENT     THRU P1110-EXIT               CL*51
01019         IF W-RPT-ERROR-NO-88                                         CL*81
01020            PERFORM P1112-CHECK-PAYMENT    THRU P1112-EXIT            CL*51
01021           IF W-RPT-ERROR-NO-88                                       CL*81
01022             DISPLAY 'X145  PAYMENT REC PASS EDITS  ' W-EMP-NO        CL*51
01023             DISPLAY 'X145  SAVED ' W-EMP-NO ' ' W-PAY-QTR ' '        CL169
01024               ' ' X145-REMITTANCE                                    CL169
01025             ADD +1                     TO W-X145-SAV-CNT             CL*51
01026             PERFORM P1120-SAVE-PAYMENT  THRU P1120-EXIT              CL*51
01027           ELSE                                                       CL*51
01028             MOVE '999999' TO LX42-X145-EMP-NO                        CL*51
01029             ADD +1        TO W-X145-ERR-CNT                          CL*51
01030             ADD +1        TO W-X145-PEN-CNT                          CL*92
01031             SET W-RPT-ERROR-YES-88 TO TRUE                           CL*81
01032             WRITE PEND-X145-REC FROM X145-REC                        CL*93
01033             PERFORM P6000-WRITE-PEND-X145  THRU P6000-EXIT           CL131
01034           END-IF                                                     CL*51
01035         ELSE                                                         CL*49
01036           MOVE '999999' TO LX42-X145-EMP-NO                          CL*50
01037           ADD +1        TO W-X145-ERR-CNT                            CL*51
01038           ADD +1        TO W-X145-PEN-CNT                            CL*92
01039           SET W-RPT-ERROR-YES-88 TO TRUE                             CL*81
01040             WRITE PEND-X145-REC FROM X145-REC                        CL*93
01041             PERFORM P6000-WRITE-PEND-X145  THRU P6000-EXIT           CL131
01042         END-IF                                                       CL*49
01043      ELSE                                                            CL*49
01044         MOVE '999999' TO LX42-X145-EMP-NO                            CL*50
01045         SET W-RPT-ERROR-YES-88 TO TRUE                               CL*81
01046         MOVE SPACES TO R140-MESSAGE                                  CL*49
01047         MOVE W-EMP-NO TO R140-EMP-NO                                 CL*49
01048         STRING                                                       CL*49
01049            ': DUPLICATE PAYMENT RECORD        '                      CL144
01050              X145-REMITTANCE                                         CL*54
01051              DELIMITED BY SIZE                                       CL*49
01052              INTO R140-MESSAGE                                       CL*49
01053         END-STRING                                                   CL*49
01054           ADD +1        TO W-X145-ERR-CNT                            CL*92
01055           ADD +1        TO W-X145-PEN-CNT                            CL*92
01056             MOVE R140-MESSAGE TO P434-MESSAGE                        CL136
01057             WRITE PEND-X145-REC FROM X145-REC                        CL*93
01058             PERFORM P6000-WRITE-PEND-X145  THRU P6000-EXIT           CL131
01059         PERFORM S946-WRITE-R140 THRU S946-EXIT.                      CL*49
01060                                                                      CL*49
01061  P1000-EXIT.                                                         CL*51
01062      EXIT.                                                           CL*49
01063                                                                      CL*49
01064  P1110-EDIT-PAYMENT.                                                 CL*47
01065                                                                      CL*54
01066       MOVE X145-PAY-TYPE      TO W-PAY-TYPE.                         CL*54
01067       IF W-VALID-PAY-88                                              CL*54
01068         NEXT SENTENCE                                                CL*54
01069       ELSE                                                           CL*54
01070          SET W-RPT-ERROR-YES-88 TO TRUE                              CL*81
01071          MOVE SPACES TO R140-MESSAGE                                 CL*54
01072          MOVE W-EMP-NO     TO R140-EMP-NO                            CL*54
01073          STRING                                                      CL*54
01074             ':PAY- INVALID PAYMENT TYPE '                            CL144
01075                X145-PAY-TYPE                                         CL*54
01076              DELIMITED BY SIZE                                       CL*54
01077              INTO R140-MESSAGE                                       CL*54
01078          END-STRING                                                  CL*54
01079         MOVE '999999'         TO LX42-X145-EMP-NO                    CL*51
01080          PERFORM S946-WRITE-R140 THRU S946-EXIT                      CL*54
01081             MOVE R140-MESSAGE TO P434-MESSAGE                        CL136
01082       END-IF.                                                        CL*54
01083      IF X145-QTR = SPACES                                            CL*47
01084        MOVE '2017/1'            TO W-SLASH-QTR                       CL194
01085      ELSE                                                            CL*47
01086         MOVE X145-QTR           TO W-SLASH-QTR.                      CL*47
01087                                                                      CL*47
01088         MOVE W-SLASH-QTR-CCYY   TO L004-QTR-5-YR                     CL*47
01089         MOVE W-SLASH-QTR-Q      TO L004-QTR-5-Q                      CL*47
01090         PERFORM S004-FROM-5     THRU S004-EXIT                       CL*47
01091         IF NOT L004-VALID-QTR                                        CL*47
01092            SET W-RPT-ERROR-YES-88 TO TRUE                            CL*81
01093            MOVE SPACES TO R140-MESSAGE                               CL*47
01094            MOVE W-EMP-NO     TO R140-EMP-NO                          CL*47
01095            STRING                                                    CL*47
01096               ':PAY- INVALID QUARTER ' W-SLASH-QTR                   CL144
01097                DELIMITED BY SIZE                                     CL*47
01098                INTO R140-MESSAGE                                     CL*47
01099            END-STRING                                                CL*47
01100            PERFORM S946-WRITE-R140 THRU S946-EXIT                    CL*47
01101         MOVE '999999'         TO LX42-X145-EMP-NO                    CL*51
01102             MOVE R140-MESSAGE TO P434-MESSAGE                        CL136
01103         ELSE                                                         CL*48
01104            MOVE L004-QTR-5-9     TO W-X145-PAYMENT-QTR               CL*56
01105         END-IF.                                                      CL*48
01106                                                                      CL*48
01107 *    DISPLAY 'X145Q ' W-SLASH-QTR ' WQTR ' W-X145-PAYMENT-QTR        CL*92
01108                                                                      CL*53
01109 *    MOVE X145-REMITTANCE     TO W-X145-REMITTANCE.                  CL194
01110 *    DISPLAY 'W145REMITCE  ' W-X145-REMITTANCE.                      CL194
01111 *    DISPLAY 'X145REMITCE  ' X145-REMITTANCE.                        CL194
01112                                                                      CL*51
01113 *    IF W-X145-REMITTANCE = ZEROS                                    CL166
01114 *       SET W-RPT-ERROR-YES-88 TO TRUE                               CL*81
01115 *       MOVE SPACES TO R140-MESSAGE                                  CL166
01116 *       MOVE W-EMP-NO     TO R140-EMP-NO                             CL166
01117 *       STRING                                                       CL166
01118 *         'X430-  REVIEW REMITTANCE AMOUNT= 0 '                      CL166
01119 *           DELIMITED BY SIZE                                        CL166
01120 *           INTO R140-MESSAGE                                        CL166
01121 *       END-STRING                                                   CL166
01122 *       PERFORM S946-WRITE-R140 THRU S946-EXIT                       CL166
01123 *    END-IF.                                                         CL166
01124                                                                      CL*51
01125      MOVE ZEROS               TO W-X145-RECEIVED-DATE                CL*72
01126      MOVE X145-RCVD-DATE      TO W-SLASH-DATE                        CL*48
01127      MOVE W-SLASH-DT-MM       TO L001-FED-8-MO                       CL*48
01128      MOVE W-SLASH-DT-DD       TO L001-FED-8-DA                       CL*48
01129      MOVE W-SLASH-DT-CCYY     TO L001-FED-8-YR                       CL*48
01130      PERFORM S001-FROM-FED-8  THRU S001-EXIT                         CL*48
01131      IF NOT L001-VALID-DATE                                          CL*48
01132         SET W-RPT-ERROR-YES-88 TO TRUE                               CL*81
01133         MOVE SPACES TO R140-MESSAGE                                  CL*48
01134         MOVE W-EMP-NO     TO R140-EMP-NO                             CL*48
01135         STRING                                                       CL*48
01136            ':PAY- INVALID RECEIVED DATE '                            CL144
01137            ' ' X145-RCVD-DATE                                        CL*48
01138             DELIMITED BY SIZE                                        CL*48
01139             INTO R140-MESSAGE                                        CL*48
01140         END-STRING                                                   CL*48
01141             MOVE R140-MESSAGE TO P434-MESSAGE                        CL136
01142         PERFORM S946-WRITE-R140 THRU S946-EXIT                       CL*48
01143         MOVE '999999'         TO LX42-X145-EMP-NO                    CL*51
01144      ELSE                                                            CL*48
01145         MOVE L001-FED-8-DATE-9  TO W-X145-RECEIVED-DATE              CL*72
01146      END-IF.                                                         CL*48
01147                                                                      CL*55
01148  P1110-EXIT.                                                         CL*55
01149      EXIT.                                                           CL*55
01150                                                                      CL*55
01151  P1112-CHECK-PAYMENT.                                                CL*51
01152      MOVE LOW-VALUE               TO MPRF-KEY-AREA.                  CL*48
01153      MOVE W-EMP-NO                   TO MPRF-EMP-NO.                 CL*48
01154      SET MPRF-PRF-88              TO TRUE.                           CL*48
01155      MOVE MPRF-KEY-AREA           TO MSKL-KEY-AREA.                  CL*48
01156                                                                      CL*48
01157      PERFORM S910-READ            THRU S910-EXIT.                    CL*48
01158      IF L910-NO-REC-88                                               CL*48
01159         SET W-RPT-ERROR-YES-88 TO TRUE                               CL*81
01160         SET W-EMP-FOUND-NO-88     TO TRUE                            CL*48
01161         MOVE SPACES TO R140-MESSAGE                                  CL*48
01162         MOVE W-EMP-NO     TO R140-EMP-NO                             CL*48
01163         STRING                                                       CL*48
01164            ':EMP NOT ON DUTAS -CANNOT PAY '                          CL144
01165               X145-EMP-NO                                            CL*48
01166             DELIMITED BY SIZE                                        CL*48
01167             INTO R140-MESSAGE                                        CL*48
01168         END-STRING                                                   CL*48
01169             MOVE R140-MESSAGE TO P434-MESSAGE                        CL136
01170         PERFORM S946-WRITE-R140 THRU S946-EXIT                       CL*48
01171         MOVE '999999'         TO LX42-X145-EMP-NO                    CL*51
01172      ELSE                                                            CL*48
01173         MOVE MSKL-REC             TO MPRF-REC                        CL*48
01174         SET W-EMP-FOUND-YES-88    TO TRUE                            CL*48
01175      END-IF.                                                         CL*48
01176                                                                      CL*48
01177  P1112-EXIT.                                                         CL*51
01178      EXIT.                                                           CL*48
01179                                                                      CL*48
01180  P1120-SAVE-PAYMENT.                                                 CL*51
01181        DISPLAY ' SAVE PAYMENT RECORD ' W-EMP-NO.                     CL*51
01182        IF X145-PAYMENT-DUP-YES-88                                    CL180
01183           DISPLAY '%%%%%%%% DUP-PAYT '                               CL180
01184           MOVE WS-HOLD-X145-REC  TO WS-Z145-DUP-REC                  CL180
01185           DISPLAY '   HOLD  DUP-PAYT ' WS-Z145-DUP-REC               CL180
01186           MOVE X145-REC  TO WS-Z145-DUP-REC                          CL180
01187           DISPLAY '   CURR  DUP-PAYT ' WS-Z145-DUP-REC               CL180
01188        ELSE                                                          CL180
01189        MOVE W-X145-REMITTANCE     TO W-X145-TOT-REMIT-AMT.           CL180
01190                                                                      CL180
01191 *      ADD +1  TO W-X145-SAV-CNT.                                    CL*96
01192        MOVE X145-REC TO WS-HOLD-X145-REC.                            CL172
01193  P1120-EXIT.                                                         CL*51
01194      EXIT.                                                           CL*51
01195                                                                      CL*51
01196                                                                      CL*48
01197                                                                   DTSBX430
01198  P2000-REPORT.                                                    DTSBX430
01199                                                                      CL220
01200      MOVE LX42-DATA-AREA               TO X140-REC.               DTSBX430
01201                                                                      CL**2
01202 *    SET W-RPT-IN-PROGRESS-YES-88   TO TRUE                          CL*56
01203                                                                      CL**2
01204      MOVE X140-EMP-NO                  TO W-EMP-NO.               DTSBX430
01205      MOVE X140-EMP-NO                  TO W-EMP-X140-NO.             CL189
01206      MOVE X140-QUARTER                 TO W-PAY-QTR.                 CL166
01207      ADD +1                            TO W-X140-RED-CNT.            CL*56
01208 *    DISPLAY ' PREV RPT REC TYPE ' W-PREV-REC-TYPE.                  CL184
01209 *    IF W-PREV-RPT-NULL-88                                           CL184
01210 *       SET W-PREV-RPT-RPT-88          TO TRUE                       CL184
01211 *       SET W-X145-PAYMENT-NO-88       TO TRUE                       CL184
01212 *    ELSE                                                            CL184
01213 *       SET W-X145-PAYMENT-YES-88      TO TRUE                       CL184
01214 *    END-IF.                                                         CL184
01215                                                                      CL*52
01216      MOVE SPACES       TO R140-MESSAGE.                              CL215
01217      MOVE R140-MESSAGE TO P434-MESSAGE                               CL214
01218      SET W-RPT-ERROR-NO-88 TO TRUE.                                  CL215
01219                                                                      CL214
01220       IF LX42-REC-TYPE-RPT-88                                        CL*40
01221          IF LX42-X140-KEY-AREA = X140-EMP-NO AND                     CL*80
01222             LX42-X140-QTR-AREA = X140-QUARTER                        CL*80
01223            SET W-RPT-ERROR-YES-88 TO TRUE                            CL*81
01224            ADD +1        TO W-X140-DUP-CNT                           CL*92
01225            ADD +1        TO W-X140-PEN-CNT                           CL*92
01226            DISPLAY ':ERROR-RPT DUPLICATE REPORT        '             CL229
01227              ' ERR IND ' W-RPT-ERROR-IND                             CL*80
01228            MOVE SPACES TO R140-MESSAGE                               CL*40
01229            MOVE W-EMP-NO TO R140-EMP-NO                              CL*40
01230            STRING                                                    CL*40
01231            ':-----FAILED - DUPLICATE RPT '                           CL240
01232              DELIMITED BY SIZE                                       CL*40
01233              INTO R140-MESSAGE                                       CL*40
01234            END-STRING                                                CL*40
01235             MOVE R140-MESSAGE TO X434-MESSAGE                        CL187
01236            PERFORM S946-WRITE-R140 THRU S946-EXIT                    CL*40
01237             PERFORM P4000-WRITE-X434-PAID-REPT THRU P4000-EXIT       CL189
01238             WRITE PEND-X140-REC FROM X140-REC                        CL*93
01239            MOVE '999999'         TO LX42-X140-EMP-NO                 CL*51
01240            GO TO P2000-EXIT                                          CL*40
01241          ELSE                                                        CL*40
01242            MOVE X140-EMP-NO  TO LX42-X140-KEY-AREA                   CL*80
01243          END-IF                                                      CL*40
01244       END-IF.                                                        CL*40
01245                                                                      CL*40
01246      MOVE X140-EMP-NO                  TO LX42-X140-EMP-NO.          CL**3
01247      MOVE X140-QUARTER                 TO LX42-X140-QTR-AREA         CL*80
01248      SET W-EMP-FOUND-NO-88             TO TRUE.                   DTSBX430
01249                                                                      CL*51
01250 *    IF LX42-X145-EMP-NO = '999999'                                  CL184
01251 *       SET W-RPT-ERROR-YES-88 TO TRUE                               CL184
01252 *       MOVE SPACES TO R140-MESSAGE                                  CL184
01253 *       MOVE W-EMP-NO TO R140-EMP-NO                                 CL184
01254 *       STRING                                                       CL184
01255 *        ':PAY RECORD INVALID -RPT BYPASSED              '           CL184
01256 *            DELIMITED BY SIZE                                       CL184
01257 *            INTO R140-MESSAGE                                       CL184
01258 *       END-STRING                                                   CL184
01259 *       MOVE '999999'                     TO LX42-X140-EMP-NO        CL184
01260 *       PERFORM S946-WRITE-R140 THRU S946-EXIT                       CL184
01261 *       ADD +1        TO W-X140-PEN-CNT                              CL184
01262 *       WRITE PEND-X140-REC FROM X140-REC                            CL184
01263 *           MOVE R140-MESSAGE TO P434-MESSAGE                        CL184
01264 *       PERFORM P6000-WRITE-PEND-X140  THRU P6000-EXIT               CL184
01265 *       GO TO P2000-EXIT.                                            CL184
01266                                                                      CL*40
01267      SET W-PREV-RPT-RPT-88             TO TRUE.                      CL*84
01268                                                                   DTSBX430
01269                                                                   DTSBX430
01270      PERFORM P2010-EDIT-REPORT         THRU P2010-EXIT            DTSBX430
01271                                                                      CL**3
01272      IF W-RPT-ERROR-YES-88                                           CL*81
01273         DISPLAY 'E10 NO: ' W-EMP-NO                                  CL213
01274         MOVE '999999'                  TO LX42-X140-EMP-NO           CL**3
01275         GO TO P2000-EDIT-REPORT-CONTINUE.                            CL*32
01276                                                                      CL**3
01277      PERFORM P2012-CHECK-MPRF       THRU P2012-EXIT                  CL**3
01278         DISPLAY 'E12 NO: ' W-EMP-NO                                  CL213
01279      IF W-RPT-ERROR-YES-88                                           CL*81
01280         MOVE '999999'                  TO LX42-X140-EMP-NO           CL**3
01281         GO TO P2000-EDIT-REPORT-CONTINUE.                            CL*32
01282                                                                      CL**3
01283        PERFORM P2015-CHECK-MRPT       THRU P2015-EXIT                CL178
01284         DISPLAY 'E15 NO: ' W-EMP-NO                                  CL213
01285        IF W-RPT-ERROR-YES-88                                         CL*81
01286          MOVE '999999'                  TO LX42-X140-EMP-NO          CL*60
01287         GO TO P2000-EDIT-REPORT-CONTINUE.                            CL*60
01288                                                                      CL*32
01289  P2000-EDIT-REPORT-CONTINUE.                                         CL*32
01290      IF W-RPT-ERROR-NO-88                                            CL166
01291        PERFORM P2020-SAVE-EXT-REPORT   THRU P2020-EXIT               CL166
01292        ADD +1        TO W-X140-SAV-CNT                               CL166
01293        GO TO P2000-EXIT.                                             CL166
01294                                                                      CL166
01295         SET W-RPT-ERROR-YES-88 TO TRUE                               CL*81
01296         MOVE SPACES TO R140-MESSAGE                                  CL*32
01297         MOVE W-EMP-NO     TO R140-EMP-NO                             CL*32
01298         DISPLAY                                                      CL217
01299            '-X140 +++ FAILED DUTAS EDITS '                           CL217
01300                ' ' X140-QUARTER ' ' W-EMP-NO                         CL217
01301         PERFORM S946-WRITE-R140 THRU S946-EXIT                       CL*32
01302         ADD +1        TO W-X140-PEN-CNT                              CL*93
01303         WRITE PEND-X140-REC FROM X140-REC                            CL*93
01304         PERFORM P4000-WRITE-X434-PAID-REPT THRU P4000-EXIT.          CL217
01305 *       IF  W-X145-PAYMENT-YES-88                                    CL184
01306 *           WRITE PEND-X145-REC FROM X145-REC                        CL184
01307 *           PERFORM P6000-WRITE-PEND-X145  THRU P6000-EXIT.          CL184
01308                                                                   DTSBX430
01309  P2000-EXIT.                                                      DTSBX430
01310      EXIT.                                                        DTSBX430
01311                                                                   DTSBX430
01312  P2010-EDIT-REPORT.                                               DTSBX430
01313      MOVE X140-QUARTER       TO W-SLASH-QTR.                      DTSBX430
01314      MOVE W-SLASH-QTR-CCYY   TO L004-QTR-5-YR.                    DTSBX430
01315      MOVE W-SLASH-QTR-Q      TO L004-QTR-5-Q.                     DTSBX430
01316      PERFORM S004-FROM-5     THRU S004-EXIT.                      DTSBX430
01317      IF NOT L004-VALID-QTR                                        DTSBX430
01318         SET W-RPT-ERROR-YES-88 TO TRUE                               CL*81
01319         MOVE SPACES TO R140-MESSAGE                               DTSBX430
01320         MOVE W-EMP-NO     TO R140-EMP-NO                          DTSBX430
01321         STRING                                                    DTSBX430
01322            ':-----FAILED INVALID QTR '                               CL240
01323             DELIMITED BY SIZE                                     DTSBX430
01324             INTO R140-MESSAGE                                     DTSBX430
01325         END-STRING                                                DTSBX430
01326             MOVE R140-MESSAGE TO X434-MESSAGE                        CL217
01327         PERFORM S946-WRITE-R140 THRU S946-EXIT                    DTSBX430
01328      ELSE                                                         DTSBX430
01329         MOVE L004-QTR-5-9     TO W-X140-REPORT-QTR                   CL*56
01330      END-IF.                                                      DTSBX430
01331                                                                   DTSBX430
01332      MOVE X140-REPORT-TYPE    TO W-RPT-TYPE.                      DTSBX430
01333      IF NOT W-RPT-TYPE-VALID-88                                   DTSBX430
01334         SET W-RPT-ERROR-YES-88 TO TRUE                               CL*81
01335         MOVE SPACES TO R140-MESSAGE                               DTSBX430
01336         MOVE W-EMP-NO     TO R140-EMP-NO                          DTSBX430
01337         STRING                                                    DTSBX430
01338            ':-----FAILED INVALID REPORT TYPE '                       CL240
01339               X140-REPORT-TYPE                                       CL**2
01340             DELIMITED BY SIZE                                     DTSBX430
01341             INTO R140-MESSAGE                                     DTSBX430
01342         END-STRING                                                DTSBX430
01343             MOVE R140-MESSAGE TO X434-MESSAGE                        CL187
01344         PERFORM S946-WRITE-R140 THRU S946-EXIT                    DTSBX430
01345      END-IF.                                                      DTSBX430
01346                                                                      CL113
01347      IF W-RPT-TYPE NOT = 'OR'                                        CL115
01348         SET W-RPT-ERROR-YES-88 TO TRUE                               CL113
01349         MOVE SPACES TO R140-MESSAGE                                  CL113
01350         MOVE W-EMP-NO     TO R140-EMP-NO                             CL113
01351         STRING                                                       CL113
01352            ':-----FAILED -NOT ORIGINAL REPORT '                      CL240
01353            ' ' W-RPT-TYPE                                            CL116
01354             DELIMITED BY SIZE                                        CL113
01355             INTO R140-MESSAGE                                        CL113
01356         END-STRING                                                   CL113
01357             MOVE R140-MESSAGE TO X434-MESSAGE                        CL187
01358         PERFORM S946-WRITE-R140 THRU S946-EXIT                       CL113
01359      END-IF.                                                         CL113
01360                                                                      CL113
01361                                                                   DTSBX430
01362 *    IF W-CURR-RPT-QTR NOT = W-X140-REPORT-QTR                       CL*82
01363 *       MOVE ZERO            TO W-TOT-WAGE                           CL*82
01364 *       MOVE W-X140-REPORT-QTR    TO W-CURR-RPT-QTR                  CL*82
01365 *    END-IF.                                                         CL*82
01366      MOVE ZEROS              TO W-TOT-WAGE                           CL222
01367                                 W-TAX-WAGE.                          CL222
01368      MOVE X140-TOTAL-WAGES   TO W-TOT-WAGE.                       DTSBX430
01369      MOVE X140-TAX-WAGES     TO W-TAX-WAGE.                       DTSBX430
01370      MOVE ZEROS              TO W-TOT-X144-WAGE.                     CL189
01371      MOVE W-TOT-WAGE         TO LX42-RPT-REMIT-AMT                   CL222
01372                                                                      CL189
01373 *    IF W-EMP-NO = 177462                                            CL*53
01374 *    MOVE 1352.07             TO X140-REMITTANCE                     CL*53
01375      DISPLAY '   X140-TOT-WAGE ' X140-TOTAL-WAGES                    CL192
01376      DISPLAY '      W-TOT-WAGE ' W-TOT-WAGE.                         CL192
01377                                                                   DTSBX430
01378 *    MOVE X140-REMITTANCE    TO W-X140-REMITTANCE.                   CL194
01379 *    DISPLAY ' W-X140-RMT ' W-X140-REMITTANCE.                       CL194
01380 *&                                                                DTSBX430
01381                                                                      CL*52
01382 *    DISPLAY ' PAY FOUND IND ' W-X145-PAYMENT-FOUND-IND.             CL194
01383                                                                      CL*68
01384 *    IF  W-X145-PAYMENT-NO-88 AND W-X140-REMITTANCE > 0              CL175
01385 *       MOVE SPACES TO R140-MESSAGE                                  CL175
01386 *       SET W-RPT-ERROR-YES-88 TO TRUE                               CL175
01387 *       MOVE W-EMP-NO      TO R140-EMP-NO                            CL175
01388 *       STRING                                                       CL175
01389 *          'ESSP AMT DUE > 0 AND NO PAYMT   '                        CL175
01390 *           DELIMITED BY SIZE                                        CL175
01391 *           INTO R140-MESSAGE                                        CL175
01392 *       END-STRING                                                   CL175
01393 *       PERFORM S946-WRITE-R140 THRU S946-EXIT                       CL175
01394 *       MOVE R140-MESSAGE TO P434-MESSAGE                            CL175
01395 *       GO TO P2010-EDIT-CONTINUE                                    CL175
01396 *    END-IF.                                                         CL175
01397                                                                      CL*52
01398 *    IF  W-X145-PAYMENT-NO-88 AND W-X140-REMITTANCE = 0              CL184
01399 *       MOVE SPACES TO R140-MESSAGE                                  CL184
01400 *       MOVE W-EMP-NO      TO R140-EMP-NO                            CL184
01401 *       STRING                                                       CL184
01402 *          'X140  REMIT AMT = 0 AND NO X145 FOUND -PROCESS '         CL184
01403 *            ' '   X140-REMITTANCE                                   CL184
01404 *           DELIMITED BY SIZE                                        CL184
01405 *           INTO R140-MESSAGE                                        CL184
01406 *       END-STRING                                                   CL184
01407 *           MOVE R140-MESSAGE TO P434-MESSAGE                        CL184
01408 *       PERFORM S946-WRITE-R140 THRU S946-EXIT                       CL184
01409 *       GO TO P2010-EDIT-CONTINUE                                    CL184
01410 *    END-IF.                                                         CL184
01411                                                                      CL*69
01412 *    IF   W-X145-TOT-REMIT-AMT > W-X140-REMITTANCE                   CL184
01413 **      MOVE SPACES TO R140-MESSAGE                                  CL184
01414 *       MOVE W-EMP-NO      TO R140-EMP-NO                            CL184
01415 *       SET W-WRITE-T025-TRAN-YES-88    TO TRUE                      CL108
01416 *       STRING                                                       CL184
01417 *          'X430  X145-PAY AMT > X140-REMIT AMT --PROCESS        '   CL184
01418 *           X145-REMITTANCE ' '   X140-REMITTANCE                    CL184
01419 *           DELIMITED BY SIZE                                        CL184
01420 *           INTO R140-MESSAGE                                        CL184
01421 *       END-STRING                                                   CL184
01422 *       PERFORM S946-WRITE-R140 THRU S946-EXIT                       CL184
01423 *    END-IF.                                                         CL184
01424                                                                      CL*53
01425 *    IF   W-X145-TOT-REMIT-AMT < W-X140-REMITTANCE                   CL184
01426 *       SET W-RPT-ERROR-YES-88 TO TRUE                               CL108
01427 *       MOVE SPACES TO R140-MESSAGE                                  CL184
01428 *       MOVE W-EMP-NO      TO R140-EMP-NO                            CL184
01429 *       STRING                                                       CL184
01430 *          'X430  X145-PAY AMT < X140-REMIT AMT '                    CL184
01431 *             X145-REMITTANCE     ' '   X140-REMITTANCE              CL184
01432 *           DELIMITED BY SIZE                                        CL184
01433 *           INTO R140-MESSAGE                                        CL184
01434 *       END-STRING                                                   CL184
01435 *       PERFORM S946-WRITE-R140 THRU S946-EXIT                       CL184
01436 *    END-IF.                                                         CL184
01437                                                                      CL*67
01438 *    IF   W-X145-TOT-REMIT-AMT > 0 AND W-X140-REMITTANCE = 0         CL184
01439 *       SET W-RPT-ERROR-YES-88 TO TRUE                               CL108
01440 *       MOVE SPACES TO R140-MESSAGE                                  CL184
01441 *       MOVE W-EMP-NO      TO R140-EMP-NO                            CL184
01442 *       STRING                                                       CL184
01443 *          'X430  X145-PAY AMT > 0 AND X140-REMIT AMT = 0 '          CL184
01444 *             X145-REMITTANCE    ' '   X140-REMITTANCE               CL184
01445 *           DELIMITED BY SIZE                                        CL184
01446 *           INTO R140-MESSAGE                                        CL184
01447 *       END-STRING                                                   CL184
01448 *       PERFORM S946-WRITE-R140 THRU S946-EXIT                       CL184
01449 *    END-IF.                                                         CL184
01450                                                                      CL*67
01451 *    IF W-X145-TOT-REMIT-AMT = W-X140-REMITTANCE                     CL184
01452 *       ADD 1 TO  W-T028-WRITEE-CNT                                  CL184
01453 *       SET W-RPT-ERROR-NO-88 TO TRUE                                CL184
01454 *       MOVE SPACES TO R140-MESSAGE                                  CL184
01455 *       MOVE W-EMP-NO      TO R140-EMP-NO                            CL184
01456 *       STRING                                                       CL184
01457 *          'X430 ++++ X145-REMIT AMT = X140-REMIT AMT  '             CL184
01458 *             X145-REMITTANCE    ' '   X140-REMITTANCE               CL184
01459 *           DELIMITED BY SIZE                                        CL184
01460 *           INTO R140-MESSAGE                                        CL184
01461 *       END-STRING                                                   CL184
01462 *       PERFORM S946-WRITE-R140 THRU S946-EXIT                       CL184
01463 *    END-IF.                                                         CL184
01464                                                                      CL102
01465  P2010-EDIT-CONTINUE.                                                CL*69
01466      DISPLAY 'BX430 P1210: ' W-EMP-NO ' TAX: ' X140-TAX-WAGES        CL*47
01467         ' TOT: ' X140-TOTAL-WAGES  ' RMT: ' W-X140-REMITTANCE        CL*57
01468 *&                                                                DTSBX430
01469      MOVE ZERO                TO W-X140-RECEIVED-DATE.               CL*72
01470      MOVE X140-RCVD-DATE      TO W-SLASH-DATE.                    DTSBX430
01471      MOVE W-SLASH-DT-MM       TO L001-FED-8-MO.                   DTSBX430
01472      MOVE W-SLASH-DT-DD       TO L001-FED-8-DA.                   DTSBX430
01473      MOVE W-SLASH-DT-CCYY     TO L001-FED-8-YR.                   DTSBX430
01474      PERFORM S001-FROM-FED-8  THRU S001-EXIT.                     DTSBX430
01475      IF NOT L001-VALID-DATE                                       DTSBX430
01476         SET W-RPT-ERROR-YES-88 TO TRUE                               CL*81
01477         MOVE SPACES TO R140-MESSAGE                               DTSBX430
01478         MOVE W-EMP-NO      TO R140-EMP-NO                         DTSBX430
01479         STRING                                                    DTSBX430
01480            ':-----FAILED -INVALID RECV DATE '                        CL240
01481               X140-RCVD-DATE                                         CL**2
01482             DELIMITED BY SIZE                                     DTSBX430
01483             INTO R140-MESSAGE                                     DTSBX430
01484         END-STRING                                                DTSBX430
01485             MOVE R140-MESSAGE TO X434-MESSAGE                        CL187
01486         PERFORM S946-WRITE-R140 THRU S946-EXIT                    DTSBX430
01487      ELSE                                                         DTSBX430
01488         MOVE L001-FED-8-DATE-9  TO W-X140-RECEIVED-DATE              CL*72
01489      END-IF.                                                      DTSBX430
01490                                                                   DTSBX430
01491      MOVE ZERO                TO W-CHK-SCAN-DATE.                 DTSBX430
01492 *    IF X140-IN-HOUSE-88                                          DTSBX430
01493 *       MOVE X140-CHECK-SCAN-DT  TO W-SLASH-DATE                  DTSBX430
01494 *       MOVE W-SLASH-DT-MM       TO L001-FED-8-MO                 DTSBX430
01495 *       MOVE W-SLASH-DT-DD       TO L001-FED-8-DA                 DTSBX430
01496 *       MOVE W-SLASH-DT-CCYY     TO L001-FED-8-YR                 DTSBX430
01497 *       PERFORM S001-FROM-FED-8  THRU S001-EXIT                   DTSBX430
01498 *       IF NOT L001-VALID-DATE                                    DTSBX430
01499 *          SET W-RPT-ERROR-YES-88 TO TRUE                            CL*81
01500 *          MOVE SPACES TO R140-MESSAGE                            DTSBX430
01501 *          MOVE W-EMP-NO      TO R140-EMP-NO                      DTSBX430
01502 *          STRING                                                 DTSBX430
01503 *             'REPORT: INVALID CHK SCAN DATE '                    DTSBX430
01504 *                X140-CHECK-SCAN-DT                               DTSBX430
01505 *              DELIMITED BY SIZE                                  DTSBX430
01506 *              INTO R140-MESSAGE                                  DTSBX430
01507 *          END-STRING                                             DTSBX430
01508 *          PERFORM S946-WRITE-R140 THRU S946-EXIT                 DTSBX430
01509 **         DISPLAY R140-MESSAGE                                   DTSBX430
01510 *       ELSE                                                      DTSBX430
01511 *          MOVE L001-FED-8-DATE-9  TO W-CHK-SCAN-DATE             DTSBX430
01512 *       END-IF                                                    DTSBX430
01513 *    END-IF.                                                      DTSBX430
01514                                                                   DTSBX430
01515      MOVE X140-WRKR-CNT-1ST-MNTH TO W-1ST-MNTH-CNT.               DTSBX430
01516      MOVE X140-WRKR-CNT-2ND-MNTH TO W-2ND-MNTH-CNT.               DTSBX430
01517      MOVE X140-WRKR-CNT-3RD-MNTH TO W-3RD-MNTH-CNT.               DTSBX430
01518                                                                   DTSBX430
01519                                                                   DTSBX430
01520  P2010-EXIT.                                                      DTSBX430
01521      EXIT.                                                        DTSBX430
01522                                                                   DTSBX430
01523  P2012-CHECK-MPRF.                                                   CL**2
01524      MOVE LOW-VALUE               TO MPRF-KEY-AREA.               DTSBX430
01525      MOVE W-EMP-NO                   TO MPRF-EMP-NO.              DTSBX430
01526      SET MPRF-PRF-88                 TO TRUE.                     DTSBX430
01527      MOVE MPRF-KEY-AREA              TO MSKL-KEY-AREA.            DTSBX430
01528                                                                   DTSBX430
01529      PERFORM S910-READ               THRU S910-EXIT.              DTSBX430
01530                                                                      CL**2
01531      IF L910-OK-88                                                   CL**2
01532         MOVE MSKL-REC                TO MPRF-REC                     CL**2
01533         MOVE W-X140-REPORT-QTR            TO L516-YRQ                CL*56
01534         PERFORM S516-LIABILITY-INFO  THRU S516-EXIT                  CL**2
01535        IF L516-LIABLE-88                                             CL*57
01536           SET W-RPT-ERROR-NO-88 TO TRUE                              CL*81
01537           SET W-EMP-FOUND-YES-88       TO TRUE                       CL*57
01538           DISPLAY 'X430 -EMPLOYER FOUND LIAB FOR QTR ' MPRF-EMP-NO   CL*57
01539           GO TO P2012-EXIT                                           CL*57
01540        ELSE                                                          CL*57
01541         SET W-RPT-ERROR-YES-88 TO TRUE                               CL*81
01542         MOVE SPACES                  TO R140-MESSAGE                 CL**2
01543         MOVE W-EMP-NO                TO R140-EMP-NO                  CL**2
01544         STRING                                                       CL**2
01545            ':-----FAILED - EMP NOT LIABLE '                          CL240
01546 *          ':EMP NOT LIABLE FOR QTRLY RPT      '                     CL187
01547             DELIMITED BY SIZE                                        CL**2
01548             INTO R140-MESSAGE                                        CL211
01549         END-STRING                                                   CL**2
01550             MOVE R140-MESSAGE TO X434-MESSAGE                        CL187
01551         PERFORM S946-WRITE-R140      THRU S946-EXIT                  CL**2
01552         SET W-EMP-FOUND-NO-88        TO TRUE                         CL**2
01553         GO TO P2012-EXIT                                             CL*51
01554      ELSE                                                            CL*51
01555        SET W-RPT-ERROR-YES-88 TO TRUE                                CL*81
01556         MOVE SPACES                  TO R140-MESSAGE                 CL*51
01557         MOVE W-EMP-NO                TO R140-EMP-NO                  CL*51
01558         STRING                                                       CL*51
01559 *          ':EMP NOT FOUND ON DUTAS-CANNOT PRCESS RPT'               CL187
01560            ':-----FAILED -EMP NOT ON DUTAS '                         CL240
01561 *             X140-EMP-NO                                            CL187
01562             DELIMITED BY SIZE                                        CL*51
01563             INTO R140-MESSAGE                                        CL*51
01564         END-STRING                                                   CL*51
01565             MOVE R140-MESSAGE TO X434-MESSAGE                        CL187
01566         PERFORM S946-WRITE-R140      THRU S946-EXIT                  CL*51
01567         SET W-EMP-FOUND-NO-88        TO TRUE                         CL*51
01568      END-IF.                                                         CL*51
01569                                                                      CL**2
01570  P2012-EXIT.                                                         CL**2
01571      EXIT.                                                        DTSBX430
01572                                                                   DTSBX430
01573                                                                      CL**2
01574  P2015-CHECK-MRPT.                                                   CL178
01575                                                                      CL178
01576      MOVE LOW-VALUES  TO MRPT-KEY-AREA.                              CL178
01577      MOVE MPRF-EMP-NO TO MRPT-EMP-NO.                                CL178
01578      MOVE W-X140-REPORT-QTR TO MRPT-YRQ.                             CL178
01579      MOVE ZEROS       TO MRPT-BATCH-NO.                              CL178
01580      MOVE ZEROS       TO MRPT-ITEM-NO                                CL178
01581                                                                      CL178
01582      SET MRPT-RPT-88  TO TRUE.                                       CL178
01583      MOVE MRPT-REC TO MSKL-REC.                                      CL178
01584                                                                      CL178
01585      PERFORM S910-START-BROWSE THRU S910-EXIT.                       CL178
01586      IF L910-OK-88                                                   CL178
01587         PERFORM P2016-SCAN-MRPT THRU P2016-EXIT                      CL178
01588            UNTIL L910-NO-REC-88                                      CL178
01589      ELSE                                                            CL178
01590        SET W-RPT-ERROR-NO-88 TO TRUE                                 CL178
01591        DISPLAY 'P2013 X430  ORIG RPT NOT ON DUTAS- PROCESS '         CL178
01592          W-EMP-NO ' ' W-X140-REPORT-QTR                              CL178
01593        DISPLAY ' '                                                   CL178
01594        GO TO P2015-EXIT.                                             CL178
01595                                                                      CL178
01596                                                                      CL178
01597  P2015-EXIT.                                                         CL178
01598      EXIT.                                                           CL178
01599                                                                      CL178
01600  P2016-SCAN-MRPT.                                                    CL178
01601      MOVE MSKL-REC TO MRPT-REC.                                      CL178
01602      IF MRPT-YRQ = W-X140-REPORT-QTR                                 CL178
01603         NEXT SENTENCE                                                CL178
01604      ELSE                                                            CL178
01605         IF MRPT-YRQ > W-X140-REPORT-QTR                              CL178
01606            SET W-RPT-ERROR-NO-88 TO TRUE                             CL178
01607            SET L910-NO-REC-88  TO TRUE                               CL178
01608            GO TO P2016-EXIT                                          CL178
01609         ELSE                                                         CL178
01610            GO TO P2016-READ-NEXT                                     CL178
01611         END-IF                                                       CL178
01612      END-IF.                                                         CL178
01613                                                                      CL178
01614      IF MRPT-ORIG-88                                                 CL178
01615        SET W-RPT-ERROR-YES-88 TO TRUE                                CL178
01616        SET L910-NO-REC-88  TO TRUE                                   CL178
01617         MOVE SPACES                  TO R140-MESSAGE                 CL179
01618         MOVE W-EMP-NO                TO R140-EMP-NO                  CL179
01619         STRING                                                       CL179
01620            ':-----FAILED - RPT EXIST IN DUTAS '                      CL240
01621 *             X140-QUARTER                                           CL187
01622             DELIMITED BY SIZE                                        CL179
01623             INTO R140-MESSAGE                                        CL179
01624         END-STRING                                                   CL179
01625             MOVE R140-MESSAGE TO X434-MESSAGE                        CL187
01626         PERFORM S946-WRITE-R140      THRU S946-EXIT                  CL179
01627        GO TO P2016-EXIT                                              CL178
01628      END-IF.                                                         CL178
01629                                                                      CL178
01630                                                                      CL178
01631  P2016-READ-NEXT.                                                    CL178
01632      PERFORM S910-READ-NEXT THRU S910-EXIT.                          CL178
01633      IF L910-NO-REC-88                                               CL178
01634        SET W-RPT-ERROR-NO-88 TO TRUE.                                CL178
01635  P2016-EXIT.                                                         CL178
01636                                                                      CL**3
01637  P2020-SAVE-EXT-REPORT.                                           DTSBX430
01638      DISPLAY 'P2020-SAVE-EXT-REPORT '                             DTSBX430
01639 ************************************************************      DTSBX430
01640 *  REPORTS FROM EXTERNAL SOURCES.  REPORTS WILL BE                DTSBX430
01641 *  ASSEMBLED INTO BATCHES IN DTSBD140. CHANGED ALL T027           DTSBX430
01642 *  TO BE T028 PER DOCUMENTATION IN BD140 FROM GIL 4/10/12         DTSBX430
01643 ************************************************************      DTSBX430
01644      MOVE LENGTH OF T028-REC        TO T028-LENGTH                DTSBX430
01645      MOVE '028'                     TO T028-REC-TYPE.             DTSBX430
01646                                                                   DTSBX430
01647      MOVE W-EMP-NO                  TO T028-EMP-NO.               DTSBX430
01648      MOVE 'WEB ESSP'                TO T028-ORIGIN.               DTSBX430
01649      MOVE LX42-SYS-DATE             TO T028-SYS-DATE.             DTSBX430
01650      MOVE LX42-SYS-TIME             TO T028-SYS-TIME.             DTSBX430
01651      SET  T028-WEB-RPT-88           TO TRUE.                      DTSBX430
01652                                                                   DTSBX430
01653      MOVE LX42-EXT-PSEUDO-BATCH     TO T028-PSEUDO-BATCH-NO.      DTSBX430
01654      MOVE LX42-EXT-PSEUDO-ITEM      TO T028-PSEUDO-ITEM-NO.       DTSBX430
01655                                                                   DTSBX430
01656      MOVE W-X140-REPORT-QTR              TO T028-YRQ.                CL*56
01657      IF W-EMP-FOUND-YES-88                                        DTSBX430
01658         MOVE MPRF-PRIMARY-NAME (1:4)                              DTSBX430
01659                                     TO T028-NAME-CHECK            DTSBX430
01660      ELSE                                                         DTSBX430
01661         MOVE SPACES                 TO T028-NAME-CHECK            DTSBX430
01662      END-IF.                                                      DTSBX430
01663      MOVE W-RPT-TYPE                TO T028-RPT-TYPE.             DTSBX430
01664                                                                   DTSBX430
01665 ****************************************************************  DTSBX430
01666 *  LX42-LAST-DETERM-EMP IS SET BY DTSBX420 WHEN PROCESSING        DTSBX430
01667 *  A DETERMINATION. IT IS USED TO DETERMINE WHEN TO WAIVE         DTSBX430
01668 *  P & I. THE WAIVER IS AUTOMATIC FOR REPORTS WITHIN              DTSBX430
01669 *  THE LAST 5 QUARTERS SUBMITTED ALONG WITH A WEB                 DTSBX430
01670 *  REGISTRATION.                                                  DTSBX430
01671 ****************************************************************  DTSBX430
01672      IF (W-EMP-NO = LX42-LAST-DETERM-EMP                          DTSBX430
01673      AND W-X140-REPORT-QTR >= W-WAIVER-QTR)                          CL*56
01674         SET T028-WAIVE-BOTH-YES-88  TO TRUE                       DTSBX430
01675      ELSE                                                         DTSBX430
01676         SET T028-WAIVE-BOTH-NO-88   TO TRUE                       DTSBX430
01677      END-IF.                                                      DTSBX430
01678      SET  T028-WAIVE-INT-NO-88      TO TRUE.                      DTSBX430
01679      SET  T028-WAIVE-LATE-PEN-NO-88 TO TRUE.                      DTSBX430
01680      MOVE W-X140-RECEIVED-DATE      TO T028-RECEIVED-DATE            CL*72
01681                                        T028-DEPOSIT-DATE.         DTSBX430
01682                                                                   DTSBX430
01683      MOVE W-TOT-WAGE                TO T028-TOT-WAGE.             DTSBX430
01684                                                                   DTSBX430
01685      IF W-EMP-FOUND-NO-88                                         DTSBX430
01686         MOVE W-TAX-WAGE             TO T028-TAX-WAGE              DTSBX430
01687         COMPUTE T028-EXCESS-WAGE =                                DTSBX430
01688            (T028-TOT-WAGE - T028-TAX-WAGE)                        DTSBX430
01689      ELSE                                                         DTSBX430
01690         IF MPRF-CLASS-SELF-INS-88                                 DTSBX430
01691            MOVE ZERO                TO T028-TAX-WAGE              DTSBX430
01692                                        T028-EXCESS-WAGE           DTSBX430
01693         ELSE                                                      DTSBX430
01694            MOVE W-TAX-WAGE          TO T028-TAX-WAGE              DTSBX430
01695            COMPUTE T028-EXCESS-WAGE =                             DTSBX430
01696               (T028-TOT-WAGE - T028-TAX-WAGE)                     DTSBX430
01697         END-IF                                                    DTSBX430
01698      END-IF.                                                      DTSBX430
01699                                                                   DTSBX430
01700      MOVE ZERO                      TO T028-TOTAL-EMPL-CNT.       DTSBX430
01701      MOVE X140-WRKR-CNT-1ST-MNTH    TO T028-1ST-MTH-EMPL-CNT.     DTSBX430
01702      MOVE X140-WRKR-CNT-2ND-MNTH    TO T028-2ND-MTH-EMPL-CNT.     DTSBX430
01703      MOVE X140-WRKR-CNT-3RD-MNTH    TO T028-3RD-MTH-EMPL-CNT.     DTSBX430
01704                                                                   DTSBX430
01705 *    DISPLAY ' X145 PAY AMT ' X145-REMITTANCE                        CL184
01706 *    DISPLAY ' X140 PAY AMT ' X140-REMITTANCE                        CL184
01707                                                                      CL108
01708 *    MOVE W-X145-TOT-REMIT-AMT           TO W-X140-REMITTANCE        CL184
01709 *    MOVE W-X140-REMITTANCE              TO T028-REMIT-AMT.          CL184
01710      MOVE ZEROS                          TO T028-REMIT-AMT.          CL184
01711                                                                   DTSBX430
01712      ADD  W-X145-TOT-REMIT-AMT           TO W-TOT-REMIT-AMT.         CL142
01713      SET T028-PASSED-FULL-EDITS-YES-88  TO TRUE                   DTSBX430
01714                                                                      CL156
01715                                                                      CL163
01716 *    IF X145-TRACE-NO > SPACES                                       CL184
01717 *       MOVE X145-TRACE-NO           TO T028-TRACE-NO                CL184
01718 *    ELSE                                                            CL184
01719        MOVE ZERO                      TO T028-TRACE-NO.              CL156
01720                                                                   DTSBX430
01721      MOVE 'VOL'                    TO T028-RESPONSIBLE-ACTIVITY.  DTSBX430
01722      MOVE 'WEBESSP '               TO T028-RESPONSIBLE-OP-ID.     DTSBX430
01723                                                                   DTSBX430
01724      DISPLAY 'BX430 WEB RPT ' X140-EMP-NO '  ' X140-QUARTER.         CL*47
01725      PERFORM S1032-WRITE-TEMP-T028  THRU S1032-EXIT.              DTSBX430
01726                                                                   DTSBX430
01727      PERFORM P4000-WRITE-X434-PAID-REPT THRU P4000-EXIT.             CL124
01728                                                                      CL124
01729 *    DISPLAY W-EMP-NO ',' T028-TOT-WAGE                              CL124
01730 *            ',' T028-EXCESS-WAGE                                    CL124
01731 *            ',' T028-TAX-WAGE                                       CL124
01732 *            ',' X140-REMITTANCE                                     CL124
01733 *            ',' X145-REMITTANCE.                                    CL124
01734                                                                      CL110
01735      IF W-X140-REMITTANCE > 0                                        CL100
01736         ADD 1 TO  W-T028-WRITE-CNT                                   CL100
01737      ELSE                                                            CL100
01738         ADD 1 TO  W-T028-WRITE-CNT                                   CL100
01739         ADD 1 TO  W-T028-WRITEO-CNT.                                 CL100
01740                                                                      CL100
01741 *    IF W-WRITE-T025-TRAN-YES-88                                     CL108
01742 *       PERFORM P2021-WRITE-T025  THRU P2021-EXIT                    CL108
01743 *    ELSE                                                            CL108
01744         SET W-RPT-ERROR-NO-88 TO TRUE                                CL*81
01745         MOVE SPACES TO R140-MESSAGE                                  CL*71
01746         MOVE W-EMP-NO     TO R140-EMP-NO                             CL*71
01747         STRING                                                       CL*71
01748            'X430 -:>>>>> REPORT ADDED TO DUTAS - ' X140-QUARTER      CL*93
01749             DELIMITED BY SIZE                                        CL*71
01750             INTO R140-MESSAGE                                        CL*71
01751         END-STRING                                                   CL*71
01752         PERFORM S946-WRITE-R140 THRU S946-EXIT.                      CL*71
01753  P2020-EXIT.                                                      DTSBX430
01754      EXIT.                                                        DTSBX430
01755                                                                   DTSBX430
01756  P2021-WRITE-T025.                                                   CL*71
01757 **                                                                   CL*73
01758 **PAYMENT TRANSACTION REMIT AMT > THAN REPORT REMIT AMT, SUBTRACT    CL*73
01759 **DIFFERENCE AND WRITE A PA T025 TRANSACTION.                        CL*73
01760 **                                                                   CL*73
01761      DISPLAY 'PAYMENT OK ' X145-EMP-NO.                              CL*71
01762                                                                      CL*71
01763      MOVE LENGTH OF T025-REC        TO T025-LENGTH                   CL*71
01764      MOVE '025'                     TO T025-REC-TYPE.                CL*71
01765                                                                      CL*71
01766      MOVE W-EMP-NO                  TO T025-EMP-NO.                  CL*71
01767      MOVE 'WEB PAY'                 TO T025-ORIGIN.                  CL*71
01768      MOVE LX42-SYS-DATE             TO T025-SYS-DATE.                CL*71
01769      MOVE LX42-SYS-TIME             TO T025-SYS-TIME.                CL*71
01770 *                                                                    CL*71
01771        MOVE ZERO                   TO T025-APPLIC-YRQ                CL*71
01772        MOVE 'PA'                   TO T025-PAY-TYPE                  CL*71
01773                                                                      CL*71
01774      MOVE SPACES                    TO T025-APPLIC-IND.              CL*71
01775      MOVE ZERO                      TO T025-APPLIC-BATCH-NO          CL*71
01776                                        T025-APPLIC-ITEM-NO.          CL*71
01777                                                                      CL*71
01778      IF W-EMP-FOUND-YES-88                                           CL*71
01779         MOVE MPRF-PRIMARY-NAME (1:4)                                 CL*71
01780                                     TO T025-NAME-CHECK               CL*71
01781      ELSE                                                            CL*71
01782         MOVE SPACES                 TO T025-NAME-CHECK               CL*71
01783      END-IF.                                                         CL*71
01784                                                                      CL*71
01785      MOVE W-X145-RECEIVED-DATE      TO T025-RECEIVED-DATE            CL*72
01786                                        T025-DEPOSIT-DATE.            CL*71
01787                                                                      CL*71
01788      COMPUTE W-T025-REMIT-AMT = W-X145-TOT-REMIT-AMT -               CL*71
01789       W-X140-REMITTANCE.                                             CL*71
01790                                                                      CL*71
01791      MOVE W-T025-REMIT-AMT          TO T025-REMIT-AMT.               CL*71
01792                                                                      CL*71
01793      MOVE  X145-TRACE-NO             TO T025-TRACE-NO.               CL165
01794                                                                      CL*71
01795      MOVE 'VOL'                    TO T025-RESPONSIBLE-ACTIVITY.     CL*71
01796      MOVE 'WEBESSP'                TO T025-RESPONSIBLE-OP-ID.        CL*71
01797                                                                      CL*71
01798 *    MOVE T025-REC                  TO TSKL-REC.                     CL*71
01799 *    PERFORM S927B-WRITE            THRU S927B-EXIT.                 CL*71
01800                                                                      CL*71
01801      PERFORM S1033-WRITE-TEMP-T025  THRU S1033-EXIT.                 CL*71
01802      ADD +1 TO W-T025-WRITE-CNT.                                     CL*71
01803                                                                      CL*71
01804      MOVE ZEROS TO  W-T025-REMIT-AMT                                 CL*72
01805                     W-X145-TOT-REMIT-AMT                             CL*72
01806                     W-X140-REMITTANCE.                               CL*72
01807                                                                      CL*72
01808      SET W-WRITE-T025-TRAN-NO-88 TO TRUE.                            CL*72
01809                                                                      CL*71
01810         SET W-RPT-ERROR-NO-88 TO TRUE                                CL*81
01811         MOVE SPACES TO R140-MESSAGE                                  CL*71
01812         MOVE W-EMP-NO     TO R140-EMP-NO                             CL*71
01813         STRING                                                       CL*71
01814            'X430 -: >>>>> PAYMENT T025 CREATED FOR EXCESS 145 '      CL*93
01815            'REMIT AMT'                                               CL*93
01816             DELIMITED BY SIZE                                        CL*71
01817             INTO R140-MESSAGE                                        CL*71
01818         END-STRING                                                   CL*71
01819         PERFORM S946-WRITE-R140 THRU S946-EXIT.                      CL*71
01820  P2021-EXIT.                                                         CL*71
01821      EXIT.                                                           CL*71
01822                                                                      CL*71
01823                                                                   DTSBX430
01824  P3000-WAGES.                                                     DTSBX430
01825      MOVE LX42-DATA-AREA               TO X144-REC.               DTSBX430
01826 *    DISPLAY 'X144: ' X144-REC.                                      CL160
01827      MOVE X144-EMP-NO                  TO W-EMP-NO.                  CL*38
01828      MOVE X144-EMP-NO                  TO W-EMP-X144-NO.             CL189
01829 *                                                                    CL**4
01830      IF W-EMP-NO = LX42-X144-KEY-AREA AND                            CL218
01831         X144-QUARTER = LX42-X144-QTR-AREA                            CL218
01832         MOVE X144-EARNINGS    TO W-EARNINGS-X                        CL189
01833         MOVE W-EARNINGS-9     TO W-EARNINGS                          CL189
01834         ADD W-EARNINGS        TO W-TOT-X144-WAGE                     CL220
01835         MOVE W-TOT-X144-WAGE TO LX42-PAY-REMIT-AMT                   CL222
01836      ELSE                                                            CL220
01837        MOVE 0 TO W-TOT-X144-WAGE                                     CL220
01838        MOVE W-EMP-NO TO LX42-X144-KEY-AREA                           CL220
01839        MOVE X144-QUARTER TO LX42-X144-QTR-AREA                       CL221
01840         MOVE X144-EARNINGS    TO W-EARNINGS-X                        CL220
01841         MOVE W-EARNINGS-9     TO W-EARNINGS                          CL220
01842         ADD W-EARNINGS        TO W-TOT-X144-WAGE                     CL222
01843         MOVE W-TOT-X144-WAGE TO LX42-PAY-REMIT-AMT.                  CL222
01844                                                                      CL220
01845 *                                                                    CL189
01846      ADD +1          TO W-X144-RED-CNT                               CL*96
01847      SET   W-RPT-ERROR-NO-88 TO TRUE.                                CL147
01848      SET   W-PREV-REC-WAGE-88 TO TRUE.                               CL162
01849 *                                                                    CL**4
01850 *    DISPLAY 'LX-E ' LX42-X140-EMP-NO  ' X145-E ' W-EMP-NO.          CL*97
01851 *    IF LX42-X145-EMP-NO = '999999' OR                               CL157
01852 *       LX42-X140-EMP-NO = '999999' OR                               CL157
01853 *       LX42-X145-EMP-NO = SPACES   OR                               CL157
01854 *       LX42-X140-EMP-NO = SPACES   OR                               CL157
01855 *       W-PREV-RPT-NULL-88                                           CL157
01856 *       SET W-RPT-ERROR-YES-88 TO TRUE                               CL157
01857 *       MOVE SPACES TO R140-MESSAGE                                  CL157
01858 *       MOVE W-EMP-NO     TO R140-EMP-NO                             CL157
01859 *       STRING                                                       CL157
01860 *       'X430 -: X144 WAGES HAS NO X140 REPORT -- CANCEL - WAGES '   CL157
01861 *              ' ' X144-QUARTER                                      CL157
01862 *           DELIMITED BY SIZE                                        CL157
01863 *           INTO R140-MESSAGE                                        CL157
01864 *       END-STRING                                                   CL157
01865 *       WRITE PEND-X144-REC FROM X144-REC                            CL157
01866 *       ADD +1          TO W-X144-ERR-CNT                            CL157
01867 *       ADD +1          TO W-X144-PEN-CNT                            CL157
01868 *       PERFORM P6000-WRITE-PEND-FILES THRU P6000-EXIT               CL117
01869 *       PERFORM S946-WRITE-R140 THRU S946-EXIT                       CL*83
01870 *       GO TO P3000-EXIT.                                            CL159
01871                                                                      CL*36
01872 *                                                                    CL**4
01873 *    IF W-PREV-RPT-RPT-88                                            CL157
01874 *    OR W-PREV-RPT-WAGE-88                                           CL157
01875 *       SET W-PREV-RPT-WAGE-88         TO TRUE                       CL162
01876         ADD +1                         TO W-X144-PRO-CNT             CL*56
01877         PERFORM P3010-EDIT-WAGES       THRU P3010-EXIT            DTSBX430
01878         IF W-RPT-ERROR-NO-88                                         CL*81
01879            PERFORM P3011-WRITE-WAGES-X144   THRU P3011-EXIT       DTSBX430
01880           ADD +1          TO W-X144-SAV-CNT                          CL*96
01881         GO TO P3000-EXIT                                             CL160
01882         ELSE                                                         CL*36
01883         SET W-RPT-ERROR-YES-88 TO TRUE                               CL*81
01884         MOVE SPACES TO R140-MESSAGE                                  CL*36
01885         MOVE W-EMP-NO     TO R140-EMP-NO                             CL*36
01886         STRING                                                       CL*36
01887            'X430 -: WAGE RECORD CONTAINS ERRORS CANNOT PROCESS '     CL*47
01888                ' ' X144-SSN                                          CL*36
01889             DELIMITED BY SIZE                                        CL*36
01890             INTO R140-MESSAGE                                        CL*36
01891         END-STRING                                                   CL*36
01892         ADD +1           TO W-X144-ERR-CNT                           CL*93
01893         ADD +1           TO W-X144-PEN-CNT                           CL*96
01894         WRITE PEND-X144-REC FROM X144-REC                            CL*93
01895 *       PERFORM P6000-WRITE-PEND-X144  THRU P6000-EXIT               CL189
01896         PERFORM S946-WRITE-R140 THRU S946-EXIT                       CL*36
01897         GO TO P3000-EXIT                                             CL*36
01898 *    ELSE                                                            CL157
01899 *       SET W-RPT-ERROR-YES-88 TO TRUE                               CL157
01900 *       MOVE SPACES TO R140-MESSAGE                                  CL157
01901 *       MOVE W-EMP-NO     TO R140-EMP-NO                             CL157
01902 *       STRING                                                       CL157
01903 *          'X430 -: REPORT RECORD X140 NOT FOUND OR MISSING    '     CL157
01904 *              ' ' X144-SSN                                          CL157
01905 *           DELIMITED BY SIZE                                        CL157
01906 *           INTO R140-MESSAGE                                        CL157
01907 *       END-STRING                                                   CL157
01908 *       WRITE PEND-X144-REC FROM X144-REC                            CL157
01909 *       ADD +1           TO W-X144-ERR-CNT                           CL157
01910 *       ADD +1           TO W-X144-PEN-CNT                           CL157
01911 *       PERFORM P6000-WRITE-PEND-FILES THRU P6000-EXIT               CL*93
01912 *       PERFORM S946-WRITE-R140 THRU S946-EXIT                       CL157
01913      END-IF.                                                      DTSBX430
01914                                                                   DTSBX430
01915  P3000-EXIT.                                                      DTSBX430
01916      EXIT.                                                        DTSBX430
01917                                                                   DTSBX430
01918  P3010-EDIT-WAGES.                                                DTSBX430
01919      DISPLAY 'P3010-EDIT-WAGES '                                     CL162
01920 *    DISPLAY 'X144-QUARTER '  X144-QUARTER                           CL*36
01921      MOVE X144-QUARTER       TO W-SLASH-QTR.                      DTSBX430
01922      MOVE W-SLASH-QTR-CCYY   TO L004-QTR-5-YR.                    DTSBX430
01923      MOVE W-SLASH-QTR-Q      TO L004-QTR-5-Q.                     DTSBX430
01924      PERFORM S004-FROM-5     THRU S004-EXIT.                      DTSBX430
01925      IF NOT L004-VALID-QTR                                        DTSBX430
01926         SET W-RPT-ERROR-YES-88 TO TRUE                               CL*81
01927         MOVE SPACES TO R140-MESSAGE                               DTSBX430
01928         MOVE W-EMP-NO      TO R140-EMP-NO                         DTSBX430
01929         STRING                                                    DTSBX430
01930            ': WAGE RECORD HAS INVALID QUARTER '                      CL144
01931               X144-QUARTER ' ' X144-SSN                              CL*36
01932             DELIMITED BY SIZE                                     DTSBX430
01933             INTO R140-MESSAGE                                     DTSBX430
01934         END-STRING                                                DTSBX430
01935             MOVE R140-MESSAGE TO P434-MESSAGE                        CL144
01936         PERFORM S946-WRITE-R140 THRU S946-EXIT                    DTSBX430
01937         ELSE                                                         CL*13
01938            MOVE L004-QTR-5-9     TO W-X144-WAGE-QTR                  CL*53
01939      END-IF.                                                      DTSBX430
01940                                                                      CL*15
01941 *       IF L004-QTR-5-9 NOT = W-X140-REPORT-QTR                      CL161
01942 *          SET W-RPT-ERROR-YES-88 TO TRUE                            CL161
01943 *          MOVE SPACES TO R140-MESSAGE                               CL161
01944 *          MOVE W-EMP-NO     TO R140-EMP-NO                          CL161
01945 *          MOVE W-X140-REPORT-QTR TO WRK-REPORT-QTR                  CL161
01946 *          STRING                                                    CL161
01947 *             ':WAGE QTR NOT = RPT QTR '                             CL161
01948 *                X144-QUARTER '  ' WRK-REPORT-QTR                    CL161
01949 *              DELIMITED BY SIZE                                     CL161
01950 *              INTO R140-MESSAGE                                     CL161
01951 *          END-STRING                                                CL161
01952 *           MOVE R140-MESSAGE TO P434-MESSAGE                        CL161
01953 *          PERFORM S946-WRITE-R140 THRU S946-EXIT                    CL161
01954 *       END-IF.                                                      CL161
01955                                                                   DTSBX430
01956      IF X144-SSN                 NOT NUMERIC                      DTSBX430
01957 *       DISPLAY 'X144-SSN '   X144-SSN                               CL*36
01958         SET W-RPT-ERROR-YES-88 TO TRUE                               CL*81
01959         MOVE SPACES TO R140-MESSAGE                               DTSBX430
01960         MOVE W-EMP-NO     TO R140-EMP-NO                          DTSBX430
01961         STRING                                                    DTSBX430
01962            ':WAGE RECORD NON-NUMERIC SSN  '                          CL144
01963               X144-SSN                                            DTSBX430
01964             DELIMITED BY SIZE                                     DTSBX430
01965             INTO R140-MESSAGE                                     DTSBX430
01966         END-STRING                                                DTSBX430
01967             MOVE R140-MESSAGE TO P434-MESSAGE                        CL144
01968         PERFORM S946-WRITE-R140 THRU S946-EXIT                    DTSBX430
01969      ELSE                                                         DTSBX430
01970         MOVE X144-SSN         TO W-SSN                            DTSBX430
01971      END-IF.                                                      DTSBX430
01972                                                                   DTSBX430
01973      IF X144-SSN = ZEROS                                             CL*53
01974 *       DISPLAY 'X144-SSN '   X144-SSN                               CL*53
01975         SET W-RPT-ERROR-YES-88 TO TRUE                               CL*81
01976         MOVE SPACES TO R140-MESSAGE                                  CL*53
01977         MOVE W-EMP-NO     TO R140-EMP-NO                             CL*53
01978         STRING                                                       CL*53
01979            ':WAGE RECORD SSN = ZEROS          '                      CL144
01980               X144-SSN                                               CL*53
01981             DELIMITED BY SIZE                                        CL*53
01982             INTO R140-MESSAGE                                        CL*53
01983         END-STRING                                                   CL*53
01984             MOVE R140-MESSAGE TO P434-MESSAGE                        CL144
01985         PERFORM S946-WRITE-R140 THRU S946-EXIT                       CL*53
01986      ELSE                                                            CL*53
01987         MOVE X144-SSN         TO W-SSN                               CL*53
01988      END-IF.                                                         CL*53
01989                                                                      CL*53
01990 *    DISPLAY 'SSN: ' X144-SSN ' LN: ' X144-LAST-NAME                 CL162
01991 *       ' FN: ' X144-FIRST-NAME.                                     CL162
01992      IF X144-LAST-NAME = SPACES                                      CL*36
01993         SET W-RPT-ERROR-YES-88 TO TRUE                               CL*81
01994         MOVE SPACES TO R140-MESSAGE                                  CL*36
01995         MOVE W-EMP-NO     TO R140-EMP-NO                             CL*36
01996         STRING                                                       CL*36
01997            ':WAGE RECORD BLANK LAST NAME  '                          CL144
01998               X144-SSN                                               CL*36
01999             DELIMITED BY SIZE                                        CL*36
02000             INTO R140-MESSAGE                                        CL*36
02001         END-STRING                                                   CL*36
02002             MOVE R140-MESSAGE TO P434-MESSAGE                        CL144
02003         PERFORM S946-WRITE-R140 THRU S946-EXIT                       CL*36
02004      END-IF.                                                         CL*36
02005                                                                      CL*36
02006      IF X144-FIRST-NAME = SPACES                                     CL*36
02007         SET W-RPT-ERROR-YES-88 TO TRUE                               CL*81
02008         MOVE SPACES TO R140-MESSAGE                                  CL*36
02009         MOVE W-EMP-NO     TO R140-EMP-NO                             CL*36
02010         STRING                                                       CL*36
02011            ':WAGE RECORD BLANK FIRST NAME  '                         CL144
02012               X144-SSN                                               CL*36
02013             DELIMITED BY SIZE                                        CL*36
02014             INTO R140-MESSAGE                                        CL*36
02015         END-STRING                                                   CL*36
02016             MOVE R140-MESSAGE TO P434-MESSAGE                        CL144
02017         PERFORM S946-WRITE-R140 THRU S946-EXIT                       CL*36
02018      END-IF.                                                         CL*36
02019                                                                      CL*36
02020 *    IF W-CURR-WAGE-QTR NOT = W-WAGE-QTR                          DTSBX430
02021 *       MOVE ZERO            TO W-WRKR-TOT-WAGE                   DTSBX430
02022 *       MOVE W-WAGE-QTR      TO W-CURR-WAGE-QTR                   DTSBX430
02023 *    END-IF.                                                      DTSBX430
02024                                                                   DTSBX430
02025                                                                   DTSBX430
02026  P3010-EXIT.                                                      DTSBX430
02027      EXIT.                                                        DTSBX430
02028                                                                   DTSBX430
02029  P3011-WRITE-WAGES-X144.                                          DTSBX430
02030                                                                   DTSBX430
02031 **************************************************************       CL*11
02032 *    WRITE W4 WAGES FOR DOCS                                         CL*11
02033 **************************************************************       CL*11
02034 *                                                                    CL*11
02035      MOVE LOW-VALUES                 TO ESP-TRANSACTION-AREA.        CL*11
02036      MOVE X144-SSN                   TO W4-SSN.                      CL*11
02037      MOVE 'W4'                       TO W4-TRAN-ID.                  CL*11
02038      MOVE '00044001'                 TO W4-TRAN-OPER-ID.             CL*11
02039 *    MOVE MHDR-CURR-RUN-DATE         TO W4-DATE-ENTERED.             CL250
02040      MOVE LX42-CURR-RUN-DATE         TO W4-DATE-ENTERED.             CL250
02041      MOVE ZEROS                      TO W4-TIME-ENTERED.             CL*11
02042      MOVE X144-LAST-NAME (1:3)       TO W4-NAME-CHECK.               CL*11
02043      MOVE W-X144-WAGE-QTR            TO W4-QUARTER.                  CL118
02044      MOVE X144-EARNINGS              TO W4-QUARTER-EARNINGS.         CL*11
02045      MOVE 2                          TO W4-AFFI-CODE.                CL*11
02046      MOVE X144-EMP-NO                TO W4-ACCOUNT.                  CL*11
02047      MOVE MPRF-PRIMARY-NAME (1:4)    TO W4-EMP-NAME.                 CL*11
02048                                                                      CL*11
02049 *    MOVE ESP-TRANSACTION-AREA       TO WAGE-TRANS-REC.              CL*20
02050      MOVE ESP-TRANSACTION-AREA       TO WAGE-OUT-REC.                CL*20
02051                                                                      CL*11
02052 *    WRITE WAGE-TRANS-REC.                                           CL*20
02053      WRITE WAGE-OUT-REC.                                             CL*20
02054                                                                      CL*11
02055      IF WAGE-TEMP-STATUS-OK-88                                       CL*32
02056         ADD +1                          TO W-W4-CNT                  CL*11
02057 *       DISPLAY 'WRITE W4 ' W4-ACCOUNT '  ' W4-QUARTER               CL162
02058 *          '  ' W4-SSN                                               CL162
02059      ELSE                                                            CL*11
02060          DISPLAY 'ERROR WRITING W4- WAGE FILE '                      CL*36
02061             WAGE-TEMP-STATUS                                         CL*32
02062       END-IF.                                                        CL*11
02063                                                                      CL*11
02064                                                                      CL*11
02065  P3011-EXIT.                                                         CL*25
02066      EXIT.                                                        DTSBX430
02067  P4000-WRITE-X434-PAID-REPT.                                         CL119
02068                                                                      CL119
02069      MOVE X140-EMP-NO          TO  X434-EMP-NO                       CL119
02070      MOVE X140-QUARTER         TO  X434-QTR                          CL125
02071      IF W-EMP-FOUND-YES-88                                           CL119
02072         MOVE MPRF-PRIMARY-NAME (1:15)                                CL119
02073                                     TO X434-NAME-CHECK               CL119
02074      ELSE                                                            CL119
02075         MOVE SPACES                 TO X434-NAME-CHECK               CL119
02076      END-IF.                                                         CL119
02077                                                                      CL119
02078 *    DISPLAY ' T028 WAGE ' T028-TOT-WAGE.                            CL194
02079      MOVE X140-RCVD-DATE       TO  X434-RCVD-DATE                    CL121
02080      MOVE W-TOT-WAGE           TO  X434-TOT-WAGE                     CL194
02081      MOVE W-TAX-WAGE           TO  X434-TAX-WAGE                     CL194
02082      COMPUTE W-EXCESS-WAGE =                                         CL194
02083               (W-TOT-WAGE - W-TAX-WAGE).                             CL194
02084      MOVE W-EXCESS-WAGE     TO  X434-EXC-WAGE                        CL194
02085 *    MOVE X140-REMITTANCE      TO  X434-X140-REMIT                   CL187
02086 *                                  WS-X140-REMITTANCE                CL187
02087 *    MOVE W-X140-REMITTANCE    TO  X434-X145-REMIT                   CL187
02088                                                                      CL148
02089 *    COMPUTE W-T025-REMIT-AMT = W-X145-TOT-REMIT-AMT -               CL187
02090 *     WS-X140-REMITTANCE.                                            CL187
02091                                                                      CL149
02092 *    MOVE W-T025-REMIT-AMT     TO  X434-DIFF.                        CL187
02093                                                                      CL148
02094 *    MOVE ZERO                      TO X434-TOTAL-EMPL-CNT.          CL121
02095      MOVE X140-WRKR-CNT-1ST-MNTH    TO X434-M1-CNT.                  CL125
02096      MOVE X140-WRKR-CNT-2ND-MNTH    TO X434-M2-CNT.                  CL125
02097      MOVE X140-WRKR-CNT-3RD-MNTH    TO X434-M3-CNT.                  CL125
02098                                                                      CL119
02099      IF W-RPT-ERROR-NO-88                                            CL191
02100         MOVE ':REPORT PASSED TO DUTAS>>>' TO  X434-MESSAGE.          CL228
02101 *    ELSE                                                            CL210
02102 *       MOVE 'PENDING  '       TO  X434-DISPOSITION.                 CL120
02103 *    MOVE R140-MESSAGE         TO  X434-MESSAGE.                     CL210
02104                                                                      CL119
02105      PERFORM P4100-PRINT-HEADER THRU P4100-EXIT.                     CL121
02106      WRITE REPT-PAID-REC FROM DETAIL-LINE-1  AFTER 1.                CL120
02107      ADD  1    TO WS-LINE-CNT2.                                      CL119
02108      ADD +1    TO WS-NUMBER-ONE.                                     CL119
02109                                                                      CL119
02110                                                                      CL119
02111  P4000-EXIT.                                                         CL119
02112        EXIT.                                                         CL119
02113  P4100-PRINT-HEADER.                                                 CL121
02114       IF WS-LINE-CNT GREATER 58 OR                                   CL121
02115            WS-LINE-CNT2 GREATER 58                                   CL121
02116          MOVE +0          TO WS-LINE-CNT                             CL121
02117          MOVE +0          TO WS-LINE-CNT2                            CL121
02118          ADD  +1          TO WS-PAGE-CNT                             CL121
02119          MOVE WS-PAGE-CNT TO HDR3-PAGE                               CL121
02120 *        MOVE L001-SLASH-DATE  TO HDR1-LRCM-SYS-DATE                 CL247
02121          MOVE '******* X140 REPORT STATUS ******* ' TO HDR5-NAME     CL206
02122          WRITE REPT-PAID-REC FROM HEADER-1 AFTER TOP-OF-PAGE         CL122
02123          WRITE REPT-PAID-REC FROM HEADER-2 AFTER 1                   CL122
02124          WRITE REPT-PAID-REC FROM HEADER-3 AFTER 1                   CL122
02125          WRITE REPT-PAID-REC FROM HEADER-4 AFTER 1                   CL122
02126          WRITE REPT-PAID-REC FROM HEADER-42 AFTER 1                  CL153
02127          WRITE REPT-PAID-REC FROM HEADER-5 AFTER 1                   CL122
02128          WRITE REPT-PAID-REC FROM HEADER-6 AFTER 1                   CL122
02129          ADD +6    TO WS-LINE-CNT2.                                  CL121
02130  P4100-EXIT.                                                         CL121
02131       EXIT.                                                          CL121
02132                                                                      CL121
02133  P4200-PRINT-HEADER.                                                 CL133
02134       IF WSP-LINE-CNT GREATER 58 OR                                  CL133
02135            WSP-LINE-CNT2 GREATER 58                                  CL133
02136          MOVE +0          TO WSP-LINE-CNT                            CL133
02137          MOVE +0          TO WSP-LINE-CNT2                           CL133
02138          ADD  +1          TO WSP-PAGE-CNT                            CL133
02139          MOVE WSP-PAGE-CNT TO HDR31-PAGE                             CL133
02140          MOVE  ' * REASON FOR PENDING *' TO HDR5-NAME                CL138
02141 *        MOVE L001-SLASH-DATE  TO HDR1-LRCM-SYS-DATE                 CL247
02142          WRITE REPT-PEND-REC FROM HEADER-1 AFTER TOP-OF-PAGE         CL133
02143          WRITE REPT-PEND-REC FROM HEADER-2 AFTER 1                   CL133
02144          WRITE REPT-PEND-REC FROM HEADER-31 AFTER 1                  CL133
02145          WRITE REPT-PEND-REC FROM HEADER-4 AFTER 1                   CL133
02146          WRITE REPT-PEND-REC FROM HEADER-42 AFTER 1                  CL144
02147          WRITE REPT-PEND-REC FROM HEADER-5 AFTER 1                   CL133
02148          WRITE REPT-PEND-REC FROM HEADER-6 AFTER 1                   CL133
02149          ADD +6    TO WSP-LINE-CNT2.                                 CL133
02150  P4200-EXIT.                                                         CL133
02151       EXIT.                                                          CL133
02152                                                                      CL133
02153                                                                   DTSBX430
02154  P5000-NEW-EMP.                                                   DTSBX430
02155 *&                                                                DTSBX430
02156         DISPLAY ' 5000-NEW-EMP ' W-PREV-REC-TYPE                     CL*89
02157                 '    ERROR-IND ' W-RPT-ERROR-IND                     CL*88
02158 *    IF W-PREV-RPT-PAY-88 AND                                        CL184
02159 *       W-RPT-ERROR-NO-88                                            CL184
02160 ***     LX42-X140-EMP-NO = SPACES AND                                CL184
02161 ***     LX42-X145-EMP-NO = SPACES                                    CL184
02162 *       ADD +1    TO W-X145-PEN-CNT                                  CL184
02163 *       MOVE SPACES TO R140-MESSAGE                                  CL184
02164 *       MOVE W-EMP-NO     TO R140-EMP-NO                             CL184
02165 *       DISPLAY 'NO REPORT FOR PAYMENT  ' W-EMP-NO ' ' W-PAY-QTR     CL184
02166 *             ' ' X145-REMITTANCE                                    CL184
02167 *       STRING                                                       CL184
02168 *        ': NO REPORT FOR PAYMENT                '                   CL184
02169 *           DELIMITED BY SIZE                                        CL184
02170 *           INTO R140-MESSAGE                                        CL184
02171 *       END-STRING                                                   CL184
02172 *       MOVE R140-MESSAGE  TO P434-MESSAGE                           CL184
02173 *       PERFORM P6000-WRITE-PEND-X145  THRU P6000-EXIT               CL184
02174 *       PERFORM S946-WRITE-R140 THRU S946-EXIT                       CL184
02175 *       WRITE PEND-X145-REC FROM X145-REC.                           CL184
02176                                                                      CL*82
02177      DISPLAY 'BX430 P5000-NEW-RPT-PAY ' W-EMP-NO '  ' LX42-EMP-NO.   CL104
02178                                                                   DTSBX430
02179      MOVE LX42-EMP-NO        TO W-EMP-NO.                         DTSBX430
02180      SET W-RPT-ERROR-NO-88   TO TRUE.                                CL*80
02181 *    SET W-PREV-REC-NULL-88  TO TRUE.                                CL107
02182      SET W-PREV-RPT-NULL-88  TO TRUE.                                CL104
02183      SET X145-PAYMENT-DUP-NO-88  TO TRUE                             CL171
02184      MOVE ZERO               TO W-X140-REPORT-QTR                    CL*56
02185                                 W-X145-PAYMENT-QTR                   CL*57
02186                                 W-X144-WAGE-QTR                      CL*56
02187                                 W-TOT-WAGE                        DTSBX430
02188                                 W-EXCESS-WAGE                        CL194
02189                                 W-TAX-WAGE                        DTSBX430
02190                                 LX42-RPT-REMIT-AMT                   CL227
02191                                 LX42-PAY-REMIT-AMT                   CL227
02192                                 W-WRKR-TOT-WAGE                   DTSBX430
02193                                 W-X145-REMITTANCE                    CL*53
02194                                 W-X140-REMITTANCE                    CL*53
02195                                 X434-X144-WAGE                       CL241
02196                                 W-X140-RECEIVED-DATE                 CL*72
02197                                 W-X145-DEPOSIT-DATE                  CL*72
02198                                 W-X145-RECEIVED-DATE                 CL*72
02199                                 W-1ST-MNTH-CNT                    DTSBX430
02200                                 W-2ND-MNTH-CNT                    DTSBX430
02201                                 W-3RD-MNTH-CNT                    DTSBX430
02202                                 W-SSN                             DTSBX430
02203                                 W-EARNINGS                        DTSBX430
02204                                 W-EMP-WAGE-CNT                    DTSBX430
02205                                 W-SEQ-NO                             CL*77
02206                                 W-T025-REMIT-AMT                     CL*76
02207                                 W-X145-TOT-REMIT-AMT                 CL*76
02208                                 W-X140-REMITTANCE                    CL*83
02209                                 LX42-X140-KEY-AREA                   CL*83
02210                                 LX42-X144-KEY-AREA                   CL*83
02211                                 LX42-X145-KEY-AREA.                  CL*83
02212                                                                      CL*76
02213      SET W-WRITE-T025-TRAN-NO-88 TO TRUE.                            CL*76
02214                                                                      CL*76
02215                                                                   DTSBX430
02216      MOVE SPACES             TO W-WRKR-FIRST-NAME                 DTSBX430
02217                                 W-WRKR-LAST-NAME                  DTSBX430
02218                                 W-WRKR-MID-INIT                      CL*56
02219                                 W-X145-PAYMENT-FOUND-IND             CL*79
02220                                 LX42-X140-EMP-NO                     CL*79
02221                                 LX42-X144-EMP-NO                     CL*82
02222                                 LX42-X145-EMP-NO                     CL*82
02223                                 LX42-X140-QTR-AREA                   CL*82
02224                                 LX42-X144-QTR-AREA                   CL*82
02225                                 P434-MESSAGE                         CL138
02226                                 LX42-X145-QTR-AREA.                  CL*82
02227                                                                      CL*53
02228      INITIALIZE              X140-REC                             DTSBX430
02229                              X144-REC                                CL*47
02230                              WS-HOLD-X145-REC                        CL174
02231                              X145-REC.                               CL173
02232                                                                      CL*48
02233 *&                                                                   CL*88
02234         DISPLAY ' 5000-INI-EMP ' W-PREV-REC-TYPE                     CL*90
02235                 '   W-RROR-IND ' W-RPT-ERROR-IND                     CL*88
02236                 'LX-W-RROR-IND ' W-RPT-ERROR-IND.                    CL*90
02237  P5000-EXIT.                                                         CL*25
02238      EXIT.                                                        DTSBX430
02239                                                                   DTSBX430
02240  P6000-WRITE-PEND-X145.                                              CL132
02241 *      IF LX42-REC-TYPE-RPT-88 AND W-X145-PAYMENT-NO-88              CL132
02242 *         WRITE PEND-X140-REC FROM X140-REC                          CL132
02243 *      ELSE                                                          CL132
02244 *      IF LX42-REC-TYPE-RPT-88 AND W-X145-PAYMENT-YES-88             CL132
02245 *         WRITE PEND-X140-REC FROM X140-REC                          CL132
02246 *         WRITE PEND-X145-REC FROM X145-REC                          CL132
02247 *      ELSE                                                          CL132
02248 *       IF LX42-REC-TYPE-WAGE-88                                     CL132
02249 *         WRITE PEND-X144-REC FROM X144-REC                          CL132
02250 *      ELSE                                                          CL132
02251 *       IF LX42-REC-TYPE-PAY-88                                      CL132
02252 *         WRITE PEND-X145-REC FROM X145-REC                          CL132
02253 *       ELSE                                                         CL132
02254 *        DISPLAY ' INVALID RECORD TYPE ' LX42-REC-TYPE               CL132
02255 *        PERFORM S999-ABEND          THRU S999-EXIT.                 CL132
02256                                                                      CL133
02257      MOVE X145-EMP-NO          TO  P434-EMP-NO                       CL133
02258      MOVE X145-QTR             TO  P434-QTR                          CL134
02259 *    IF W-EMP-FOUND-YES-88                                           CL135
02260 *       MOVE MPRF-PRIMARY-NAME (1:15)                                CL135
02261 *                                   TO P434-NAME-CHECK               CL136
02262 *    ELSE                                                            CL135
02263         MOVE 'PAY'                  TO P434-NAME-CHECK               CL135
02264 *    END-IF.                                                         CL135
02265                                                                      CL133
02266      MOVE X145-RCVD-DATE       TO  P434-RCVD-DATE                    CL133
02267      MOVE ZEROS                TO  P434-TOT-WAGE                     CL134
02268      MOVE ZEROS                TO  P434-EXC-WAGE                     CL133
02269 *    MOVE ZEROS                TO  P434-EXC-WAGE                     CL134
02270      MOVE ZEROS                TO  P434-TAX-WAGE                     CL133
02271      MOVE ZEROS                TO  P434-X140-REMIT                   CL133
02272      MOVE W-X145-TOT-REMIT-AMT TO  P434-X145-REMIT                   CL135
02273                                                                      CL133
02274 *    MOVE ZERO                      TO X434-TOTAL-EMPL-CNT.          CL133
02275 *    MOVE X140-WRKR-CNT-1ST-MNTH    TO X434-M1-CNT.                  CL133
02276 *    MOVE X140-WRKR-CNT-2ND-MNTH    TO X434-M2-CNT.                  CL133
02277 *    MOVE X140-WRKR-CNT-3RD-MNTH    TO X434-M3-CNT.                  CL133
02278                                                                      CL133
02279 *    IF W-ERROR-NO-88                                                CL133
02280 *       MOVE 'PROCESSED'       TO  X434-DISPOSITION                  CL133
02281 *    ELSE                                                            CL133
02282 *       MOVE 'PENDING  '       TO  X434-DISPOSITION.                 CL133
02283 *    MOVE R140-MESSAGE         TO  P434-MESSAGE                      CL135
02284                                                                      CL133
02285      PERFORM P4200-PRINT-HEADER THRU P4200-EXIT.                     CL133
02286      WRITE REPT-PEND-REC FROM DETAIL-PEND-1  AFTER 1.                CL133
02287      ADD  1    TO WS-LINE-CNT2.                                      CL133
02288      ADD +1    TO WS-NUMBER-ONE.                                     CL133
02289      GO TO P6000-EXIT.                                               CL133
02290                                                                      CL132
02291  P6000-WRITE-PEND-X140.                                              CL132
02292       IF W-X140-RED-CNT = 0                                          CL231
02293          GO TO P6000-EXIT.                                           CL231
02294         DISPLAY '*****NEW EMP: '                                     CL233
02295                 ' EMP: ' LX42-X140-EMP-NO                            CL232
02296                 ' QTR: ' LX42-X140-QTR-AREA                          CL232
02297        ' WAGE: ' LX42-PAY-REMIT-AMT ' REPT: ' LX42-RPT-REMIT-AMT.    CL232
02298                                                                      CL229
02299      IF LX42-PAY-REMIT-AMT NOT = LX42-RPT-REMIT-AMT                  CL229
02300         MOVE '**X140/X144 TOTAL WAGE MISSING' TO  X434-MESSAGE       CL240
02301         DISPLAY  '***NOT MATCH: '                                    CL233
02302                 ' EMP: ' LX42-X140-EMP-NO                            CL232
02303                 ' QTR: ' LX42-X140-QTR-AREA                          CL232
02304        ' WAGE: ' LX42-PAY-REMIT-AMT ' REPT: ' LX42-RPT-REMIT-AMT     CL232
02305      ELSE                                                            CL229
02306        GO TO P6000-EXIT.                                             CL229
02307                                                                      CL132
02308      MOVE X140-EMP-NO          TO  X434-EMP-NO                       CL237
02309      MOVE X140-QUARTER         TO  X434-QTR                          CL237
02310      IF W-EMP-FOUND-YES-88                                           CL190
02311         MOVE MPRF-PRIMARY-NAME (1:15)                                CL190
02312                                     TO X434-NAME-CHECK               CL237
02313      ELSE                                                            CL190
02314         MOVE 'RPT'                  TO X434-NAME-CHECK               CL237
02315      END-IF.                                                         CL190
02316                                                                      CL132
02317      MOVE X140-RCVD-DATE       TO  X434-RCVD-DATE                    CL237
02318      MOVE LX42-RPT-REMIT-AMT   TO  X434-TOT-WAGE                     CL237
02319 *    MOVE ZEROS                TO  X434-EXC-WAGE                     CL241
02320 *    MOVE T028-EXCESS-WAGE     TO  P434-EXC-WAGE                     CL141
02321 *    MOVE X140-TAX-WAGES       TO  P434-TAX-WAGE                     CL190
02322      MOVE LX42-PAY-REMIT-AMT   TO  X434-X144-WAGE                    CL241
02323 *    MOVE X140-REMITTANCE      TO  P434-X140-REMIT                   CL190
02324 *    MOVE ZEROS                TO  X434-X145-REMIT                   CL239
02325                                                                      CL132
02326 *    MOVE ZERO                      TO X434-TOTAL-EMPL-CNT.          CL132
02327 *    MOVE X140-WRKR-CNT-1ST-MNTH    TO X434-M1-CNT.                  CL132
02328 *    MOVE X140-WRKR-CNT-2ND-MNTH    TO X434-M2-CNT.                  CL132
02329 *    MOVE X140-WRKR-CNT-3RD-MNTH    TO X434-M3-CNT.                  CL132
02330                                                                      CL132
02331 *    IF W-ERROR-NO-88                                                CL222
02332 *       MOVE 'PROCESSED'       TO  X434-DISPOSITION                  CL132
02333 *    ELSE                                                            CL132
02334 *       MOVE 'PENDING  '       TO  X434-DISPOSITION.                 CL132
02335 *    MOVE R140-MESSAGE         TO  P434-MESSAGE                      CL137
02336                                                                      CL132
02337      PERFORM P4200-PRINT-HEADER THRU P4200-EXIT.                     CL133
02338 *    WRITE REPT-PEND-REC FROM DETAIL-PEND-1  AFTER 1.                CL237
02339      WRITE REPT-PAID-REC FROM DETAIL-LINE-1  AFTER 1.                CL237
02340      ADD  1    TO WS-LINE-CNT2.                                      CL132
02341      ADD +1    TO WS-NUMBER-ONE.                                     CL132
02342      GO TO P6000-EXIT.                                               CL144
02343                                                                      CL132
02344  P6000-WRITE-PEND-X144.                                              CL144
02345                                                                      CL144
02346      MOVE X140-EMP-NO          TO  P434-EMP-NO                       CL144
02347      MOVE X140-QUARTER         TO  P434-QTR                          CL144
02348      IF W-EMP-FOUND-YES-88                                           CL189
02349         MOVE MPRF-PRIMARY-NAME (1:15)                                CL189
02350                                     TO P434-NAME-CHECK               CL189
02351      ELSE                                                            CL189
02352         MOVE 'WAGE'                 TO P434-NAME-CHECK               CL144
02353      END-IF.                                                         CL189
02354                                                                      CL144
02355      MOVE SPACES               TO  P434-RCVD-DATE                    CL144
02356      MOVE W-TOT-WAGE           TO  P434-TOT-WAGE                     CL189
02357      MOVE ZEROS                TO  P434-EXC-WAGE                     CL144
02358 *    MOVE T028-EXCESS-WAGE     TO  P434-EXC-WAGE                     CL144
02359      MOVE ZEROS                TO  P434-TAX-WAGE                     CL144
02360      MOVE ZEROS                TO  P434-X140-REMIT                   CL144
02361      MOVE ZEROS                TO  P434-X145-REMIT                   CL144
02362                                                                      CL144
02363 *    MOVE ZERO                      TO X434-TOTAL-EMPL-CNT.          CL144
02364 *    MOVE X140-WRKR-CNT-1ST-MNTH    TO X434-M1-CNT.                  CL144
02365 *    MOVE X140-WRKR-CNT-2ND-MNTH    TO X434-M2-CNT.                  CL144
02366 *    MOVE X140-WRKR-CNT-3RD-MNTH    TO X434-M3-CNT.                  CL144
02367                                                                      CL144
02368 *    IF W-ERROR-NO-88                                                CL144
02369 *       MOVE 'PROCESSED'       TO  X434-DISPOSITION                  CL144
02370 *    ELSE                                                            CL144
02371 *       MOVE 'PENDING  '       TO  X434-DISPOSITION.                 CL144
02372 *    MOVE R140-MESSAGE         TO  P434-MESSAGE                      CL144
02373                                                                      CL144
02374      PERFORM P4200-PRINT-HEADER THRU P4200-EXIT.                     CL144
02375      WRITE REPT-PEND-REC FROM DETAIL-PEND-1  AFTER 1.                CL144
02376      ADD  1    TO WS-LINE-CNT2.                                      CL144
02377      ADD +1    TO WS-NUMBER-ONE.                                     CL144
02378                                                                      CL144
02379                                                                      CL144
02380                                                                      CL*59
02381  P6000-EXIT.                                                         CL*59
02382      EXIT.                                                           CL*59
02383                                                                      CL*59
02384                                                                   DTSBX430
02385  T0000-TERMINATE.                                                 DTSBX430
02386      IF WS-LINE-CNT2 > 52 OR WS-NUMBER-ONE = ZERO                    CL121
02387         PERFORM P4100-PRINT-HEADER THRU P4100-EXIT                   CL121
02388      END-IF.                                                         CL121
02389      MOVE W-X145-RED-CNT TO WS-FOOTING-CNT.                          CL128
02390      MOVE W-X145-ERR-CNT TO WS-X145-ERR-CNT.                         CL121
02391      MOVE W-X145-PEN-CNT TO WS-X145-PEN-CNT.                         CL121
02392      MOVE W-X140-RED-CNT TO WS-X140-RED-CNT.                         CL130
02393      MOVE W-X140-PEN-CNT TO WS-X140-ERR-CNT.                         CL208
02394      MOVE W-X140-PEN-CNT TO WS-X140-PEN-CNT.                         CL130
02395      MOVE W-X144-RED-CNT TO WS-X144-RED-CNT.                         CL153
02396      MOVE W-X144-ERR-CNT TO WS-X144-ERR-CNT.                         CL153
02397      MOVE W-X144-PEN-CNT TO WS-X144-PEN-CNT.                         CL153
02398      MOVE W-TOT-REMIT-AMT TO WS-TOT-REMIT.                           CL121
02399      WRITE REPT-PAID-REC FROM FOOTING-LINE-1 AFTER 1.                CL208
02400      WRITE REPT-PAID-REC FROM FOOTING-LINE-2 AFTER 1.                CL208
02401 *    WRITE REPT-PAID-REC FROM FOOTING-LINE-3 AFTER 1.                CL207
02402 *    WRITE REPT-PAID-REC FROM FOOTING-LINE-4 AFTER 1.                CL207
02403 *    WRITE REPT-PAID-REC FROM FOOTING-LINE-5 AFTER 1.                CL207
02404      WRITE REPT-PAID-REC FROM FOOTING-LINE-6 AFTER 2.                CL208
02405      WRITE REPT-PAID-REC FROM FOOTING-LINE-7  AFTER 1.               CL153
02406      WRITE REPT-PAID-REC FROM FOOTING-LINE-8  AFTER 1.               CL153
02407      WRITE REPT-PAID-REC FROM FOOTING-LINE-9 AFTER 1.                CL153
02408      WRITE REPT-PAID-REC FROM FOOTING-LINE-10 AFTER 1.               CL207
02409      WRITE REPT-PAID-REC FROM FOOTING-LINE-11 AFTER 1.               CL153
02410 *    WRITE REPT-PAID-REC FROM FOOTING-LINE-12 AFTER 1.               CL208
02411      WRITE REPT-PAID-REC FROM FOOTING-LINE-13 AFTER 1.               CL208
02412      WRITE REPT-PAID-REC FROM FOOTING-LINE-14 AFTER 1.               CL153
02413                                                                      CL121
02414      DISPLAY ' '.                                                 DTSBX430
02415                                                                   DTSBX430
02416                                                                   DTSBX430
02417      DISPLAY ' '.                                                 DTSBX430
02418      DISPLAY '***************************************'.              CL*47
02419      DISPLAY '*** DTSBX430 TERMINATION STATISTICS ***'.              CL*47
02420      DISPLAY '*** ESSP- REPORT WAGES AND PAYMENTS ***'.              CL*47
02421      DISPLAY '***************************************'.              CL*47
02422      DISPLAY ' '.                                                 DTSBX430
02423                                                                   DTSBX430
02424      PERFORM T2000-DISPLAY-TOTALS         THRU T2000-EXIT.        DTSBX430
02425                                                                   DTSBX430
02426      DISPLAY '***************************************'.           DTSBX430
02427                                                                   DTSBX430
02428      CLOSE                    WAGE-FILE-OUT                          CL*20
02429                               PEND-X140-FILE                         CL*59
02430                               PEND-X144-FILE                         CL*59
02431                               X430-PAID-FILE                         CL201
02432                               X430-PEND-FILE                         CL201
02433                               PEND-X145-FILE                         CL120
02434                               TEMP-BTC-FILE                          CL*59
02435                               BATCH-XREF-FILE.                       CL*26
02436  T0000-EXIT.                                                      DTSBX430
02437      EXIT.                                                        DTSBX430
02438                                                                   DTSBX430
02439                                                                   DTSBX430
02440  T2000-DISPLAY-TOTALS.                                            DTSBX430
02441      DISPLAY '*****  QUARTERLY REPORTS *************    '.           CL*92
02442      DISPLAY 'TOTAL X140-REPORT RECORDS READ..........: '            CL*96
02443              W-X140-RED-CNT.                                         CL*57
02444                                                                      CL*99
02445      DISPLAY ' NO OF X140-REPORTS PASSED ALL EDITS....: '            CL*99
02446              W-X140-SAV-CNT.                                         CL*99
02447                                                                   DTSBX430
02448      DISPLAY ' NO OF X140-REPORTS T028 TRANS WRITTEN..: '            CL*96
02449              W-T028-WRITE-CNT.                                    DTSBX430
02450                                                                      CL*99
02451      DISPLAY '  ##T028 TRANS WRITTEN - REMIT AMT ZERO.: '            CL100
02452              W-T028-WRITEO-CNT.                                      CL100
02453                                                                      CL*99
02454      DISPLAY '   #T028 TRANS WRITTEN - REMIT AMT EQUAL: '            CL102
02455              W-T028-WRITEE-CNT.                                      CL102
02456      DISPLAY ' NO OF X140-REPORTS WRITTEN TO PENDING..: '            CL*96
02457              W-X140-PEN-CNT.                                         CL*92
02458      DISPLAY ' NO OF X140-REPORTS HAS ERRORS..........: '            CL*96
02459              W-X140-ERR-CNT.                                         CL*92
02460      DISPLAY ' NO OF X140-REPORTS HAS DUPLICATE.......: '            CL*96
02461              W-X140-DUP-CNT.                                         CL*92
02462                                                                      CL*92
02463      DISPLAY ' '.                                                    CL*92
02464      DISPLAY '*****  QUARTERLY PAYMENTS    *********    '.           CL*96
02465      DISPLAY 'TOTAL X145-PAYMENTS  RECORDS READ.......: '            CL*96
02466              W-X145-RED-CNT.                                         CL*92
02467                                                                      CL*92
02468      DISPLAY ' NO OF X145-PAYMENTS PASSED ALL EDITS...: '            CL*98
02469              W-X145-SAV-CNT.                                         CL*92
02470                                                                      CL*92
02471      DISPLAY ' NO OF X145-PAYMENTS T025 TRANS WRITTEN.: '            CL*96
02472              W-T025-WRITE-CNT.                                       CL*94
02473                                                                      CL*94
02474      DISPLAY '    ## T025 TRANS WRITTEN-ZERO REMIT....: '            CL100
02475              W-T025-WRITEO-CNT.                                      CL100
02476                                                                      CL100
02477      DISPLAY ' NO OF X145-PAYMENTS WRITTEN TO PENDING.: '            CL*96
02478              W-X145-PEN-CNT.                                         CL*92
02479      DISPLAY ' NO OF X145-PAYMENTS HAS ERRORS.........: '            CL*96
02480              W-X145-ERR-CNT.                                         CL*92
02481      DISPLAY ' NO OF X145-PAYMENTS HAS DUPLICATE......: '            CL*96
02482              W-X145-DUP-CNT.                                         CL*92
02483                                                                      CL*92
02484      DISPLAY ' '.                                                    CL*92
02485      DISPLAY '*****  QUARTERLY WAGES   *************    '.           CL*92
02486      DISPLAY 'TOTAL X144-WAGES  RECORDS READ..........: '            CL*96
02487              W-X144-RED-CNT.                                         CL*92
02488                                                                      CL*99
02489      DISPLAY ' NO OF X144-WAGES PASSED ALL EDITS......: '            CL*99
02490              W-X144-SAV-CNT.                                         CL*99
02491                                                                      CL*99
02492      DISPLAY ' NO OF X144-WAGES W004 TRANS WRITTEN....: '            CL*96
02493              W-W4-CNT.                                               CL*96
02494                                                                      CL*92
02495      DISPLAY ' NO OF X144-WAGES WRITTEN TO PENDING....: '            CL*96
02496              W-X144-PEN-CNT.                                         CL*92
02497      DISPLAY ' NO OF X144-WAGES HAS ERRORS............: '            CL*96
02498              W-X144-ERR-CNT.                                         CL*92
02499      DISPLAY ' NO OF X144-WAGES HAS DUPLICATE.........: '            CL*96
02500              W-X144-DUP-CNT.                                         CL*92
02501                                                                      CL*92
02502                                                                      CL*10
02503      DISPLAY '  '.                                                DTSBX430
02504      DISPLAY '***** END REPORTS/WAGES AND PAYMENTS **** '.           CL*96
02505                                                                   DTSBX430
02506  T2000-EXIT.                                                      DTSBX430
02507      EXIT.                                                        DTSBX430
02508                                                                   DTSBX430
02509  S001-FROM-FED-8.                                                 DTSBX430
02510      SET L001-FROM-FED-8 TO TRUE.                                 DTSBX430
02511      GO TO S001-DATE.                                             DTSBX430
02512                                                                   DTSBX430
02513  S001-FROM-CAL-8.                                                 DTSBX430
02514      SET L001-FROM-CAL-8 TO TRUE.                                 DTSBX430
02515      GO TO S001-DATE.                                             DTSBX430
02516                                                                   DTSBX430
02517  S001-FROM-ABS-DAY.                                               DTSBX430
02518      SET L001-FROM-ABS-DAY TO TRUE.                               DTSBX430
02519      GO TO S001-DATE.                                             DTSBX430
02520                                                                   DTSBX430
02521  S001-DATE.                                                       DTSBX430
02522      CALL 'DTSBU001' USING L001-LINK-AREA.                        DTSBX430
02523  S001-EXIT.                                                       DTSBX430
02524      EXIT.                                                        DTSBX430
02525                                                                   DTSBX430
02526  S003-AGENCY-DAY.                                                 DTSBX430
02527      SET L003-AGENCY-DAY TO TRUE.                                 DTSBX430
02528      GO TO S003-WORK-DAY.                                         DTSBX430
02529                                                                   DTSBX430
02530  S003-WORK-DAY.                                                   DTSBX430
02531      CALL 'DTSBU003' USING L003-LINK-AREA.                        DTSBX430
02532  S003-EXIT.                                                       DTSBX430
02533      EXIT.                                                        DTSBX430
02534                                                                   DTSBX430
02535  S004-FROM-5.                                                     DTSBX430
02536      SET L004-FROM-5        TO TRUE.                              DTSBX430
02537      GO TO S004-YRQ.                                              DTSBX430
02538                                                                   DTSBX430
02539  S004-FROM-DATE.                                                  DTSBX430
02540      SET L004-FROM-DATE     TO TRUE.                              DTSBX430
02541      GO TO S004-YRQ.                                              DTSBX430
02542                                                                   DTSBX430
02543  S004-FROM-ABS.                                                   DTSBX430
02544      SET L004-FROM-ABS      TO TRUE.                              DTSBX430
02545      GO TO S004-YRQ.                                              DTSBX430
02546                                                                   DTSBX430
02547  S004-YRQ.                                                        DTSBX430
02548      CALL 'DTSBU004' USING L004-LINK-AREA.                        DTSBX430
02549                                                                      CL251
02550  S004-EXIT.                                                       DTSBX430
02551      EXIT.                                                        DTSBX430
02552                                                                   DTSBX430
02553  S516-LIABILITY-INFO.                                             DTSBX430
02554      CALL 'DTSBU516' USING L516-LINK-AREA                         DTSBX430
02555                            MPRF-REC.                              DTSBX430
02556  S516-EXIT.                                                       DTSBX430
02557      EXIT.                                                        DTSBX430
02558                                                                   DTSBX430
02559  S910-OPEN-READ.                                                  DTSBX430
02560      SET L910-OPEN-READ-88 TO TRUE.                               DTSBX430
02561      GO TO S910-MSTR-IO.                                          DTSBX430
02562                                                                   DTSBX430
02563  S910-READ.                                                       DTSBX430
02564      SET L910-READ-88 TO TRUE.                                    DTSBX430
02565      GO TO S910-MSTR-IO.                                          DTSBX430
02566                                                                   DTSBX430
02567  S910-START-BROWSE.                                               DTSBX430
02568      SET L910-START-BROWSE-88 TO TRUE.                            DTSBX430
02569      GO TO S910-MSTR-IO.                                          DTSBX430
02570                                                                   DTSBX430
02571  S910-READ-NEXT.                                                  DTSBX430
02572      SET L910-READ-NEXT-88 TO TRUE.                               DTSBX430
02573      GO TO S910-MSTR-IO.                                          DTSBX430
02574                                                                   DTSBX430
02575  S910-CLOSE.                                                      DTSBX430
02576      SET L910-CLOSE-88     TO TRUE.                               DTSBX430
02577      GO TO S910-MSTR-IO.                                          DTSBX430
02578                                                                   DTSBX430
02579  S910-MSTR-IO.                                                    DTSBX430
02580      CALL 'DTSBU910' USING L910-LINK-AREA                         DTSBX430
02581                            MSKL-REC.                              DTSBX430
02582  S910-EXIT.                                                       DTSBX430
02583      EXIT.                                                        DTSBX430
02584                                                                   DTSBX430
02585  S921-OPEN-READ.                                                  DTSBX430
02586      SET L921-OPEN-READ-88 TO TRUE.                               DTSBX430
02587      GO TO S921-AIX-IO.                                           DTSBX430
02588                                                                   DTSBX430
02589  S921-READ.                                                       DTSBX430
02590      SET L921-READ-88 TO TRUE.                                    DTSBX430
02591      GO TO S921-AIX-IO.                                           DTSBX430
02592                                                                   DTSBX430
02593  S921-START-BROWSE.                                               DTSBX430
02594      SET L921-START-BROWSE-88 TO TRUE.                            DTSBX430
02595      GO TO S921-AIX-IO.                                           DTSBX430
02596                                                                   DTSBX430
02597  S921-READ-NEXT.                                                  DTSBX430
02598      SET L921-READ-NEXT-88 TO TRUE.                               DTSBX430
02599      GO TO S921-AIX-IO.                                           DTSBX430
02600                                                                   DTSBX430
02601  S921-CLOSE.                                                      DTSBX430
02602      SET L921-CLOSE-88 TO TRUE.                                   DTSBX430
02603      GO TO S921-AIX-IO.                                           DTSBX430
02604                                                                   DTSBX430
02605  S921-AIX-IO.                                                     DTSBX430
02606      CALL 'DTSBU921' USING L921-LINK-AREA                         DTSBX430
02607                            ISKL-REC.                              DTSBX430
02608  S921-EXIT.                                                       DTSBX430
02609      EXIT.                                                        DTSBX430
02610                                                                   DTSBX430
02611  S923-OPEN-UPDATE.                                                DTSBX430
02612      SET L923-OPEN-UPDATE-88 TO TRUE.                             DTSBX430
02613      GO TO S923-ATC-CALL.                                         DTSBX430
02614                                                                   DTSBX430
02615  S923-WRITE.                                                      DTSBX430
02616      SET L923-WRITE-88 TO TRUE.                                   DTSBX430
02617      GO TO S923-ATC-CALL.                                         DTSBX430
02618                                                                   DTSBX430
02619  S923-CLOSE.                                                      DTSBX430
02620      SET L923-CLOSE-88 TO TRUE.                                   DTSBX430
02621      GO TO S923-ATC-CALL.                                         DTSBX430
02622                                                                   DTSBX430
02623  S923-ATC-CALL.                                                   DTSBX430
02624      CALL 'DTSBU923' USING L923-LINK-AREA                         DTSBX430
02625                            ASKL-REC.                              DTSBX430
02626  S923-EXIT.                                                       DTSBX430
02627      EXIT.                                                        DTSBX430
02628                                                                   DTSBX430
02629 *S927A-OPEN.                                                      DTSBX430
02630 *    SET L927-OPEN-UPDATE-88  TO TRUE.                            DTSBX430
02631 *    PERFORM S927Z-IO   THRU S927Z-EXIT.                          DTSBX430
02632 *                                                                 DTSBX430
02633 *S927A-EXIT.                                                      DTSBX430
02634 *    EXIT.                                                        DTSBX430
02635                                                                   DTSBX430
02636  S927B-WRITE.                                                     DTSBX430
02637      SET L927-WRITE-88 TO TRUE.                                   DTSBX430
02638      PERFORM S927Z-IO   THRU S927Z-EXIT.                          DTSBX430
02639                                                                   DTSBX430
02640  S927B-EXIT.                                                      DTSBX430
02641      EXIT.                                                        DTSBX430
02642                                                                   DTSBX430
02643 *S927C-CLOSE.                                                     DTSBX430
02644 *    SET L927-CLOSE-88        TO TRUE.                            DTSBX430
02645 *    PERFORM S927Z-IO   THRU S927Z-EXIT.                          DTSBX430
02646 *                                                                 DTSBX430
02647 *S927C-EXIT.                                                      DTSBX430
02648 *    EXIT.                                                        DTSBX430
02649                                                                   DTSBX430
02650  S927Z-IO.                                                        DTSBX430
02651      CALL 'DTSBU927' USING L927-LINK-AREA                         DTSBX430
02652                            TSKL-REC.                              DTSBX430
02653  S927Z-EXIT.                                                      DTSBX430
02654      EXIT.                                                        DTSBX430
02655                                                                   DTSBX430
02656  S931-OPEN-READ.                                                  DTSBX430
02657      SET L931-OPEN-READ-88 TO TRUE.                               DTSBX430
02658      GO TO S931-REF-IO.                                           DTSBX430
02659                                                                   DTSBX430
02660  S931-CLOSE.                                                      DTSBX430
02661      SET L931-CLOSE-88 TO TRUE.                                   DTSBX430
02662      GO TO S931-REF-IO.                                           DTSBX430
02663                                                                   DTSBX430
02664  S931-REF-IO.                                                     DTSBX430
02665      CALL 'DTSBU931' USING L931-LINK-AREA                         DTSBX430
02666                            FSKL-REC.                              DTSBX430
02667  S931-EXIT.                                                       DTSBX430
02668      EXIT.                                                        DTSBX430
02669                                                                   DTSBX430
02670  S1032-WRITE-TEMP-T028.                                           DTSBX430
02671      MOVE T028-LENGTH     TO VAR-CHAR-CNT.                        DTSBX430
02672      MOVE T028-REC        TO TEMP-BTC-REC.                        DTSBX430
02673      WRITE TEMP-BTC-REC.                                          DTSBX430
02674      IF TEMP-BTC-STATUS-OK-88                                     DTSBX430
02675         NEXT SENTENCE                                             DTSBX430
02676      ELSE                                                         DTSBX430
02677         SET W-RPT-ERROR-YES-88 TO TRUE                               CL*81
02678         DISPLAY 'CANNOT WRITE TEMP T028: '                        DTSBX430
02679            TEMP-BTC-STATUS                                        DTSBX430
02680      END-IF.                                                      DTSBX430
02681                                                                   DTSBX430
02682  S1032-EXIT.                                                         CL**9
02683      EXIT.                                                        DTSBX430
02684                                                                   DTSBX430
02685  S1033-WRITE-TEMP-T025.                                           DTSBX430
02686      MOVE T025-LENGTH     TO VAR-CHAR-CNT.                        DTSBX430
02687      MOVE T025-REC        TO TEMP-BTC-REC.                        DTSBX430
02688      WRITE TEMP-BTC-REC.                                          DTSBX430
02689      IF TEMP-BTC-STATUS-OK-88                                     DTSBX430
02690         NEXT SENTENCE                                             DTSBX430
02691      ELSE                                                         DTSBX430
02692         SET W-RPT-ERROR-YES-88 TO TRUE                               CL*81
02693         DISPLAY 'CANNOT WRITE TEMP T025: '                        DTSBX430
02694            TEMP-BTC-STATUS                                        DTSBX430
02695      END-IF.                                                      DTSBX430
02696                                                                   DTSBX430
02697  S1033-EXIT.                                                      DTSBX430
02698      EXIT.                                                        DTSBX430
02699                                                                   DTSBX430
02700  S1040-OPEN-TEMP-BTC-OUT.                                         DTSBX430
02701      OPEN OUTPUT   TEMP-BTC-FILE.                                 DTSBX430
02702      IF TEMP-BTC-STATUS-OK-88                                     DTSBX430
02703         NEXT SENTENCE                                             DTSBX430
02704 ***     SET WAGE-TEMP-OPEN-88  TO TRUE                            DTSBX430
02705 ***     DISPLAY 'TEMP BTC OPENED OUTPUT '                         DTSBX430
02706      ELSE                                                         DTSBX430
02707         SET W-FATAL-ERROR-YES-88 TO TRUE                          DTSBX430
02708         DISPLAY 'CANNOT OPEN X430 BTC FILE OUTPUT: '                 CL225
02709            TEMP-BTC-STATUS                                        DTSBX430
02710      END-IF.                                                      DTSBX430
02711                                                                   DTSBX430
02712  S1040-EXIT.                                                      DTSBX430
02713      EXIT.                                                        DTSBX430
02714                                                                   DTSBX430
02715  S1050-OPEN-TEMP-BTC-IN.                                          DTSBX430
02716      OPEN INPUT    TEMP-BTC-FILE.                                 DTSBX430
02717      IF TEMP-BTC-STATUS-OK-88                                     DTSBX430
02718         NEXT SENTENCE                                             DTSBX430
02719 ***     SET WAGE-TEMP-OPEN-88  TO TRUE                            DTSBX430
02720 ***     DISPLAY 'TEMP BTC OPENED INP '                            DTSBX430
02721      ELSE                                                         DTSBX430
02722         SET W-FATAL-ERROR-YES-88 TO TRUE                          DTSBX430
02723         DISPLAY 'CANNOT OPEN TEMP BTC FILE INPUT: '               DTSBX430
02724            TEMP-BTC-STATUS                                        DTSBX430
02725      END-IF.                                                      DTSBX430
02726                                                                   DTSBX430
02727  S1050-EXIT.                                                      DTSBX430
02728      EXIT.                                                        DTSBX430
02729                                                                   DTSBX430
02730  S1060-CLOSE-TEMP-BTC.                                            DTSBX430
02731      CLOSE    TEMP-BTC-FILE.                                      DTSBX430
02732      IF TEMP-BTC-STATUS-OK-88                                     DTSBX430
02733 ***     DISPLAY 'TEMP-BTC CLOSED'                                 DTSBX430
02734         NEXT SENTENCE                                             DTSBX430
02735      ELSE                                                         DTSBX430
02736         SET W-FATAL-ERROR-YES-88 TO TRUE                          DTSBX430
02737         DISPLAY 'CANNOT CLOSE TEMP BTC FILE: '                    DTSBX430
02738            TEMP-BTC-STATUS                                        DTSBX430
02739      END-IF.                                                      DTSBX430
02740                                                                   DTSBX430
02741  S1060-EXIT.                                                      DTSBX430
02742      EXIT.                                                        DTSBX430
02743                                                                   DTSBX430
02744  S1070-READ-TEMP-BTC.                                             DTSBX430
02745      READ TEMP-BTC-FILE.                                          DTSBX430
02746      IF TEMP-BTC-STATUS-OK-88                                     DTSBX430
02747         COMPUTE VAR-CHAR-CNT = (RVAR-LENGTH - 2)                  DTSBX430
02748      ELSE                                                         DTSBX430
02749         IF TEMP-BTC-STATUS-EOF-88                                 DTSBX430
02750            NEXT SENTENCE                                          DTSBX430
02751         ELSE                                                      DTSBX430
02752            DISPLAY 'CANNOT READ TEMP-BTC FILE '                   DTSBX430
02753               TEMP-BTC-STATUS                                     DTSBX430
02754            SET W-FATAL-ERROR-YES-88 TO TRUE                       DTSBX430
02755         END-IF                                                    DTSBX430
02756      END-IF.                                                      DTSBX430
02757                                                                   DTSBX430
02758  S1070-EXIT.                                                      DTSBX430
02759      EXIT.                                                        DTSBX430
02760                                                                   DTSBX430
02761  S1100-OPEN-WAGE-TEMP-OUT.                                        DTSBX430
02762      OPEN OUTPUT   WAGE-FILE-TEMP.                                DTSBX430
02763      IF NOT WAGE-TEMP-STATUS-OK-88                                DTSBX430
02764         SET W-FATAL-ERROR-YES-88 TO TRUE                          DTSBX430
02765         DISPLAY 'CANNOT OPEN WAGE TEMP FILE OUTPUT: '             DTSBX430
02766            WAGE-TEMP-STATUS                                       DTSBX430
02767      END-IF.                                                      DTSBX430
02768                                                                   DTSBX430
02769  S1100-EXIT.                                                      DTSBX430
02770      EXIT.                                                        DTSBX430
02771                                                                   DTSBX430
02772  S1110-CLOSE-WAGE-TEMP.                                           DTSBX430
02773      CLOSE   WAGE-FILE-TEMP.                                      DTSBX430
02774      IF NOT WAGE-TEMP-STATUS-OK-88                                DTSBX430
02775         SET W-FATAL-ERROR-YES-88 TO TRUE                          DTSBX430
02776         DISPLAY 'CANNOT CLOSE WAGE TEMP FILE: '                   DTSBX430
02777            WAGE-TEMP-STATUS                                       DTSBX430
02778      END-IF.                                                      DTSBX430
02779                                                                   DTSBX430
02780  S1110-EXIT.                                                      DTSBX430
02781      EXIT.                                                        DTSBX430
02782                                                                   DTSBX430
02783  S1120-WRITE-WAGE-TEMP.                                           DTSBX430
02784      WRITE WAGE-TEMP-REC FROM W001-REC.                           DTSBX430
02785      IF NOT WAGE-TEMP-STATUS-OK-88                                DTSBX430
02786         SET W-FATAL-ERROR-YES-88 TO TRUE                          DTSBX430
02787         DISPLAY 'CANNOT WRITE WAGE TEMP FILE: '                   DTSBX430
02788            WAGE-TEMP-STATUS                                       DTSBX430
02789      END-IF.                                                      DTSBX430
02790                                                                   DTSBX430
02791  S1120-EXIT.                                                      DTSBX430
02792      EXIT.                                                        DTSBX430
02793                                                                   DTSBX430
02794  S1130-OPEN-WAGE-TEMP-IN.                                         DTSBX430
02795      OPEN INPUT    WAGE-FILE-TEMP.                                DTSBX430
02796      IF NOT WAGE-TEMP-STATUS-OK-88                                DTSBX430
02797         SET W-FATAL-ERROR-YES-88 TO TRUE                          DTSBX430
02798         DISPLAY 'CANNOT OPEN WAGE TEMP FILE INPUT: '              DTSBX430
02799            WAGE-TEMP-STATUS                                       DTSBX430
02800      END-IF.                                                      DTSBX430
02801                                                                   DTSBX430
02802  S1130-EXIT.                                                      DTSBX430
02803      EXIT.                                                        DTSBX430
02804                                                                   DTSBX430
02805  S1140-READ-WAGE-TEMP.                                            DTSBX430
02806      READ WAGE-FILE-TEMP INTO W001-REC.                           DTSBX430
02807      IF WAGE-TEMP-STATUS-EOF-88                                   DTSBX430
02808         NEXT SENTENCE                                             DTSBX430
02809      ELSE                                                         DTSBX430
02810         IF NOT WAGE-TEMP-STATUS-OK-88                             DTSBX430
02811            SET W-FATAL-ERROR-YES-88 TO TRUE                       DTSBX430
02812            DISPLAY 'READ ERROR ON WAGE TEMP FILE: '               DTSBX430
02813               WAGE-TEMP-STATUS                                    DTSBX430
02814         END-IF                                                    DTSBX430
02815      END-IF.                                                      DTSBX430
02816                                                                   DTSBX430
02817  S1140-EXIT.                                                      DTSBX430
02818      EXIT.                                                        DTSBX430
02819                                                                   DTSBX430
02820  S1150-OPEN-WAGE-FILE-OUT.                                           CL*20
02821      OPEN OUTPUT   WAGE-FILE-OUT.                                    CL*20
02822      IF NOT WAGE-OUT-STATUS-OK-88                                    CL*20
02823         SET W-FATAL-ERROR-YES-88 TO TRUE                             CL*20
02824         DISPLAY 'CANNOT OPEN WAGE FILE OUTPUT: '                     CL*20
02825            WAGE-OUT-STATUS                                           CL*20
02826      END-IF.                                                         CL*20
02827                                                                   DTSBX430
02828  S1150-EXIT.                                                         CL*20
02829      EXIT.                                                           CL*20
02830                                                                   DTSBX430
02831  S1160-CLOSE-WAGE-OUT.                                               CL*20
02832      CLOSE   WAGE-FILE-OUT.                                          CL*20
02833      IF NOT WAGE-OUT-STATUS-OK-88                                    CL*20
02834         SET W-FATAL-ERROR-YES-88 TO TRUE                             CL*20
02835         DISPLAY 'CANNOT CLOSE WAGE FILE: '                           CL*20
02836            WAGE-OUT-STATUS                                           CL*20
02837      END-IF.                                                         CL*20
02838                                                                   DTSBX430
02839  S1160-EXIT.                                                         CL*20
02840      EXIT.                                                           CL*20
02841                                                                   DTSBX430
02842  S1170-WRITE-WAGE-OUT.                                               CL*20
02843      MOVE ESP-TRANSACTION-AREA       TO WAGE-OUT-REC.                CL*20
02844      WRITE WAGE-OUT-REC.                                             CL*20
02845      IF NOT WAGE-OUT-STATUS-OK-88                                    CL*20
02846         SET W-FATAL-ERROR-YES-88 TO TRUE                             CL*20
02847         DISPLAY 'CANNOT WRITE WAGE OUT FILE: '                       CL*20
02848            WAGE-OUT-STATUS                                           CL*20
02849      END-IF.                                                         CL*20
02850                                                                   DTSBX430
02851  S1170-EXIT.                                                         CL*20
02852      EXIT.                                                           CL*20
02853                                                                   DTSBX430
02854  S946-WRITE-R140.                                                 DTSBX430
02855      CALL 'DTSBU946' USING R140-REC.                              DTSBX430
02856                                                                   DTSBX430
02857  S946-EXIT.                                                       DTSBX430
02858      EXIT.                                                        DTSBX430
02859                                                                   DTSBX430
02860  S999-ABEND.                                                      DTSBX430
02861      CALL 'DTSBU999' USING W-ABEND-CD.                            DTSBX430
02862  S999-EXIT.                                                       DTSBX430
02863      EXIT.                                                        DTSBX430
02864                                                                   DTSBX430
