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