00001  IDENTIFICATION DIVISION.                                         02/12/25
00002  PROGRAM-ID.             DTSBX421.                                DTSBX421
00003  AUTHOR.                 NGC.                                        LV165
00004  DATE-WRITTEN.           APRIL 2005.                              DTSBX421
00005  DATE-COMPILED.                                                   DTSBX421
00006      SKIP3                                                        DTSBX421
00007 ****                                                                 CL*78
00008 *                                                                 DTSBX421
00009 *    NOTE:      P1510-EDIT-ADDRESS IS COMMENTED OUT.              DTSBX421
00010 *                                                                 DTSBX421
00011 *    FUNCTION:  PROCESS EMPLOYER REGISTRATION DATA FROM           DTSBX421
00012 *               WEB APPLICATION.                                  DTSBX421
00013 *               FORMAT T002 TRANSACTIONS FOR INPUT TO DAILY       DTSBX421
00014 *               BATCH UPDATE PROCESS.                             DTSBX421
00015 *               IF ANY EDIT ERROR OCCURED, IT WILL WRITE THAT TO  DTSBX421
00016 *               DTSIR140 RECORD. DTSBR140 READS DTSIR140 RECORDS  DTSBX421
00017 *               TO PRODUCE THE ERRORS FORMAT REPORT.              DTSBX421
00018 *                                                                 DTSBX421
00019 *    MODIFICATION HISTORY:                                        DTSBX421
00020 *                                                                 DTSBX421
00021 *    04-05-2005 INITIAL DEVELOPMENT                               DTSBX421
00022 *               REFERENCE RFP: WEB REGISTRATION                   DTSBX421
00023 *                                                                 DTSBX421
00024 *                                                                    CL142
00025 *    09-15-2018 MODIFY CODE TO VALIDATE FEIN BASED ON IRS RULES.     CL142
00026 *               REFERENCE RFP: WEB REGISTRATION              ZL1     CL142
00027 *                                                                    CL142
00028 *                                                                    CL152
00029 *    11-29-2020 MODIFY CODE TO ADD RATE RECORD FOR 2021              CL152
00030 *               REFERENCE RFP: WEB REGISTRATION              ZL1     CL152
00031 *                                                                    CL152
00032 *                                                                 DTSBX421
00033 *****                                                             DTSBX421
00034      SKIP3                                                        DTSBX421
00035  ENVIRONMENT DIVISION.                                            DTSBX421
00036  CONFIGURATION SECTION.                                              CL*99
00037  SPECIAL-NAMES. C01 IS TOP-OF-PAGE.                                  CL*99
00038      SKIP2                                                        DTSBX421
00039  INPUT-OUTPUT SECTION.                                            DTSBX421
00040                                                                   DTSBX421
00041  FILE-CONTROL.                                                    DTSBX421
00042                                                                   DTSBX421
00043      SELECT TEMP-BTC-FILE    ASSIGN TO X421BTC                    DTSBX421
00044         FILE STATUS IS TEMP-BTC-STATUS.                           DTSBX421
00045                                                                      CL*87
00046      SELECT REPT-PAID-FILE    ASSIGN TO X421RPT1                     CL*87
00047         FILE STATUS IS REPT-STATUS.                                  CL*87
00048                                                                      CL*87
00049      SELECT REPT-PEND-FILE    ASSIGN TO X421RPT2                     CL*87
00050         FILE STATUS IS REPT-STATUS.                                  CL*87
00051                                                                      CL*87
00052                                                                   DTSBX421
00053  DATA DIVISION.                                                   DTSBX421
00054                                                                   DTSBX421
00055  FILE SECTION.                                                    DTSBX421
00056                                                                   DTSBX421
00057  FD  TEMP-BTC-FILE                                                DTSBX421
00058      RECORDING MODE IS V                                          DTSBX421
00059      BLOCK CONTAINS 0 RECORDS.                                    DTSBX421
00060                                                                   DTSBX421
00061  01  TEMP-BTC-REC.                                                DTSBX421
00062  ++INCLUDE DTSIRVAR                                               DTSBX421
00063                                                                   DTSBX421
00064  01  TSKL-REC.                                                    DTSBX421
00065  ++INCLUDE DTSITSKL                                               DTSBX421
00066  FD  REPT-PAID-FILE                                                  CL*87
00067      RECORDING MODE IS F                                             CL*87
00068      BLOCK CONTAINS 0 RECORDS                                        CL*87
00069      LABEL RECORDS ARE OMITTED.                                      CL*87
00070                                                                      CL*87
00071  01  REPT-PAID-REC           PIC X(133).                             CL*87
00072                                                                      CL*87
00073                                                                      CL*87
00074  FD  REPT-PEND-FILE                                                  CL*87
00075      RECORDING MODE IS F                                             CL*87
00076      BLOCK CONTAINS 0 RECORDS                                        CL*87
00077      LABEL RECORDS ARE OMITTED.                                      CL*87
00078                                                                      CL*87
00079  01  REPT-PEND-REC           PIC X(133).                             CL*87
00080                                                                      CL*87
00081                                                                      CL*87
00082                                                                   DTSBX421
00083  WORKING-STORAGE SECTION.                                         DTSBX421
000835 77  PAN-VALET PICTURE X(24) VALUE '165DTSBX421  02/12/25'.       DTSBX421
00084  77  PAN-VALET PICTURE X(24) VALUE '011DTSBX421  10/07/14'.       DTSBX421
00085  77  PAN-VALET PICTURE X(24) VALUE '032DTSBX421  10/07/14'.       DTSBX421
00086      SKIP3                                                        DTSBX421
00087  01  WRK-AREA.                                                    DTSBX421
00088      05  W-ABEND-CD                  PIC S9(04)  COMP  VALUE 421. DTSBX421
00089      05  W-MOD-NAME                  PIC  X(08)  VALUE 'DTSBX421'.DTSBX421
00090                                                                   DTSBX421
00091      05  W-PREV-REC-TYPE         PIC  X(03) VALUE SPACES.         DTSBX421
00092          88 W-PREV-REC-NULL-88    VALUE 'XXX'.                    DTSBX421
00093          88 W-PREV-REC-PRF-88     VALUE '102'.                    DTSBX421
00094          88 W-PREV-REC-DETERM-88  VALUE '104'.                    DTSBX421
00095          88 W-PREV-REC-NAME-88    VALUE '106'.                    DTSBX421
00096          88 W-PREV-REC-RATE-88    VALUE '108'.                    DTSBX421
00097          88 W-PREV-REC-ADDR-88    VALUE '110'.                    DTSBX421
00098          88 W-PREV-REC-OPO-88     VALUE '120'.                    DTSBX421
00099          88 W-PREV-REC-REL-88     VALUE '130'.                    DTSBX421
00100          88 W-PREV-REC-IND-88     VALUE '132'.                    DTSBX421
00101          88 W-PREV-REC-RPT-88     VALUE '140'.                    DTSBX421
00102          88 W-PREV-REC-WAGE-88    VALUE '144'.                    DTSBX421
00103                                                                   DTSBX421
00104                                                                      CL*91
00105      05  REPT-STATUS                 PIC  X(02).                     CL*91
00106          88 REPT-STATUS-EOF-88         VALUE '10'.                   CL*91
00107          88 REPT-STATUS-OK-88          VALUE '00'.                   CL*91
00108                                                                      CL*91
00109      05  BATCH-STATUS            PIC  X(02).                      DTSBX421
00110          88 BATCH-STATUS-OK-88       VALUE '00'.                  DTSBX421
00111          88 BATCH-STATUS-EOF-88      VALUE '10'.                  DTSBX421
00112                                                                   DTSBX421
00113      05  TEMP-BTC-STATUS         PIC  X(02).                      DTSBX421
00114          88 TEMP-BTC-STATUS-OK-88     VALUE '00'.                 DTSBX421
00115          88 TEMP-BTC-STATUS-EOF-88    VALUE '10'.                 DTSBX421
00116                                                                   DTSBX421
00117      05  WAGE-TEMP-STATUS        PIC  X(02).                      DTSBX421
00118          88 WAGE-TEMP-STATUS-OK-88    VALUE '00'.                 DTSBX421
00119          88 WAGE-TEMP-STATUS-EOF-88   VALUE '10'.                 DTSBX421
00120                                                                   DTSBX421
00121      05  WAGE-OUT-STATUS         PIC  X(02).                      DTSBX421
00122          88 WAGE-OUT-STATUS-OK-88     VALUE '00'.                 DTSBX421
00123                                                                   DTSBX421
00124      05  VAR-CHAR-CNT             PIC S9(04) COMP.                DTSBX421
00125                                                                   DTSBX421
00126      05  W-ERROR-IND                 PIC  X(01) VALUE 'N'.        DTSBX421
00127          88 W-ERROR-YES-88            VALUE 'Y'.                  DTSBX421
00128          88 W-ERROR-NO-88             VALUE 'N'.                  DTSBX421
00129                                                                   DTSBX421
00130      05  W-FATAL-ERROR-IND           PIC  X(01) VALUE 'N'.        DTSBX421
00131          88 W-FATAL-ERROR-YES-88      VALUE 'Y'.                  DTSBX421
00132          88 W-FATAL-ERROR-NO-88       VALUE 'N'.                  DTSBX421
00133                                                                   DTSBX421
00134      05  W-RATE-ERROR-IND            PIC  X(01) VALUE 'N'.        DTSBX421
00135          88 W-RATE-ERROR-YES-88       VALUE 'Y'.                  DTSBX421
00136          88 W-RATE-ERROR-NO-88        VALUE 'N'.                  DTSBX421
00137                                                                   DTSBX421
00138      05  W-DUP-RATE-ERROR-IND        PIC  X(01) VALUE 'N'.        DTSBX421
00139          88 W-DUP-RATE-YES-88         VALUE 'Y'.                  DTSBX421
00140          88 W-DUP-RATE-NO-88          VALUE 'N'.                  DTSBX421
00141                                                                   DTSBX421
00142      05  W-EMP-IN-PROGRESS-IND       PIC  X(01) VALUE 'N'.        DTSBX421
00143          88 W-EMP-IN-PROGRESS-YES-88  VALUE 'Y'.                  DTSBX421
00144          88 W-EMP-IN-PROGRESS-NO-88   VALUE 'N'.                  DTSBX421
00145                                                                   DTSBX421
00146      05  W-DUP-FEIN-IND              PIC  X(01) VALUE 'N'.        DTSBX421
00147          88 W-DUP-FEIN-YES-88         VALUE 'Y'.                  DTSBX421
00148          88 W-DUP-FEIN-NO-88          VALUE 'N'.                  DTSBX421
00149                                                                   DTSBX421
00150      05  W-EMP-NO                PIC  9(07) VALUE ZERO.           DTSBX421
00151      05  W-FEIN                  PIC  9(09) VALUE ZERO.           DTSBX421
00152      05  W-SOURCE-CD             PIC  X(02) VALUE SPACES.         DTSBX421
00153      05  W-CLASS                 PIC  X(01) VALUE SPACES.         DTSBX421
00154 **   05  W-FEIN-EMP-NO           PIC  9(06) VALUE ZERO.           DTSBX421
00155      05  W-CURR-RUN-DATE         PIC S9(09) COMP-3.               DTSBX421
00156      05  W-LIABLE-DATE           PIC S9(09) COMP-3.               DTSBX421
00157      05  W-WAGES-PLANNED-DATE    PIC S9(09) COMP-3.               DTSBX421
00158      05  W-INCORP-DATE           PIC S9(09) COMP-3.               DTSBX421
00159      05  W-FIRST-500-QTR         PIC S9(05) COMP-3.               DTSBX421
00160      05  W-LAST-RPT-DUE          PIC S9(05) COMP-3.               DTSBX421
00161      05  W-RATE                  PIC S9V9(04) COMP-3.             DTSBX421
00162      05  W-RATE-Z                PIC  X(6).                          CL130
00163      05  W-RATE-X REDEFINES W-RATE-Z  PIC 9.9999.                    CL130
00164      05  W-FIELD-ZIP             PIC  X(10).                      DTSBX421
00165      05  W-FIELD-STATE           PIC  X(02).                      DTSBX421
00166      05  W-PRED-EMP-NO           PIC  9(07) VALUE ZERO.           DTSBX421
00167      05  W-PRED-FEIN             PIC  9(09) VALUE ZERO.           DTSBX421
00168      05  W-PRED-EFF-DATE         PIC  X(10).                      DTSBX421
00169      05  W-PORTION-EXP-TRNSF-X   PIC  X(06).                      DTSBX421
00170      05  W-PORTION-EXP-TRNSF-N REDEFINES                          DTSBX421
00171          W-PORTION-EXP-TRNSF-X   PIC  999.99.                     DTSBX421
00172      05  W-WAGES-X               PIC  X(14).                      DTSBX421
00173      05  W-WAGES-9 REDEFINES W-WAGES-X                            DTSBX421
00174                                  PIC  9(11).99.                   DTSBX421
00175      05  W-REMIT-X               PIC  X(12).                      DTSBX421
00176      05  W-REMIT-9 REDEFINES W-REMIT-X                            DTSBX421
00177                                  PIC  9(09).99.                   DTSBX421
00178      05  W-COUNT-X               PIC  X(07).                      DTSBX421
00179      05  W-COUNT-9 REDEFINES W-COUNT-X                            DTSBX421
00180                                  PIC  9(07).                      DTSBX421
00181 *    05  W-REPORT-QTR            PIC S9(05) COMP-3.               DTSBX421
00182 *    05  WRK-REPORT-QTR          PIC 9(05).                       DTSBX421
00183 *    05  W-TOT-WAGE              PIC S9(11)V99.                   DTSBX421
00184 *    05  W-TAX-WAGE              PIC S9(11)V99.                   DTSBX421
00185 *    05  W-WRKR-TOT-WAGE         PIC S9(11)V99.                   DTSBX421
00186 *    05  W-WRKR-TAX-WAGE         PIC S9(11)V99.                   DTSBX421
00187 *    05  W-REMITTANCE            PIC S9(09)V99.                   DTSBX421
00188 *    05  W-RECEIVED-DATE         PIC S9(09) COMP-3.               DTSBX421
00189 *    05  W-1ST-MNTH-CNT          PIC S9(07) COMP-3.               DTSBX421
00190 *    05  W-2ND-MNTH-CNT          PIC S9(07) COMP-3.               DTSBX421
00191 *    05  W-3RD-MNTH-CNT          PIC S9(07) COMP-3.               DTSBX421
00192 *    05  W-WAGE-QTR              PIC S9(05) COMP-3.               DTSBX421
00193 *    05  W-SSN                   PIC S9(09) COMP-3.               DTSBX421
00194      05  W-RUN-DATE              PIC  9(07) VALUE 0.                 CL121
00195      05  Z-RUN-DATE REDEFINES W-RUN-DATE.                            CL122
00196          10  Z-CC              PIC  9(01).                           CL122
00197          10  Z-YY              PIC  9(02).                           CL122
00198          10  Z-MM              PIC  9(02).                           CL122
00199          10  Z-DD              PIC  9(02).                           CL122
00200 **   05  W-EARNINGS-X            PIC  X(12).                         CL122
00201 *    05  W-EARNINGS-9   REDEFINES W-EARNINGS-X                    DTSBX421
00202 *                                PIC  9(09).99.                   DTSBX421
00203 *    05  W-EARNINGS              PIC S9(09)V99.                   DTSBX421
00204 *    05  W-NAME-EFF-DATE         PIC  X(10).                      DTSBX421
00205 *    05  W-WORKER-NAME.                                           DTSBX421
00206 *        10  W-WRKR-FIRST-NAME   PIC  X(15).                      DTSBX421
00207 *        10  W-WRKR-MID-INIT     PIC  X(01).                      DTSBX421
00208 *        10  W-WRKR-LAST-NAME    PIC  X(20).                      DTSBX421
00209                                                                   DTSBX421
00210      05  W-ENTITY-NAME           PIC  X(40).                      DTSBX421
00211      05  W-TRADE-NAME            PIC  X(40).                      DTSBX421
00212      05  W-X421-NAME             PIC  X(20) VALUE  SPACES.           CL164
00213                                                                   DTSBX421
00214 *    05  W-RPT-TYPE              PIC  X(02).                      DTSBX421
00215 *        88  W-ORIG-88               VALUE 'OR'.                  DTSBX421
00216 *        88  W-EMP-AMEND-88          VALUE 'EA'.                  DTSBX421
00217 *        88  W-AUDIT-88              VALUE 'AU'.                  DTSBX421
00218 *        88  W-FLD-SUP-88            VALUE 'FS'.                  DTSBX421
00219 *        88  W-ADMIN-CORR-88         VALUE 'AC'.                  DTSBX421
00220 *        88  W-ESTIM-88              VALUE 'ES'.                  DTSBX421
00221 *        88  W-WITHDRW-88            VALUE 'WD'.                  DTSBX421
00222 *        88  W-SUPPLEM-88            VALUE 'EA' 'AU'              DTSBX421
00223 *                                          'FS' 'AC'.             DTSBX421
00224 *        88  W-RPT-TYPE-VALID-88     VALUE 'OR' 'EA' 'AU'         DTSBX421
00225 *                                          'FS' 'AC' 'ES'         DTSBX421
00226 *                                          'WD'.                  DTSBX421
00227 *                                                                 DTSBX421
00228      05  WRK-FEIN.                                                   CL136
00229          10  WRK-FEIN-PREFIX     PIC  9(02).                         CL137
00230          88  WRK-FEIN-VALID-88   VALUE 01 02 03 04 05 06 10 11 12    CL136
00231                                        13 14 16 21 22 23 25 30 32    CL136
00232                                        34 35 36 37 38 50 51 52 53    CL136
00233                                        54 55 56 57 58 59 60 61 65    CL136
00234                                        67 15 24 40 44 94 95 80 90    CL136
00235                                        20 26 27 45 46 47 81 82 83    CL136
00236                                        33 39 41 42 43 46 48 62 63    CL136
00237                                        64 66 68 71 72 73 74 75 76    CL136
00238                                        77 82 83 84 85 86 87 88 91    CL136
00239                                        92 93 98 99 31.               CL140
00240                                                                      CL136
00241          10  WRK-FEIN-SUFFIX     PIC  9(07).                         CL137
00242 *    05  W-PSEUDO-BATCH-NO       PIC  9(05) VALUE ZERO.           DTSBX421
00243 *    05  FILLER REDEFINES W-PSEUDO-BATCH-NO.                      DTSBX421
00244 *        10  W-PSEUDO-DAYS       PIC  9(03).                      DTSBX421
00245 *        10  W-PSEUDO-BATCH-SEQ  PIC  9(02).                      DTSBX421
00246 *                                                                 DTSBX421
00247 *    05  W-START-BATCH           PIC  9(05) VALUE ZERO.           DTSBX421
00248 *    05  W-END-BATCH             PIC  9(05) VALUE ZERO.           DTSBX421
00249 *                                                                 DTSBX421
00250 *    05  W-PSEUDO-ITEM-NO        PIC  9(03)  VALUE 0.             DTSBX421
00251 *                                                                 DTSBX421
00252 *    05  W-SEQ-NO                PIC  9(07)  VALUE 0.             DTSBX421
00253                                                                   DTSBX421
00254      05  ISUB1                   PIC S9(04) COMP.                 DTSBX421
00255      05  ISUB2                   PIC S9(04) COMP.                 DTSBX421
00256      05  ISUB3                   PIC S9(04) COMP.                 DTSBX421
00257      05  ISUB4                   PIC S9(04) COMP.                 DTSBX421
00258      05  W-CURR-FIELD            PIC S9(04) COMP.                 DTSBX421
00259      05  W-LAST-FIELD            PIC S9(04) COMP.                 DTSBX421
00260      05  W-LAST-FIELD-LEN        PIC S9(04) COMP.                 DTSBX421
00261      05  W-INPUT-LENGTH          PIC S9(04) COMP                  DTSBX421
00262                                   VALUE +502.                     DTSBX421
00263      05  W-INPUT-LINE            PIC  X(500).                     DTSBX421
00264      05  W-PARSE-COMPLETE-IND    PIC  X(01).                      DTSBX421
00265          88  W-PARSE-COMPLETE-YES-88  VALUE 'Y'.                  DTSBX421
00266          88  W-PARSE-COMPLETE-NO-88   VALUE 'N'.                  DTSBX421
00267      05  W-FIELD-LENGTH          PIC S9(04) COMP.                 DTSBX421
00268      05  W-CONV-LINE             PIC  X(32).                      DTSBX421
00269                                                                   DTSBX421
00270      05  W-MNTE-SUBJECT          PIC  X(40).                      DTSBX421
00271          88  W-MNTE-NOT-LIAB-88   VALUE                           DTSBX421
00272          'REASON FOR NOT-LIABLE DETERMINATION     '.              DTSBX421
00273          88  W-MNTE-KEY-WORD-88   VALUE                           DTSBX421
00274          'FR-500 INDUSTRY DESCRIPTION - KEY WORD  '.              DTSBX421
00275          88  W-MNTE-DATA-ENTRY-88 VALUE                           DTSBX421
00276          'FR-500 INDUSTRY DESCRIPTION - DATA ENTRY'.              DTSBX421
00277          88  W-MNTE-RELATIONSHIP-88 VALUE                         DTSBX421
00278          'WEB REGISTRATION RELATED EMPLOYER       '.              DTSBX421
00279                                                                   DTSBX421
00280      05  W-MNTE-COMPLETE-IND         PIC  X(01) VALUE 'N'.        DTSBX421
00281          88 W-MNTE-COMPLETE-YES-88    VALUE 'Y'.                  DTSBX421
00282          88 W-MNTE-COMPLETE-NO-88     VALUE 'N'.                  DTSBX421
00283                                                                   DTSBX421
00284      05  TSUB1                   PIC S9(04) COMP.                 DTSBX421
00285      05  TSUB2                   PIC S9(04) COMP.                 DTSBX421
00286      05  W-LAST-SPACE            PIC S9(04) COMP.                 DTSBX421
00287                                                                   DTSBX421
00288      05  W-MNTE-LINE             PIC  X(72).                      DTSBX421
00289                                                                   DTSBX421
00290      05  W-TEST-AMT            PIC  X(06) VALUE SPACES.           DTSBX421
00291                                                                   DTSBX421
00292      05  W-VALUE               PIC S9(7)V9(06) COMP-3.            DTSBX421
00293      05  W-DIGIT               PIC  9(01).                        DTSBX421
00294      05  W-DISP-AMT            PIC ------9.9(06).                 DTSBX421
00295                                                                   DTSBX421
00296      05  RSUB                  PIC S9(04) COMP.                   DTSBX421
00297      05  W-MULTIPLIER          PIC S9(07)V9(07) COMP-3.           DTSBX421
00298      05  W-DECIMAL-FOUND-IND   PIC  X(01) VALUE 'N'.              DTSBX421
00299          88  W-DECIMAL-FOUND-YES-88  VALUE 'Y'.                   DTSBX421
00300          88  W-DECIMAL-FOUND-NO-88   VALUE 'N'.                   DTSBX421
00301                                                                   DTSBX421
00302      05  SUB                     PIC S9(04) COMP.                 DTSBX421
00303      05  W-RATE-AREA OCCURS 5 TIMES.                              DTSBX421
00304          10  W-RATE-YEAR         PIC S9(05) COMP-3.               DTSBX421
00305          10  W-RATE-FOUND-IND    PIC  X(01).                      DTSBX421
00306              88  W-RATE-FOUND-YES-88   VALUE 'Y'.                 DTSBX421
00307              88  W-RATE-FOUND-NO-88    VALUE 'N'.                 DTSBX421
00308                                                                   DTSBX421
00309      05  W-SLASH-DATE            PIC  X(10).                      DTSBX421
00310      05  FILLER REDEFINES W-SLASH-DATE.                           DTSBX421
00311          10  W-SLASH-DT-MM       PIC  X(02).                      DTSBX421
00312          10  FILLER              PIC  X(01).                      DTSBX421
00313          10  W-SLASH-DT-DD       PIC  X(02).                      DTSBX421
00314          10  FILLER              PIC  X(01).                      DTSBX421
00315          10  W-SLASH-DT-CCYY     PIC  X(04).                      DTSBX421
00316                                                                   DTSBX421
00317      05  W-SLASH-QTR             PIC  X(06).                      DTSBX421
00318      05  FILLER REDEFINES W-SLASH-QTR.                            DTSBX421
00319          10  W-SLASH-QTR-CCYY    PIC  X(04).                      DTSBX421
00320          10  FILLER              PIC  X(01).                      DTSBX421
00321          10  W-SLASH-QTR-Q       PIC  X(01).                      DTSBX421
00322                                                                   DTSBX421
00323      05  WRK-PHONE                   PIC  X(15)  VALUE SPACES.    DTSBX421
00324      05  FILLER REDEFINES WRK-PHONE.                              DTSBX421
00325          10  WRK-AREA-CD             PIC  X(03).                  DTSBX421
00326          10  WRK-PREFIX              PIC  X(03).                  DTSBX421
00327          10  WRK-SUFFIX              PIC  X(04).                  DTSBX421
00328          10  WRK-EXT                 PIC  X(05).                  DTSBX421
00329      05  WRK-EXT-HYPHEN              PIC  X(01)  VALUE SPACES.    DTSBX421
00330      05  WRK-PHONE-TEXT1             PIC  X(72)  VALUE SPACES.    DTSBX421
00331      05  WRK-PHONE-TEXT2             PIC  X(72)  VALUE SPACES.    DTSBX421
00332                                                                   DTSBX421
00333      05  W-WEB-IMP-CNT           PIC S9(07)  COMP-3 VALUE +0.     DTSBX421
00334      05  W-EMP-CNT               PIC S9(07)  COMP-3 VALUE +0.     DTSBX421
00335      05  W-EMP-WAGE-CNT          PIC S9(07)  COMP-3 VALUE +0.     DTSBX421
00336      05  WRK-EMP-WAGE-CNT        PIC 9(07) VALUE 0.               DTSBX421
00337 *  SAVED KEY-AREAS.                                                  CL*15
00338      05  X102-KEY-AREA           PIC X(06) VALUE SPACES.             CL*15
00339      05  X104-KEY-AREA           PIC X(06) VALUE SPACES.             CL*15
00340      05  X106-KEY-AREA           PIC X(06) VALUE SPACES.             CL*15
00341      05  X108-KEY-AREA           PIC X(06) VALUE SPACES.             CL*15
00342      05  X110-KEY-AREA           PIC X(06) VALUE SPACES.             CL*15
00343      05  X120-KEY-AREA           PIC X(06) VALUE SPACES.             CL*15
00344 *  PROFILE                                                        DTSBX421
00345      05  W-X102-RED-CNT          PIC S9(07)  COMP-3 VALUE +0.        CL*39
00346      05  W-X102-PRO-CNT          PIC S9(07)  COMP-3 VALUE +0.        CL*39
00347      05  W-X102-ERR-CNT          PIC S9(07)  COMP-3 VALUE +0.        CL*39
00348      05  W-X102-DUP-CNT          PIC S9(07)  COMP-3 VALUE +0.        CL*39
00349      05  W-X102-SAV-CNT          PIC S9(07)  COMP-3 VALUE +0.        CL*39
00350 *  DETERMINATION                                                  DTSBX421
00351      05  W-X104-RED-CNT          PIC S9(07)  COMP-3 VALUE +0.        CL*39
00352      05  W-X104-PRO-CNT          PIC S9(07)  COMP-3 VALUE +0.        CL*39
00353      05  W-X104-ERR-CNT          PIC S9(07)  COMP-3 VALUE +0.        CL*39
00354      05  W-X104-DUP-CNT          PIC S9(07)  COMP-3 VALUE +0.        CL*39
00355      05  W-X104-SAV-CNT          PIC S9(07)  COMP-3 VALUE +0.        CL*39
00356 *  NAME                                                           DTSBX421
00357      05  W-X106-RED-CNT          PIC S9(07)  COMP-3 VALUE +0.        CL*39
00358      05  W-X106-PRO-CNT          PIC S9(07)  COMP-3 VALUE +0.        CL*39
00359      05  W-X106-ERR-CNT          PIC S9(07)  COMP-3 VALUE +0.        CL*39
00360      05  W-X106-DUP-CNT          PIC S9(07)  COMP-3 VALUE +0.        CL*39
00361      05  W-X106-SAV-CNT          PIC S9(07)  COMP-3 VALUE +0.        CL*39
00362 *  RATE                                                           DTSBX421
00363      05  W-X108-RED-CNT          PIC S9(07)  COMP-3 VALUE +0.        CL*39
00364      05  W-X108-PRO-CNT          PIC S9(07)  COMP-3 VALUE +0.        CL*39
00365      05  W-X108-ERR-CNT          PIC S9(07)  COMP-3 VALUE +0.        CL*39
00366      05  W-X108-DUP-CNT          PIC S9(07)  COMP-3 VALUE +0.        CL*39
00367      05  W-X108-SAV-CNT          PIC S9(07)  COMP-3 VALUE +0.        CL*39
00368 *  ADDRESS                                                        DTSBX421
00369      05  W-X110-RED-CNT          PIC S9(07)  COMP-3 VALUE +0.        CL*39
00370      05  W-X110-PRO-CNT          PIC S9(07)  COMP-3 VALUE +0.        CL*39
00371      05  W-X110-ERR-CNT          PIC S9(07)  COMP-3 VALUE +0.        CL*39
00372      05  W-X110-DUP-CNT          PIC S9(07)  COMP-3 VALUE +0.        CL*39
00373      05  W-X110-SAV-CNT          PIC S9(07)  COMP-3 VALUE +0.        CL*39
00374 *  OPO                                                            DTSBX421
00375      05  W-X120-RED-CNT          PIC S9(07)  COMP-3 VALUE +0.        CL*39
00376      05  W-X120-PRO-CNT          PIC S9(07)  COMP-3 VALUE +0.        CL*39
00377      05  W-X120-ERR-CNT          PIC S9(07)  COMP-3 VALUE +0.        CL*39
00378      05  W-X120-DUP-CNT          PIC S9(07)  COMP-3 VALUE +0.        CL*39
00379      05  W-X120-SAV-CNT          PIC S9(07)  COMP-3 VALUE +0.        CL*39
00380 *  RELATIONSHIP                                                   DTSBX421
00381      05  W-X130-CNT              PIC S9(07)  COMP-3 VALUE +0.     DTSBX421
00382 *  INDUSTRY DESCRIPTION                                           DTSBX421
00383      05  W-X132-CNT              PIC S9(07)  COMP-3 VALUE +0.     DTSBX421
00384 *  REPORT                                                         DTSBX421
00385      05  W-X140-RED-CNT          PIC S9(07)  COMP-3 VALUE +0.        CL*39
00386      05  W-X140-PRO-CNT          PIC S9(07)  COMP-3 VALUE +0.        CL*39
00387      05  W-X140-ERR-CNT          PIC S9(07)  COMP-3 VALUE +0.        CL*39
00388      05  W-X140-DUP-CNT          PIC S9(07)  COMP-3 VALUE +0.        CL*39
00389      05  W-X140-SAV-CNT          PIC S9(07)  COMP-3 VALUE +0.        CL*39
00390                                                                   DTSBX421
00391      05  W-T002-PRF-CNT          PIC S9(07)  COMP-3 VALUE +0.     DTSBX421
00392      05  W-T002-DETERM-CNT       PIC S9(07)  COMP-3 VALUE +0.     DTSBX421
00393      05  W-T002-NAME-CNT         PIC S9(07)  COMP-3 VALUE +0.     DTSBX421
00394      05  W-T002-RATE-CNT         PIC S9(07)  COMP-3 VALUE +0.     DTSBX421
00395      05  W-T002-ADDR-CNT         PIC S9(07)  COMP-3 VALUE +0.     DTSBX421
00396      05  W-T002-OPO-CNT          PIC S9(07)  COMP-3 VALUE +0.     DTSBX421
00397      05  W-T002-REL-CNT          PIC S9(07)  COMP-3 VALUE +0.     DTSBX421
00398      05  W-T002-WRITE-CNT        PIC S9(07)  COMP-3 VALUE +0.     DTSBX421
00399                                                                   DTSBX421
00400      05  W-T003-WRITE-CNT        PIC S9(07)  COMP-3 VALUE +0.     DTSBX421
00401                                                                   DTSBX421
00402      05  TOT-DUTAS-ADD-CNT       PIC S9(07)  COMP-3 VALUE +0.        CL*41
00403      05  TOT-DUTAS-ERR-CNT       PIC S9(07)  COMP-3 VALUE +0.        CL*41
00404      05  W-W001-WRITE-CNT        PIC S9(07)  COMP-3 VALUE +0.     DTSBX421
00405      05  W-X140-RPT-CNT          PIC S9(07)  COMP-3 VALUE +0.     DTSBX421
00406                                                                   DTSBX421
00407      05  W-WEB-IMP-LENGTH        PIC S9(04)  COMP.                DTSBX421
00408      05  W-X102-LENGTH           PIC S9(04)  COMP.                DTSBX421
00409      05  W-X104-LENGTH           PIC S9(04)  COMP.                DTSBX421
00410      05  W-X106-LENGTH           PIC S9(04)  COMP.                DTSBX421
00411      05  W-X108-LENGTH           PIC S9(04)  COMP.                DTSBX421
00412      05  W-X110-LENGTH           PIC S9(04)  COMP.                DTSBX421
00413      05  W-X120-LENGTH           PIC S9(04)  COMP.                DTSBX421
00414      05  W-X130-LENGTH           PIC S9(04)  COMP.                DTSBX421
00415      05  W-X132-LENGTH           PIC S9(04)  COMP.                DTSBX421
00416      05  W-X140-LENGTH           PIC S9(04)  COMP.                DTSBX421
00417      05  WS-X140-RED-CNT         PIC 9(5) VALUE 0.                   CL106
00418      05  WS-X140-ERR-CNT         PIC 9(5) VALUE 0.                   CL106
00419      05  WS-X140-PEN-CNT         PIC 9(5) VALUE 0.                   CL107
00420                                                                   DTSBX421
00421      05  W-AMT-DISP1             PIC ----------9.99.              DTSBX421
00422      05  W-AMT-DISP2             PIC ----------9.99.              DTSBX421
00423 *RW1                                                              DTSBX421
00424      05  WRK-R140-CNT            PIC S9(07) COMP-3 VALUE +0.      DTSBX421
00425      05  DISPLAY-CNT             PIC  Z(06)9.                     DTSBX421
00426                                                                   DTSBX421
00427  01  MESSAGE-AREA.                                                DTSBX421
00428      05  WRK-MESSAGE                           PIC X(80).         DTSBX421
00429      05  MSG1-INVALID-FEIN.                                       DTSBX421
00430          10  FILLER                            PIC X(08)          DTSBX421
00431              VALUE 'X102-:'.                                         CL*20
00432          10  FILLER                            PIC X(02)          DTSBX421
00433              VALUE SPACES.                                        DTSBX421
00434          10  FILLER                            PIC X(18)          DTSBX421
00435              VALUE 'NON-NUMERIC FEIN: '.                          DTSBX421
00436          10  MSG1-FEIN                         PIC X(09).         DTSBX421
00437      05  MSG11-INVALID-FEIN.                                         CL138
00438          10  FILLER                            PIC X(08)             CL138
00439              VALUE 'X102-:'.                                         CL138
00440          10  FILLER                            PIC X(02)             CL138
00441              VALUE SPACES.                                           CL138
00442          10  FILLER                            PIC X(18)             CL138
00443              VALUE 'INVAL FEIN PREFX: '.                             CL138
00444          10  MSG11-FEIN                         PIC X(09).           CL138
00445      05  MSG2-SOURCE-CODE.                                        DTSBX421
00446          10  FILLER                            PIC X(08)          DTSBX421
00447              VALUE 'X102-:'.                                         CL*20
00448          10  FILLER                            PIC X(27)          DTSBX421
00449              VALUE 'INVALID SOURCE CODE: '.                       DTSBX421
00450          10  MSG2-SOURCE-CD                    PIC X(02).         DTSBX421
00451      05  MSG3-EMP-ON-FILE.                                        DTSBX421
00452          10  FILLER                            PIC X(08)          DTSBX421
00453              VALUE 'X102-:'.                                         CL*20
00454          10  FILLER                            PIC X(29)          DTSBX421
00455              VALUE 'EMPLOYER ACCT ALREADY ON FILE'.               DTSBX421
00456      05  MSG4-DUP-EMP.                                            DTSBX421
00457          10  FILLER                            PIC X(14)          DTSBX421
00458              VALUE 'X102-:'.                                         CL*20
00459          10  FILLER                            PIC X(22)          DTSBX421
00460              VALUE 'FEIN ALREADY ON FILE: '.                      DTSBX421
00461          10  MSG4-FEIN                         PIC X(09).         DTSBX421
00462      05  MSG5-INVALID-LIAB-CD.                                    DTSBX421
00463          10  FILLER                            PIC X(08)          DTSBX421
00464              VALUE 'X104-: '.                                        CL*20
00465          10  FILLER                            PIC X(24)          DTSBX421
00466              VALUE 'INVALID LIABILITY CODE: '.                    DTSBX421
00467          10  MSG5-LIAB-CD                      PIC X(02).         DTSBX421
00468      05  MSG6-INVALID-ELIG-CD.                                    DTSBX421
00469          10  FILLER                            PIC X(08)          DTSBX421
00470              VALUE 'X104-: '.                                        CL*20
00471          10  FILLER                            PIC X(26)          DTSBX421
00472              VALUE 'INVALID ELIGIBILITY CODE: '.                  DTSBX421
00473          10  MSG6-ELIG-CD                      PIC X(02).         DTSBX421
00474      05  MSG7-INVALID-ORG-TYPE.                                   DTSBX421
00475          10  FILLER                            PIC X(08)          DTSBX421
00476              VALUE 'X104: '.                                         CL*20
00477          10  FILLER                            PIC X(27)          DTSBX421
00478              VALUE 'INVALID ORGANIZATION TYPE: '.                 DTSBX421
00479          10  MSG7-ORG-TYPE                     PIC X(03).         DTSBX421
00480      05  MSG8-INVALID-INCORP-DATE.                                DTSBX421
00481          10  FILLER                            PIC X(08)          DTSBX421
00482              VALUE 'X104: '.                                         CL*20
00483          10  FILLER                            PIC X(28)          DTSBX421
00484              VALUE 'INVALID INCORPORATION DATE: '.                DTSBX421
00485          10  MSG8-INCORP-DATE                  PIC X(10).         DTSBX421
00486      05  MSG9-INVALID-FILING-SCHED.                               DTSBX421
00487          10  FILLER                            PIC X(08)          DTSBX421
00488              VALUE 'X104: '.                                         CL*20
00489          10  FILLER                            PIC X(25)          DTSBX421
00490              VALUE 'INVALID FILING SCHEDULE: '.                   DTSBX421
00491          10  MSG9-ORG-TYPE                     PIC X(02).         DTSBX421
00492          10  FILLER                            PIC X(02)          DTSBX421
00493              VALUE SPACES.                                        DTSBX421
00494          10  MSG9-FILING-SCHED                 PIC X(01).         DTSBX421
00495      05  MSG10-INCONSISTENT-LIAB-CD.                              DTSBX421
00496          10  FILLER                            PIC X(08)          DTSBX421
00497              VALUE 'X104-: '.                                        CL*20
00498          10  FILLER                            PIC X(34)          DTSBX421
00499              VALUE 'INCONSISTENT ELIG AND LIAB CODES: '.          DTSBX421
00500          10  MSG10-ELIG-CD                     PIC X(02).         DTSBX421
00501          10  FILLER                            PIC X(02)          DTSBX421
00502              VALUE SPACES.                                        DTSBX421
00503          10  MSG10-LIAB-CD                     PIC X(02).         DTSBX421
00504      05  MSG11-WAGES-PAID-QTR.                                    DTSBX421
00505          10  FILLER                            PIC X(08)          DTSBX421
00506              VALUE 'X104-: '.                                        CL*20
00507          10  FILLER                            PIC X(24)          DTSBX421
00508              VALUE 'INVALID WAGES PAID QTR: '.                    DTSBX421
00509          10  MSG11-QTR                         PIC X(02).         DTSBX421
00510      05  MSG12-FIRST-WAGE-DATE.                                   DTSBX421
00511          10  FILLER                            PIC X(08)          DTSBX421
00512              VALUE 'X104-: '.                                        CL*20
00513          10  FILLER                            PIC X(31)          DTSBX421
00514              VALUE 'INVALID FIRST WAGES PAID DATE: '.             DTSBX421
00515          10  MSG12-DATE                        PIC X(02).         DTSBX421
00516  01  HEADER-1.                                                       CL*87
00517      05  FILLER                   PIC X(01) VALUE SPACES.            CL*87
00518      05  FILLER                   PIC X(49) VALUE 'X421R'.           CL113
00519      05  FILLER                   PIC X(60) VALUE                    CL*87
00520          'DISTRICT OF COLUMBIA'.                                     CL*87
00521      05  FILLER                   PIC X(06) VALUE 'DATE:'.           CL*87
00522      05  HDR1-DATE.                                                  CL122
00523          10  W-MM                 PIC  X(02).                        CL122
00524          10  FILLER               PIC  X(01) VALUE '/'.              CL122
00525          10  W-DD                 PIC  X(02).                        CL122
00526          10  FILLER               PIC  X(01) VALUE '/'.              CL122
00527          10  W-YY                 PIC  X(02).                        CL122
00528                                                                      CL122
00529  01  HEADER-2.                                                       CL*87
00530      05  FILLER                   PIC X(54) VALUE SPACES.            CL*87
00531      05  FILLER                   PIC X(56) VALUE                    CL*87
00532          'TAX DIVISION'.                                             CL*87
00533 *    05  FILLER                   PIC X(06) VALUE 'TIME:'.           CL113
00534 *    05  HDR2-LRCM-SYS-TIME       PIC X(08).                         CL113
00535  01  HEADER-3.                                                       CL*87
00536      05  FILLER                   PIC X(01) VALUE SPACES.            CL*87
00537      05  FILLER                   PIC X(38) VALUE                    CL*87
00538          'ROUTE TO:  TAX STATUS STAFF'.                              CL*93
00539      05  HDR3-LITERAL             PIC X(43) VALUE                    CL*87
00540          '  ESSP DAILY REGISTRATIONS TO DUTAS       '.               CL*93
00541      05  FILLER                   PIC X(28) VALUE SPACES.            CL*87
00542 *    05  FILLER                   PIC X(06) VALUE 'PAGE:'.           CL113
00543 *    05  HDR3-PAGE                PIC ZZ,ZZ9.                        CL113
00544                                                                      CL*87
00545  01  HEADER-31.                                                      CL*87
00546      05  FILLER                   PIC X(01) VALUE SPACES.            CL*87
00547      05  FILLER                   PIC X(38) VALUE                    CL*87
00548          'ROUTE TO:  TAX ACCOUNTING STAFF'.                          CL*87
00549      05  HDR3-LITERAL             PIC X(43) VALUE                    CL*87
00550          '  ESSP DAILY RPTS-PAYMTS-WAGES IN ERROR   '.               CL*87
00551      05  FILLER                   PIC X(28) VALUE SPACES.            CL*87
00552      05  FILLER                   PIC X(06) VALUE 'PAGE:'.           CL*87
00553      05  HDR31-PAGE               PIC ZZ,ZZ9.                        CL*87
00554                                                                      CL*87
00555  01  HEADER-4.                                                       CL*87
00556      05  FILLER                   PIC X(01)  VALUE SPACES.           CL*87
00557      05  FILLER                   PIC X(132) VALUE SPACES.           CL*87
00558  01  HEADER-42.                                                      CL*87
00559      05  FILLER                   PIC X(02)  VALUE SPACES.           CL*87
00560      05  FILLER                   PIC X(34)  VALUE                   CL*87
00561          '                                 '.                        CL*87
00562      05  FILLER                   PIC X(02)  VALUE SPACES.           CL*87
00563      05  FILLER                   PIC X(25)  VALUE                   CL*87
00564             '                        '.                              CL*87
00565      05  FILLER                   PIC X(03)  VALUE SPACES.           CL*87
00566      05  FILLER                   PIC X(43)  VALUE                   CL*87
00567             '           ESSP-CALC    TPA/EMPL       DIFF'.           CL*87
00568      05  FILLER                   PIC X(30)  VALUE                   CL*87
00569             '        EMPLOYEES          '.                           CL*87
00570  01  HEADER-43.                                                      CL113
00571      05  FILLER                   PIC X(02)  VALUE SPACES.           CL113
00572      05  FILLER                   PIC X(36)  VALUE                   CL116
00573          '--------X102--------+---------------'.                     CL117
00574      05  FILLER                   PIC X(26)  VALUE                   CL117
00575             'X104----------------------'.                            CL117
00576      05  FILLER                   PIC X(38)  VALUE                   CL116
00577             '+-------X106----------+----X108-------'.                CL116
00578      05  HDR5-NAME                PIC X(31)  VALUE                   CL116
00579               '+-X421 REGISTRATION STATUS-+'.                        CL116
00580  01  HEADER-5.                                                       CL*87
00581      05  FILLER                   PIC X(02)  VALUE SPACES.           CL*98
00582      05  FILLER                   PIC X(35)  VALUE                   CL*98
00583          'EMP NO,  FEIN,      CLAS,ORG,LIAB,'.                       CL160
00584      05  FILLER                   PIC X(26)  VALUE                   CL105
00585             'ELIG,ANN,FILE, 1ST PAID, '.                             CL160
00586      05  FILLER                   PIC X(01)  VALUE SPACES.           CL104
00587      05  FILLER                   PIC X(36)  VALUE                   CL107
00588             'PRIMARY NAME,         RATE,   YEAR, '.                  CL160
00589      05  FILLER                   PIC X(02)  VALUE SPACES.           CL105
00590      05  HDR5-NAME                PIC X(28)  VALUE                   CL*87
00591               '------MESSAGES------------'.                          CL*99
00592  01  HEADER-6.                                                       CL*87
00593      05  FILLER                   PIC X(01)  VALUE SPACES.           CL*87
00594      05  FILLER                   PIC X(132) VALUE SPACES.           CL*87
00595  01  DETAIL-LINE-1.                                                  CL*87
00596      15  FILLER                     PIC  X(02) VALUE SPACES.         CL*87
00597      15  X421-EMP-NO                PIC  999B999 BLANK WHEN ZERO.    CL*87
00598      15  FILLER                     PIC  X(01) VALUE ','.            CL158
00599      15  FILLER                     PIC  X(01) VALUE SPACES.         CL158
00600      15  X421-FEIN                  PIC  9(09) VALUE ZEROS.          CL*87
00601      15  FILLER                     PIC  X(01) VALUE ','.            CL158
00602      15  FILLER                     PIC  X(01) VALUE SPACES.         CL158
00603      15  X421-CLASS                 PIC  X(01).                      CL*87
00604      15  FILLER                     PIC  X(01) VALUE ','.            CL158
00605      15  FILLER                     PIC  X(03) VALUE SPACES.         CL158
00606      15  X421-ORG-TYPE              PIC  X(04).                      CL*94
00607      15  FILLER                     PIC  X(01) VALUE ','.            CL158
00608      15  X421-LIAB-CD               PIC  X(02).                      CL*89
00609      15  FILLER                     PIC  X(01) VALUE ','.            CL158
00610      15  FILLER                     PIC  X(02) VALUE SPACES.         CL158
00611      15  X421-ELIG-CD               PIC  X(03).                      CL*89
00612      15  FILLER                     PIC  X(01) VALUE ','.            CL158
00613      15  FILLER                     PIC  X(01) VALUE SPACES.         CL158
00614      15  X421-HHOLD                 PIC  X(01).                      CL101
00615      15  FILLER                     PIC  X(01) VALUE ','.            CL158
00616      15  FILLER                     PIC  X(03) VALUE SPACES.         CL158
00617      15  X421-FILING                PIC  X(03).                      CL*89
00618      15  FILLER                     PIC  X(01) VALUE ','.            CL158
00619      15  FILLER                     PIC  X(01) VALUE SPACES.         CL158
00620      15  X421-PAID                  PIC  X(10).                      CL102
00621      15  FILLER                     PIC  X(01) VALUE ','.            CL158
00622      15  FILLER                     PIC  X(01) VALUE SPACES.         CL158
00623      15  X421-NAME                  PIC  X(20).                      CL*89
00624      15  FILLER                     PIC  X(01) VALUE ','.            CL158
00625      15  FILLER                     PIC  X(01) VALUE SPACES.         CL158
00626      15  X421-RATE                  PIC  9.9BBB.                     CL104
00627      15  FILLER                     PIC  X(01) VALUE ','.            CL158
00628      15  FILLER                     PIC  X(01) VALUE SPACES.         CL158
00629      15  X421-RATYR                 PIC  X(06).                      CL104
00630      15  FILLER                     PIC  X(01) VALUE ','.            CL158
00631      15  FILLER                     PIC  X(01) VALUE SPACES.         CL158
00632      15  X421-MESSAGE               PIC  X(30).                      CL100
00633                                                                      CL*89
00634  01  DETAIL-PEND-1.                                                  CL*87
00635      15  FILLER                     PIC  X(02) VALUE SPACES.         CL*87
00636      15  P421-EMP-NO                PIC  999B999 BLANK WHEN ZERO.    CL*87
00637      15  FILLER                     PIC  X(02) VALUE SPACES.         CL*87
00638      15  P421-NAME-CHECK            PIC  X(04) VALUE SPACES.         CL*87
00639      15  FILLER                     PIC  X(02) VALUE SPACES.         CL*87
00640      15  P421-QTR                   PIC  X(06).                      CL*87
00641      15  FILLER                     PIC  X(02) VALUE SPACES.         CL*87
00642      15  P421-RCVD-DATE             PIC  X(10).                      CL*87
00643      15  FILLER                     PIC  X(01) VALUE SPACES.         CL*87
00644      15  P421-TOT-WAGE              PIC  --------9.99.               CL*87
00645      15  FILLER                     PIC  X(01) VALUE SPACES.         CL*87
00646      15  P421-EXC-WAGE              PIC  --------9.99.               CL*87
00647      15  FILLER                     PIC  X(01) VALUE SPACES.         CL*87
00648      15  P421-TAX-WAGE              PIC  --------9.99.               CL*87
00649      15  FILLER                     PIC  X(01) VALUE SPACES.         CL*87
00650      15  FILLER                     PIC  X(01) VALUE SPACES.         CL*87
00651      15  P421-X140-REMIT            PIC  --------9.99.               CL*87
00652      15  FILLER                     PIC  X(01) VALUE SPACES.         CL*87
00653      15  P421-X145-REMIT            PIC  --------9.99.               CL*87
00654      15  FILLER                     PIC  X(02) VALUE SPACES.         CL*87
00655      15  P421-MESSAGE               PIC  X(30).                      CL*87
00656                                                                      CL*87
00657  01  FOOTING-LINE-1               PIC X(133) VALUE SPACES.           CL*87
00658  01  FOOTING-LINE-2               PIC X(133) VALUE SPACES.           CL*87
00659                                                                      CL*87
00660  01  FOOTING-LINE-3.                                                 CL*87
00661      05  FILLER                   PIC  X(25)  VALUE SPACES.          CL*87
00662      05  WS-FOOTING-CNT           PIC  ZZ,ZZ9.                       CL*87
00663      05  FILLER                   PIC  X(02)  VALUE SPACES.          CL*87
00664      05  FILLER                   PIC  X(45) VALUE                   CL*87
00665                       'TOTAL PAYMENT RELEASED TO DUTAS    '.         CL*87
00666      05  FILLER                   PIC  X(32)  VALUE SPACES.          CL*87
00667  01  FOOTING-LINE-4.                                                 CL*87
00668      05  FILLER                   PIC  X(25)  VALUE SPACES.          CL*87
00669      05  WS-X145-ERR-CNT           PIC  ZZ,ZZ9.                      CL*87
00670      05  FILLER                   PIC  X(02)  VALUE SPACES.          CL*87
00671      05  FILLER                   PIC  X(34) VALUE                   CL*87
00672                       ' # OF  PAYMENTS HAD ERRORS       '.           CL*87
00673      05  FILLER                   PIC  X(32)  VALUE SPACES.          CL*87
00674                                                                      CL*87
00675  01  FOOTING-LINE-5.                                                 CL*87
00676      05  FILLER                   PIC  X(25)  VALUE SPACES.          CL*87
00677      05  WS-X145-PEN-CNT           PIC  ZZ,ZZ9.                      CL*87
00678      05  FILLER                   PIC  X(02)  VALUE SPACES.          CL*87
00679      05  FILLER                   PIC  X(40) VALUE                   CL*87
00680                       ' # OF  ZERO PAYMENTS DISCARDED      '.        CL*87
00681      05  FILLER                   PIC  X(32)  VALUE SPACES.          CL*87
00682  01  FOOTING-LINE-51.                                                CL107
00683      05  FILLER                   PIC  X(25)  VALUE SPACES.          CL107
00684      05  WS-X102-PEN-CNT           PIC  ZZ,ZZ9.                      CL107
00685      05  FILLER                   PIC  X(02)  VALUE SPACES.          CL107
00686      05  FILLER                   PIC  X(40) VALUE                   CL107
00687                       '# OF REGISTRATIONS RECEIVED FROM ESSP'.       CL110
00688      05  FILLER                   PIC  X(32)  VALUE SPACES.          CL107
00689                                                                      CL107
00690  01  FOOTING-LINE-6.                                                 CL*87
00691      05  FILLER                   PIC  X(25)  VALUE SPACES.          CL*87
00692      05  WS-X102-RED-CNT           PIC  ZZ,ZZ9.                      CL106
00693      05  FILLER                   PIC  X(02)  VALUE SPACES.          CL*87
00694      05  FILLER                   PIC  X(45) VALUE                   CL*87
00695                       '# OF REGISTRATIONS DUTAS PASSED    '.         CL110
00696      05  FILLER                   PIC  X(32)  VALUE SPACES.          CL*87
00697  01  FOOTING-LINE-7.                                                 CL*87
00698      05  FILLER                   PIC  X(25)  VALUE SPACES.          CL*87
00699      05  WS-X102-ERR-CNT           PIC  ZZ,ZZ9.                      CL106
00700      05  FILLER                   PIC  X(02)  VALUE SPACES.          CL*87
00701      05  FILLER                   PIC  X(40) VALUE                   CL108
00702          '# OF REGISTRATIONS DUTAS FAILED'.                          CL108
00703      05  FILLER                   PIC  X(32)  VALUE SPACES.          CL*87
00704  01  FOOTING-LINE-8.                                                 CL*87
00705      05  FILLER                   PIC  X(25)  VALUE SPACES.          CL*87
00706      05   W-X140-PEN-CNT           PIC  ZZ,ZZ9.                      CL108
00707      05  FILLER                   PIC  X(02)  VALUE SPACES.          CL*87
00708      05  FILLER                   PIC  X(40) VALUE                   CL*87
00709                       ' # OF REPORTS DUTAS CANNOT PROCESS '.         CL*87
00710      05  FILLER                   PIC  X(32)  VALUE SPACES.          CL*87
00711                                                                      CL*87
00712  01  FOOTING-LINE-9.                                                 CL*87
00713      05  FILLER                   PIC  X(24)  VALUE SPACES.          CL*87
00714      05  WS-X144-RED-CNT           PIC  ZZZ,ZZ9.                     CL*87
00715      05  FILLER                   PIC  X(02)  VALUE SPACES.          CL*87
00716      05  FILLER                   PIC  X(45) VALUE                   CL*87
00717                       'TOTAL WAGES RELEASED TO DUTAS    '.           CL*87
00718      05  FILLER                   PIC  X(32)  VALUE SPACES.          CL*87
00719  01  FOOTING-LINE-10.                                                CL*87
00720      05  FILLER                   PIC  X(24)  VALUE SPACES.          CL*87
00721      05  WS-X144-ERR-CNT           PIC  ZZZ,ZZ9.                     CL*87
00722      05  FILLER                   PIC  X(02)  VALUE SPACES.          CL*87
00723      05  FILLER                   PIC  X(34) VALUE                   CL*87
00724                       ' # OF WAGES   HAD ERRORS       '.             CL*87
00725      05  FILLER                   PIC  X(32)  VALUE SPACES.          CL*87
00726                                                                      CL*87
00727  01  FOOTING-LINE-11.                                                CL*87
00728      05  FILLER                   PIC  X(24)  VALUE SPACES.          CL*87
00729      05  WS-X144-PEN-CNT           PIC  ZZZ,ZZ9.                     CL*87
00730      05  FILLER                   PIC  X(02)  VALUE SPACES.          CL*87
00731      05  FILLER                   PIC  X(40) VALUE                   CL*87
00732                       ' # OF WAGES DUTAS CANNOT PROCESS  '.          CL*87
00733      05  FILLER                   PIC  X(32)  VALUE SPACES.          CL*87
00734  01  FOOTING-LINE-12.                                                CL*87
00735      05  FILLER                   PIC  X(19)  VALUE SPACES.          CL*87
00736      05  WS-TOT-REMIT             PIC  $$$$$$$$9.99.                 CL*87
00737      05  FILLER                   PIC  X(02)  VALUE SPACES.          CL*87
00738      05  FILLER                   PIC  X(45) VALUE                   CL*87
00739                       ' TOTAL PAYMENTS APPLIED TO DUTAS'.            CL*87
00740      05  FILLER                   PIC  X(32)  VALUE SPACES.          CL*87
00741                                                                      CL*87
00742  01  FOOTING-LINE-15.                                                CL*87
00743      05  FILLER                   PIC  X(19)  VALUE SPACES.          CL*87
00744      05  WS-TOT-CREDIT            PIC  $$$$$$$$9.99.                 CL*87
00745      05  FILLER                   PIC  X(02)  VALUE SPACES.          CL*87
00746      05  FILLER                   PIC  X(45) VALUE                   CL*87
00747                       ' TOTAL CREDITS  APPLIED TO DUTAS'.            CL*87
00748      05  FILLER                   PIC  X(32)  VALUE SPACES.          CL*87
00749  01  FOOTING-LINE-13.                                                CL*87
00750      05  FILLER                   PIC X(25)  VALUE SPACES.           CL*87
00751      05  FILLER                   PIC  X(67) VALUE                   CL*87
00752           '*** END ESSP/DUTAS REGISTRATION PROCESSING ***'.          CL105
00753  01  FOOTING-LINE-14              PIC  X(133) VALUE SPACES.          CL*87
00754                                                                      CL*87
00755                                                                   DTSBX421
00756  01  T002-REC.                                                    DTSBX421
00757  ++INCLUDE DTSIT002                                               DTSBX421
00758                                                                   DTSBX421
00759  01  Y104-REC.                                                    DTSBX421
00760  ++INCLUDE DTSIY104                                               DTSBX421
00761                                                                   DTSBX421
00762  01  Y106-REC.                                                    DTSBX421
00763  ++INCLUDE DTSIY106                                               DTSBX421
00764                                                                   DTSBX421
00765  01  Y108-REC.                                                    DTSBX421
00766  ++INCLUDE DTSIY108                                               DTSBX421
00767                                                                   DTSBX421
00768  01  Y130-REC.                                                    DTSBX421
00769  ++INCLUDE DTSIY130                                               DTSBX421
00770                                                                   DTSBX421
00771  01  T003-REC.                                                    DTSBX421
00772  ++INCLUDE DTSIT003                                               DTSBX421
00773                                                                   DTSBX421
00774  01  T027-REC.                                                    DTSBX421
00775  ++INCLUDE DTSIT027                                               DTSBX421
00776                                                                   DTSBX421
00777  01  W001-REC.                                                    DTSBX421
00778  ++INCLUDE DTSIW001                                               DTSBX421
00779                                                                   DTSBX421
00780 *  PROFILE                                                        DTSBX421
00781  01  X102-REC.                                                    DTSBX421
00782  ++INCLUDE DTSIX102                                               DTSBX421
00783                                                                   DTSBX421
00784 *  DETERMINATION                                                  DTSBX421
00785  01  X104-REC.                                                    DTSBX421
00786  ++INCLUDE DTSIX104                                               DTSBX421
00787                                                                   DTSBX421
00788 *  NAME                                                           DTSBX421
00789  01  X106-REC.                                                    DTSBX421
00790  ++INCLUDE DTSIX106                                               DTSBX421
00791                                                                   DTSBX421
00792 *  RATE                                                           DTSBX421
00793  01  X108-REC.                                                    DTSBX421
00794  ++INCLUDE DTSIX108                                               DTSBX421
00795                                                                   DTSBX421
00796 *  ADDRESS                                                        DTSBX421
00797  01  X110-REC.                                                    DTSBX421
00798  ++INCLUDE DTSIX110                                               DTSBX421
00799                                                                   DTSBX421
00800 *  OPO                                                            DTSBX421
00801  01  X120-REC.                                                    DTSBX421
00802  ++INCLUDE DTSIX120                                               DTSBX421
00803                                                                   DTSBX421
00804 *  RELATIONSHIP                                                   DTSBX421
00805  01  X130-REC.                                                    DTSBX421
00806  ++INCLUDE DTSIX130                                               DTSBX421
00807                                                                   DTSBX421
00808 *  INDUSTRY DESCRIPTION                                           DTSBX421
00809 *01  X132-REC.                                                    DTSBX421
00810 ***INCLUDE DTSIX132                                               DTSBX421
00811                                                                   DTSBX421
00812 *  REPORT                                                         DTSBX421
00813  01  X140-REC.                                                    DTSBX421
00814  ++INCLUDE DTSIX140                                               DTSBX421
00815                                                                   DTSBX421
00816                                                                   DTSBX421
00817                                                                   DTSBX421
00818 *  ERRORS                                                         DTSBX421
00819 *01  X907-REC.                                                    DTSBX421
00820 ***INCLUDE DTSIX907                                               DTSBX421
00821                                                                   DTSBX421
00822  01  L001-LINK-AREA.                                              DTSBX421
00823  ++INCLUDE DTSIL001                                               DTSBX421
00824                                                                   DTSBX421
00825  01  L003-LINK-AREA.                                              DTSBX421
00826  ++INCLUDE DTSIL003                                               DTSBX421
00827                                                                   DTSBX421
00828  01  L004-LINK-AREA.                                              DTSBX421
00829  ++INCLUDE DTSIL004                                               DTSBX421
00830                                                                   DTSBX421
00831  01  L009-LINK-AREA.                                                 CL*74
00832  ++INCLUDE DTSIL009                                                  CL*74
00833                                                                      CL*74
00834  01  L072-LINK-AREA.                                              DTSBX421
00835  ++INCLUDE DTSIL072                                               DTSBX421
00836                                                                   DTSBX421
00837  01  L052-LINK-AREA.                                              DTSBX421
00838  ++INCLUDE DTSIL052                                               DTSBX421
00839                                                                   DTSBX421
00840  01  L516-LINK-AREA.                                              DTSBX421
00841  ++INCLUDE DTSIL516                                               DTSBX421
00842                                                                   DTSBX421
00843  01  L600-LINK-AREA.                                              DTSBX421
00844  ++INCLUDE DTSIL600                                               DTSBX421
00845                                                                   DTSBX421
00846  01  L910-LINK-AREA.                                              DTSBX421
00847  ++INCLUDE DTSIL910                                               DTSBX421
00848  01  MSKL-REC.                                                    DTSBX421
00849  ++INCLUDE DTSIMSKL                                               DTSBX421
00850                                                                   DTSBX421
00851  01  MHDR-REC.                                                    DTSBX421
00852  ++INCLUDE DTSIMHDR                                               DTSBX421
00853                                                                   DTSBX421
00854  01  MPRF-REC.                                                    DTSBX421
00855  ++INCLUDE DTSIMPRF                                               DTSBX421
00856                                                                   DTSBX421
00857  01  MSOL-REC.                                                    DTSBX421
00858  ++INCLUDE DTSIMSOL                                               DTSBX421
00859                                                                   DTSBX421
00860  01  MQTR-REC.                                                    DTSBX421
00861  ++INCLUDE DTSIMQTR                                               DTSBX421
00862                                                                   DTSBX421
00863  01  MOPO-REC.                                                    DTSBX421
00864  ++INCLUDE DTSIMOPO                                               DTSBX421
00865                                                                   DTSBX421
00866  01  MTAD-REC.                                                    DTSBX421
00867  ++INCLUDE DTSIMTAD                                               DTSBX421
00868                                                                   DTSBX421
00869  01  MNTE-REC.                                                    DTSBX421
00870  ++INCLUDE DTSIMNTE                                               DTSBX421
00871                                                                   DTSBX421
00872  01  L921-LINK-AREA.                                              DTSBX421
00873  ++INCLUDE DTSIL921                                               DTSBX421
00874      SKIP3                                                        DTSBX421
00875  01  ISKL-REC.                                                    DTSBX421
00876  ++INCLUDE DTSIISKL                                               DTSBX421
00877      SKIP3                                                        DTSBX421
00878  01  IEIN-REC.                                                    DTSBX421
00879  ++INCLUDE DTSIIEIN                                               DTSBX421
00880                                                                   DTSBX421
00881  01  L927-LINK-AREA.                                              DTSBX421
00882  ++INCLUDE DTSIL927                                               DTSBX421
00883                                                                   DTSBX421
00884  01  L931-LINK-AREA.                                              DTSBX421
00885  ++INCLUDE DTSIL931                                               DTSBX421
00886                                                                   DTSBX421
00887  01  FSKL-REC.                                                    DTSBX421
00888  ++INCLUDE DTSIFSKL                                               DTSBX421
00889                                                                   DTSBX421
00890  01  R140-REC.                                                    DTSBX421
00891  ++INCLUDE DTSIR140                                               DTSBX421
00892                                                                   DTSBX421
00893  LINKAGE SECTION.                                                 DTSBX421
00894                                                                   DTSBX421
00895  01  LX42-LINK-AREA.                                              DTSBX421
00896  ++INCLUDE DTSILX42                                                  CL*50
00897                                                                   DTSBX421
00898  PROCEDURE DIVISION USING LX42-LINK-AREA.                            CL148
00899                                                                   DTSBX421
00900  DTSBX421-MAIN.                                                   DTSBX421
00901 *    DISPLAY 'LX42-LINK-AREA'  LX42-LINK-AREA                     DTSBX421
00902 ***                                                                  CL123
00903 *** SET RATE FOR NEW YEAR BEFORE RATE RUN                            CL123
00904 ***                                                                  CL123
00905      MOVE 2021               TO LX42-LAST-RATE-YEAR                  CL152
00906      MOVE 1.9000            TO W-RATE-X                              CL152
00907      MOVE LX42-ERROR-IND     TO W-ERROR-IND.                         CL*10
00908      MOVE LX42-CURR-RUN-DATE TO W-RUN-DATE.                          CL118
00909      DISPLAY 'RDATE ' W-RUN-DATE.                                    CL118
00910      MOVE Z-YY               TO W-YY.                                CL122
00911      MOVE Z-MM               TO W-MM.                                CL122
00912      MOVE Z-DD               TO W-DD.                                CL122
00913                                                                   DTSBX421
00914      IF W-ERROR-YES-88                                            DTSBX421
00915         DISPLAY 'BX421 LX42 EMP REC HAS ERROR ' LX42-EMP-NO          CL*13
00916           '  ' LX42-ERROR-IND '  ' W-ERROR-IND                    DTSBX421
00917      ELSE                                                         DTSBX421
00918         DISPLAY 'BX421 EMP REC HAS NO ERROR ' W-ERROR-IND            CL*13
00919      END-IF.                                                      DTSBX421
00920                                                                   DTSBX421
00921      EVALUATE TRUE                                                DTSBX421
00922         WHEN LX42-INITIALIZE-88                                   DTSBX421
00923            PERFORM I0000-INITIATE        THRU I0000-EXIT          DTSBX421
00924                                                                   DTSBX421
00925         WHEN LX42-NEW-EMPLOYER-88                                 DTSBX421
00926            PERFORM P3000-NEW-EMP         THRU P3000-EXIT          DTSBX421
00927                                                                   DTSBX421
00928         WHEN LX42-PROCESS-88                                      DTSBX421
00929            PERFORM P0000-PROCESS         THRU P0000-EXIT          DTSBX421
00930                                                                   DTSBX421
00931         WHEN LX42-TERMINATE-88                                    DTSBX421
00932            PERFORM P3000-NEW-EMP         THRU P3000-EXIT          DTSBX421
00933            PERFORM T0000-TERMINATE       THRU T0000-EXIT          DTSBX421
00934                                                                   DTSBX421
00935      END-EVALUATE.                                                DTSBX421
00936                                                                   DTSBX421
00937      IF LX42-PROCESS-88                                           DTSBX421
00938         MOVE W-ERROR-IND              TO LX42-ERROR-IND           DTSBX421
00939      END-IF.                                                      DTSBX421
00940                                                                   DTSBX421
00941  DTSBX421-MAIN-EXIT.                                              DTSBX421
00942      GOBACK.                                                      DTSBX421
00943                                                                   DTSBX421
00944  I0000-INITIATE.                                                  DTSBX421
00945 ***  SET W-ERROR-NO-88                 TO TRUE.                   DTSBX421
00946      SET W-FATAL-ERROR-NO-88           TO TRUE.                   DTSBX421
00947                                                                   DTSBX421
00948      MOVE LENGTH OF X102-REC           TO W-X102-LENGTH.          DTSBX421
00949      MOVE LENGTH OF X104-REC           TO W-X104-LENGTH.          DTSBX421
00950      MOVE LENGTH OF X106-REC           TO W-X106-LENGTH.          DTSBX421
00951      MOVE LENGTH OF X108-REC           TO W-X108-LENGTH.          DTSBX421
00952      MOVE LENGTH OF X130-REC           TO W-X130-LENGTH.          DTSBX421
00953                                                                   DTSBX421
00954 *RW1 FOR VARIABLE REPORT FILE.                                    DTSBX421
00955      MOVE LENGTH OF R140-REC           TO R140-LENGTH.            DTSBX421
00956      MOVE '140'                        TO R140-REC-TYPE.          DTSBX421
00957                                                                   DTSBX421
00958      PERFORM I2000-OPEN-FILES          THRU I2000-EXIT            DTSBX421
00959      IF W-FATAL-ERROR-YES-88                                      DTSBX421
00960         GO TO I0000-EXIT                                          DTSBX421
00961      END-IF.                                                      DTSBX421
00962                                                                   DTSBX421
00963  I0000-EXIT.                                                      DTSBX421
00964      EXIT.                                                        DTSBX421
00965                                                                   DTSBX421
00966  I2000-OPEN-FILES.                                                DTSBX421
00967      PERFORM S1040-OPEN-TEMP-BTC-OUT THRU S1040-EXIT.             DTSBX421
00968      IF W-FATAL-ERROR-YES-88                                      DTSBX421
00969         DISPLAY 'CANNOT OPEN TEMP BTC FILE '                      DTSBX421
00970            TEMP-BTC-STATUS                                        DTSBX421
00971         GO TO I2000-EXIT                                          DTSBX421
00972      END-IF.                                                      DTSBX421
00973      OPEN OUTPUT   REPT-PEND-FILE.                                   CL*87
00974      IF REPT-STATUS-OK-88                                            CL*87
00975         NEXT SENTENCE                                                CL*87
00976      ELSE                                                            CL*87
00977         DISPLAY 'X421-CANNOT OPEN REPORT PENDING FILE '              CL*92
00978            REPT-STATUS                                               CL*87
00979         PERFORM S999-ABEND THRU S999-EXIT                            CL*87
00980      END-IF.                                                         CL*87
00981                                                                      CL*87
00982      OPEN OUTPUT   REPT-PAID-FILE.                                   CL*87
00983      IF REPT-STATUS-OK-88                                            CL*87
00984         NEXT SENTENCE                                                CL*87
00985      ELSE                                                            CL*87
00986         DISPLAY 'X421-CANNOT OPEN REPORT PAID  FILE '                CL*92
00987            REPT-STATUS                                               CL*87
00988         PERFORM S999-ABEND THRU S999-EXIT                            CL*87
00989      END-IF.                                                         CL*87
00990      WRITE REPT-PAID-REC FROM HEADER-1 AFTER ADVANCING TOP-OF-PAGE   CL*99
00991      WRITE REPT-PAID-REC FROM HEADER-2 AFTER ADVANCING 1             CL*99
00992      WRITE REPT-PAID-REC FROM HEADER-3 AFTER ADVANCING 1             CL*99
00993      WRITE REPT-PAID-REC FROM HEADER-6 AFTER ADVANCING 1.            CL100
00994      WRITE REPT-PAID-REC FROM HEADER-43 AFTER ADVANCING 1.           CL113
00995      WRITE REPT-PAID-REC FROM HEADER-5 AFTER ADVANCING 1.            CL113
00996                                                                      CL*99
00997  I2000-EXIT.                                                      DTSBX421
00998      EXIT.                                                        DTSBX421
00999                                                                   DTSBX421
01000                                                                   DTSBX421
01001  P0000-PROCESS.                                                   DTSBX421
01002 *&                                                                DTSBX421
01003      DISPLAY SPACE.                                               DTSBX421
01004 *    DISPLAY 'BX421 P0000 ' W-EMP-NO '  ' LX42-REC-TYPE.          DTSBX421
01005 *&                                                                DTSBX421
01006      EVALUATE TRUE                                                DTSBX421
01007        WHEN LX42-REC-TYPE-PRF-88                                  DTSBX421
01008          PERFORM P1100-PROFILE            THRU P1100-EXIT         DTSBX421
01009                                                                   DTSBX421
01010        WHEN LX42-REC-TYPE-DETERM-88                               DTSBX421
01011          PERFORM P1200-DETERM             THRU P1200-EXIT         DTSBX421
01012                                                                   DTSBX421
01013        WHEN LX42-REC-TYPE-NAME-88                                 DTSBX421
01014          PERFORM P1300-NAME               THRU P1300-EXIT         DTSBX421
01015                                                                   DTSBX421
01016        WHEN LX42-REC-TYPE-RATE-88                                 DTSBX421
01017          PERFORM P1400-RATE               THRU P1400-EXIT         DTSBX421
01018                                                                   DTSBX421
01019 **     WHEN LX42-REC-TYPE-REL-88                                  DTSBX421
01020 **       PERFORM P1700-RELATION           THRU P1700-EXIT         DTSBX421
01021                                                                   DTSBX421
01022      END-EVALUATE.                                                DTSBX421
01023                                                                   DTSBX421
01024  P0000-EXIT.                                                      DTSBX421
01025      EXIT.                                                        DTSBX421
01026                                                                   DTSBX421
01027  P1100-PROFILE.                                                   DTSBX421
01028      SET W-EMP-IN-PROGRESS-YES-88      TO TRUE.                   DTSBX421
01029      MOVE LX42-DATA-AREA               TO X102-REC.               DTSBX421
01030 *&                                                                DTSBX421
01031      ADD +1        TO WS-X140-PEN-CNT                                CL107
01032      DISPLAY SPACE.                                               DTSBX421
01033      DISPLAY 'BX421- NEW EMPLOYER PROFILE ' X102-EMP-NO.             CL*13
01034      DISPLAY ' X102-KEY ' X102-EMP-NO.                               CL*18
01035      DISPLAY 'LX102-KEY ' LX42-X102-KEY-AREA.                        CL*14
01036 *&                                                                   CL*17
01037       IF LX42-REC-TYPE-PRF-88                                        CL*14
01038          IF LX42-X102-KEY-AREA = X102-EMP-NO                         CL*17
01039            ADD +1        TO W-X102-DUP-CNT                           CL*38
01040            DISPLAY 'X102  DUPLICATE PROFILE RECORD  ' W-EMP-NO       CL*19
01041              ' ERR IND ' W-ERROR-IND                                 CL*19
01042            MOVE '999999' TO LX42-X102-EMP-NO                         CL*14
01043            SET W-ERROR-YES-88    TO TRUE                             CL*14
01044            MOVE SPACES TO R140-MESSAGE                               CL*14
01045            MOVE W-EMP-NO TO R140-EMP-NO                              CL*14
01046            STRING                                                    CL*14
01047            'X102  DUPLICATE PROFILE RECORD ---- RECORDS SKIPED '     CL*14
01048              X102-EMP-CLASS                                          CL*14
01049              DELIMITED BY SIZE                                       CL*14
01050              INTO R140-MESSAGE                                       CL*14
01051            END-STRING                                                CL*14
01052            PERFORM S946-WRITE-R140 THRU S946-EXIT                    CL*14
01053            GO TO P1100-EXIT                                          CL*14
01054          ELSE                                                        CL*14
01055            MOVE X102-EMP-NO TO LX42-X102-KEY-AREA                    CL*17
01056          END-IF                                                      CL*14
01057       END-IF.                                                        CL*14
01058                                                                      CL*14
01059                                                                   DTSBX421
01060      MOVE X102-EMP-NO                  TO LX42-X102-EMP-NO.          CL**2
01061      DISPLAY ' PREV REC TYPE ' W-PREV-REC-TYPE.                      CL*11
01062      IF W-PREV-REC-NULL-88                                        DTSBX421
01063         SET W-PREV-REC-PRF-88          TO TRUE                    DTSBX421
01064         ADD +1                         TO W-X102-PRO-CNT             CL*38
01065         PERFORM P1110-EDIT-PROFILE     THRU P1110-EXIT            DTSBX421
01066         IF W-ERROR-NO-88                                          DTSBX421
01067         DISPLAY 'X102  PROFILE REC PASS EDITS  ' W-EMP-NO            CL*20
01068            PERFORM P1120-SAVE-PROFILE  THRU P1120-EXIT            DTSBX421
01069            ADD +1                     TO W-X102-SAV-CNT              CL*38
01070            MOVE SPACES   TO LX42-X102-EMP-NO                         CL*56
01071         ELSE                                                         CL**6
01072           MOVE '999999' TO LX42-X102-EMP-NO                          CL**6
01073            ADD +1        TO W-X102-ERR-CNT                           CL*38
01074 *         SET W-ERROR-YES-88    TO TRUE                              CL*20
01075 *         MOVE SPACES TO R140-MESSAGE                                CL*20
01076 *         MOVE W-EMP-NO TO R140-EMP-NO                               CL*20
01077 *         STRING                                                     CL*20
01078 *          'X102  PROFILE REC HAS ERRORS - ALL  RECORDS SKIPED '     CL*20
01079 *            X102-EMP-CLASS                                          CL*20
01080 *            DELIMITED BY SIZE                                       CL*20
01081 *            INTO R140-MESSAGE                                       CL*20
01082 *         END-STRING                                                 CL*20
01083 *         PERFORM S946-WRITE-R140 THRU S946-EXIT                     CL*20
01084         END-IF                                                    DTSBX421
01085      ELSE                                                         DTSBX421
01086         MOVE '999999' TO LX42-X102-EMP-NO                            CL**2
01087         SET W-ERROR-YES-88    TO TRUE                                CL**2
01088         MOVE SPACES TO R140-MESSAGE                                  CL**2
01089         MOVE W-EMP-NO TO R140-EMP-NO                                 CL**2
01090         STRING                                                       CL**2
01091            'X102  PROFILE REC HAS DUPLICATE --  RECORDS SKIPED '     CL*17
01092              X102-EMP-CLASS                                          CL**2
01093              DELIMITED BY SIZE                                       CL**2
01094              INTO R140-MESSAGE                                       CL**2
01095         END-STRING                                                   CL**2
01096         PERFORM S946-WRITE-R140 THRU S946-EXIT.                      CL**2
01097                                                                   DTSBX421
01098  P1100-EXIT.                                                      DTSBX421
01099      EXIT.                                                        DTSBX421
01100                                                                   DTSBX421
01101  P1110-EDIT-PROFILE.                                              DTSBX421
01102      PERFORM P1111-EDIT-DATA         THRU P1111-EXIT.             DTSBX421
01103      IF W-ERROR-NO-88                                             DTSBX421
01104         PERFORM P1112-CHECK-DATABASE THRU P1112-EXIT              DTSBX421
01105      END-IF.                                                      DTSBX421
01106                                                                   DTSBX421
01107  P1110-EXIT.                                                      DTSBX421
01108      EXIT.                                                        DTSBX421
01109                                                                   DTSBX421
01110  P1111-EDIT-DATA.                                                 DTSBX421
01111      DISPLAY 'FEIN: ' X102-EMP-FEIN                                  CL146
01112      IF X102-EMP-FEIN NOT NUMERIC                                    CL146
01113         SET W-ERROR-YES-88            TO TRUE                     DTSBX421
01114         MOVE X102-EMP-FEIN            TO MSG1-FEIN                DTSBX421
01115         MOVE MSG1-INVALID-FEIN        TO R140-MESSAGE             DTSBX421
01116         PERFORM S2000-WRITE-RPT       THRU S2000-EXIT             DTSBX421
01117      ELSE                                                         DTSBX421
01118 *       PERFORM P1199-EDIT-FEIN       THRU P1199-EXIT                CL141
01119 *       IF W-ERROR-YES-88                                            CL141
01120 *          MOVE X102-EMP-FEIN         TO MSG11-FEIN W-FEIN           CL141
01121 *          MOVE MSG11-INVALID-FEIN    TO R140-MESSAGE                CL141
01122 *          PERFORM S2000-WRITE-RPT    THRU S2000-EXIT                CL141
01123 *       ELSE                                                         CL141
01124            MOVE X102-EMP-FEIN            TO W-FEIN                   CL136
01125 *       END-IF                                                       CL141
01126      END-IF.                                                         CL136
01127                                                                   DTSBX421
01128      IF NOT X102-SOURCE-CD-VALID-88                               DTSBX421
01129         SET W-ERROR-YES-88            TO TRUE                     DTSBX421
01130         MOVE X102-SOURCE-CD           TO MSG2-SOURCE-CD           DTSBX421
01131         MOVE MSG2-SOURCE-CODE         TO R140-MESSAGE             DTSBX421
01132         PERFORM S2000-WRITE-RPT       THRU S2000-EXIT             DTSBX421
01133      END-IF.                                                      DTSBX421
01134                                                                   DTSBX421
01135      IF NOT X102-CLASS-CD-VALID-88                                DTSBX421
01136         SET W-ERROR-YES-88    TO TRUE                             DTSBX421
01137         MOVE SPACES TO R140-MESSAGE                               DTSBX421
01138         MOVE W-EMP-NO TO R140-EMP-NO                              DTSBX421
01139         STRING                                                    DTSBX421
01140            'X421  INVALID EMP CLASS CD ' X102-EMP-CLASS              CL**2
01141              DELIMITED BY SIZE                                    DTSBX421
01142              INTO R140-MESSAGE                                    DTSBX421
01143         END-STRING                                                DTSBX421
01144         PERFORM S946-WRITE-R140 THRU S946-EXIT                    DTSBX421
01145      END-IF.                                                      DTSBX421
01146                                                                   DTSBX421
01147      IF NOT X102-STATUS-CD-VALID-88                               DTSBX421
01148         SET W-ERROR-YES-88    TO TRUE                             DTSBX421
01149         MOVE SPACES TO R140-MESSAGE                               DTSBX421
01150         MOVE W-EMP-NO TO R140-EMP-NO                              DTSBX421
01151         STRING                                                    DTSBX421
01152            'X421  INVALID EMP STATUS CD ' X102-EMP-STATUS            CL**2
01153              DELIMITED BY SIZE                                    DTSBX421
01154              INTO R140-MESSAGE                                    DTSBX421
01155         END-STRING                                                DTSBX421
01156         PERFORM S946-WRITE-R140 THRU S946-EXIT                    DTSBX421
01157      END-IF.                                                      DTSBX421
01158                                                                   DTSBX421
01159      IF NOT X102-ACTION-CD-VALID-88                               DTSBX421
01160         SET W-ERROR-YES-88    TO TRUE                             DTSBX421
01161         MOVE SPACES TO R140-MESSAGE                               DTSBX421
01162         MOVE W-EMP-NO TO R140-EMP-NO                              DTSBX421
01163         STRING                                                    DTSBX421
01164            'X421  INVALID ACTION CD ' X102-ACTION-CD                 CL**2
01165              DELIMITED BY SIZE                                    DTSBX421
01166              INTO R140-MESSAGE                                    DTSBX421
01167         END-STRING                                                DTSBX421
01168         PERFORM S946-WRITE-R140 THRU S946-EXIT                    DTSBX421
01169      END-IF.                                                      DTSBX421
01170                                                                   DTSBX421
01171                                                                   DTSBX421
01172  P1111-EXIT.                                                      DTSBX421
01173      EXIT.                                                        DTSBX421
01174                                                                   DTSBX421
01175  P1112-CHECK-DATABASE.                                            DTSBX421
01176      MOVE LOW-VALUE               TO MPRF-KEY-AREA.               DTSBX421
01177      MOVE W-EMP-NO                TO MPRF-EMP-NO.                 DTSBX421
01178      SET MPRF-PRF-88              TO TRUE.                        DTSBX421
01179      MOVE MPRF-KEY-AREA           TO MSKL-KEY-AREA.               DTSBX421
01180                                                                   DTSBX421
01181      PERFORM S910-READ            THRU S910-EXIT.                 DTSBX421
01182      IF L910-NO-REC-88                                            DTSBX421
01183         NEXT SENTENCE                                             DTSBX421
01184      ELSE                                                         DTSBX421
01185         SET W-ERROR-YES-88        TO TRUE                         DTSBX421
01186         MOVE MSG3-EMP-ON-FILE     TO R140-MESSAGE                 DTSBX421
01187         PERFORM S2000-WRITE-RPT   THRU S2000-EXIT                 DTSBX421
01188         MOVE '999999'             TO LX42-X102-EMP-NO                CL112
01189         GO TO P1112-EXIT                                          DTSBX421
01190      END-IF.                                                      DTSBX421
01191                                                                   DTSBX421
01192 **   MOVE ZERO                    TO W-FEIN-EMP-NO.               DTSBX421
01193      SET W-DUP-FEIN-NO-88         TO TRUE.                        DTSBX421
01194                                                                   DTSBX421
01195      MOVE LOW-VALUE               TO IEIN-KEY-AREA                DTSBX421
01196      SET IEIN-EIN-88              TO TRUE                         DTSBX421
01197      MOVE W-FEIN                  TO IEIN-FEIN                    DTSBX421
01198      MOVE +0                      TO IEIN-EMP-NO                  DTSBX421
01199      MOVE IEIN-KEY-AREA           TO ISKL-KEY-AREA                DTSBX421
01200      PERFORM S921-START-BROWSE    THRU S921-EXIT                  DTSBX421
01201      MOVE ISKL-REC                TO IEIN-REC                     DTSBX421
01202      PERFORM                                                      DTSBX421
01203        UNTIL L921-NO-REC-88                                       DTSBX421
01204        OR W-DUP-FEIN-YES-88                                       DTSBX421
01205           IF IEIN-FEIN = W-FEIN                                   DTSBX421
01206              PERFORM P1112A-FIND-MPRF  THRU P1112A-EXIT           DTSBX421
01207              PERFORM S921-READ-NEXT    THRU S921-EXIT             DTSBX421
01208              MOVE ISKL-REC             TO IEIN-REC                DTSBX421
01209 **           IF W-FEIN-EMP-NO = ZERO                              DTSBX421
01210 *               PERFORM S921-READ-NEXT THRU S921-EXIT             DTSBX421
01211 *               MOVE ISKL-REC TO IEIN-REC                         DTSBX421
01212 **           END-IF                                               DTSBX421
01213           ELSE                                                    DTSBX421
01214              SET L921-NO-REC-88       TO TRUE                     DTSBX421
01215           END-IF                                                  DTSBX421
01216      END-PERFORM.                                                 DTSBX421
01217                                                                   DTSBX421
01218 *    IF W-DUP-FEIN-YES-88                                         DTSBX421
01219 *       DISPLAY 'BX421 DUP FEIN ' W-EMP-NO '  ' W-FEIN            DTSBX421
01220 *    ELSE                                                         DTSBX421
01221 *       DISPLAY 'BX421 FEIN OK  ' W-EMP-NO '  ' W-FEIN            DTSBX421
01222 *    END-IF.                                                      DTSBX421
01223  P1112-EXIT.                                                      DTSBX421
01224      EXIT.                                                        DTSBX421
01225                                                                   DTSBX421
01226  P1112A-FIND-MPRF.                                                DTSBX421
01227      MOVE LOW-VALUE             TO MSKL-KEY-AREA.                 DTSBX421
01228      MOVE IEIN-EMP-NO           TO MSKL-EMP-NO.                   DTSBX421
01229      SET MSKL-PRF-88            TO TRUE.                          DTSBX421
01230                                                                   DTSBX421
01231      PERFORM S910-READ          THRU S910-EXIT.                   DTSBX421
01232      IF L910-NO-REC-88                                            DTSBX421
01233          NEXT SENTENCE                                            DTSBX421
01234      ELSE                                                         DTSBX421
01235         MOVE MSKL-REC                    TO MPRF-REC              DTSBX421
01236 **      MOVE MPRF-EMP-NO                 TO W-FEIN-EMP-NO         DTSBX421
01237         IF MPRF-STATUS-ACT-88                                     DTSBX421
01238            SET W-ERROR-YES-88            TO TRUE                  DTSBX421
01239            SET W-DUP-FEIN-YES-88         TO TRUE                  DTSBX421
01240            MOVE W-FEIN                   TO MSG4-FEIN             DTSBX421
01241            MOVE MSG4-DUP-EMP             TO R140-MESSAGE          DTSBX421
01242            PERFORM S2000-WRITE-RPT       THRU S2000-EXIT          DTSBX421
01243            MOVE '999999'                 TO LX42-X102-EMP-NO         CL112
01244         END-IF                                                    DTSBX421
01245      END-IF.                                                      DTSBX421
01246                                                                   DTSBX421
01247  P1112A-EXIT.                                                     DTSBX421
01248      EXIT.                                                        DTSBX421
01249                                                                   DTSBX421
01250  P1120-SAVE-PROFILE.                                              DTSBX421
01251      MOVE X102-EMP-FEIN     TO W-FEIN X421-FEIN                      CL*90
01252      MOVE '17'              TO W-SOURCE-CD.                       DTSBX421
01253  P1120-EXIT.                                                      DTSBX421
01254      EXIT.                                                           CL136
01255  P1199-EDIT-FEIN.                                                    CL136
01256         MOVE X102-EMP-FEIN            TO WRK-FEIN                    CL136
01257         IF WRK-FEIN-VALID-88                                         CL136
01258            NEXT SENTENCE                                             CL136
01259         ELSE                                                         CL136
01260         SET W-ERROR-YES-88               TO TRUE                     CL136
01261      END-IF.                                                         CL136
01262  P1199-EXIT.                                                         CL136
01263      EXIT.                                                           CL136
01264                                                                   DTSBX421
01265  P1200-DETERM.                                                    DTSBX421
01266      SET W-EMP-IN-PROGRESS-YES-88      TO TRUE.                   DTSBX421
01267      MOVE LX42-DATA-AREA               TO X104-REC.               DTSBX421
01268      DISPLAY 'X104- DETERMINATION ' X104-EMP-NO.                     CL*80
01269                                                                      CL*21
01270      ADD +1        TO W-X104-RED-CNT.                                CL*38
01271       IF LX42-REC-TYPE-DETERM-88                                     CL*54
01272          IF LX42-X104-KEY-AREA = X104-EMP-NO                         CL*54
01273            ADD +1        TO W-X104-DUP-CNT                           CL*54
01274            DISPLAY 'X104  DUPLICATE PROFILE RECORD  ' W-EMP-NO       CL*54
01275              ' ERR IND ' W-ERROR-IND                                 CL*54
01276            MOVE '999999' TO LX42-X104-EMP-NO                         CL*54
01277            SET W-ERROR-YES-88    TO TRUE                             CL*54
01278            MOVE SPACES TO R140-MESSAGE                               CL*54
01279            MOVE W-EMP-NO TO R140-EMP-NO                              CL*54
01280            STRING                                                    CL*54
01281            'X104  DUPLICATE DETERM  RECORD ---- RECORDS SKIPED '     CL*54
01282              DELIMITED BY SIZE                                       CL*54
01283              INTO R140-MESSAGE                                       CL*54
01284            END-STRING                                                CL*54
01285            PERFORM S946-WRITE-R140 THRU S946-EXIT                    CL*54
01286            GO TO P1200-EXIT                                          CL*54
01287          ELSE                                                        CL*54
01288            MOVE X104-EMP-NO TO LX42-X104-KEY-AREA                    CL*54
01289          END-IF                                                      CL*54
01290       END-IF.                                                        CL*54
01291                                                                   DTSBX421
01292                                                                   DTSBX421
01293      MOVE X104-EMP-NO                  TO LX42-X104-EMP-NO           CL**3
01294      MOVE X104-EMP-NO                  TO W-EMP-NO.                  CL*49
01295                                                                      CL**4
01296 *    PERFORM P1112-CHECK-DATABASE THRU P1112-EXIT                    CL*54
01297 *     GO TO P1200-EXIT.                                              CL*54
01298                                                                      CL*49
01299      IF LX42-X102-EMP-NO = '999999' OR                               CL*54
01300         LX42-X102-EMP-NO = '888888' OR                               CL*58
01301         W-PREV-REC-NULL-88                                           CL*54
01302         SET W-ERROR-YES-88    TO TRUE                                CL*54
01303         MOVE SPACES TO R140-MESSAGE                                  CL*54
01304         ADD +1                         TO W-X104-ERR-CNT             CL*54
01305         MOVE W-EMP-NO TO R140-EMP-NO                                 CL*54
01306         STRING                                                       CL*54
01307            'X104 NO PROFILE OR PROFILE RECORD IN ERROR ' W-EMP-NO    CL*54
01308              DELIMITED BY SIZE                                       CL*54
01309              INTO R140-MESSAGE                                       CL*54
01310         END-STRING                                                   CL*54
01311         MOVE '999999'                     TO LX42-X104-EMP-NO        CL*54
01312         PERFORM S946-WRITE-R140 THRU S946-EXIT                       CL*54
01313         GO TO P1200-EXIT.                                            CL*54
01314                                                                      CL**2
01315      IF W-PREV-REC-PRF-88                                            CL*54
01316         SET W-PREV-REC-DETERM-88       TO TRUE                    DTSBX421
01317         ADD +1                         TO W-X104-PRO-CNT             CL*38
01318         PERFORM P1210-EDIT-DETERM      THRU P1210-EXIT            DTSBX421
01319         IF W-ERROR-NO-88                                          DTSBX421
01320           ADD +1        TO W-X104-SAV-CNT                            CL*44
01321            DISPLAY ' X104 -DETEMINATION REC PASS EDITS OK'           CL*30
01322            PERFORM P1230-RATE-YEARS    THRU P1230-EXIT            DTSBX421
01323            MOVE SPACES   TO LX42-X104-EMP-NO                         CL*56
01324         ELSE                                                         CL**2
01325            MOVE '999999'               TO LX42-X104-EMP-NO           CL**2
01326         END-IF                                                       CL*55
01327      ELSE                                                            CL*54
01328         SET W-ERROR-YES-88    TO TRUE                                CL*54
01329         MOVE SPACES TO R140-MESSAGE                                  CL*54
01330         MOVE W-EMP-NO TO R140-EMP-NO                                 CL*54
01331         ADD +1                         TO W-X104-DUP-CNT             CL*54
01332         STRING                                                       CL*54
01333            'X104  DUPLICATE DETERMINATION RECORD '                   CL*54
01334              W-PREV-REC-TYPE ' ' W-EMP-NO                            CL*54
01335              DELIMITED BY SIZE                                       CL*54
01336              INTO R140-MESSAGE                                       CL*54
01337         END-STRING                                                   CL*54
01338         PERFORM S946-WRITE-R140 THRU S946-EXIT                       CL*54
01339      END-IF.                                                         CL*54
01340                                                                   DTSBX421
01341                                                                   DTSBX421
01342  P1200-EXIT.                                                      DTSBX421
01343      EXIT.                                                        DTSBX421
01344                                                                   DTSBX421
01345  P1210-EDIT-DETERM.                                               DTSBX421
01346      IF NOT X104-LIAB-VALID-88                                    DTSBX421
01347         SET W-ERROR-YES-88            TO TRUE                     DTSBX421
01348         MOVE X104-LIAB-CD             TO MSG5-LIAB-CD             DTSBX421
01349         MOVE MSG5-INVALID-LIAB-CD     TO R140-MESSAGE             DTSBX421
01350         PERFORM S2000-WRITE-RPT       THRU S2000-EXIT             DTSBX421
01351      ELSE                                                            CL**2
01352         MOVE X104-LIAB-CD             TO LX42-X104-LIAB-CD           CL**2
01353      END-IF.                                                      DTSBX421
01354                                                                   DTSBX421
01355      IF X104-LIAB-NOT-LIABLE-88                                      CL*60
01356         SET W-ERROR-YES-88            TO TRUE                        CL*77
01357         MOVE X104-LIAB-CD             TO MSG5-LIAB-CD                CL*77
01358         MOVE MSG5-INVALID-LIAB-CD     TO R140-MESSAGE                CL*77
01359         PERFORM S2000-WRITE-RPT       THRU S2000-EXIT                CL*77
01360      END-IF.                                                         CL*82
01361                                                                      CL*82
01362 *    ELSE                                                            CL*82
01363 *       MOVE SPACES                TO LX42-X108-EMP-NO.              CL*82
01364      IF X104-LIAB-SELF-INS-88                                        CL*84
01365         MOVE SPACES TO LX42-X108-EMP-NO.                             CL*84
01366                                                                      CL*59
01367      IF NOT X104-ELIG-VALID-88                                    DTSBX421
01368         SET W-ERROR-YES-88            TO TRUE                     DTSBX421
01369         MOVE X104-ELIG-CD             TO MSG6-ELIG-CD             DTSBX421
01370         MOVE MSG6-INVALID-ELIG-CD     TO R140-MESSAGE             DTSBX421
01371         PERFORM S2000-WRITE-RPT       THRU S2000-EXIT             DTSBX421
01372      END-IF.                                                      DTSBX421
01373                                                                   DTSBX421
01374      IF X104-NAICS-CD NOT NUMERIC                                 DTSBX421
01375 ***     SET W-ERROR-YES-88    TO TRUE                             DTSBX421
01376 *       MOVE SPACES TO R140-MESSAGE                               DTSBX421
01377 *       MOVE W-EMP-NO TO R140-EMP-NO                              DTSBX421
01378 *       STRING                                                    DTSBX421
01379 *          'DETERM     NON-NUMERIC NAICS ' X104-NAICS-CD          DTSBX421
01380 *            DELIMITED BY SIZE                                    DTSBX421
01381 *            INTO R140-MESSAGE                                    DTSBX421
01382 *       END-STRING                                                DTSBX421
01383 *       DISPLAY R140-MESSAGE                                      DTSBX421
01384 ***     PERFORM S946-WRITE-R140 THRU S946-EXIT                    DTSBX421
01385         MOVE 999999           TO X104-NAICS-CD                    DTSBX421
01386      END-IF.                                                      DTSBX421
01387      IF NOT X104-ORG-TYPE-VALID-88                                DTSBX421
01388         IF X104-LIAB-NOT-LIABLE-88                                DTSBX421
01389            MOVE 'UNK'           TO X104-ORG-TYPE                  DTSBX421
01390         ELSE                                                      DTSBX421
01391            SET W-ERROR-YES-88            TO TRUE                  DTSBX421
01392            MOVE X104-ORG-TYPE            TO MSG7-ORG-TYPE         DTSBX421
01393            MOVE MSG7-INVALID-ORG-TYPE    TO R140-MESSAGE          DTSBX421
01394            PERFORM S2000-WRITE-RPT       THRU S2000-EXIT          DTSBX421
01395         END-IF                                                    DTSBX421
01396      END-IF.                                                      DTSBX421
01397 *    IF X104-ORG-CORPORATION-88                                      CL151
01398 *       DISPLAY 'X104 ORG: ' X104-ORG-TYPE                           CL151
01399 *       DISPLAY 'X104DATE: ' X104-INCORP-DATE                        CL151
01400 *       MOVE X104-INCORP-DATE    TO W-SLASH-DATE                     CL151
01401 *       MOVE W-SLASH-DT-MM       TO L001-FED-8-MO                    CL151
01402 *       MOVE W-SLASH-DT-DD       TO L001-FED-8-DA                    CL151
01403 *       MOVE W-SLASH-DT-CCYY     TO L001-FED-8-YR                    CL151
01404 *       PERFORM S001-FROM-FED-8  THRU S001-EXIT                      CL151
01405 *       IF NOT L001-VALID-DATE                                       CL151
01406 *          SET W-ERROR-YES-88            TO TRUE                     CL151
01407 *          MOVE X104-INCORP-DATE         TO MSG8-INCORP-DATE         CL151
01408 *          MOVE MSG8-INVALID-INCORP-DATE TO R140-MESSAGE             CL151
01409 *          PERFORM S2000-WRITE-RPT       THRU S2000-EXIT             CL151
01410 *       ELSE                                                         CL151
01411 *       DISPLAY 'X104FEDE: ' L001-FED-8-DATE-9                       CL151
01412 *          MOVE L001-FED-8-DATE-9    TO W-INCORP-DATE                CL151
01413 *       END-IF                                                       CL151
01414 *    END-IF.                                                         CL151
01415                                                                   DTSBX421
01416                                                                   DTSBX421
01417      EVALUATE TRUE                                                DTSBX421
01418        WHEN X104-ELIG-NOT-SUBJECT-88                              DTSBX421
01419           IF NOT X104-LIAB-NOT-LIABLE-88                          DTSBX421
01420              PERFORM P1211-INCONSIST-ELIG-LIAB  THRU P1211-EXIT   DTSBX421
01421           END-IF                                                  DTSBX421
01422                                                                   DTSBX421
01423        WHEN X104-ELIG-RATED-88                                    DTSBX421
01424           IF NOT X104-LIAB-RATED-88                               DTSBX421
01425              PERFORM P1211-INCONSIST-ELIG-LIAB  THRU P1211-EXIT   DTSBX421
01426           END-IF                                                  DTSBX421
01427                                                                   DTSBX421
01428        WHEN X104-ELIG-SELF-INS-88                                 DTSBX421
01429           IF NOT X104-LIAB-SELF-INS-88                            DTSBX421
01430              PERFORM P1211-INCONSIST-ELIG-LIAB  THRU P1211-EXIT   DTSBX421
01431           END-IF                                                  DTSBX421
01432                                                                   DTSBX421
01433        WHEN X104-ELIG-UCX-88                                      DTSBX421
01434          OR X104-ELIG-UCFE-88                                     DTSBX421
01435          OR X104-ELIG-INTERSTATE-88                               DTSBX421
01436          OR X104-ELIG-DC-GOV-88                                   DTSBX421
01437             IF NOT X104-LIAB-NOT-LIABLE-88                        DTSBX421
01438                PERFORM P1211-INCONSIST-ELIG-LIAB  THRU P1211-EXIT DTSBX421
01439             END-IF                                                DTSBX421
01440       END-EVALUATE.                                               DTSBX421
01441                                                                   DTSBX421
01442      IF X104-LIAB-NO-DETERM-88                                    DTSBX421
01443      OR X104-LIAB-NOT-LIABLE-88                                   DTSBX421
01444         MOVE SPACE   TO X104-HOUSEHOLD-FILING                     DTSBX421
01445      ELSE                                                         DTSBX421
01446         IF X104-ORG-HSEHLD-DMSTIC-88                              DTSBX421
01447            IF X104-HH-ANNUAL-88                                   DTSBX421
01448            OR X104-HH-QUARTERLY-88                                DTSBX421
01449               NEXT SENTENCE                                       DTSBX421
01450            ELSE                                                   DTSBX421
01451               SET W-ERROR-YES-88           TO TRUE                DTSBX421
01452             STRING                                                DTSBX421
01453             'X104 INVALID DOMESTIC FILING ' X104-HOUSEHOLD-FILING DTSBX421
01454             DELIMITED BY SIZE                                     DTSBX421
01455             INTO R140-MESSAGE                                     DTSBX421
01456             END-STRING                                            DTSBX421
01457             PERFORM S946-WRITE-R140 THRU S946-EXIT                DTSBX421
01458            END-IF                                                 DTSBX421
01459         ELSE                                                      DTSBX421
01460            MOVE SPACE   TO X104-HOUSEHOLD-FILING                  DTSBX421
01461         END-IF                                                    DTSBX421
01462      END-IF.                                                      DTSBX421
01463                                                                   DTSBX421
01464      IF X104-LIAB-RATED-88                                        DTSBX421
01465      OR X104-LIAB-SELF-INS-88                                     DTSBX421
01466         PERFORM P1212-WAGES-PAID        THRU P1212-EXIT           DTSBX421
01467      ELSE                                                         DTSBX421
01468         PERFORM P1213-NO-WAGES          THRU P1213-EXIT           DTSBX421
01469      END-IF.                                                      DTSBX421
01470                                                                   DTSBX421
01471      IF X104-ORG-HSEHLD-DMSTIC-88                                    CL141
01472         NEXT SENTENCE                                                CL141
01473      ELSE                                                            CL141
01474         PERFORM P1199-EDIT-FEIN       THRU P1199-EXIT                CL141
01475         IF W-ERROR-YES-88                                            CL141
01476             MOVE '999999'             TO LX42-X102-EMP-NO            CL141
01477             DISPLAY ' #### INVALID FEIN ... ' X102-EMP-FEIN          CL141
01478            MOVE X102-EMP-FEIN         TO MSG11-FEIN W-FEIN           CL141
01479            MOVE MSG11-INVALID-FEIN    TO R140-MESSAGE                CL141
01480            PERFORM S2000-WRITE-RPT    THRU S2000-EXIT.               CL141
01481                                                                      CL141
01482      IF X104-ORG-HSEHLD-DMSTIC-88                                 DTSBX421
01483      OR X104-LIAB-NO-DETERM-88                                    DTSBX421
01484      OR X104-LIAB-NOT-LIABLE-88                                   DTSBX421
01485         NEXT SENTENCE                                             DTSBX421
01486      ELSE                                                         DTSBX421
01487         PERFORM P1217-PRED-SUCC      THRU P1217-EXIT              DTSBX421
01488      END-IF.                                                      DTSBX421
01489                                                                   DTSBX421
01490  P1210-EXIT.                                                      DTSBX421
01491      EXIT.                                                        DTSBX421
01492                                                                   DTSBX421
01493  P1211-INCONSIST-ELIG-LIAB.                                       DTSBX421
01494      SET W-ERROR-YES-88               TO TRUE.                    DTSBX421
01495      MOVE X104-ELIG-CD                TO MSG10-ELIG-CD.           DTSBX421
01496      MOVE X104-LIAB-CD                TO MSG10-LIAB-CD.           DTSBX421
01497      MOVE MSG10-INCONSISTENT-LIAB-CD  TO R140-MESSAGE.            DTSBX421
01498      PERFORM S2000-WRITE-RPT          THRU S2000-EXIT.            DTSBX421
01499                                                                   DTSBX421
01500  P1211-EXIT.                                                      DTSBX421
01501      EXIT.                                                        DTSBX421
01502                                                                   DTSBX421
01503  P1212-WAGES-PAID.                                                DTSBX421
01504      IF X104-ORG-HSEHLD-DMSTIC-88                                 DTSBX421
01505         PERFORM P1212A-HOUSEHOLD  THRU P1212A-EXIT                DTSBX421
01506      ELSE                                                         DTSBX421
01507         PERFORM P1212B-REGULAR    THRU P1212B-EXIT                DTSBX421
01508      END-IF.                                                      DTSBX421
01509                                                                   DTSBX421
01510  P1212-EXIT.                                                      DTSBX421
01511      EXIT.                                                        DTSBX421
01512                                                                   DTSBX421
01513  P1212A-HOUSEHOLD.                                                DTSBX421
01514                                                                      CL*54
01515      IF X104-FIRST-500-QTR > SPACES                                  CL*54
01516         NEXT SENTENCE                                                CL*54
01517      ELSE                                                            CL*54
01518       GO TO P1212A-HOUSEHOLD-WAGES-PAID.                             CL*54
01519                                                                      CL*54
01520      MOVE X104-FIRST-500-QTR TO W-SLASH-QTR.                         CL*54
01521      MOVE W-SLASH-QTR-CCYY   TO L004-QTR-5-YR.                    DTSBX421
01522      MOVE W-SLASH-QTR-Q      TO L004-QTR-5-Q.                     DTSBX421
01523      PERFORM S004-FROM-5     THRU S004-EXIT.                      DTSBX421
01524      IF NOT L004-VALID-QTR                                        DTSBX421
01525         SET W-ERROR-YES-88  TO TRUE                               DTSBX421
01526         MOVE X104-FIRST-500-QTR          TO MSG11-QTR             DTSBX421
01527         MOVE MSG11-WAGES-PAID-QTR        TO R140-MESSAGE          DTSBX421
01528         PERFORM S2000-WRITE-RPT          THRU S2000-EXIT          DTSBX421
01529      ELSE                                                         DTSBX421
01530         MOVE L004-QTR-START-DATE  TO W-LIABLE-DATE                DTSBX421
01531         MOVE L004-QTR-5-9         TO W-FIRST-500-QTR              DTSBX421
01532         GO TO P1212A-EXIT                                            CL*54
01533      END-IF.                                                      DTSBX421
01534                                                                   DTSBX421
01535  P1212A-HOUSEHOLD-WAGES-PAID.                                        CL*54
01536      MOVE X104-FIRST-WAGE-DT  TO W-SLASH-DATE                        CL*54
01537      MOVE W-SLASH-DT-MM       TO L001-FED-8-MO                       CL*54
01538      MOVE W-SLASH-DT-DD       TO L001-FED-8-DA                       CL*54
01539      MOVE W-SLASH-DT-CCYY     TO L001-FED-8-YR                       CL*54
01540      PERFORM S001-FROM-FED-8  THRU S001-EXIT                         CL*54
01541      IF NOT L001-VALID-DATE                                          CL*54
01542         SET W-ERROR-YES-88  TO TRUE                                  CL*54
01543         MOVE X104-FIRST-WAGE-DT          TO MSG12-DATE               CL*54
01544         MOVE MSG12-FIRST-WAGE-DATE       TO R140-MESSAGE             CL*54
01545         PERFORM S2000-WRITE-RPT          THRU S2000-EXIT             CL*54
01546      ELSE                                                            CL*54
01547         MOVE L001-FED-8-DATE-9    TO W-LIABLE-DATE                   CL*54
01548         MOVE ZEROS                TO W-FIRST-500-QTR                 CL*54
01549      END-IF.                                                         CL*54
01550                                                                      CL*54
01551  P1212A-EXIT.                                                     DTSBX421
01552      EXIT.                                                        DTSBX421
01553                                                                   DTSBX421
01554  P1212B-REGULAR.                                                  DTSBX421
01555      MOVE X104-FIRST-WAGE-DT  TO W-SLASH-DATE                     DTSBX421
01556      MOVE W-SLASH-DT-MM       TO L001-FED-8-MO                    DTSBX421
01557      MOVE W-SLASH-DT-DD       TO L001-FED-8-DA                    DTSBX421
01558      MOVE W-SLASH-DT-CCYY     TO L001-FED-8-YR                    DTSBX421
01559      PERFORM S001-FROM-FED-8  THRU S001-EXIT                      DTSBX421
01560      IF NOT L001-VALID-DATE                                       DTSBX421
01561         SET W-ERROR-YES-88  TO TRUE                               DTSBX421
01562         MOVE X104-FIRST-WAGE-DT          TO MSG12-DATE            DTSBX421
01563         MOVE MSG12-FIRST-WAGE-DATE       TO R140-MESSAGE          DTSBX421
01564         PERFORM S2000-WRITE-RPT          THRU S2000-EXIT          DTSBX421
01565      ELSE                                                         DTSBX421
01566         MOVE L001-FED-8-DATE-9    TO W-LIABLE-DATE                DTSBX421
01567      END-IF.                                                      DTSBX421
01568                                                                   DTSBX421
01569  P1212B-EXIT.                                                     DTSBX421
01570      EXIT.                                                        DTSBX421
01571                                                                   DTSBX421
01572  P1213-NO-WAGES.                                                  DTSBX421
01573      MOVE SPACES     TO X104-FIRST-500-QTR                        DTSBX421
01574                         X104-FIRST-WAGE-DT.                       DTSBX421
01575                                                                   DTSBX421
01576 ***  IF X104-FIRST-500-QTR > SPACES                               DTSBX421
01577 *    OR X104-FIRST-WAGE-DT > SPACES                               DTSBX421
01578 *       SET W-ERROR-YES-88  TO TRUE                               DTSBX421
01579 *    MOVE SPACES TO R140-MESSAGE                                  DTSBX421
01580 *    MOVE W-EMP-NO TO R140-EMP-NO                                 DTSBX421
01581 *    STRING                                                       DTSBX421
01582 *       'DETERM     WAGE DATES NOT NULL '                         DTSBX421
01583 *        X104-FIRST-WAGE-DT '  ' X104-FIRST-500-QTR               DTSBX421
01584 *        DELIMITED BY SIZE                                        DTSBX421
01585 *        INTO R140-MESSAGE                                        DTSBX421
01586 *    END-STRING                                                   DTSBX421
01587 *    DISPLAY R140-MESSAGE                                         DTSBX421
01588 *    PERFORM S946-WRITE-R140 THRU S946-EXIT                       DTSBX421
01589 ***  END-IF.                                                      DTSBX421
01590                                                                   DTSBX421
01591  P1213-EXIT.                                                      DTSBX421
01592      EXIT.                                                        DTSBX421
01593                                                                   DTSBX421
01594  P1217-PRED-SUCC.                                                 DTSBX421
01595      IF X104-ACQUIRE-IND = SPACES                                 DTSBX421
01596         SET X104-ACQUIRE-NO-88  TO TRUE                           DTSBX421
01597      ELSE                                                         DTSBX421
01598         IF (X104-ACQUIRE-IND NOT = 'Y' AND 'N')                   DTSBX421
01599            SET W-ERROR-YES-88    TO TRUE                          DTSBX421
01600            MOVE SPACES TO R140-MESSAGE                            DTSBX421
01601            MOVE W-EMP-NO TO R140-EMP-NO                           DTSBX421
01602            STRING                                                 DTSBX421
01603               'X421       INVALID ACQUIRE IND '                      CL**2
01604                X104-ACQUIRE-IND                                   DTSBX421
01605                DELIMITED BY SIZE                                  DTSBX421
01606                INTO R140-MESSAGE                                  DTSBX421
01607            END-STRING                                             DTSBX421
01608 **         DISPLAY R140-MESSAGE                                   DTSBX421
01609            PERFORM S946-WRITE-R140 THRU S946-EXIT                 DTSBX421
01610         END-IF                                                    DTSBX421
01611      END-IF.                                                      DTSBX421
01612                                                                   DTSBX421
01613      IF X104-MERGER-SPLIT-IND = SPACES                            DTSBX421
01614         SET X104-MERGE-SPLIT-NO-88  TO TRUE                       DTSBX421
01615      ELSE                                                         DTSBX421
01616         IF (X104-MERGER-SPLIT-IND NOT = 'Y' AND 'N')              DTSBX421
01617            SET W-ERROR-YES-88    TO TRUE                          DTSBX421
01618            MOVE SPACES TO R140-MESSAGE                            DTSBX421
01619            MOVE W-EMP-NO TO R140-EMP-NO                           DTSBX421
01620            STRING                                                 DTSBX421
01621               'X421       INVALID MERGER-SPLIT IND '                 CL**2
01622                X104-MERGER-SPLIT-IND                              DTSBX421
01623                DELIMITED BY SIZE                                  DTSBX421
01624                INTO R140-MESSAGE                                  DTSBX421
01625            END-STRING                                             DTSBX421
01626 **         DISPLAY R140-MESSAGE                                   DTSBX421
01627            PERFORM S946-WRITE-R140 THRU S946-EXIT                 DTSBX421
01628         END-IF                                                    DTSBX421
01629      END-IF.                                                      DTSBX421
01630                                                                   DTSBX421
01631      IF X104-REORG-IND = SPACES                                   DTSBX421
01632         SET X104-REORG-NO-88  TO TRUE                             DTSBX421
01633      ELSE                                                         DTSBX421
01634         IF (X104-REORG-IND NOT = 'Y' AND 'N')                     DTSBX421
01635            SET W-ERROR-YES-88    TO TRUE                          DTSBX421
01636            MOVE SPACES TO R140-MESSAGE                            DTSBX421
01637            MOVE W-EMP-NO TO R140-EMP-NO                           DTSBX421
01638            STRING                                                 DTSBX421
01639               'X421       INVALID REORG IND '                        CL**2
01640                X104-REORG-IND                                     DTSBX421
01641                DELIMITED BY SIZE                                  DTSBX421
01642                INTO R140-MESSAGE                                  DTSBX421
01643            END-STRING                                             DTSBX421
01644 **         DISPLAY R140-MESSAGE                                   DTSBX421
01645            PERFORM S946-WRITE-R140 THRU S946-EXIT                 DTSBX421
01646         END-IF                                                    DTSBX421
01647      END-IF.                                                      DTSBX421
01648                                                                   DTSBX421
01649      IF X104-COMMON-OWN-IND = SPACES                              DTSBX421
01650         SET X104-COMMON-OWN-NO-88  TO TRUE                        DTSBX421
01651      ELSE                                                         DTSBX421
01652         IF (X104-COMMON-OWN-IND NOT = 'Y' AND 'N')                DTSBX421
01653            MOVE SPACES TO R140-MESSAGE                            DTSBX421
01654            MOVE W-EMP-NO TO R140-EMP-NO                           DTSBX421
01655            STRING                                                 DTSBX421
01656               'X421       INVALID COMMON OWN IND '                   CL**2
01657                X104-COMMON-OWN-IND                                DTSBX421
01658                DELIMITED BY SIZE                                  DTSBX421
01659                INTO R140-MESSAGE                                  DTSBX421
01660            END-STRING                                             DTSBX421
01661 **         DISPLAY R140-MESSAGE                                   DTSBX421
01662            PERFORM S946-WRITE-R140 THRU S946-EXIT                 DTSBX421
01663            SET W-ERROR-YES-88    TO TRUE                          DTSBX421
01664         END-IF                                                    DTSBX421
01665      END-IF.                                                      DTSBX421
01666                                                                   DTSBX421
01667      IF X104-SALE-TRANSFER-IND = SPACES                           DTSBX421
01668         SET X104-SALE-TRANSFER-NO-88  TO TRUE                     DTSBX421
01669      ELSE                                                         DTSBX421
01670         IF (X104-SALE-TRANSFER-IND NOT = 'Y' AND 'N')             DTSBX421
01671            SET W-ERROR-YES-88    TO TRUE                          DTSBX421
01672            MOVE SPACES TO R140-MESSAGE                            DTSBX421
01673            MOVE W-EMP-NO TO R140-EMP-NO                           DTSBX421
01674            STRING                                                 DTSBX421
01675               'X421       INVALID SALE-TRANS IND '                   CL**2
01676                X104-SALE-TRANSFER-IND                             DTSBX421
01677                DELIMITED BY SIZE                                  DTSBX421
01678                INTO R140-MESSAGE                                  DTSBX421
01679            END-STRING                                             DTSBX421
01680 **         DISPLAY R140-MESSAGE                                   DTSBX421
01681            PERFORM S946-WRITE-R140 THRU S946-EXIT                 DTSBX421
01682         END-IF                                                    DTSBX421
01683      END-IF.                                                      DTSBX421
01684                                                                   DTSBX421
01685  P1217-EXIT.                                                      DTSBX421
01686      EXIT.                                                        DTSBX421
01687                                                                   DTSBX421
01688  P1230-RATE-YEARS.                                                DTSBX421
01689      IF W-LIABLE-DATE > ZERO                                      DTSBX421
01690         MOVE W-LIABLE-DATE         TO L001-FED-8-DATE-9           DTSBX421
01691         PERFORM                                                   DTSBX421
01692           VARYING SUB FROM +1 BY +1                               DTSBX421
01693           UNTIL L001-FED-8-YR > LX42-LAST-RATE-YEAR               DTSBX421
01694              MOVE L001-FED-8-YR    TO W-RATE-YEAR (SUB)           DTSBX421
01695              ADD 1                 TO L001-FED-8-YR               DTSBX421
01696         END-PERFORM                                               DTSBX421
01697      END-IF.                                                      DTSBX421
01698                                                                   DTSBX421
01699  P1230-EXIT.                                                      DTSBX421
01700      EXIT.                                                        DTSBX421
01701                                                                   DTSBX421
01702  P1300-NAME.                                                      DTSBX421
01703      SET W-EMP-IN-PROGRESS-YES-88      TO TRUE.                   DTSBX421
01704      MOVE LX42-DATA-AREA               TO X106-REC.               DTSBX421
01705                                                                   DTSBX421
01706      ADD +1        TO W-X106-RED-CNT.                                CL*38
01707      DISPLAY 'X106- EMPLOYER NAME    ' W-EMP-NO.                     CL*23
01708                                                                      CL*23
01709 *     IF LX42-REC-TYPE-NAME-88                                       CL*28
01710 *        IF LX42-X106-KEY-AREA = X106-EMP-NO                         CL*28
01711 *          ADD +1        TO W-X106-DUP-CNT                           CL*38
01712 *          DISPLAY 'X106  DUPLICATE EMP NAME RECORD  ' W-EMP-NO      CL*28
01713 *            ' ERR IND ' W-ERROR-IND                                 CL*28
01714 *          MOVE '999999' TO LX42-X106-EMP-NO                         CL*28
01715 *          SET W-ERROR-YES-88    TO TRUE                             CL*28
01716 *          MOVE SPACES TO R140-MESSAGE                               CL*28
01717 *          MOVE W-EMP-NO TO R140-EMP-NO                              CL*28
01718 *          STRING                                                    CL*28
01719 *          'X106  DUPLICATE EMPLOYER NAME  ---- RECORDS SKIPED '     CL*28
01720 *            DELIMITED BY SIZE                                       CL*28
01721 *            INTO R140-MESSAGE                                       CL*28
01722 *          END-STRING                                                CL*28
01723 *          PERFORM S946-WRITE-R140 THRU S946-EXIT                    CL*28
01724 *          GO TO P1300-EXIT                                          CL*28
01725 *        ELSE                                                        CL*28
01726 *          MOVE X106-EMP-NO TO LX42-X106-KEY-AREA                    CL*28
01727 *        END-IF                                                      CL*28
01728 *     END-IF.                                                        CL*28
01729                                                                   DTSBX421
01730      MOVE X106-EMP-NO                  TO LX42-X106-EMP-NO           CL**2
01731                                                                      CL**4
01732      IF LX42-X102-EMP-NO = '999999' OR                               CL**4
01733         LX42-X102-EMP-NO = '888888' OR                               CL*58
01734         LX42-X104-EMP-NO = '999999' OR                               CL*58
01735         LX42-X104-EMP-NO = '888888'                                  CL*58
01736         SET W-ERROR-YES-88    TO TRUE                                CL**4
01737         MOVE SPACES TO R140-MESSAGE                                  CL**4
01738         MOVE W-EMP-NO TO R140-EMP-NO                                 CL**4
01739         ADD +1        TO W-X106-ERR-CNT                              CL*38
01740         STRING                                                       CL**4
01741          'X106-  PROFILE OR DETERMINATION IN ERROR -'                CL*23
01742              W-EMP-NO                                                CL**4
01743              DELIMITED BY SIZE                                       CL**4
01744              INTO R140-MESSAGE                                       CL**4
01745         END-STRING                                                   CL**4
01746         MOVE '999999'                     TO LX42-X106-EMP-NO        CL**4
01747         PERFORM S946-WRITE-R140 THRU S946-EXIT                       CL**4
01748         GO TO P1300-EXIT.                                            CL**4
01749                                                                      CL**4
01750      IF W-PREV-REC-DETERM-88                                         CL**2
01751      OR W-PREV-REC-PRF-88                                            CL*33
01752      OR W-PREV-REC-NAME-88                                        DTSBX421
01753         SET W-PREV-REC-NAME-88         TO TRUE                    DTSBX421
01754         ADD +1                         TO W-X106-PRO-CNT             CL*38
01755         PERFORM P1310-EDIT-NAME        THRU P1310-EXIT            DTSBX421
01756         IF W-ERROR-NO-88                                          DTSBX421
01757            DISPLAY 'X106- EMPLOYER NAME PASS EDITS OK'               CL*30
01758            PERFORM P1320-SAVE-NAME     THRU P1320-EXIT            DTSBX421
01759            ADD +1                      TO W-X106-SAV-CNT             CL*38
01760            MOVE SPACES   TO LX42-X106-EMP-NO                         CL*56
01761         ELSE                                                         CL**2
01762           MOVE '999999'                TO LX42-X106-EMP-NO           CL**2
01763         END-IF                                                    DTSBX421
01764      ELSE                                                         DTSBX421
01765         SET W-ERROR-YES-88  TO TRUE                               DTSBX421
01766         MOVE SPACES TO R140-MESSAGE                               DTSBX421
01767         MOVE W-EMP-NO TO R140-EMP-NO                              DTSBX421
01768         ADD +1                      TO W-X106-ERR-CNT                CL*38
01769         STRING                                                    DTSBX421
01770            'X106 - NAME RECORD NOT IN SYNC - DUP REC '            DTSBX421
01771             DELIMITED BY SIZE                                     DTSBX421
01772             INTO R140-MESSAGE                                     DTSBX421
01773         END-STRING                                                DTSBX421
01774         PERFORM S946-WRITE-R140 THRU S946-EXIT                    DTSBX421
01775      END-IF.                                                      DTSBX421
01776                                                                   DTSBX421
01777  P1300-EXIT.                                                      DTSBX421
01778      EXIT.                                                        DTSBX421
01779                                                                   DTSBX421
01780  P1310-EDIT-NAME.                                                 DTSBX421
01781         IF X106-NAME-TYPE-TRADE-88 AND                               CL133
01782            X106-EMP-NAME = SPACES                                    CL133
01783         SET W-ERROR-YES-88  TO TRUE                               DTSBX421
01784         MOVE SPACES TO R140-MESSAGE                               DTSBX421
01785         MOVE W-EMP-NO TO R140-EMP-NO                              DTSBX421
01786         STRING                                                    DTSBX421
01787            'X106 - EMPLOYER NAME IS BLANK - ERROR '                  CL133
01788             DELIMITED BY SIZE                                     DTSBX421
01789             INTO R140-MESSAGE                                     DTSBX421
01790         END-STRING                                                DTSBX421
01791         DISPLAY R140-MESSAGE                                         CL133
01792         PERFORM S946-WRITE-R140 THRU S946-EXIT                    DTSBX421
01793      END-IF.                                                      DTSBX421
01794                                                                   DTSBX421
01795  P1310-EXIT.                                                      DTSBX421
01796      EXIT.                                                        DTSBX421
01797                                                                   DTSBX421
01798  P1320-SAVE-NAME.                                                 DTSBX421
01799      IF X106-NAME-TYPE-ENTITY-88                                  DTSBX421
01800         MOVE X106-EMP-NAME   TO W-ENTITY-NAME                     DTSBX421
01801      ELSE                                                         DTSBX421
01802         IF X106-NAME-TYPE-TRADE-88                                DTSBX421
01803            IF W-TRADE-NAME = SPACES                               DTSBX421
01804               MOVE X106-EMP-NAME   TO W-TRADE-NAME                DTSBX421
01805            ELSE                                                   DTSBX421
01806               PERFORM P1321-ALT-NAME   THRU P1321-EXIT            DTSBX421
01807            END-IF                                                 DTSBX421
01808         END-IF                                                    DTSBX421
01809      END-IF.                                                      DTSBX421
01810                                                                   DTSBX421
01811  P1320-EXIT.                                                      DTSBX421
01812      EXIT.                                                        DTSBX421
01813                                                                   DTSBX421
01814  P1321-ALT-NAME.                                                  DTSBX421
01815      DISPLAY 'P1321-ALT-NAME'                                        CL*24
01816      MOVE LOW-VALUES                TO T002-REC.                  DTSBX421
01817                                                                   DTSBX421
01818      SET T002-LENGTH-EMP-NAME-88    TO TRUE.                      DTSBX421
01819      MOVE '002'                     TO T002-REC-TYPE.             DTSBX421
01820      MOVE X106-EMP-NO               TO T002-EMP-NO.               DTSBX421
01821      MOVE 'WEB REG   '              TO T002-ORIGIN.               DTSBX421
01822      MOVE LX42-SYS-DATE             TO T002-SYS-DATE.             DTSBX421
01823      MOVE LX42-SYS-TIME             TO T002-SYS-TIME.             DTSBX421
01824                                                                   DTSBX421
01825                                                                   DTSBX421
01826      MOVE X106-NAME-TYPE            TO Y106-EMP-NAME-TYPE.        DTSBX421
01827                                                                      CL*74
01828      IF  X106-EMP-NAME > SPACES                                      CL*74
01829         MOVE X106-EMP-NAME     TO L009-DATA                          CL*74
01830         PERFORM S009-CONVERT-TO-CAPS THRU S009-EXIT                  CL*74
01831         MOVE L009-DATA        TO Y106-EMP-NAME                       CL*74
01832      ELSE                                                            CL*74
01833        MOVE X106-EMP-NAME             TO Y106-EMP-NAME.              CL*74
01834                                                                   DTSBX421
01835      MOVE Y106-REC                  TO T002-DATA-AREA.            DTSBX421
01836      SET T002-EMP-NAME-88           TO TRUE.                      DTSBX421
01837      PERFORM S1030-WRITE-TEMP-T002  THRU S1030-EXIT.              DTSBX421
01838                                                                   DTSBX421
01839      ADD +1 TO W-T002-NAME-CNT.                                      CL*26
01840  P1321-EXIT.                                                      DTSBX421
01841      EXIT.                                                        DTSBX421
01842                                                                   DTSBX421
01843  P1400-RATE.                                                      DTSBX421
01844      SET W-EMP-IN-PROGRESS-YES-88      TO TRUE.                   DTSBX421
01845      MOVE LX42-DATA-AREA               TO X108-REC.               DTSBX421
01846 *&                                                                DTSBX421
01847      DISPLAY 'BX421- RATE ' W-EMP-NO '  ' X108-RATE-YEAR             CL*35
01848          '  ' X108-RATE.                                          DTSBX421
01849                                                                      CL**4
01850       ADD +1        TO W-X108-RED-CNT.                               CL*38
01851                                                                      CL*24
01852 *     IF LX42-REC-TYPE-RATE-88                                       CL*33
01853 *        IF LX42-X108-KEY-AREA = X108-EMP-NO                         CL*33
01854 *          ADD +1        TO W-X108-DUP                               CL*33
01855 *          DISPLAY 'X108  DUPLICATE EMP RATE RECORD  ' W-EMP-NO      CL*33
01856 *            ' ERR IND ' W-ERROR-IND                                 CL*33
01857 *          MOVE SPACES TO R140-MESSAGE                               CL*33
01858 *          MOVE W-EMP-NO TO R140-EMP-NO                              CL*33
01859 *          STRING                                                    CL*33
01860 *          'X108  DUPLICATE RATE RECORD - REVIEW FOR ERRORS    '     CL*33
01861 *            DELIMITED BY SIZE                                       CL*33
01862 *            INTO R140-MESSAGE                                       CL*33
01863 *          END-STRING                                                CL*33
01864 *          PERFORM S946-WRITE-R140 THRU S946-EXIT                    CL*33
01865 *          GO TO P1400-EXIT                                          CL*33
01866 *        ELSE                                                        CL*33
01867 *          MOVE X108-EMP-NO TO LX42-X108-KEY-AREA                    CL*33
01868 *        END-IF                                                      CL*33
01869 *     END-IF.                                                        CL*33
01870                                                                      CL*24
01871      MOVE X108-EMP-NO                  TO LX42-X108-EMP-NO           CL**4
01872                                                                      CL**4
01873      IF LX42-X102-EMP-NO = '999999' OR                               CL**4
01874         LX42-X102-EMP-NO = '888888' OR                               CL*58
01875         LX42-X104-EMP-NO = '999999' OR                               CL*34
01876         LX42-X104-EMP-NO = '888888' OR                               CL*58
01877         LX42-X106-EMP-NO = '999999' OR                               CL*58
01878         LX42-X106-EMP-NO = '888888'                                  CL*58
01879         SET W-ERROR-YES-88    TO TRUE                                CL**4
01880         ADD +1        TO W-X108-ERR-CNT                              CL*38
01881         MOVE SPACES TO R140-MESSAGE                                  CL**4
01882         MOVE W-EMP-NO TO R140-EMP-NO                                 CL**4
01883         STRING                                                       CL**4
01884          'X108-  PROFILE / DETERMINATION OR NAME REC IN ERROR  '     CL*34
01885              DELIMITED BY SIZE                                       CL**4
01886              INTO R140-MESSAGE                                       CL**4
01887         END-STRING                                                   CL**4
01888         MOVE '999999'                     TO LX42-X108-EMP-NO        CL**4
01889         PERFORM S946-WRITE-R140 THRU S946-EXIT                       CL**4
01890         GO TO P1400-EXIT.                                            CL**4
01891                                                                      CL**4
01892      IF X104-LIAB-SELF-INS-88                                        CL*84
01893         MOVE SPACES TO R140-MESSAGE                                  CL*84
01894         MOVE W-EMP-NO TO R140-EMP-NO                                 CL*84
01895         STRING                                                       CL*84
01896          'X108-  SELF INSURED - RATE RECORD FOUND              '     CL*84
01897              DELIMITED BY SIZE                                       CL*84
01898              INTO R140-MESSAGE                                       CL*84
01899         END-STRING                                                   CL*84
01900         MOVE '999999'                     TO LX42-X108-EMP-NO        CL*84
01901         PERFORM S946-WRITE-R140 THRU S946-EXIT                       CL*84
01902         GO TO P1400-EXIT.                                            CL*84
01903                                                                   DTSBX421
01904      IF W-PREV-REC-DETERM-88                                      DTSBX421
01905      OR W-PREV-REC-NAME-88                                           CL*24
01906      OR W-PREV-REC-RATE-88                                           CL*24
01907         SET W-PREV-REC-RATE-88         TO TRUE                    DTSBX421
01908         ADD +1                         TO W-X108-PRO-CNT             CL*38
01909         PERFORM P1410-EDIT-RATE        THRU P1410-EXIT            DTSBX421
01910         IF W-ERROR-NO-88                                          DTSBX421
01911            IF W-DUP-RATE-NO-88                                    DTSBX421
01912               DISPLAY 'X108- RATE PASS EDITS OK'                     CL*30
01913               PERFORM P1420-SAVE-RATE     THRU P1420-EXIT         DTSBX421
01914               ADD +1        TO W-X108-SAV-CNT                        CL*38
01915            MOVE SPACES   TO LX42-X108-EMP-NO                         CL*56
01916            ELSE                                                      CL**4
01917              MOVE  '999999'             TO LX42-X108-EMP-NO          CL**4
01918               ADD +1        TO W-X108-ERR-CNT                        CL*38
01919            END-IF                                                 DTSBX421
01920         ELSE                                                         CL**4
01921              MOVE  '999999'             TO LX42-X108-EMP-NO          CL**4
01922               ADD +1        TO W-X108-ERR-CNT                        CL*38
01923         END-IF                                                    DTSBX421
01924      ELSE                                                         DTSBX421
01925         SET W-ERROR-YES-88  TO TRUE                               DTSBX421
01926         MOVE SPACES TO R140-MESSAGE                               DTSBX421
01927         MOVE W-EMP-NO TO R140-EMP-NO                              DTSBX421
01928         ADD +1        TO W-X108-ERR-CNT                              CL*38
01929         STRING                                                    DTSBX421
01930            'X108 - RATE RECORD OUT OF SYNC - DUP REC '            DTSBX421
01931             DELIMITED BY SIZE                                     DTSBX421
01932             INTO R140-MESSAGE                                     DTSBX421
01933         END-STRING                                                DTSBX421
01934         MOVE  '999999'             TO LX42-X108-EMP-NO               CL**4
01935         PERFORM S946-WRITE-R140 THRU S946-EXIT                    DTSBX421
01936      END-IF.                                                      DTSBX421
01937                                                                   DTSBX421
01938  P1400-EXIT.                                                      DTSBX421
01939      EXIT.                                                        DTSBX421
01940                                                                   DTSBX421
01941  P1410-EDIT-RATE.                                                 DTSBX421
01942      SET W-RATE-ERROR-NO-88    TO TRUE.                           DTSBX421
01943      SET W-DUP-RATE-NO-88    TO TRUE.                             DTSBX421
01944                                                                   DTSBX421
01945      IF X104-STAFF-REVIEW-YES-88                                  DTSBX421
01946 *       SET W-ERROR-YES-88  TO TRUE                                  CL*29
01947         MOVE SPACES TO R140-MESSAGE                                  CL**4
01948         MOVE W-EMP-NO TO R140-EMP-NO                                 CL**4
01949         STRING                                                       CL**4
01950            'X108 - RATE RECORD - STAFF NEED REVIEW   '               CL**4
01951             DELIMITED BY SIZE                                        CL**4
01952             INTO R140-MESSAGE                                        CL**4
01953         END-STRING                                                   CL**4
01954         PERFORM S946-WRITE-R140 THRU S946-EXIT                       CL**4
01955         DISPLAY ' STAFF NEED REVIEW ------- ' W-EMP-NO            DTSBX421
01956 *       MOVE '999999'                     TO LX42-X108-EMP-NO        CL*29
01957 *       GO TO P1410-EXIT                                             CL*35
01958      END-IF.                                                      DTSBX421
01959                                                                   DTSBX421
01960      IF NOT X104-LIAB-RATED-88                                    DTSBX421
01961         SET W-ERROR-YES-88  TO TRUE                               DTSBX421
01962         MOVE SPACES TO R140-MESSAGE                               DTSBX421
01963         MOVE W-EMP-NO TO R140-EMP-NO                              DTSBX421
01964         STRING                                                    DTSBX421
01965            'X108  EMPLOYER IS NOT LIAB CANNOT HAVE RATE '            CL*24
01966             DELIMITED BY SIZE                                     DTSBX421
01967             INTO R140-MESSAGE                                     DTSBX421
01968         END-STRING                                                DTSBX421
01969         PERFORM S946-WRITE-R140 THRU S946-EXIT                    DTSBX421
01970         MOVE '999999'                     TO LX42-X108-EMP-NO        CL*24
01971         GO TO P1410-EXIT                                          DTSBX421
01972      END-IF.                                                      DTSBX421
01973                                                                   DTSBX421
01974      MOVE X108-RATE-YEAR (1:4)  TO L004-QTR-5-YR.                 DTSBX421
01975      MOVE 1                     TO L004-QTR-5-Q.                  DTSBX421
01976      PERFORM S004-FROM-5        THRU S004-EXIT.                   DTSBX421
01977      IF NOT L004-VALID-QTR                                        DTSBX421
01978         SET W-ERROR-YES-88  TO TRUE                               DTSBX421
01979         MOVE SPACES TO R140-MESSAGE                               DTSBX421
01980         MOVE W-EMP-NO TO R140-EMP-NO                              DTSBX421
01981         STRING                                                    DTSBX421
01982            'X108   RATE RECORD CANTAINS INVALID RATE YEAR '          CL*24
01983             L004-QTR-5-X                                          DTSBX421
01984             DELIMITED BY SIZE                                     DTSBX421
01985             INTO R140-MESSAGE                                     DTSBX421
01986         END-STRING                                                DTSBX421
01987         PERFORM S946-WRITE-R140 THRU S946-EXIT                    DTSBX421
01988         MOVE '999999'                     TO LX42-X108-EMP-NO        CL*24
01989         GO TO P1410-EXIT                                             CL*33
01990      ELSE                                                         DTSBX421
01991         PERFORM P1411-ADD-TO-TBL  THRU P1411-EXIT                 DTSBX421
01992      END-IF.                                                      DTSBX421
01993                                                                   DTSBX421
01994 *    IF W-DUP-RATE-YES-88                                         DTSBX421
01995 **      DISPLAY 'RATE: DUP IGNORED '                              DTSBX421
01996 **         W-EMP-NO '  ' X108-RATE-YEAR                           DTSBX421
01997 *       GO TO P1410-EXIT                                          DTSBX421
01998 *    END-IF.                                                      DTSBX421
01999                                                                   DTSBX421
02000      PERFORM P1415-FORMAT-RATE  THRU P1415-EXIT.                  DTSBX421
02001      IF W-ERROR-YES-88                                            DTSBX421
02002         DISPLAY 'X108 - RATE HAS ERRORS ' W-EMP-NO                   CL128
02003         MOVE '999999'                     TO LX42-X108-EMP-NO        CL*24
02004         GO TO P1410-EXIT                                          DTSBX421
02005      END-IF.                                                      DTSBX421
02006                                                                   DTSBX421
02007       DISPLAY '  BEFORE L005 YRQ ' L004-QTR-5-9                      CL*76
02008 *    IF L004-QTR-5-9 = 20191                                         CL156
02009 *       MOVE 20211                TO L052-EFF-YRQ                    CL156
02010 *       MOVE W-RATE               TO L052-UI-RATE                    CL156
02011 *    ELSE                                                            CL156
02012      MOVE L004-QTR-5-9         TO L052-EFF-YRQ                       CL*76
02013      MOVE W-RATE               TO L052-UI-RATE                    DTSBX421
02014      PERFORM S052-UI-RATE-EDIT THRU S052-EXIT                     DTSBX421
02015      IF L052-NOT-VALID                                            DTSBX421
02016         SET W-ERROR-YES-88  TO TRUE                               DTSBX421
02017         MOVE SPACES TO R140-MESSAGE                               DTSBX421
02018         MOVE W-EMP-NO TO R140-EMP-NO                              DTSBX421
02019         STRING                                                    DTSBX421
02020            'X108  INVALID TAX RATE (BU052)YEAR FOR DUTAS '           CL*24
02021             X108-RATE '  ' X108-RATE-YEAR                         DTSBX421
02022             DELIMITED BY SIZE                                     DTSBX421
02023             INTO R140-MESSAGE                                     DTSBX421
02024         END-STRING                                                DTSBX421
02025         PERFORM S946-WRITE-R140 THRU S946-EXIT                    DTSBX421
02026         MOVE '999999'                     TO LX42-X108-EMP-NO        CL*24
02027      ELSE                                                            CL*34
02028       DISPLAY ' L052 YRQ ' L052-EFF-YRQ                              CL*34
02029       DISPLAY ' L005 YRQ ' L004-QTR-5-9                              CL*34
02030      END-IF.                                                      DTSBX421
02031  P1410-EXIT.                                                      DTSBX421
02032      EXIT.                                                        DTSBX421
02033                                                                   DTSBX421
02034  P1411-ADD-TO-TBL.                                                DTSBX421
02035      PERFORM                                                      DTSBX421
02036        VARYING SUB FROM +1 BY +1                                  DTSBX421
02037        UNTIL SUB > +5                                             DTSBX421
02038          IF W-RATE-YEAR (SUB) = L004-QTR-5-YR                     DTSBX421
02039             IF W-RATE-FOUND-YES-88 (SUB)                          DTSBX421
02040                SET W-DUP-RATE-YES-88          TO TRUE             DTSBX421
02041             ELSE                                                  DTSBX421
02042                SET W-RATE-FOUND-YES-88 (SUB)  TO TRUE             DTSBX421
02043             END-IF                                                DTSBX421
02044          END-IF                                                   DTSBX421
02045      END-PERFORM.                                                 DTSBX421
02046                                                                   DTSBX421
02047  P1411-EXIT.                                                      DTSBX421
02048      EXIT.                                                        DTSBX421
02049                                                                   DTSBX421
02050  P1415-FORMAT-RATE.                                               DTSBX421
02051      MOVE X108-RATE              TO W-TEST-AMT.                   DTSBX421
02052                                                                   DTSBX421
02053      SET W-DECIMAL-FOUND-NO-88   TO TRUE.                         DTSBX421
02054      MOVE +1             TO W-MULTIPLIER.                         DTSBX421
02055      MOVE +0             TO W-VALUE.                              DTSBX421
02056                                                                   DTSBX421
02057 **   DISPLAY 'INTEGER'.                                           DTSBX421
02058      PERFORM                                                      DTSBX421
02059         VARYING RSUB FROM +6 BY -1                                DTSBX421
02060         UNTIL RSUB < +1                                           DTSBX421
02061            IF W-TEST-AMT (RSUB:1) = '.'                           DTSBX421
02062               SET W-DECIMAL-FOUND-YES-88   TO TRUE                DTSBX421
02063 **            DISPLAY 'DECIMAL ' RSUB                             DTSBX421
02064            ELSE                                                   DTSBX421
02065               IF W-DECIMAL-FOUND-YES-88                           DTSBX421
02066                  PERFORM P1415A-INTEGER       THRU P1415A-EXIT    DTSBX421
02067               END-IF                                              DTSBX421
02068            END-IF                                                 DTSBX421
02069      END-PERFORM.                                                 DTSBX421
02070                                                                   DTSBX421
02071      IF W-DECIMAL-FOUND-NO-88                                     DTSBX421
02072         SET W-ERROR-YES-88  TO TRUE                               DTSBX421
02073         MOVE SPACES TO R140-MESSAGE                               DTSBX421
02074         MOVE W-EMP-NO TO R140-EMP-NO                              DTSBX421
02075         STRING                                                    DTSBX421
02076            'X108  CONTAINS INVALID RATE NO DEC POINT '               CL*24
02077             X108-RATE '  ' X108-RATE-YEAR                         DTSBX421
02078             DELIMITED BY SIZE                                     DTSBX421
02079             INTO R140-MESSAGE                                     DTSBX421
02080         END-STRING                                                DTSBX421
02081         PERFORM S946-WRITE-R140 THRU S946-EXIT                    DTSBX421
02082         SET W-ERROR-YES-88       TO TRUE                          DTSBX421
02083         MOVE '999999'                     TO LX42-X108-EMP-NO        CL*24
02084         GO TO P1415-EXIT                                          DTSBX421
02085      END-IF.                                                      DTSBX421
02086                                                                   DTSBX421
02087      SET W-DECIMAL-FOUND-NO-88   TO TRUE.                         DTSBX421
02088      MOVE +0.1           TO W-MULTIPLIER.                         DTSBX421
02089                                                                   DTSBX421
02090      PERFORM                                                      DTSBX421
02091         VARYING RSUB FROM +1 BY +1                                DTSBX421
02092         UNTIL RSUB > +6                                           DTSBX421
02093            IF W-TEST-AMT (RSUB:1) = '.'                           DTSBX421
02094               SET W-DECIMAL-FOUND-YES-88   TO TRUE                DTSBX421
02095 **            DISPLAY 'DECIMAL ' RSUB                             DTSBX421
02096            ELSE                                                   DTSBX421
02097               IF W-DECIMAL-FOUND-YES-88                           DTSBX421
02098                  PERFORM P1415B-FRACTION       THRU P1415B-EXIT   DTSBX421
02099               END-IF                                              DTSBX421
02100            END-IF                                                 DTSBX421
02101      END-PERFORM.                                                 DTSBX421
02102                                                                   DTSBX421
02103      COMPUTE W-RATE = (W-VALUE / 100).                            DTSBX421
02104       IF X108-RATE < W-RATE-X                                        CL130
02105         SET W-ERROR-YES-88  TO TRUE                                  CL125
02106         MOVE SPACES TO R140-MESSAGE                                  CL125
02107         MOVE W-EMP-NO TO R140-EMP-NO                                 CL125
02108         DISPLAY ' X108-RATE ' X108-RATE                              CL129
02109         DISPLAY ' XXXX-RATE ' W-RATE-X                               CL130
02110         STRING                                                       CL125
02111            'X108  CONTAINS INVALID RATE              '               CL125
02112             X108-RATE '  ' X108-RATE-YEAR                            CL125
02113             DELIMITED BY SIZE                                        CL125
02114             INTO R140-MESSAGE                                        CL125
02115         END-STRING                                                   CL125
02116         PERFORM S946-WRITE-R140 THRU S946-EXIT                       CL125
02117         SET W-ERROR-YES-88       TO TRUE                             CL125
02118         MOVE '999999'                     TO LX42-X108-EMP-NO        CL125
02119         GO TO P1415-EXIT.                                            CL125
02120  P1415-EXIT.                                                      DTSBX421
02121      EXIT.                                                        DTSBX421
02122                                                                   DTSBX421
02123  P1415A-INTEGER.                                                  DTSBX421
02124      MOVE W-TEST-AMT(RSUB:1)     TO W-DIGIT.                      DTSBX421
02125      COMPUTE W-VALUE = W-VALUE +                                  DTSBX421
02126         (W-DIGIT * W-MULTIPLIER).                                 DTSBX421
02127 **   MOVE W-VALUE                TO W-DISP-AMT.                   DTSBX421
02128 **   DISPLAY W-DISP-AMT '  ' W-MULTIPLIER.                        DTSBX421
02129      COMPUTE W-MULTIPLIER =                                       DTSBX421
02130         (W-MULTIPLIER * +10).                                     DTSBX421
02131                                                                   DTSBX421
02132  P1415A-EXIT.                                                     DTSBX421
02133      EXIT.                                                        DTSBX421
02134                                                                   DTSBX421
02135  P1415B-FRACTION.                                                 DTSBX421
02136      MOVE W-TEST-AMT(RSUB:1)     TO W-DIGIT.                      DTSBX421
02137      COMPUTE W-VALUE = W-VALUE +                                  DTSBX421
02138         (W-DIGIT * W-MULTIPLIER).                                 DTSBX421
02139 **   MOVE W-VALUE                TO W-DISP-AMT.                   DTSBX421
02140 **   DISPLAY W-DISP-AMT '  ' W-MULTIPLIER.                        DTSBX421
02141      COMPUTE W-MULTIPLIER =                                       DTSBX421
02142         (W-MULTIPLIER / +10).                                     DTSBX421
02143                                                                   DTSBX421
02144  P1415B-EXIT.                                                     DTSBX421
02145      EXIT.                                                        DTSBX421
02146                                                                   DTSBX421
02147  P1420-SAVE-RATE.                                                 DTSBX421
02148      DISPLAY 'P1420-SAVE-RATE'                                    DTSBX421
02149      MOVE LOW-VALUES                TO T002-REC.                  DTSBX421
02150      MOVE SPACES                    TO LX42-X108-EMP-NO.             CL*83
02151      SET T002-LENGTH-RATE-88        TO TRUE.                      DTSBX421
02152      MOVE '002'                     TO T002-REC-TYPE.             DTSBX421
02153      MOVE X108-EMP-NO               TO T002-EMP-NO.               DTSBX421
02154      MOVE 'WEB REG   '              TO T002-ORIGIN.               DTSBX421
02155      MOVE LX42-SYS-DATE             TO T002-SYS-DATE.             DTSBX421
02156      MOVE LX42-SYS-TIME             TO T002-SYS-TIME.             DTSBX421
02157                                                                   DTSBX421
02158      DISPLAY ' RATE YRQ ' L004-QTR-5-9                               CL*34
02159      MOVE ZEROS                     TO Y108-RATE-EFF-YRQ.            CL*32
02160      DISPLAY ' L052 YRQ ' L052-EFF-YRQ.                              CL*32
02161      MOVE L052-EFF-YRQ              TO Y108-RATE-EFF-YRQ.         DTSBX421
02162      MOVE L052-UI-RATE              TO Y108-UI-RATE.              DTSBX421
02163                                                                   DTSBX421
02164      MOVE Y108-REC                  TO T002-DATA-AREA.            DTSBX421
02165      SET T002-EMP-RATE-88           TO TRUE.                      DTSBX421
02166      PERFORM S1030-WRITE-TEMP-T002  THRU S1030-EXIT.              DTSBX421
02167      ADD +1   TO W-T002-RATE-CNT.                                    CL*26
02168 *&                                                                   CL153
02169      DISPLAY 'ESSP Y108 ' Y108-REC.                                  CL156
02170      DISPLAY 'ESSP  RATE ' X108-EMP-NO '  ' Y108-RATE-EFF-YRQ        CL154
02171              '  ' Y108-UI-RATE.                                      CL154
02172 *&                                                                   CL156
02173      PERFORM P1421-SAVE-2021 THRU P1421-EXIT.                        CL156
02174 *&                                                                   CL153
02175  P1420-EXIT.                                                      DTSBX421
02176      EXIT.                                                        DTSBX421
02177  P1421-SAVE-2021.                                                    CL156
02178      DISPLAY 'P1421-SAVE-RATE'                                       CL156
02179      MOVE LOW-VALUES                TO T002-REC.                     CL156
02180      MOVE SPACES                    TO LX42-X108-EMP-NO.             CL156
02181      SET T002-LENGTH-RATE-88        TO TRUE.                         CL156
02182      MOVE '002'                     TO T002-REC-TYPE.                CL156
02183      MOVE X108-EMP-NO               TO T002-EMP-NO.                  CL156
02184      MOVE 'WEB REG   '              TO T002-ORIGIN.                  CL156
02185      MOVE LX42-SYS-DATE             TO T002-SYS-DATE.                CL156
02186      MOVE LX42-SYS-TIME             TO T002-SYS-TIME.                CL156
02187                                                                      CL156
02188      DISPLAY ' RATE YRQ ' L004-QTR-5-9                               CL156
02189      MOVE ZEROS                     TO Y108-RATE-EFF-YRQ.            CL156
02190      DISPLAY ' L052 YRQ ' L052-EFF-YRQ.                              CL156
02191 *    MOVE L052-EFF-YRQ              TO Y108-RATE-EFF-YRQ.            CL156
02192 *    MOVE L052-UI-RATE              TO Y108-UI-RATE.                 CL156
02193                                                                      CL156
02194      MOVE 20211                     TO Y108-RATE-EFF-YRQ.            CL156
02195      MOVE 27000                     TO Y108-UI-RATE.                 CL156
02196                                                                      CL156
02197      MOVE Y108-REC                  TO T002-DATA-AREA.               CL156
02198      SET T002-EMP-RATE-88           TO TRUE.                         CL156
02199      PERFORM S1030-WRITE-TEMP-T002  THRU S1030-EXIT.                 CL156
02200      ADD +1   TO W-T002-RATE-CNT.                                    CL156
02201 *&                                                                   CL156
02202      DISPLAY 'DUTAS Y108 ' Y108-REC.                                 CL156
02203      DISPLAY 'DUTAS RATE ' X108-EMP-NO '  ' Y108-RATE-EFF-YRQ        CL156
02204              '  ' Y108-UI-RATE.                                      CL156
02205 *&                                                                   CL156
02206 *&                                                                   CL156
02207  P1421-EXIT.                                                         CL156
02208      EXIT.                                                           CL156
02209                                                                   DTSBX421
02210 *                                                                 DTSBX421
02211 *P1700-RELATION.                                                  DTSBX421
02212 *    SET W-EMP-IN-PROGRESS-YES-88      TO TRUE.                   DTSBX421
02213 *    INITIALIZE X130-REC.                                         DTSBX421
02214 *    MOVE +16                          TO W-LAST-FIELD.           DTSBX421
02215 *    MOVE +40                          TO W-LAST-FIELD-LEN.       DTSBX421
02216 *    PERFORM S2000-PARSE-INPUT         THRU S2000-EXIT.           DTSBX421
02217 *&                                                                DTSBX421
02218 *    DISPLAY 'RELATIONSHIP'.                                      DTSBX421
02219 **   DISPLAY X130-REC.                                            DTSBX421
02220 *&                                                                DTSBX421
02221 *                                                                 DTSBX421
02222 *    IF W-PREV-REC-OPO-88                                         DTSBX421
02223 *    OR W-PREV-REC-REL-88                                         DTSBX421
02224 *       SET W-PREV-REC-REL-88          TO TRUE                    DTSBX421
02225 *       ADD +1                         TO W-X130-CNT              DTSBX421
02226 *       PERFORM P1710-EDIT-RELATION    THRU P1710-EXIT            DTSBX421
02227 *       IF W-ERROR-NO-88                                          DTSBX421
02228 *          PERFORM P1720-SAVE-REL      THRU P1720-EXIT            DTSBX421
02229 *       END-IF                                                    DTSBX421
02230 *    ELSE                                                         DTSBX421
02231 *       DISPLAY 'REL RECORD FOUND FOLLOWING '                     DTSBX421
02232 *          W-PREV-REC-TYPE '  ' W-EMP-NO                          DTSBX421
02233 *       SET W-ERROR-YES-88              TO TRUE                   DTSBX421
02234 *    END-IF.                                                      DTSBX421
02235 *                                                                 DTSBX421
02236 *P1700-EXIT.                                                      DTSBX421
02237 *    EXIT.                                                        DTSBX421
02238 *                                                                 DTSBX421
02239 *P1710-EDIT-RELATION.                                             DTSBX421
02240 *    IF X130-PRED-FEIN NOT NUMERIC                                DTSBX421
02241 *       DISPLAY 'REL: NON-NUMERIC FEIN ' X130-PRED-FEIN           DTSBX421
02242 *          '  ' W-EMP-NO                                          DTSBX421
02243 *       SET W-ERROR-YES-88    TO TRUE                             DTSBX421
02244 *RW1                                                              DTSBX421
02245 *       MOVE SPACES TO R140-MESSAGE                               DTSBX421
02246 *       MOVE W-EMP-NO TO R140-EMP-NO                              DTSBX421
02247 *       STRING                                                    DTSBX421
02248 *          'RELATION   NON-NUMERIC FEIN ' X130-PRED-FEIN          DTSBX421
02249 *           DELIMITED BY SIZE                                     DTSBX421
02250 *           INTO R140-MESSAGE                                     DTSBX421
02251 *       END-STRING                                                DTSBX421
02252 *       PERFORM S946-WRITE-R140 THRU S946-EXIT                    DTSBX421
02253 *RW2                                                              DTSBX421
02254 *    ELSE                                                         DTSBX421
02255 *       MOVE X130-PRED-FEIN   TO W-PRED-FEIN                      DTSBX421
02256 *    END-IF.                                                      DTSBX421
02257 *                                                                 DTSBX421
02258 ***     DISPLAY 'REL: EMP ' X130-PRED-EMP-NO.                     DTSBX421
02259 *    IF X130-PRED-EMP-NO NOT NUMERIC                              DTSBX421
02260 *       DISPLAY 'REL: NON-NUMERIC PRED EMP '                      DTSBX421
02261 *          X130-PRED-EMP-NO '  ' W-EMP-NO                         DTSBX421
02262 ***     SET W-ERROR-YES-88    TO TRUE                             DTSBX421
02263 *RW1                                                              DTSBX421
02264 *       MOVE SPACES TO R140-MESSAGE                               DTSBX421
02265 *       MOVE W-EMP-NO TO R140-EMP-NO                              DTSBX421
02266 *       STRING                                                    DTSBX421
02267 *          'RELATION   NON-NUMERIC PRED EMP ' X130-PRED-EMP-NO    DTSBX421
02268 *           DELIMITED BY SIZE                                     DTSBX421
02269 *           INTO R140-MESSAGE                                     DTSBX421
02270 *       END-STRING                                                DTSBX421
02271 *       PERFORM S946-WRITE-R140 THRU S946-EXIT                    DTSBX421
02272 *       MOVE ZERO             TO W-PRED-EMP-NO                    DTSBX421
02273 *RW2                                                              DTSBX421
02274 *    ELSE                                                         DTSBX421
02275 *       MOVE X130-PRED-EMP-NO TO W-PRED-EMP-NO                    DTSBX421
02276 *    END-IF.                                                      DTSBX421
02277 *                                                                 DTSBX421
02278 *    IF NOT X130-REL-VALID-88                                     DTSBX421
02279 *       DISPLAY 'REL: INVALID RELATIONSHIP CODE '                 DTSBX421
02280 *          X130-RELATIONSHIP-CD '  ' W-EMP-NO                     DTSBX421
02281 *       SET W-ERROR-YES-88    TO TRUE                             DTSBX421
02282 *    END-IF.                                                      DTSBX421
02283 *                                                                 DTSBX421
02284 *    MOVE X130-EFF-DATE       TO W-SLASH-DATE                     DTSBX421
02285 *    MOVE W-SLASH-DT-MM       TO L001-FED-8-MO                    DTSBX421
02286 *    MOVE W-SLASH-DT-DD       TO L001-FED-8-DA                    DTSBX421
02287 *    MOVE W-SLASH-DT-CCYY     TO L001-FED-8-YR                    DTSBX421
02288 *    PERFORM S001-FROM-FED-8  THRU S001-EXIT                      DTSBX421
02289 *    IF NOT L001-VALID-DATE                                       DTSBX421
02290 *       DISPLAY 'REL: INVALID EFFECTIVE DATE '                    DTSBX421
02291 *          W-EMP-NO '  ' X130-EFF-DATE                            DTSBX421
02292 *       SET W-ERROR-YES-88  TO TRUE                               DTSBX421
02293 *RW1                                                              DTSBX421
02294 *       MOVE SPACES TO R140-MESSAGE                               DTSBX421
02295 *       MOVE W-EMP-NO TO R140-EMP-NO                              DTSBX421
02296 *       STRING                                                    DTSBX421
02297 *          'RELATION   INVALID EFFECTIVE DATE ' X130-EFF-DATE     DTSBX421
02298 *           DELIMITED BY SIZE                                     DTSBX421
02299 *           INTO R140-MESSAGE                                     DTSBX421
02300 *       END-STRING                                                DTSBX421
02301 *       PERFORM S946-WRITE-R140 THRU S946-EXIT                    DTSBX421
02302 *RW2                                                              DTSBX421
02303 *    ELSE                                                         DTSBX421
02304 *       MOVE L001-SLASH-8-DATE  TO W-PRED-EFF-DATE                DTSBX421
02305 *    END-IF.                                                      DTSBX421
02306 *                                                                 DTSBX421
02307 *    PERFORM                                                      DTSBX421
02308 *      VARYING RSUB FROM +1 BY +1                                 DTSBX421
02309 *      UNTIL RSUB > +6                                            DTSBX421
02310 *        IF RSUB = +4                                             DTSBX421
02311 *           IF X130-PORTION-EXP-TRNSF (RSUB:1) = '.'              DTSBX421
02312 *              NEXT SENTENCE                                      DTSBX421
02313 *           ELSE                                                  DTSBX421
02314 *              DISPLAY 'NON-NUMERIC PERCENT '                     DTSBX421
02315 *                 X130-PORTION-EXP-TRNSF                          DTSBX421
02316 *              SET W-ERROR-YES-88  TO TRUE                        DTSBX421
02317 *RW1                                                              DTSBX421
02318 *              MOVE SPACES TO R140-MESSAGE                        DTSBX421
02319 *              MOVE W-EMP-NO TO R140-EMP-NO                       DTSBX421
02320 *              STRING                                             DTSBX421
02321 *                 'RELATION   NON-NUMERIC PERCENT '               DTSBX421
02322 *                    X130-PORTION-EXP-TRNSF                       DTSBX421
02323 *                  DELIMITED BY SIZE                              DTSBX421
02324 *                  INTO R140-MESSAGE                              DTSBX421
02325 *              END-STRING                                         DTSBX421
02326 *              PERFORM S946-WRITE-R140 THRU S946-EXIT             DTSBX421
02327 *RW2                                                              DTSBX421
02328 *           END-IF                                                DTSBX421
02329 *        ELSE                                                     DTSBX421
02330 *           IF X130-PORTION-EXP-TRNSF (RSUB:1) >= '0'             DTSBX421
02331 *           OR X130-PORTION-EXP-TRNSF (RSUB:1) <= '9'             DTSBX421
02332 *              NEXT SENTENCE                                      DTSBX421
02333 *           ELSE                                                  DTSBX421
02334 *              DISPLAY 'NON-NUMERIC PERCENT '                     DTSBX421
02335 *                 X130-PORTION-EXP-TRNSF                          DTSBX421
02336 *              SET W-ERROR-YES-88  TO TRUE                        DTSBX421
02337 *RW1                                                              DTSBX421
02338 *              MOVE SPACES TO R140-MESSAGE                        DTSBX421
02339 *              MOVE W-EMP-NO TO R140-EMP-NO                       DTSBX421
02340 *              STRING                                             DTSBX421
02341 *                 'RELATION   NON-NUMERIC PERCENT '               DTSBX421
02342 *                    X130-PORTION-EXP-TRNSF                       DTSBX421
02343 *                  DELIMITED BY SIZE                              DTSBX421
02344 *                  INTO R140-MESSAGE                              DTSBX421
02345 *              END-STRING                                         DTSBX421
02346 *              PERFORM S946-WRITE-R140 THRU S946-EXIT             DTSBX421
02347 *RW2                                                              DTSBX421
02348 *           END-IF                                                DTSBX421
02349 *        END-IF                                                   DTSBX421
02350 *    END-PERFORM.                                                 DTSBX421
02351 *                                                                 DTSBX421
02352 *    MOVE X130-PORTION-EXP-TRNSF  TO W-PORTION-EXP-TRNSF-X.       DTSBX421
02353 *                                                                 DTSBX421
02354 *    IF W-PRED-EMP-NO > ZERO                                      DTSBX421
02355 *       MOVE LOW-VALUE        TO MPRF-KEY-AREA                    DTSBX421
02356 *       MOVE X130-PRED-EMP-NO TO MPRF-EMP-NO                      DTSBX421
02357 *       SET MPRF-PRF-88       TO TRUE                             DTSBX421
02358 *       MOVE MPRF-KEY-AREA    TO MSKL-KEY-AREA                    DTSBX421
02359 *       PERFORM S910-READ     THRU S910-EXIT                      DTSBX421
02360 *       IF L910-NO-REC-88                                         DTSBX421
02361 *          DISPLAY 'PREDECESSOR DOES NOT EXIST '                  DTSBX421
02362 *             X130-PRED-EMP-NO '  ' W-EMP-NO                      DTSBX421
02363 ***        SET W-ERROR-YES-88   TO TRUE                           DTSBX421
02364 *RW1                                                              DTSBX421
02365 *       MOVE SPACES TO R140-MESSAGE                               DTSBX421
02366 *       MOVE W-EMP-NO TO R140-EMP-NO                              DTSBX421
02367 *       STRING                                                    DTSBX421
02368 *          'RELATION   PREDECESSOR DOES NOT EXIST '               DTSBX421
02369 *             X130-PRED-EMP-NO                                    DTSBX421
02370 *           DELIMITED BY SIZE                                     DTSBX421
02371 *           INTO R140-MESSAGE                                     DTSBX421
02372 *       END-STRING                                                DTSBX421
02373 *       PERFORM S946-WRITE-R140 THRU S946-EXIT                    DTSBX421
02374 *RW2                                                              DTSBX421
02375 *       END-IF                                                    DTSBX421
02376 *    END-IF.                                                      DTSBX421
02377 *                                                                 DTSBX421
02378 *P1710-EXIT.                                                      DTSBX421
02379 *    EXIT.                                                        DTSBX421
02380 *                                                                 DTSBX421
02381 *P1720-SAVE-REL.                                                  DTSBX421
02382 *    PERFORM S3000-INIT-T003        THRU S3000-EXIT.              DTSBX421
02383 *                                                                 DTSBX421
02384 *    SET W-MNTE-RELATIONSHIP-88     TO TRUE                       DTSBX421
02385 *    MOVE W-MNTE-SUBJECT            TO MNTE-SUBJECT               DTSBX421
02386 *                                                                 DTSBX421
02387 *    PERFORM P1721-MOVE-TEXT        THRU P1721-EXIT.              DTSBX421
02388 *                                                                 DTSBX421
02389 *    MOVE MNTE-REC                  TO T003-MNTE-REC.             DTSBX421
02390 *                                                                 DTSBX421
02391 *    PERFORM S1031-WRITE-TEMP-T003  THRU S1031-EXIT.              DTSBX421
02392 *                                                                 DTSBX421
02393 *&                                                                DTSBX421
02394 *    DISPLAY 'MNTE ' W-EMP-NO.                                    DTSBX421
02395 *    PERFORM                                                      DTSBX421
02396 *      VARYING SUB FROM +1 BY +1                                  DTSBX421
02397 *      UNTIL SUB > MNTE-TEXT-CNT                                  DTSBX421
02398 *         DISPLAY MNTE-TEXT (SUB)                                 DTSBX421
02399 *    END-PERFORM.                                                 DTSBX421
02400 *&                                                                DTSBX421
02401 ***********************************************                   DTSBX421
02402 *    MOVE LOW-VALUES                TO T002-REC.                  DTSBX421
02403 *                                                                 DTSBX421
02404 *    SET T002-LENGTH-REL-88         TO TRUE.                      DTSBX421
02405 *    MOVE '002'                     TO T002-REC-TYPE.             DTSBX421
02406 *    MOVE W-EMP-NO                  TO T002-EMP-NO.               DTSBX421
02407 *    MOVE 'WEB REG   '              TO T002-ORIGIN.               DTSBX421
02408 *    MOVE LX42-SYS-DATE             TO T002-SYS-DATE.             DTSBX421
02409 *    MOVE LX42-SYS-TIME             TO T002-SYS-TIME.             DTSBX421
02410 *                                                                 DTSBX421
02411 *    SET T002-EMP-REL-88            TO TRUE.                      DTSBX421
02412 *                                                                 DTSBX421
02413 *    MOVE W-PRED-EMP-NO             TO T002-PRED-EMP-NO.          DTSBX421
02414 *    MOVE W-PRED-FEIN               TO T002-PRED-FEIN.            DTSBX421
02415 *    MOVE X130-RELATIONSHIP-CD      TO T002-RELATIONSHIP-CD.      DTSBX421
02416 *    COMPUTE T002-PORTION-EXP-TRNSF =                             DTSBX421
02417 *       (W-PORTION-EXP-TRNSF / 100).                              DTSBX421
02418 *    MOVE W-PRED-EFF-DATE           TO T002-REL-EFF-DATE.         DTSBX421
02419 *    MOVE X130-SOURCE               TO T002-REL-SOURCE.           DTSBX421
02420 *    MOVE X130-ENTITY-NAME          TO T002-REL-NAME.             DTSBX421
02421 *                                                                 DTSBX421
02422 *    MOVE X130-ATTENTION            TO T002-REL-ATTN.             DTSBX421
02423 *    MOVE X130-STREET-1             TO T002-REL-DELV1.            DTSBX421
02424 *    MOVE X130-STREET-2             TO T002-REL-DELV2.            DTSBX421
02425 *    MOVE X130-CITY                 TO T002-REL-CITY.             DTSBX421
02426 *    MOVE X130-STATE                TO T002-REL-STATE.            DTSBX421
02427 *    MOVE X130-ZIP                  TO T002-REL-ZIP.              DTSBX421
02428 *    MOVE X130-PHONE                TO T002-REL-VOICE.            DTSBX421
02429 *    MOVE X130-FAX                  TO T002-REL-FAX.              DTSBX421
02430 *    MOVE X130-EMAIL                TO T002-REL-EMAIL.            DTSBX421
02431 *                                                                 DTSBX421
02432 *    PERFORM S1030-WRITE-TEMP-T002  THRU S1030-EXIT.              DTSBX421
02433 *                                                                 DTSBX421
02434 *P1720-EXIT.                                                      DTSBX421
02435 *    EXIT.                                                        DTSBX421
02436 *                                                                 DTSBX421
02437 *P1721-MOVE-TEXT.                                                 DTSBX421
02438 *    IF X104-LIAB-RATED-88                                        DTSBX421
02439 *       MOVE 'R'                  TO W-CLASS                      DTSBX421
02440 *    ELSE                                                         DTSBX421
02441 *       IF X104-LIAB-SELF-INS-88                                  DTSBX421
02442 *          MOVE 'S'                  TO W-CLASS                   DTSBX421
02443 *       ELSE                                                      DTSBX421
02444 *          MOVE 'U'                  TO W-CLASS                   DTSBX421
02445 *       END-IF                                                    DTSBX421
02446 *    END-IF.                                                      DTSBX421
02447 *                                                                 DTSBX421
02448 *    MOVE +1                      TO MNTE-TEXT-CNT.               DTSBX421
02449 *    MOVE 'SUCCESSOR LIABILITY INFO: '                            DTSBX421
02450 *       TO MNTE-TEXT (MNTE-TEXT-CNT).                             DTSBX421
02451 *                                                                 DTSBX421
02452 *    ADD  +1                      TO MNTE-TEXT-CNT.               DTSBX421
02453 *    STRING 'CLASS: ' W-CLASS                                     DTSBX421
02454 *           '    LIABILITY CODE: ' X104-LIAB-CD                   DTSBX421
02455 *           '    LIABILITY DATE: ' X104-FIRST-WAGE-DT             DTSBX421
02456 *         DELIMITED BY SIZE                                       DTSBX421
02457 *         INTO MNTE-TEXT (MNTE-TEXT-CNT)                          DTSBX421
02458 *    END-STRING.                                                  DTSBX421
02459 *                                                                 DTSBX421
02460 *    ADD +1                       TO MNTE-TEXT-CNT.               DTSBX421
02461 *    MOVE SPACES                                                  DTSBX421
02462 *       TO MNTE-TEXT (MNTE-TEXT-CNT).                             DTSBX421
02463 *                                                                 DTSBX421
02464 *    ADD +1                       TO MNTE-TEXT-CNT.               DTSBX421
02465 *    MOVE 'PREDECESSOR INFO:'                                     DTSBX421
02466 *       TO MNTE-TEXT (MNTE-TEXT-CNT).                             DTSBX421
02467 *                                                                 DTSBX421
02468 *    ADD +1                       TO MNTE-TEXT-CNT.               DTSBX421
02469 *    STRING 'NAME: ' X130-ENTITY-NAME                             DTSBX421
02470 *         DELIMITED BY SIZE                                       DTSBX421
02471 *         INTO MNTE-TEXT (MNTE-TEXT-CNT)                          DTSBX421
02472 *    END-STRING.                                                  DTSBX421
02473 *                                                                 DTSBX421
02474 *    ADD  +1                      TO MNTE-TEXT-CNT.               DTSBX421
02475 *    STRING 'ACCOUNT ' W-PRED-EMP-NO                              DTSBX421
02476 *           '    FEIN ' W-PRED-FEIN                               DTSBX421
02477 *           '    RELATIONSHIP CODE: ' X130-RELATIONSHIP-CD        DTSBX421
02478 *         DELIMITED BY SIZE                                       DTSBX421
02479 *         INTO MNTE-TEXT (MNTE-TEXT-CNT)                          DTSBX421
02480 *    END-STRING.                                                  DTSBX421
02481 *                                                                 DTSBX421
02482 *    ADD  +1                      TO MNTE-TEXT-CNT.               DTSBX421
02483 *    STRING 'EXP TRANSFERRED: '                                   DTSBX421
02484 *           W-PORTION-EXP-TRNSF-X                                 DTSBX421
02485 *           '    EFF DATE: '                                      DTSBX421
02486 *           W-PRED-EFF-DATE                                       DTSBX421
02487 *         DELIMITED BY SIZE                                       DTSBX421
02488 *         INTO MNTE-TEXT (MNTE-TEXT-CNT)                          DTSBX421
02489 *    END-STRING.                                                  DTSBX421
02490 *                                                                 DTSBX421
02491 ***  ADD  +1                      TO MNTE-TEXT-CNT.               DTSBX421
02492 **   STRING 'TRANSFER EFFECTIVE DATE: '                           DTSBX421
02493 **          W-PRED-EFF-DATE                                       DTSBX421
02494 **        DELIMITED BY SIZE                                       DTSBX421
02495 **        INTO MNTE-TEXT (MNTE-TEXT-CNT)                          DTSBX421
02496 **   END-STRING.                                                  DTSBX421
02497 **                                                                DTSBX421
02498 **   IF X130-ATTENTION > SPACES                                   DTSBX421
02499 **      ADD  +1                      TO MNTE-TEXT-CNT             DTSBX421
02500 **      MOVE X130-ATTENTION                                       DTSBX421
02501 **         TO MNTE-TEXT (MNTE-TEXT-CNT)                           DTSBX421
02502 ***  END-IF.                                                      DTSBX421
02503 *                                                                 DTSBX421
02504 *    IF X130-STREET-1 > SPACES                                    DTSBX421
02505 *       ADD  +1                      TO MNTE-TEXT-CNT             DTSBX421
02506 *       MOVE X130-STREET-1                                        DTSBX421
02507 *          TO MNTE-TEXT (MNTE-TEXT-CNT)                           DTSBX421
02508 *    END-IF.                                                      DTSBX421
02509 *                                                                 DTSBX421
02510 *    IF X130-STREET-2 > SPACES                                    DTSBX421
02511 *       ADD  +1                      TO MNTE-TEXT-CNT             DTSBX421
02512 *       MOVE X130-STREET-2                                        DTSBX421
02513 *          TO MNTE-TEXT (MNTE-TEXT-CNT)                           DTSBX421
02514 *    END-IF.                                                      DTSBX421
02515 *                                                                 DTSBX421
02516 *    ADD  +1                      TO MNTE-TEXT-CNT                DTSBX421
02517 *    STRING X130-CITY ', '                                        DTSBX421
02518 *           X130-STATE ' '                                        DTSBX421
02519 *           X130-ZIP                                              DTSBX421
02520 *         DELIMITED BY SIZE                                       DTSBX421
02521 *         INTO MNTE-TEXT (MNTE-TEXT-CNT)                          DTSBX421
02522 *    END-STRING.                                                  DTSBX421
02523 *                                                                 DTSBX421
02524 *    MOVE SPACES                  TO WRK-PHONE                    DTSBX421
02525 *                                    WRK-PHONE-TEXT1              DTSBX421
02526 *                                    WRK-PHONE-TEXT2.             DTSBX421
02527 *    IF X130-PHONE > SPACES                                       DTSBX421
02528 *       MOVE X130-PHONE           TO WRK-PHONE                    DTSBX421
02529 *       IF WRK-EXT > SPACES                                       DTSBX421
02530 *          MOVE '-'               TO WRK-EXT-HYPHEN               DTSBX421
02531 *       ELSE                                                      DTSBX421
02532 *          MOVE ' '               TO WRK-EXT-HYPHEN               DTSBX421
02533 *       END-IF                                                    DTSBX421
02534 *       STRING                                                    DTSBX421
02535 *          'PHONE ' WRK-AREA-CD '-'                               DTSBX421
02536 *          WRK-PREFIX '-'                                         DTSBX421
02537 *          WRK-SUFFIX                                             DTSBX421
02538 *          WRK-EXT-HYPHEN                                         DTSBX421
02539 *          WRK-EXT                                                DTSBX421
02540 *            DELIMITED BY SIZE                                    DTSBX421
02541 *            INTO WRK-PHONE-TEXT1                                 DTSBX421
02542 *       END-STRING                                                DTSBX421
02543 *    END-IF.                                                      DTSBX421
02544 *                                                                 DTSBX421
02545 *    IF X130-FAX > SPACES                                         DTSBX421
02546 *       MOVE X130-FAX             TO WRK-PHONE                    DTSBX421
02547 *       STRING                                                    DTSBX421
02548 *          'FAX ' WRK-AREA-CD '-'                                 DTSBX421
02549 *          WRK-PREFIX '-'                                         DTSBX421
02550 *          WRK-SUFFIX                                             DTSBX421
02551 *            DELIMITED BY SIZE                                    DTSBX421
02552 *            INTO WRK-PHONE-TEXT2                                 DTSBX421
02553 *       END-STRING                                                DTSBX421
02554 *    END-IF.                                                      DTSBX421
02555 *                                                                 DTSBX421
02556 *    ADD  +1                      TO MNTE-TEXT-CNT.               DTSBX421
02557 *    STRING WRK-PHONE-TEXT1 '    '                                DTSBX421
02558 *           WRK-PHONE-TEXT2                                       DTSBX421
02559 *         DELIMITED BY SIZE                                       DTSBX421
02560 *         INTO MNTE-TEXT (MNTE-TEXT-CNT)                          DTSBX421
02561 *    END-STRING.                                                  DTSBX421
02562 *                                                                 DTSBX421
02563 *    ADD  +1                      TO MNTE-TEXT-CNT.               DTSBX421
02564 *    MOVE X130-EMAIL                                              DTSBX421
02565 *       TO MNTE-TEXT (MNTE-TEXT-CNT).                             DTSBX421
02566 *                                                                 DTSBX421
02567 *P1721-EXIT.                                                      DTSBX421
02568 *    EXIT.                                                        DTSBX421
02569 *                                                                 DTSBX421
02570 *P1800-IND-DESC.                                                  DTSBX421
02571 *    SET W-EMP-IN-PROGRESS-YES-88      TO TRUE.                   DTSBX421
02572 *    INITIALIZE X132-REC.                                         DTSBX421
02573 *    MOVE +4                           TO W-LAST-FIELD.           DTSBX421
02574 *    MOVE +500                         TO W-LAST-FIELD-LEN.       DTSBX421
02575 *    PERFORM S2000-PARSE-INPUT         THRU S2000-EXIT.           DTSBX421
02576 *&                                                                DTSBX421
02577 *    DISPLAY 'INDUSTRY DESCRIPTION'.                              DTSBX421
02578 *&                                                                DTSBX421
02579 *                                                                 DTSBX421
02580 *    SET W-PREV-REC-IND-88             TO TRUE.                   DTSBX421
02581 *    ADD +1                            TO W-X132-CNT.             DTSBX421
02582 *    PERFORM P1820-SAVE-IND            THRU P1820-EXIT.           DTSBX421
02583 *                                                                 DTSBX421
02584 *P1800-EXIT.                                                      DTSBX421
02585 *    EXIT.                                                        DTSBX421
02586 *                                                                 DTSBX421
02587 *P1820-SAVE-IND.                                                  DTSBX421
02588 *    MOVE LOW-VALUES              TO MNTE-KEY-AREA.               DTSBX421
02589 *    MOVE W-EMP-NO                TO MNTE-EMP-NO.                 DTSBX421
02590 *    SET MNTE-NTE-88              TO TRUE.                        DTSBX421
02591 *    MOVE +0                      TO MNTE-PURGE-DATE.             DTSBX421
02592 *    SET MNTE-NOT-CONVERTED-88    TO TRUE.                        DTSBX421
02593 *                                                                 DTSBX421
02594 *    MOVE LX42-SYS-DATE           TO MNTE-ESTB-DATE               DTSBX421
02595 *                                    MNTE-CHNG-DATE.              DTSBX421
02596 *    MOVE ZERO                    TO MNTE-KEY-ESTB-ABSTIME        DTSBX421
02597 *                                    MNTE-DATA-ESTB-ABSTIME       DTSBX421
02598 *                                    MNTE-CHNG-ABSTIME.           DTSBX421
02599 *    MOVE 'WEB REG '              TO MNTE-ESTB-OP-ID              DTSBX421
02600 *                                    MNTE-CHNG-OP-ID.             DTSBX421
02601 *    MOVE +0                      TO MNTE-TEXT-CNT.               DTSBX421
02602 *    MOVE SPACES                  TO MNTE-TEXT-AREA.              DTSBX421
02603 *                                                                 DTSBX421
02604 *    IF X132-SOURCE-KEY-WORD-88                                   DTSBX421
02605 *       SET W-MNTE-KEY-WORD-88     TO TRUE                        DTSBX421
02606 *       MOVE W-MNTE-SUBJECT        TO MNTE-SUBJECT                DTSBX421
02607 *    ELSE                                                         DTSBX421
02608 *       SET W-MNTE-DATA-ENTRY-88   TO TRUE                        DTSBX421
02609 *       MOVE W-MNTE-SUBJECT        TO MNTE-SUBJECT                DTSBX421
02610 *    END-IF.                                                      DTSBX421
02611 *                                                                 DTSBX421
02612 *    PERFORM P1821-MOVE-TEXT        THRU P1821-EXIT.              DTSBX421
02613 *                                                                 DTSBX421
02614 *    MOVE LENGTH OF T003-REC        TO T003-LENGTH                DTSBX421
02615 *    MOVE '003'                     TO T003-REC-TYPE.             DTSBX421
02616 *    MOVE W-EMP-NO                  TO T003-EMP-NO.               DTSBX421
02617 *    MOVE 'WEB REG   '              TO T003-ORIGIN.               DTSBX421
02618 *    MOVE LX42-SYS-DATE             TO T003-SYS-DATE.             DTSBX421
02619 *    MOVE LX42-SYS-TIME             TO T003-SYS-TIME.             DTSBX421
02620 *    SET T003-ADD-MNTE-88           TO TRUE.                      DTSBX421
02621 *    MOVE MNTE-REC                  TO T003-MNTE-REC.             DTSBX421
02622 *                                                                 DTSBX421
02623 *    PERFORM S1031-WRITE-TEMP-T003  THRU S1031-EXIT.              DTSBX421
02624 *                                                                 DTSBX421
02625 *P1820-EXIT.                                                      DTSBX421
02626 *    EXIT.                                                        DTSBX421
02627 *                                                                 DTSBX421
02628 *P1821-MOVE-TEXT.                                                 DTSBX421
02629 *    SET W-MNTE-COMPLETE-NO-88          TO TRUE.                  DTSBX421
02630 *    MOVE SPACES                        TO W-MNTE-LINE.           DTSBX421
02631 *    MOVE +0                            TO W-LAST-SPACE           DTSBX421
02632 *                                          TSUB1                  DTSBX421
02633 *                                          TSUB2.                 DTSBX421
02634 *                                                                 DTSBX421
02635 *    PERFORM                                                      DTSBX421
02636 *      UNTIL W-MNTE-COMPLETE-YES-88                               DTSBX421
02637 *        ADD +1                         TO TSUB1                  DTSBX421
02638 *        IF TSUB1 <= +500                                         DTSBX421
02639 *           PERFORM P1821A-MOVE-DATA    THRU P1821A-EXIT          DTSBX421
02640 *        ELSE                                                     DTSBX421
02641 *           SET W-MNTE-COMPLETE-YES-88  TO TRUE                   DTSBX421
02642 *        END-IF                                                   DTSBX421
02643 *    END-PERFORM.                                                 DTSBX421
02644 *                                                                 DTSBX421
02645 *P1821-EXIT.                                                      DTSBX421
02646 *    EXIT.                                                        DTSBX421
02647 *                                                                 DTSBX421
02648 *P1821A-MOVE-DATA.                                                DTSBX421
02649 *    IF TSUB2 < +72                                               DTSBX421
02650 *       ADD +1               TO TSUB2                             DTSBX421
02651 *       MOVE X132-IND-DESC (TSUB1:1)                              DTSBX421
02652 *                            TO W-MNTE-LINE (TSUB2:1)             DTSBX421
02653 *       IF X132-IND-DESC (TSUB1:1) = SPACE                        DTSBX421
02654 *          MOVE TSUB2        TO W-LAST-SPACE                      DTSBX421
02655 *       END-IF                                                    DTSBX421
02656 *    ELSE                                                         DTSBX421
02657 *       PERFORM P1821B-RESET THRU P1821B-EXIT                     DTSBX421
02658 *       ADD +1               TO MNTE-TEXT-CNT                     DTSBX421
02659 *       MOVE W-MNTE-LINE     TO MNTE-TEXT (MNTE-TEXT-CNT)         DTSBX421
02660 *       MOVE SPACES          TO W-MNTE-LINE                       DTSBX421
02661 *       MOVE +0              TO W-LAST-SPACE                      DTSBX421
02662 *                               TSUB2                             DTSBX421
02663 *    END-IF.                                                      DTSBX421
02664 *                                                                 DTSBX421
02665 ***  DISPLAY 'A ' TSUB1 '  ' TSUB2 '  ' W-MNTE-LINE.              DTSBX421
02666 *P1821A-EXIT.                                                     DTSBX421
02667 *    EXIT.                                                        DTSBX421
02668 *                                                                 DTSBX421
02669 *P1821B-RESET.                                                    DTSBX421
02670 ***  DISPLAY 'B1 ' W-LAST-SPACE '  ' TSUB1 '  ' TSUB2.            DTSBX421
02671 *************                                                     DTSBX421
02672 * EXIT IF THE LAST LETTER MOVED IS A SPACE, OR IF THE CURRENT     DTSBX421
02673 * LINE DOES NOT CONTAIN ANY SPACES.                               DTSBX421
02674 *************                                                     DTSBX421
02675 *    IF W-MNTE-LINE (72:1)   = SPACE                              DTSBX421
02676 *       SUBTRACT +1          FROM TSUB1                           DTSBX421
02677 *       GO TO P1821B-EXIT                                         DTSBX421
02678 *    END-IF.                                                      DTSBX421
02679 *                                                                 DTSBX421
02680 *    IF W-LAST-SPACE         = ZERO                               DTSBX421
02681 *       GO TO P1821B-EXIT                                         DTSBX421
02682 *    END-IF.                                                      DTSBX421
02683 *                                                                 DTSBX421
02684 *************                                                     DTSBX421
02685 * REPLACE THE LAST LETTERS WRITTEN (OCCURRING IN THE MIDDLE OF    DTSBX421
02686 * A WORD) WITH SPACES.                                            DTSBX421
02687 *************                                                     DTSBX421
02688 *    PERFORM                                                      DTSBX421
02689 *      VARYING TSUB2 FROM W-LAST-SPACE BY +1                      DTSBX421
02690 *      UNTIL TSUB2 > +72                                          DTSBX421
02691 *        MOVE SPACE          TO W-MNTE-LINE (TSUB2:1)             DTSBX421
02692 *    END-PERFORM.                                                 DTSBX421
02693 *                                                                 DTSBX421
02694 *************                                                     DTSBX421
02695 * RESET TSUB1 TO POINT TO THE FIRST LETTER OF THE INCOMPLETED     DTSBX421
02696 * WORD.                                                           DTSBX421
02697 *************                                                     DTSBX421
02698 *    COMPUTE TSUB1 = TSUB1 - (73 - W-LAST-SPACE).                 DTSBX421
02699 *                                                                 DTSBX421
02700 ***  DISPLAY 'B2 ' TSUB1 '  ' TSUB2 '  ' W-MNTE-LINE.             DTSBX421
02701 *P1821B-EXIT.                                                     DTSBX421
02702 *    EXIT.                                                        DTSBX421
02703                                                                   DTSBX421
02704  P3000-NEW-EMP.                                                   DTSBX421
02705                                                                   DTSBX421
02706      DISPLAY 'BX421 P3000 OLDE ' W-EMP-NO ' NEWE ' LX42-EMP-NO.      CL*10
02707      DISPLAY 'W-ERROR-IND ' W-ERROR-IND                           DTSBX421
02708      IF W-EMP-IN-PROGRESS-YES-88                                  DTSBX421
02709         SET W-EMP-IN-PROGRESS-NO-88      TO TRUE                  DTSBX421
02710            PERFORM P3100-CHK-COMPLETION  THRU P3100-EXIT          DTSBX421
02711           IF W-ERROR-NO-88                                           CL**8
02712               PERFORM P3200-DETERM       THRU P3200-EXIT             CL*51
02713 *             PERFORM P3300-COPY-TO-BTC  THRU P3300-EXIT             CL*52
02714                MOVE SPACES TO R140-MESSAGE                           CL*19
02715                MOVE W-EMP-NO TO R140-EMP-NO                          CL*19
02716                ADD +1        TO TOT-DUTAS-ADD-CNT                    CL*38
02717                ADD +1        TO WS-X140-RED-CNT                      CL105
02718                MOVE 'X421- ESSP REG PASSED >>>> ' TO X421-MESSAGE    CL*90
02719                STRING                                                CL*19
02720                 'X421- ESSP REGISTRATION ACCEPTED BY DUTAS >>>> '    CL*85
02721                    W-EMP-NO                                          CL*19
02722                    DELIMITED BY SIZE                                 CL*19
02723                    INTO R140-MESSAGE                                 CL*19
02724                END-STRING                                            CL*19
02725                PERFORM S2100-WRITE-REG-RPT THRU S2100-EXIT           CL*90
02726                PERFORM S946-WRITE-R140 THRU S946-EXIT                CL*19
02727           END-IF                                                     CL*19
02728      END-IF.                                                      DTSBX421
02729      PERFORM P3400-INIT-NEW-EMP          THRU P3400-EXIT.         DTSBX421
02730                                                                   DTSBX421
02731                                                                   DTSBX421
02732  P3000-EXIT.                                                      DTSBX421
02733      EXIT.                                                        DTSBX421
02734                                                                   DTSBX421
02735  P3100-CHK-COMPLETION.                                            DTSBX421
02736       MOVE SPACES TO X421-MESSAGE.                                   CL*97
02737       IF LX42-X102-EMP-NO NOT = SPACES                               CL*56
02738         MOVE SPACES TO R140-MESSAGE                                  CL*84
02739         MOVE W-EMP-NO TO R140-EMP-NO                                 CL*84
02740         MOVE 'X102 ERROR - ESSP REG FAILED >' TO X421-MESSAGE        CL*96
02741         STRING                                                       CL*84
02742            'X102- ESSP REGISTRATION FAILED (PROFILE ERROR) >>>> '    CL*86
02743               W-EMP-NO                                               CL*84
02744             DELIMITED BY SIZE                                        CL*84
02745             INTO R140-MESSAGE                                        CL*84
02746         END-STRING                                                   CL*84
02747         PERFORM S946-WRITE-R140 THRU S946-EXIT                       CL*84
02748          SET W-ERROR-YES-88 TO TRUE.                                 CL**7
02749                                                                      CL*84
02750       IF LX42-X104-EMP-NO NOT = SPACES                               CL*56
02751         MOVE SPACES TO R140-MESSAGE                                  CL*84
02752         MOVE W-EMP-NO TO R140-EMP-NO                                 CL*84
02753         STRING                                                       CL*84
02754            'X104- ESSP REGISTRATION FAILED (DETERM ERROR) >>>>  '    CL*86
02755               W-EMP-NO                                               CL*84
02756             DELIMITED BY SIZE                                        CL*84
02757             INTO R140-MESSAGE                                        CL*84
02758         END-STRING                                                   CL*84
02759         PERFORM S946-WRITE-R140 THRU S946-EXIT                       CL*84
02760          SET W-ERROR-YES-88 TO TRUE                                  CL*97
02761       IF X421-MESSAGE = SPACES                                       CL*97
02762         MOVE 'X104 ERROR - ESSP REG FAILED >' TO X421-MESSAGE.       CL*97
02763                                                                      CL*84
02764       IF LX42-X106-EMP-NO NOT =  SPACES                              CL*56
02765         MOVE SPACES TO R140-MESSAGE                                  CL*84
02766         MOVE W-EMP-NO TO R140-EMP-NO                                 CL*84
02767         STRING                                                       CL*84
02768            'X106- ESSP REGISTRAION FAILED (EMPL NAME ERROR) >>> '    CL*86
02769               W-EMP-NO                                               CL*84
02770             DELIMITED BY SIZE                                        CL*84
02771             INTO R140-MESSAGE                                        CL*84
02772         END-STRING                                                   CL*84
02773         PERFORM S946-WRITE-R140 THRU S946-EXIT                       CL*84
02774          SET W-ERROR-YES-88 TO TRUE                                  CL*97
02775       IF X421-MESSAGE = SPACES                                       CL*97
02776         MOVE 'X106 ERROR - ESSP REG FAILED >' TO X421-MESSAGE.       CL*97
02777                                                                      CL*84
02778       IF LX42-X108-EMP-NO NOT = SPACES                               CL*79
02779         MOVE SPACES TO R140-MESSAGE                                  CL*84
02780         MOVE W-EMP-NO TO R140-EMP-NO                                 CL*84
02781         STRING                                                       CL*84
02782            'X108- ESSP REFISTRATION FAILED (RATE ERROR) >>>> '       CL*86
02783               W-EMP-NO                                               CL*84
02784             DELIMITED BY SIZE                                        CL*84
02785             INTO R140-MESSAGE                                        CL*84
02786         END-STRING                                                   CL*84
02787         PERFORM S946-WRITE-R140 THRU S946-EXIT                       CL*84
02788          SET W-ERROR-YES-88 TO TRUE                                  CL*97
02789       IF X421-MESSAGE = SPACES                                       CL*97
02790         MOVE 'X108 ERROR - ESSP REG FAILED >' TO X421-MESSAGE.       CL*97
02791                                                                      CL*84
02792       IF LX42-X110-EMP-NO NOT =  SPACES                              CL*70
02793         MOVE SPACES TO R140-MESSAGE                                  CL*84
02794         MOVE W-EMP-NO TO R140-EMP-NO                                 CL*84
02795         STRING                                                       CL*84
02796            'X110- ESSP REGISTRATION FAILED (ADDRESS ERROR) >>>> '    CL*86
02797               W-EMP-NO                                               CL*84
02798             DELIMITED BY SIZE                                        CL*84
02799             INTO R140-MESSAGE                                        CL*84
02800         END-STRING                                                   CL*84
02801         PERFORM S946-WRITE-R140 THRU S946-EXIT                       CL*84
02802          SET W-ERROR-YES-88 TO TRUE                                  CL*97
02803       IF X421-MESSAGE = SPACES                                       CL*97
02804         MOVE 'X110 ERROR - ESSP REG FAILED >' TO X421-MESSAGE.       CL*97
02805                                                                      CL*84
02806 *     IF LX42-X120-EMP-NO NOT =  SPACES                              CL*71
02807 *        DISPLAY 'X120 HAS ERRORS ' W-EMP-NO                         CL*71
02808 *        SET W-ERROR-YES-88 TO TRUE.                                 CL*71
02809                                                                      CL**7
02810       IF  W-ERROR-YES-88                                             CL**7
02811         MOVE SPACES TO R140-MESSAGE                                  CL**7
02812         MOVE W-EMP-NO TO R140-EMP-NO                                 CL**7
02813         ADD +1        TO TOT-DUTAS-ERR-CNT                           CL*38
02814         ADD +1        TO WS-X140-ERR-CNT                             CL105
02815         STRING                                                       CL**7
02816         'X421- ****** ESSP REGISTRATION FAILED (REVIEW) ****** '     CL*85
02817               W-EMP-NO                                               CL**7
02818             DELIMITED BY SIZE                                        CL**7
02819             INTO R140-MESSAGE                                        CL**7
02820         END-STRING                                                   CL**7
02821         PERFORM S946-WRITE-R140 THRU S946-EXIT                       CL**7
02822 *       MOVE 'X421- ESSP REG FAILED ****** ' TO X421-MESSAGE         CL*96
02823         PERFORM S2100-WRITE-REG-RPT THRU S2100-EXIT                  CL*90
02824      END-IF.                                                         CL**7
02825                                                                      CL**7
02826      DISPLAY 'P3100-CHK-COMPLETION '                                 CL*65
02827      GO TO P3100-EXIT.                                               CL*67
02828                                                                      CL*65
02829 ***    DO NOT CHECK RATES IF PREDECESSORS EXIST                   DTSBX421
02830 **   IF X104-STAFF-REVIEW-YES-88                                     CL**9
02831 *    OR W-ERROR-YES-88                                               CL**9
02832 *       NEXT SENTENCE                                                CL**9
02833 *    ELSE                                                            CL**9
02834 *       IF X104-LIAB-RATED-88                                        CL**9
02835 *          PERFORM P3111-CHECK-RATES   THRU P3111-EXIT               CL**9
02836 *       END-IF                                                       CL**9
02837 *    END-IF.                                                         CL**9
02838 **     DISPLAY 'W-ENTITY-NAME'  W-ENTITY-NAME                     DTSBX421
02839 *    IF W-ENTITY-NAME = SPACES                                       CL**9
02840 **      DISPLAY 'NO ENITITY NAME'                                 DTSBX421
02841 *       SET W-ERROR-YES-88              TO TRUE                      CL**9
02842 *       MOVE SPACES TO R140-MESSAGE                                  CL**9
02843 *       MOVE W-EMP-NO TO R140-EMP-NO                                 CL**9
02844 *       STRING                                                       CL**9
02845 *          'ENTITY     NO ENTITY NAME FOUND '                        CL**9
02846 *             W-EMP-NO                                               CL**9
02847 *           DELIMITED BY SIZE                                        CL**9
02848 *           INTO R140-MESSAGE                                        CL**9
02849 *       END-STRING                                                   CL**9
02850 *       PERFORM S946-WRITE-R140 THRU S946-EXIT                       CL**9
02851 *    END-IF.                                                         CL**9
02852                                                                   DTSBX421
02853 *    IF W-ERROR-YES-88                                               CL*65
02854 *       PERFORM S1060-CLOSE-TEMP-BTC           THRU S1060-EXIT       CL*65
02855 *       IF W-FATAL-ERROR-NO-88                                       CL*65
02856 *          PERFORM S1040-OPEN-TEMP-BTC-OUT     THRU S1040-EXIT       CL*65
02857 *          GO TO P3100-EXIT                                          CL*65
02858 *       ELSE                                                         CL*65
02859 *          GO TO P3100-EXIT                                          CL*65
02860 *       END-IF                                                       CL*65
02861 *    END-IF.                                                         CL*65
02862 **   DISPLAY 'P3100 - 2 ' W-EMP-NO '  ' W-ERROR-IND.              DTSBX421
02863                                                                      CL*66
02864  P3100-EXIT.  EXIT.                                                  CL*67
02865                                                                   DTSBX421
02866  P3111-CHECK-RATES.                                               DTSBX421
02867        DISPLAY 'P3111-CHECK-RATES '                               DTSBX421
02868      SET W-RATE-ERROR-NO-88    TO TRUE.                           DTSBX421
02869      PERFORM                                                      DTSBX421
02870        VARYING SUB FROM +1 BY +1                                  DTSBX421
02871        UNTIL SUB > +5                                             DTSBX421
02872          IF W-RATE-YEAR (SUB) > ZERO                              DTSBX421
02873             IF W-RATE-FOUND-NO-88 (SUB)                           DTSBX421
02874                SET W-RATE-ERROR-YES-88     TO TRUE                DTSBX421
02875                SET W-ERROR-YES-88          TO TRUE                DTSBX421
02876             END-IF                                                DTSBX421
02877          END-IF                                                   DTSBX421
02878      END-PERFORM.                                                 DTSBX421
02879                                                                   DTSBX421
02880      IF W-RATE-ERROR-YES-88                                       DTSBX421
02881         MOVE SPACES TO R140-MESSAGE                               DTSBX421
02882         MOVE W-EMP-NO TO R140-EMP-NO                              DTSBX421
02883         STRING                                                    DTSBX421
02884            'RATE       SOME RATES MISSING '                       DTSBX421
02885               W-EMP-NO                                            DTSBX421
02886             DELIMITED BY SIZE                                     DTSBX421
02887             INTO R140-MESSAGE                                     DTSBX421
02888         END-STRING                                                DTSBX421
02889         PERFORM S946-WRITE-R140 THRU S946-EXIT                    DTSBX421
02890 **      PERFORM                                                   DTSBX421
02891 *         VARYING SUB FROM +1 BY +1                               DTSBX421
02892 *         UNTIL SUB > +5                                          DTSBX421
02893 *           IF W-RATE-YEAR (SUB) > ZERO                           DTSBX421
02894 *              DISPLAY W-RATE-YEAR (SUB) '  '                     DTSBX421
02895 *                      W-RATE-FOUND-IND (SUB)                     DTSBX421
02896 *           END-IF                                                DTSBX421
02897 **      END-PERFORM                                               DTSBX421
02898      END-IF.                                                      DTSBX421
02899                                                                   DTSBX421
02900  P3111-EXIT.                                                      DTSBX421
02901      EXIT.                                                        DTSBX421
02902                                                                   DTSBX421
02903  P3200-DETERM.                                                    DTSBX421
02904 *    DISPLAY 'P3200-DETERM'                                          CL*10
02905      DISPLAY 'BX421 NEW EMP ADDED ' W-EMP-NO '  ' W-ENTITY-NAME.     CL*36
02906                                                                   DTSBX421
02907      MOVE LOW-VALUES                TO T002-REC.                  DTSBX421
02908                                                                   DTSBX421
02909      SET T002-LENGTH-DETERM-88      TO TRUE.                      DTSBX421
02910      MOVE '002'                     TO T002-REC-TYPE.             DTSBX421
02911      MOVE W-EMP-NO                  TO T002-EMP-NO.               DTSBX421
02912      MOVE 'WEB REG   '              TO T002-ORIGIN.               DTSBX421
02913      MOVE LX42-SYS-DATE             TO T002-SYS-DATE.             DTSBX421
02914      MOVE LX42-SYS-TIME             TO T002-SYS-TIME.             DTSBX421
02915                                                                   DTSBX421
02916                                                                   DTSBX421
02917      MOVE W-FEIN                    TO Y104-FEIN.                 DTSBX421
02918 *    MOVE X104-STAFF-REVIEW-IND     TO Y104-STAFF-REVIEW-IND.        CL*73
02919      MOVE 'N'                       TO Y104-STAFF-REVIEW-IND.        CL*73
02920      IF  W-ENTITY-NAME > SPACES                                      CL*74
02921         MOVE W-ENTITY-NAME     TO L009-DATA                          CL*74
02922         PERFORM S009-CONVERT-TO-CAPS THRU S009-EXIT                  CL*74
02923         MOVE L009-DATA        TO Y104-ENTITY-NAME                    CL*74
02924      ELSE                                                            CL*74
02925         MOVE W-ENTITY-NAME             TO Y104-ENTITY-NAME.          CL*74
02926                                                                      CL*74
02927      IF  W-TRADE-NAME > SPACES                                       CL*74
02928         MOVE W-TRADE-NAME     TO L009-DATA                           CL*74
02929         PERFORM S009-CONVERT-TO-CAPS THRU S009-EXIT                  CL*74
02930         MOVE L009-DATA        TO Y104-TRADE-NAME                     CL*74
02931      ELSE                                                            CL*74
02932         MOVE W-TRADE-NAME              TO Y104-TRADE-NAME.           CL*74
02933                                                                      CL*74
02934      MOVE W-SOURCE-CD               TO Y104-SOURCE-CD.            DTSBX421
02935      MOVE X104-LIAB-CD              TO Y104-LIAB-CD.              DTSBX421
02936      MOVE X104-ELIG-CD              TO Y104-ELIG-CD.              DTSBX421
02937      MOVE X104-NAICS-CD             TO Y104-NAICS.                DTSBX421
02938      MOVE SPACES                    TO Y104-OWN-CD.               DTSBX421
02939      MOVE X104-ORG-TYPE             TO Y104-ORG-TYPE.             DTSBX421
02940      MOVE X104-HOUSEHOLD-FILING     TO Y104-HOUSEHOLD-FILING.     DTSBX421
02941      MOVE X104-INCORP-STATE         TO Y104-CORP-STATE.           DTSBX421
02942      MOVE W-INCORP-DATE             TO Y104-CORP-DATE.            DTSBX421
02943      MOVE W-LIABLE-DATE             TO Y104-FIRST-WAGE-DT.        DTSBX421
02944      MOVE W-FIRST-500-QTR           TO Y104-FIRST-500-QTR.        DTSBX421
02945      MOVE ZERO                      TO Y104-LAST-WAGE-DT.         DTSBX421
02946      MOVE X104-ACQUIRE-IND          TO Y104-ACQUIRE-IND.          DTSBX421
02947      MOVE X104-MERGER-SPLIT-IND     TO Y104-MERGE-SPLIT-IND.      DTSBX421
02948      MOVE X104-REORG-IND            TO Y104-REORG-IND.            DTSBX421
02949      MOVE X104-COMMON-OWN-IND       TO Y104-COMMON-OWN-IND.       DTSBX421
02950      MOVE X104-SALE-TRANSFER-IND    TO Y104-SALE-TRANSFER-IND.    DTSBX421
02951                                                                      CL*79
02952 *    IF X104-ORG-HSEHLD-DMSTIC-88                                    CL135
02953         MOVE 'N'                    TO Y104-MERGE-SPLIT-IND          CL*79
02954                                        Y104-REORG-IND                CL*79
02955                                        Y104-ACQUIRE-IND              CL*79
02956                                        Y104-COMMON-OWN-IND           CL*79
02957                                        Y104-SALE-TRANSFER-IND.       CL135
02958 *    END-IF.                                                         CL135
02959                                                                   DTSBX421
02960      MOVE Y104-REC                  TO T002-DATA-AREA.            DTSBX421
02961      SET T002-DETERM-88             TO TRUE.                      DTSBX421
02962      PERFORM S1030-WRITE-TEMP-T002  THRU S1030-EXIT.              DTSBX421
02963                                                                      CL*79
02964 ***  ADD +1 TO W-T002-DETERM-CNT.                                    CL*44
02965 *&                                                                DTSBX421
02966      DISPLAY 'BX421 NEW EMP LIABILITY ADDED ' W-EMP-NO '  '          CL*54
02967            X104-HOUSEHOLD-FILING ' '                                 CL*54
02968            W-LIABLE-DATE ' ' W-FIRST-500-QTR.                        CL*54
02969 *&                                                                   CL*54
02970      IF NOT X104-NOT-LIAB-NULL-88                                 DTSBX421
02971         PERFORM P3210-NOT-LIAB-REASON      THRU P3210-EXIT        DTSBX421
02972      END-IF.                                                      DTSBX421
02973                                                                   DTSBX421
02974  P3200-EXIT.                                                      DTSBX421
02975      EXIT.                                                        DTSBX421
02976                                                                   DTSBX421
02977  P3210-NOT-LIAB-REASON.                                           DTSBX421
02978      DISPLAY 'P3210-NOT-LIAB-REASON '                             DTSBX421
02979      DISPLAY 'P3210 ' W-EMP-NO '  ' X104-NOT-LIAB-REASON.         DTSBX421
02980                                                                   DTSBX421
02981      PERFORM S3000-INIT-T003        THRU S3000-EXIT.              DTSBX421
02982                                                                   DTSBX421
02983      SET W-MNTE-NOT-LIAB-88         TO TRUE                       DTSBX421
02984      MOVE W-MNTE-SUBJECT            TO MNTE-SUBJECT               DTSBX421
02985                                                                   DTSBX421
02986      MOVE +1                      TO MNTE-TEXT-CNT.               DTSBX421
02987      MOVE W-ENTITY-NAME                                           DTSBX421
02988         TO MNTE-TEXT (MNTE-TEXT-CNT).                             DTSBX421
02989                                                                   DTSBX421
02990      ADD  +1                      TO MNTE-TEXT-CNT.               DTSBX421
02991                                                                   DTSBX421
02992      EVALUATE TRUE                                                DTSBX421
02993         WHEN X104-NOT-LIAB-BUS-ACT-88                             DTSBX421
02994            MOVE 'THE TYPE OF EMPLOYMENT IS NOT COVERED'           DTSBX421
02995             TO MNTE-TEXT (MNTE-TEXT-CNT)                          DTSBX421
02996                                                                   DTSBX421
02997         WHEN X104-NOT-LIAB-NO-EMPL-88                             DTSBX421
02998            STRING 'THE BUSINESS PAYS WAGES ONLY TO '              DTSBX421
02999                   'OWNERS OR OFFICERS'                            DTSBX421
03000               DELIMITED BY SIZE                                   DTSBX421
03001               INTO MNTE-TEXT (MNTE-TEXT-CNT)                      DTSBX421
03002            END-STRING                                             DTSBX421
03003                                                                   DTSBX421
03004         WHEN X104-NOT-LIAB-NO-WAGES-88                            DTSBX421
03005            IF X104-ORG-HSEHLD-DMSTIC-88                           DTSBX421
03006               STRING 'A HOUSEHOLD EMPLOYER PAYS LESS '            DTSBX421
03007                      'THAN $500.00 EACH QUARTER'                  DTSBX421
03008                  DELIMITED BY SIZE                                DTSBX421
03009                  INTO MNTE-TEXT (MNTE-TEXT-CNT)                   DTSBX421
03010               END-STRING                                          DTSBX421
03011            ELSE                                                   DTSBX421
03012               STRING 'THE BUSINESS DOES NOT PAY WAGES '           DTSBX421
03013                      'FOR WORK PERFORMED IN DC'                   DTSBX421
03014                  DELIMITED BY SIZE                                DTSBX421
03015                  INTO MNTE-TEXT (MNTE-TEXT-CNT)                   DTSBX421
03016               END-STRING                                          DTSBX421
03017            END-IF                                                 DTSBX421
03018                                                                   DTSBX421
03019         WHEN X104-NOT-LIAB-LOCALIZE-88                            DTSBX421
03020            MOVE 'THE WORK IS NOT LOCALIZED IN DC '                DTSBX421
03021                 TO MNTE-TEXT (MNTE-TEXT-CNT)                      DTSBX421
03022                                                                   DTSBX421
03023      END-EVALUATE.                                                DTSBX421
03024                                                                   DTSBX421
03025                                                                   DTSBX421
03026      MOVE MNTE-REC                  TO T003-MNTE-REC.             DTSBX421
03027                                                                   DTSBX421
03028      PERFORM S1031-WRITE-TEMP-T003  THRU S1031-EXIT.              DTSBX421
03029                                                                   DTSBX421
03030 *&                                                                DTSBX421
03031 *    DISPLAY 'NOT LIAB MNTE ' W-EMP-NO.                           DTSBX421
03032 *    PERFORM                                                      DTSBX421
03033 *      VARYING SUB FROM +1 BY +1                                  DTSBX421
03034 *      UNTIL SUB > MNTE-TEXT-CNT                                  DTSBX421
03035 *         DISPLAY MNTE-TEXT (SUB)                                 DTSBX421
03036 *    END-PERFORM.                                                 DTSBX421
03037 *&                                                                DTSBX421
03038  P3210-EXIT.                                                      DTSBX421
03039      EXIT.                                                        DTSBX421
03040                                                                   DTSBX421
03041 *P3300-COPY-TO-BTC.                                                  CL*63
03042 *    DISPLAY 'P3300-COPY-TO-BTC '                                    CL*63
03043 *    DISPLAY 'BX421 COMPLETE ' W-EMP-NO.                             CL*63
03044 *    PERFORM S1060-CLOSE-TEMP-BTC           THRU S1060-EXIT.         CL*63
03045 *    IF W-FATAL-ERROR-NO-88                                          CL*63
03046 *       IF W-ERROR-NO-88                                             CL*63
03047 *          PERFORM P3310-COPY-TO-BTC        THRU P3310-EXIT          CL*63
03048 *       END-IF                                                       CL*63
03049 *    ELSE                                                            CL*63
03050 *       DISPLAY 'P3300 FATAL ERR ON CLOSE'                           CL*63
03051 *       GO TO P3300-EXIT                                             CL*63
03052 *    END-IF.                                                         CL*63
03053                                                                   DTSBX421
03054 *    IF NOT LX42-TERMINATE-88                                        CL*63
03055 *       PERFORM S1040-OPEN-TEMP-BTC-OUT     THRU S1040-EXIT          CL*63
03056 *    END-IF.                                                         CL*63
03057                                                                   DTSBX421
03058 *P3300-EXIT.                                                         CL*63
03059      EXIT.                                                        DTSBX421
03060                                                                   DTSBX421
03061 *P3310-COPY-TO-BTC.                                                  CL*64
03062 *     DISPLAY 'P3310-COPY-TO-BTC '                                   CL*64
03063 *    PERFORM S1050-OPEN-TEMP-BTC-IN   THRU S1050-EXIT                CL*64
03064 *    IF W-FATAL-ERROR-YES-88                                         CL*64
03065 *       GO TO P3310-EXIT                                             CL*64
03066 *    END-IF.                                                         CL*64
03067                                                                   DTSBX421
03068 *    PERFORM S1070-READ-TEMP-BTC        THRU S1070-EXIT.             CL*64
03069                                                                   DTSBX421
03070 *    PERFORM                                                         CL*64
03071 *      UNTIL TEMP-BTC-STATUS-EOF-88                                  CL*64
03072 *      OR W-FATAL-ERROR-YES-88                                       CL*64
03073 *         PERFORM S927B-WRITE           THRU S927B-EXIT              CL*64
03074 *         PERFORM P3311-COUNT           THRU P3311-EXIT              CL*64
03075 *         PERFORM S1070-READ-TEMP-BTC   THRU S1070-EXIT              CL*64
03076 *    END-PERFORM.                                                    CL*64
03077                                                                   DTSBX421
03078 *    PERFORM S1060-CLOSE-TEMP-BTC       THRU S1060-EXIT.             CL*64
03079                                                                   DTSBX421
03080 *P3310-EXIT.                                                         CL*64
03081 *    EXIT.                                                           CL*64
03082                                                                   DTSBX421
03083  P3311-COUNT.                                                     DTSBX421
03084      IF TSKL-NOTEPAD-88                                           DTSBX421
03085         ADD +1                     TO W-T003-WRITE-CNT            DTSBX421
03086         GO TO P3311-EXIT                                          DTSBX421
03087      END-IF.                                                      DTSBX421
03088                                                                   DTSBX421
03089      MOVE TEMP-BTC-REC             TO T002-REC.                   DTSBX421
03090      ADD +1                        TO W-T002-WRITE-CNT.           DTSBX421
03091                                                                   DTSBX421
03092      EVALUATE TRUE                                                DTSBX421
03093        WHEN T002-DETERM-88                                        DTSBX421
03094          ADD +1                    TO W-T002-DETERM-CNT           DTSBX421
03095                                                                   DTSBX421
03096        WHEN T002-EMP-NAME-88                                      DTSBX421
03097          ADD +1                    TO W-T002-NAME-CNT             DTSBX421
03098                                                                   DTSBX421
03099        WHEN T002-EMP-RATE-88                                      DTSBX421
03100          ADD +1                    TO W-T002-RATE-CNT             DTSBX421
03101                                                                   DTSBX421
03102        WHEN T002-EMP-ADDR-88                                      DTSBX421
03103          ADD +1                    TO W-T002-ADDR-CNT             DTSBX421
03104                                                                   DTSBX421
03105        WHEN T002-CONTACT-88                                       DTSBX421
03106          ADD +1                    TO W-T002-OPO-CNT              DTSBX421
03107                                                                   DTSBX421
03108        WHEN T002-EMP-REL-88                                       DTSBX421
03109          ADD +1                    TO W-T002-REL-CNT              DTSBX421
03110                                                                   DTSBX421
03111      END-EVALUATE.                                                DTSBX421
03112                                                                   DTSBX421
03113  P3311-EXIT.                                                      DTSBX421
03114      EXIT.                                                        DTSBX421
03115                                                                   DTSBX421
03116  P3400-INIT-NEW-EMP.                                              DTSBX421
03117      MOVE LX42-EMP-NO        TO W-EMP-NO.                         DTSBX421
03118      SET W-ERROR-NO-88       TO TRUE.                             DTSBX421
03119      SET W-PREV-REC-NULL-88  TO TRUE.                             DTSBX421
03120      MOVE ZERO               TO W-LIABLE-DATE                     DTSBX421
03121                                 W-INCORP-DATE                     DTSBX421
03122                                 W-WAGES-PLANNED-DATE              DTSBX421
03123                                 W-FIRST-500-QTR                   DTSBX421
03124                                 W-FEIN.                           DTSBX421
03125                                                                   DTSBX421
03126      MOVE SPACES             TO W-ENTITY-NAME                     DTSBX421
03127                                 W-TRADE-NAME                      DTSBX421
03128                                 W-SOURCE-CD                       DTSBX421
03129                                 W-FIELD-ZIP                       DTSBX421
03130                                 W-FIELD-STATE                        CL*56
03131                                 LX42-X104-LIAB-CD.                   CL*56
03132      MOVE '888888'           TO LX42-X102-EMP-NO                     CL*57
03133                                 LX42-X104-EMP-NO                     CL**4
03134                                 LX42-X106-EMP-NO                     CL**4
03135                                 LX42-X108-EMP-NO                     CL**4
03136                                 LX42-X110-EMP-NO                     CL**4
03137                                 LX42-X120-EMP-NO.                    CL*56
03138 *                               LX42-X140-EMP-NO                     CL*45
03139 *                               LX42-X144-EMP-NO                     CL*45
03140 *                               LX42-X145-EMP-NO.                    CL*56
03141                                                                      CL**4
03142      INITIALIZE              X102-REC                             DTSBX421
03143                              X104-REC                             DTSBX421
03144                              X106-REC                             DTSBX421
03145                              X108-REC                             DTSBX421
03146                              X110-REC                             DTSBX421
03147                              X120-REC                             DTSBX421
03148                              X130-REC.                            DTSBX421
03149      PERFORM                                                      DTSBX421
03150        VARYING SUB FROM +1 BY +1                                  DTSBX421
03151        UNTIL SUB > +5                                             DTSBX421
03152           MOVE ZERO                     TO W-RATE-YEAR (SUB)      DTSBX421
03153           SET W-RATE-FOUND-NO-88 (SUB)  TO TRUE                   DTSBX421
03154      END-PERFORM.                                                 DTSBX421
03155                                                                   DTSBX421
03156  P3400-EXIT.                                                      DTSBX421
03157      EXIT.                                                        DTSBX421
03158                                                                   DTSBX421
03159                                                                   DTSBX421
03160  T0000-TERMINATE.                                                 DTSBX421
03161      DISPLAY ' '.                                                 DTSBX421
03162                                                                   DTSBX421
03163      DISPLAY '***************************************'.              CL*44
03164      DISPLAY '*** DTSBX421 TERMINATION STATISTICS ***'.           DTSBX421
03165      DISPLAY '***     EMPLOYER REGISTRATION       ***'.           DTSBX421
03166      DISPLAY '***************************************'.              CL*44
03167                                                                   DTSBX421
03168      PERFORM T2000-DISPLAY-TOTALS         THRU T2000-EXIT.        DTSBX421
03169                                                                   DTSBX421
03170      DISPLAY ' '.                                                 DTSBX421
03171      MOVE WS-X140-RED-CNT TO WS-X102-RED-CNT                         CL106
03172      MOVE WS-X140-ERR-CNT TO WS-X102-ERR-CNT                         CL106
03173      MOVE WS-X140-PEN-CNT TO WS-X102-PEN-CNT                         CL107
03174      WRITE REPT-PAID-REC FROM FOOTING-LINE-1 AFTER 2                 CL106
03175      WRITE REPT-PAID-REC FROM FOOTING-LINE-2 AFTER 1                 CL106
03176      WRITE REPT-PAID-REC FROM FOOTING-LINE-51 AFTER 1                CL107
03177      WRITE REPT-PAID-REC FROM FOOTING-LINE-6 AFTER 1                 CL107
03178      WRITE REPT-PAID-REC FROM FOOTING-LINE-7 AFTER 1                 CL106
03179      WRITE REPT-PAID-REC FROM FOOTING-LINE-14 AFTER 1                CL106
03180                                                                   DTSBX421
03181      CLOSE                    TEMP-BTC-FILE.                      DTSBX421
03182                                                                   DTSBX421
03183                                                                   DTSBX421
03184  T0000-EXIT.                                                      DTSBX421
03185      EXIT.                                                        DTSBX421
03186                                                                   DTSBX421
03187  T2000-DISPLAY-TOTALS.                                            DTSBX421
03188      DISPLAY ' '                                                     CL*38
03189      DISPLAY 'X102-  PROFILE RECORDS READ  :' W-X102-RED-CNT.        CL*38
03190      DISPLAY '  X102-PROFILE RECORDS ERROR :' W-X102-ERR-CNT.        CL*38
03191      DISPLAY '  X102-PROFILE RECORDS DUP   :' W-X102-DUP-CNT.        CL*38
03192      DISPLAY '  X102-PROFILE RECORDS SAVED :' W-X102-SAV-CNT.        CL*38
03193      DISPLAY ' '                                                     CL*38
03194      DISPLAY 'X104-  DETERM  RECORDS READ  :' W-X104-RED-CNT.        CL*38
03195      DISPLAY '  X104-DETERM  RECORDS ERROR :' W-X104-ERR-CNT.        CL*38
03196      DISPLAY '  X104-DETERM  RECORDS DUP   :' W-X104-DUP-CNT.        CL*38
03197      DISPLAY '  X104-DETERM  RECORDS SAVED :' W-X104-SAV-CNT.        CL*38
03198      DISPLAY ' '                                                     CL*38
03199      DISPLAY 'X106-  EMPNAME RECORDS READ  : ' W-X106-RED-CNT.       CL*38
03200      DISPLAY '  X106-EMPNAME RECORDS ERROR : ' W-X106-ERR-CNT.       CL*38
03201      DISPLAY '  X106-EMPNAME RECORDS DUP   : ' W-X106-DUP-CNT.       CL*38
03202      DISPLAY '  X106-EMPNAME RECORDS SAVED : ' W-X106-SAV-CNT.       CL*38
03203      DISPLAY ' '                                                     CL*38
03204      DISPLAY 'X108-  RATE    RECORDS READ  : ' W-X108-RED-CNT.       CL*38
03205      DISPLAY '  X108-RATE    RECORDS ERROR : ' W-X108-ERR-CNT.       CL*38
03206      DISPLAY '  X108-RATE    RECORDS DUP   : ' W-X108-DUP-CNT.       CL*38
03207      DISPLAY '  X108-RATE    RECORDS SAVED : ' W-X108-SAV-CNT.       CL*38
03208      DISPLAY ' '                                                     CL*38
03209      DISPLAY 'TOTAL- DUTAS EMPLOYERS CREATED :  '                    CL*44
03210              W-T002-DETERM-CNT.                                   DTSBX421
03211                                                                   DTSBX421
03212 *    DISPLAY 'TOTAL OUTPUT T002 RECORDS WRITTEN: '                   CL*44
03213 *            W-T002-WRITE-CNT.                                       CL*44
03214                                                                      CL*25
03215 *    DISPLAY 'TOTAL OUTPUT T003 RECORDS WRITTEN  '                   CL*44
03216 *            W-T003-WRITE-CNT.                                       CL*44
03217                                                                   DTSBX421
03218      DISPLAY '  '.                                                DTSBX421
03219      DISPLAY '***********  END REGISTRATION  ************ '.         CL*44
03220                                                                   DTSBX421
03221  T2000-EXIT.                                                      DTSBX421
03222      EXIT.                                                        DTSBX421
03223                                                                   DTSBX421
03224  S001-FROM-FED-8.                                                 DTSBX421
03225      SET L001-FROM-FED-8 TO TRUE.                                 DTSBX421
03226      GO TO S001-DATE.                                             DTSBX421
03227                                                                   DTSBX421
03228  S001-FROM-CAL-8.                                                 DTSBX421
03229      SET L001-FROM-CAL-8 TO TRUE.                                 DTSBX421
03230      GO TO S001-DATE.                                             DTSBX421
03231                                                                   DTSBX421
03232  S001-FROM-ABS-DAY.                                               DTSBX421
03233      SET L001-FROM-ABS-DAY TO TRUE.                               DTSBX421
03234      GO TO S001-DATE.                                             DTSBX421
03235                                                                   DTSBX421
03236  S001-DATE.                                                       DTSBX421
03237      CALL 'DTSBU001' USING L001-LINK-AREA.                        DTSBX421
03238  S001-EXIT.                                                       DTSBX421
03239      EXIT.                                                        DTSBX421
03240                                                                   DTSBX421
03241  S003-AGENCY-DAY.                                                 DTSBX421
03242      SET L003-AGENCY-DAY TO TRUE.                                 DTSBX421
03243      GO TO S003-WORK-DAY.                                         DTSBX421
03244                                                                   DTSBX421
03245  S003-WORK-DAY.                                                   DTSBX421
03246      CALL 'DTSBU003' USING L003-LINK-AREA.                        DTSBX421
03247  S003-EXIT.                                                       DTSBX421
03248      EXIT.                                                        DTSBX421
03249                                                                   DTSBX421
03250  S004-FROM-5.                                                     DTSBX421
03251      SET L004-FROM-5        TO TRUE.                              DTSBX421
03252      GO TO S004-YRQ.                                              DTSBX421
03253                                                                   DTSBX421
03254  S004-FROM-DATE.                                                  DTSBX421
03255      SET L004-FROM-DATE     TO TRUE.                              DTSBX421
03256      GO TO S004-YRQ.                                              DTSBX421
03257                                                                   DTSBX421
03258  S004-FROM-ABS.                                                   DTSBX421
03259      SET L004-FROM-ABS      TO TRUE.                              DTSBX421
03260      GO TO S004-YRQ.                                              DTSBX421
03261                                                                   DTSBX421
03262  S004-YRQ.                                                        DTSBX421
03263      CALL 'DTSBU004' USING L004-LINK-AREA.                        DTSBX421
03264                                                                   DTSBX421
03265  S004-EXIT.                                                       DTSBX421
03266      EXIT.                                                        DTSBX421
03267  S009-CONVERT-TO-CAPS.                                               CL*74
03268                                                                      CL*74
03269      CALL 'DTSBU009' USING L009-LINK-AREA.                           CL*74
03270                                                                      CL*74
03271  S009-EXIT.                                                          CL*74
03272      EXIT.                                                           CL*74
03273                                                                      CL*74
03274                                                                   DTSBX421
03275  S052-UI-RATE-EDIT.                                               DTSBX421
03276      CALL 'DTSBU052' USING L052-LINK-AREA.                        DTSBX421
03277                                                                   DTSBX421
03278  S052-EXIT.                                                       DTSBX421
03279      EXIT.                                                        DTSBX421
03280                                                                   DTSBX421
03281  S072-ADDRESS.                                                    DTSBX421
03282      CALL 'DTSBU072' USING L072-LINK-AREA.                        DTSBX421
03283                                                                   DTSBX421
03284  S072-EXIT.                                                       DTSBX421
03285      EXIT.                                                        DTSBX421
03286                                                                   DTSBX421
03287  S516-LIABILITY-INFO.                                             DTSBX421
03288      CALL 'DTSBU516' USING L516-LINK-AREA                         DTSBX421
03289                            MPRF-REC.                              DTSBX421
03290  S516-EXIT.                                                       DTSBX421
03291      EXIT.                                                        DTSBX421
03292                                                                   DTSBX421
03293 *S910-OPEN-READ.                                                  DTSBX421
03294 *    SET L910-OPEN-READ-88 TO TRUE.                               DTSBX421
03295 *    GO TO S910-MSTR-IO.                                          DTSBX421
03296                                                                   DTSBX421
03297  S910-READ.                                                       DTSBX421
03298      SET L910-READ-88 TO TRUE.                                    DTSBX421
03299      GO TO S910-MSTR-IO.                                          DTSBX421
03300                                                                   DTSBX421
03301  S910-START-BROWSE.                                               DTSBX421
03302      SET L910-START-BROWSE-88 TO TRUE.                            DTSBX421
03303      GO TO S910-MSTR-IO.                                          DTSBX421
03304                                                                   DTSBX421
03305  S910-READ-NEXT.                                                  DTSBX421
03306      SET L910-READ-NEXT-88 TO TRUE.                               DTSBX421
03307      GO TO S910-MSTR-IO.                                          DTSBX421
03308                                                                   DTSBX421
03309 *S910-CLOSE.                                                      DTSBX421
03310 *    SET L910-CLOSE-88     TO TRUE.                               DTSBX421
03311 *    GO TO S910-MSTR-IO.                                          DTSBX421
03312                                                                   DTSBX421
03313  S910-MSTR-IO.                                                    DTSBX421
03314      CALL 'DTSBU910' USING L910-LINK-AREA                         DTSBX421
03315                            MSKL-REC.                              DTSBX421
03316  S910-EXIT.                                                       DTSBX421
03317      EXIT.                                                        DTSBX421
03318                                                                   DTSBX421
03319  S921-OPEN-READ.                                                  DTSBX421
03320      SET L921-OPEN-READ-88 TO TRUE.                               DTSBX421
03321      GO TO S921-AIX-IO.                                           DTSBX421
03322                                                                   DTSBX421
03323  S921-READ.                                                       DTSBX421
03324      SET L921-READ-88 TO TRUE.                                    DTSBX421
03325      GO TO S921-AIX-IO.                                           DTSBX421
03326                                                                   DTSBX421
03327  S921-START-BROWSE.                                               DTSBX421
03328      SET L921-START-BROWSE-88 TO TRUE.                            DTSBX421
03329      GO TO S921-AIX-IO.                                           DTSBX421
03330                                                                   DTSBX421
03331  S921-READ-NEXT.                                                  DTSBX421
03332      SET L921-READ-NEXT-88 TO TRUE.                               DTSBX421
03333      GO TO S921-AIX-IO.                                           DTSBX421
03334                                                                   DTSBX421
03335  S921-CLOSE.                                                      DTSBX421
03336      SET L921-CLOSE-88 TO TRUE.                                   DTSBX421
03337      GO TO S921-AIX-IO.                                           DTSBX421
03338                                                                   DTSBX421
03339  S921-AIX-IO.                                                     DTSBX421
03340      CALL 'DTSBU921' USING L921-LINK-AREA                         DTSBX421
03341                            ISKL-REC.                              DTSBX421
03342  S921-EXIT.                                                       DTSBX421
03343      EXIT.                                                        DTSBX421
03344                                                                   DTSBX421
03345 *S927A-OPEN.                                                      DTSBX421
03346 *    SET L927-OPEN-UPDATE-88  TO TRUE.                            DTSBX421
03347 *    PERFORM S927Z-IO   THRU S927Z-EXIT.                          DTSBX421
03348 *                                                                 DTSBX421
03349 *S927A-EXIT.                                                      DTSBX421
03350 *    EXIT.                                                        DTSBX421
03351                                                                   DTSBX421
03352  S927B-WRITE.                                                     DTSBX421
03353      SET L927-WRITE-88 TO TRUE.                                   DTSBX421
03354      PERFORM S927Z-IO   THRU S927Z-EXIT.                          DTSBX421
03355                                                                   DTSBX421
03356  S927B-EXIT.                                                      DTSBX421
03357      EXIT.                                                        DTSBX421
03358                                                                   DTSBX421
03359 *S927C-CLOSE.                                                     DTSBX421
03360 *    SET L927-CLOSE-88        TO TRUE.                            DTSBX421
03361 *    PERFORM S927Z-IO   THRU S927Z-EXIT.                          DTSBX421
03362 *                                                                 DTSBX421
03363 *S927C-EXIT.                                                      DTSBX421
03364 *    EXIT.                                                        DTSBX421
03365                                                                   DTSBX421
03366  S927Z-IO.                                                        DTSBX421
03367      CALL 'DTSBU927' USING L927-LINK-AREA                         DTSBX421
03368                            TSKL-REC.                              DTSBX421
03369  S927Z-EXIT.                                                      DTSBX421
03370      EXIT.                                                        DTSBX421
03371                                                                   DTSBX421
03372 *S931-OPEN-READ.                                                  DTSBX421
03373 *    SET L931-OPEN-READ-88 TO TRUE.                               DTSBX421
03374 *    GO TO S931-REF-IO.                                           DTSBX421
03375 *                                                                 DTSBX421
03376 *S931-CLOSE.                                                      DTSBX421
03377 *    SET L931-CLOSE-88 TO TRUE.                                   DTSBX421
03378 *    GO TO S931-REF-IO.                                           DTSBX421
03379 *                                                                 DTSBX421
03380 *S931-REF-IO.                                                     DTSBX421
03381 *    CALL 'DTSBU931' USING L931-LINK-AREA                         DTSBX421
03382 *                          FSKL-REC.                              DTSBX421
03383 *S931-EXIT.                                                       DTSBX421
03384 *    EXIT.                                                        DTSBX421
03385                                                                   DTSBX421
03386  S946-WRITE-R140.                                                 DTSBX421
03387 *    MOVE SPACES TO R140-MESSAGE                                  DTSBX421
03388 *    MOVE W-EMP-NO TO R140-EMP-NO                                 DTSBX421
03389 *    STRING                                                       DTSBX421
03390 *       MSG1-TYPE ' - '                                           DTSBX421
03391 *       MSG1-MESSAGE ': '                                         DTSBX421
03392 *       X108-RATE-YEAR                                            DTSBX421
03393 *     DELIMITED BY SIZE                                           DTSBX421
03394 *     INTO R140-MESSAGE                                           DTSBX421
03395 *    END-STRING.                                                  DTSBX421
03396                                                                   DTSBX421
03397      CALL 'DTSBU946' USING R140-REC.                              DTSBX421
03398                                                                   DTSBX421
03399  S946-EXIT.                                                       DTSBX421
03400      EXIT.                                                        DTSBX421
03401                                                                   DTSBX421
03402  S1030-WRITE-TEMP-T002.                                           DTSBX421
03403      DISPLAY 'S1020-WRITE-TEMP-T002'                              DTSBX421
03404      MOVE T002-LENGTH     TO VAR-CHAR-CNT.                        DTSBX421
03405      MOVE T002-REC        TO TEMP-BTC-REC.                        DTSBX421
03406      WRITE TEMP-BTC-REC.                                          DTSBX421
03407      IF TEMP-BTC-STATUS-OK-88                                     DTSBX421
03408         DISPLAY 'WROTE PROFILE T002 EMP REC X421 ' W-EMP-NO          CL*62
03409      ELSE                                                         DTSBX421
03410         SET W-ERROR-YES-88 TO TRUE                                DTSBX421
03411         DISPLAY 'CANNOT WRITE TEMP T002: '                        DTSBX421
03412            TEMP-BTC-STATUS                                        DTSBX421
03413      END-IF.                                                      DTSBX421
03414                                                                   DTSBX421
03415  S1030-EXIT.                                                      DTSBX421
03416      EXIT.                                                        DTSBX421
03417                                                                   DTSBX421
03418  S1031-WRITE-TEMP-T003.                                           DTSBX421
03419      MOVE T003-LENGTH     TO VAR-CHAR-CNT.                        DTSBX421
03420      MOVE T003-REC        TO TEMP-BTC-REC.                        DTSBX421
03421      WRITE TEMP-BTC-REC.                                          DTSBX421
03422      IF TEMP-BTC-STATUS-OK-88                                     DTSBX421
03423         NEXT SENTENCE                                             DTSBX421
03424      ELSE                                                         DTSBX421
03425         SET W-ERROR-YES-88 TO TRUE                                DTSBX421
03426         DISPLAY 'CANNOT WRITE TEMP T003: '                        DTSBX421
03427            TEMP-BTC-STATUS                                        DTSBX421
03428      END-IF.                                                      DTSBX421
03429                                                                   DTSBX421
03430  S1031-EXIT.                                                      DTSBX421
03431      EXIT.                                                        DTSBX421
03432                                                                   DTSBX421
03433  S1032-WRITE-TEMP-T027.                                           DTSBX421
03434      MOVE T027-LENGTH     TO VAR-CHAR-CNT.                        DTSBX421
03435      MOVE T027-REC        TO TEMP-BTC-REC.                        DTSBX421
03436      WRITE TEMP-BTC-REC.                                          DTSBX421
03437      IF TEMP-BTC-STATUS-OK-88                                     DTSBX421
03438         NEXT SENTENCE                                             DTSBX421
03439      ELSE                                                         DTSBX421
03440         SET W-ERROR-YES-88 TO TRUE                                DTSBX421
03441         DISPLAY 'CANNOT WRITE TEMP T027: '                        DTSBX421
03442            TEMP-BTC-STATUS                                        DTSBX421
03443      END-IF.                                                      DTSBX421
03444                                                                   DTSBX421
03445  S1032-EXIT.                                                      DTSBX421
03446      EXIT.                                                        DTSBX421
03447                                                                   DTSBX421
03448  S1040-OPEN-TEMP-BTC-OUT.                                         DTSBX421
03449      OPEN OUTPUT   TEMP-BTC-FILE.                                 DTSBX421
03450      IF TEMP-BTC-STATUS-OK-88                                     DTSBX421
03451         NEXT SENTENCE                                             DTSBX421
03452 ***     SET WAGE-TEMP-OPEN-88  TO TRUE                            DTSBX421
03453 ***     DISPLAY 'TEMP BTC OPENED OUTPUT '                         DTSBX421
03454      ELSE                                                         DTSBX421
03455         SET W-FATAL-ERROR-YES-88 TO TRUE                          DTSBX421
03456         DISPLAY 'CANNOT OPEN TEMP X421BTC FILE OUTPUT: '             CL*53
03457            TEMP-BTC-STATUS                                        DTSBX421
03458      END-IF.                                                      DTSBX421
03459                                                                   DTSBX421
03460  S1040-EXIT.                                                      DTSBX421
03461      EXIT.                                                        DTSBX421
03462                                                                   DTSBX421
03463 *S1050-OPEN-TEMP-BTC-IN.                                             CL*62
03464 *    OPEN INPUT    TEMP-BTC-FILE.                                    CL*62
03465 *    IF TEMP-BTC-STATUS-OK-88                                        CL*62
03466 *       NEXT SENTENCE                                                CL*62
03467 ***     SET WAGE-TEMP-OPEN-88  TO TRUE                            DTSBX421
03468 ***     DISPLAY 'TEMP BTC OPENED INP '                            DTSBX421
03469 *    ELSE                                                            CL*62
03470 *       SET W-FATAL-ERROR-YES-88 TO TRUE                             CL*62
03471 *       DISPLAY 'CANNOT OPEN TEMP BTC FILE INPUT: '                  CL*62
03472 *          TEMP-BTC-STATUS                                           CL*62
03473 *    END-IF.                                                         CL*62
03474                                                                   DTSBX421
03475 *S1050-EXIT.                                                         CL*62
03476 *    EXIT.                                                           CL*62
03477                                                                   DTSBX421
03478  S1060-CLOSE-TEMP-BTC.                                            DTSBX421
03479      CLOSE    TEMP-BTC-FILE.                                      DTSBX421
03480      IF TEMP-BTC-STATUS-OK-88                                     DTSBX421
03481 ***     DISPLAY 'TEMP-BTC CLOSED'                                 DTSBX421
03482         NEXT SENTENCE                                             DTSBX421
03483      ELSE                                                         DTSBX421
03484         SET W-FATAL-ERROR-YES-88 TO TRUE                          DTSBX421
03485         DISPLAY 'CANNOT CLOSE TEMP BTC FILE: '                    DTSBX421
03486            TEMP-BTC-STATUS                                        DTSBX421
03487      END-IF.                                                      DTSBX421
03488                                                                   DTSBX421
03489  S1060-EXIT.                                                      DTSBX421
03490      EXIT.                                                        DTSBX421
03491                                                                   DTSBX421
03492 *S1070-READ-TEMP-BTC.                                                CL*62
03493 *    READ TEMP-BTC-FILE.                                             CL*62
03494 *    IF TEMP-BTC-STATUS-OK-88                                        CL*62
03495 *       COMPUTE VAR-CHAR-CNT = (RVAR-LENGTH - 2)                     CL*62
03496 *    ELSE                                                            CL*62
03497 *       IF TEMP-BTC-STATUS-EOF-88                                    CL*62
03498 *          NEXT SENTENCE                                             CL*62
03499 *       ELSE                                                         CL*62
03500 *          DISPLAY 'CANNOT READ TEMP-BTC FILE '                      CL*62
03501 *             TEMP-BTC-STATUS                                        CL*62
03502 *          SET W-FATAL-ERROR-YES-88 TO TRUE                          CL*62
03503 *       END-IF                                                       CL*62
03504 *    END-IF.                                                         CL*62
03505 *                                                                    CL*62
03506 *S1070-EXIT.                                                         CL*62
03507      EXIT.                                                        DTSBX421
03508                                                                   DTSBX421
03509  S2000-WRITE-RPT.                                                 DTSBX421
03510      MOVE W-EMP-NO                TO R140-EMP-NO                  DTSBX421
03511      DISPLAY W-EMP-NO ':  ' R140-MESSAGE                          DTSBX421
03512      PERFORM S946-WRITE-R140      THRU S946-EXIT                  DTSBX421
03513      ADD +1                       TO WRK-R140-CNT.                DTSBX421
03514                                                                   DTSBX421
03515  S2000-EXIT.                                                      DTSBX421
03516      EXIT.                                                        DTSBX421
03517                                                                   DTSBX421
03518  S2100-WRITE-REG-RPT.                                                CL*90
03519      IF X104-LIAB-SELF-INS-88                                        CL*95
03520      MOVE 'S'                   TO  X421-CLASS                       CL*95
03521      ELSE                                                            CL*95
03522      MOVE 'R'                   TO  X421-CLASS.                      CL*95
03523                                                                      CL*95
03524      IF X104-ORG-HSEHLD-DMSTIC-88                                    CL100
03525      MOVE 'Y'                   TO  X421-HHOLD                       CL100
03526      ELSE                                                            CL100
03527      MOVE 'N'                   TO  X421-HHOLD.                      CL100
03528                                                                      CL100
03529      IF X104-HH-ANNUAL-88                                            CL107
03530      MOVE 'A'                   TO  X104-HOUSEHOLD-FILING            CL107
03531      ELSE                                                            CL107
03532      MOVE 'Q'                   TO  X104-HOUSEHOLD-FILING.           CL107
03533                                                                      CL107
03534      MOVE W-EMP-NO               TO  X421-EMP-NO                     CL107
03535      MOVE W-FEIN                 TO  X421-FEIN                       CL107
03536      MOVE X104-ORG-TYPE          TO  X421-ORG-TYPE                   CL*90
03537      MOVE X104-LIAB-CD           TO  X421-LIAB-CD                    CL*90
03538      MOVE X104-ELIG-CD           TO  X421-ELIG-CD                    CL*90
03539      MOVE X104-HOUSEHOLD-FILING  TO  X421-FILING                     CL110
03540      MOVE X106-EMP-NAME          TO  W-X421-NAME                     CL163
03541      INSPECT W-X421-NAME   REPLACING ALL ',' BY SPACE                CL163
03542      MOVE W-X421-NAME            TO  X421-NAME                       CL163
03543      MOVE X104-FIRST-WAGE-DT     TO  X421-PAID                       CL102
03544      MOVE X108-RATE-YEAR (1:4)   TO  X421-RATYR                      CL102
03545      MOVE X108-RATE              TO  X421-RATE                       CL102
03546                                                                      CL*90
03547      WRITE REPT-PAID-REC FROM DETAIL-LINE-1.                         CL*91
03548                                                                      CL*90
03549  S2100-EXIT.                                                         CL*90
03550      EXIT.                                                           CL*90
03551                                                                      CL*90
03552                                                                   DTSBX421
03553  S3000-INIT-T003.                                                 DTSBX421
03554      MOVE LOW-VALUES              TO MNTE-KEY-AREA.               DTSBX421
03555      MOVE W-EMP-NO                TO MNTE-EMP-NO.                 DTSBX421
03556      SET MNTE-NTE-88              TO TRUE.                        DTSBX421
03557      MOVE +0                      TO MNTE-PURGE-DATE.             DTSBX421
03558      SET MNTE-NOT-CONVERTED-88    TO TRUE.                        DTSBX421
03559                                                                   DTSBX421
03560      MOVE LX42-SYS-DATE           TO MNTE-ESTB-DATE               DTSBX421
03561                                      MNTE-CHNG-DATE.              DTSBX421
03562      MOVE ZERO                    TO MNTE-KEY-ESTB-ABSTIME        DTSBX421
03563                                      MNTE-DATA-ESTB-ABSTIME       DTSBX421
03564                                      MNTE-CHNG-ABSTIME.           DTSBX421
03565      MOVE 'WEBESSP '              TO MNTE-ESTB-OP-ID              DTSBX421
03566                                      MNTE-CHNG-OP-ID.             DTSBX421
03567      MOVE +0                      TO MNTE-TEXT-CNT.               DTSBX421
03568      MOVE SPACES                  TO MNTE-TEXT-AREA.              DTSBX421
03569                                                                   DTSBX421
03570      MOVE LENGTH OF T003-REC        TO T003-LENGTH                DTSBX421
03571      MOVE '003'                     TO T003-REC-TYPE.             DTSBX421
03572      MOVE W-EMP-NO                  TO T003-EMP-NO.               DTSBX421
03573      MOVE 'WEB REG   '              TO T003-ORIGIN.               DTSBX421
03574      MOVE LX42-SYS-DATE             TO T003-SYS-DATE.             DTSBX421
03575      MOVE LX42-SYS-TIME             TO T003-SYS-TIME.             DTSBX421
03576      SET T003-ADD-MNTE-88           TO TRUE.                      DTSBX421
03577                                                                   DTSBX421
03578  S3000-EXIT.                                                      DTSBX421
03579      EXIT.                                                        DTSBX421
03580                                                                   DTSBX421
03581  S999-ABEND.                                                      DTSBX421
03582      CALL 'DTSBU999' USING W-ABEND-CD.                            DTSBX421
03583  S999-EXIT.                                                       DTSBX421
03584      EXIT.                                                        DTSBX421
03585                                                                   DTSBX421
