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