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