00001 IDENTIFICATION DIVISION. 10/07/14 00002 PROGRAM-ID. DTSBX421. DTSBX421 00003 AUTHOR. NGC. LV011 00004 DATE-WRITTEN. APRIL 2005. DTSBX421 00005 DATE-COMPILED. DTSBX421 00006 SKIP3 DTSBX421 00007 ***** DTSBX421 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 * DTSBX421 00025 ***** DTSBX421 00026 SKIP3 DTSBX421 00027 ENVIRONMENT DIVISION. DTSBX421 00028 SKIP2 DTSBX421 00029 INPUT-OUTPUT SECTION. DTSBX421 00030 DTSBX421 00031 FILE-CONTROL. DTSBX421 00032 DTSBX421 00033 SELECT TEMP-BTC-FILE ASSIGN TO X421BTC DTSBX421 00034 FILE STATUS IS TEMP-BTC-STATUS. DTSBX421 00035 DTSBX421 00036 DATA DIVISION. DTSBX421 00037 DTSBX421 00038 FILE SECTION. DTSBX421 00039 DTSBX421 00040 FD TEMP-BTC-FILE DTSBX421 00041 RECORDING MODE IS V DTSBX421 00042 BLOCK CONTAINS 0 RECORDS. DTSBX421 00043 DTSBX421 00044 01 TEMP-BTC-REC. DTSBX421 00045 ++INCLUDE DTSIRVAR DTSBX421 00046 DTSBX421 00047 01 TSKL-REC. DTSBX421 00048 ++INCLUDE DTSITSKL DTSBX421 00049 DTSBX421 00050 WORKING-STORAGE SECTION. DTSBX421 000505 77 PAN-VALET PICTURE X(24) VALUE '011DTSBX421 10/07/14'. DTSBX421 00051 77 PAN-VALET PICTURE X(24) VALUE '032DTSBX421 10/07/14'. DTSBX421 00052 SKIP3 DTSBX421 00053 01 WRK-AREA. DTSBX421 00054 05 W-ABEND-CD PIC S9(04) COMP VALUE 421. DTSBX421 00055 05 W-MOD-NAME PIC X(08) VALUE 'DTSBX421'.DTSBX421 00056 DTSBX421 00057 05 W-PREV-REC-TYPE PIC X(03) VALUE SPACES. DTSBX421 00058 88 W-PREV-REC-NULL-88 VALUE 'XXX'. DTSBX421 00059 88 W-PREV-REC-PRF-88 VALUE '102'. DTSBX421 00060 88 W-PREV-REC-DETERM-88 VALUE '104'. DTSBX421 00061 88 W-PREV-REC-NAME-88 VALUE '106'. DTSBX421 00062 88 W-PREV-REC-RATE-88 VALUE '108'. DTSBX421 00063 88 W-PREV-REC-ADDR-88 VALUE '110'. DTSBX421 00064 88 W-PREV-REC-OPO-88 VALUE '120'. DTSBX421 00065 88 W-PREV-REC-REL-88 VALUE '130'. DTSBX421 00066 88 W-PREV-REC-IND-88 VALUE '132'. DTSBX421 00067 88 W-PREV-REC-RPT-88 VALUE '140'. DTSBX421 00068 88 W-PREV-REC-WAGE-88 VALUE '144'. DTSBX421 00069 DTSBX421 00070 05 BATCH-STATUS PIC X(02). DTSBX421 00071 88 BATCH-STATUS-OK-88 VALUE '00'. DTSBX421 00072 88 BATCH-STATUS-EOF-88 VALUE '10'. DTSBX421 00073 DTSBX421 00074 05 TEMP-BTC-STATUS PIC X(02). DTSBX421 00075 88 TEMP-BTC-STATUS-OK-88 VALUE '00'. DTSBX421 00076 88 TEMP-BTC-STATUS-EOF-88 VALUE '10'. DTSBX421 00077 DTSBX421 00078 05 WAGE-TEMP-STATUS PIC X(02). DTSBX421 00079 88 WAGE-TEMP-STATUS-OK-88 VALUE '00'. DTSBX421 00080 88 WAGE-TEMP-STATUS-EOF-88 VALUE '10'. DTSBX421 00081 DTSBX421 00082 05 WAGE-OUT-STATUS PIC X(02). DTSBX421 00083 88 WAGE-OUT-STATUS-OK-88 VALUE '00'. DTSBX421 00084 DTSBX421 00085 05 VAR-CHAR-CNT PIC S9(04) COMP. DTSBX421 00086 DTSBX421 00087 05 W-ERROR-IND PIC X(01) VALUE 'N'. DTSBX421 00088 88 W-ERROR-YES-88 VALUE 'Y'. DTSBX421 00089 88 W-ERROR-NO-88 VALUE 'N'. DTSBX421 00090 DTSBX421 00091 05 W-FATAL-ERROR-IND PIC X(01) VALUE 'N'. DTSBX421 00092 88 W-FATAL-ERROR-YES-88 VALUE 'Y'. DTSBX421 00093 88 W-FATAL-ERROR-NO-88 VALUE 'N'. DTSBX421 00094 DTSBX421 00095 05 W-RATE-ERROR-IND PIC X(01) VALUE 'N'. DTSBX421 00096 88 W-RATE-ERROR-YES-88 VALUE 'Y'. DTSBX421 00097 88 W-RATE-ERROR-NO-88 VALUE 'N'. DTSBX421 00098 DTSBX421 00099 05 W-DUP-RATE-ERROR-IND PIC X(01) VALUE 'N'. DTSBX421 00100 88 W-DUP-RATE-YES-88 VALUE 'Y'. DTSBX421 00101 88 W-DUP-RATE-NO-88 VALUE 'N'. DTSBX421 00102 DTSBX421 00103 05 W-EMP-IN-PROGRESS-IND PIC X(01) VALUE 'N'. DTSBX421 00104 88 W-EMP-IN-PROGRESS-YES-88 VALUE 'Y'. DTSBX421 00105 88 W-EMP-IN-PROGRESS-NO-88 VALUE 'N'. DTSBX421 00106 DTSBX421 00107 05 W-DUP-FEIN-IND PIC X(01) VALUE 'N'. DTSBX421 00108 88 W-DUP-FEIN-YES-88 VALUE 'Y'. DTSBX421 00109 88 W-DUP-FEIN-NO-88 VALUE 'N'. DTSBX421 00110 DTSBX421 00111 05 W-EMP-NO PIC 9(07) VALUE ZERO. DTSBX421 00112 05 W-FEIN PIC 9(09) VALUE ZERO. DTSBX421 00113 05 W-SOURCE-CD PIC X(02) VALUE SPACES. DTSBX421 00114 05 W-CLASS PIC X(01) VALUE SPACES. DTSBX421 00115 ** 05 W-FEIN-EMP-NO PIC 9(06) VALUE ZERO. DTSBX421 00116 05 W-CURR-RUN-DATE PIC S9(09) COMP-3. DTSBX421 00117 05 W-LIABLE-DATE PIC S9(09) COMP-3. DTSBX421 00118 05 W-WAGES-PLANNED-DATE PIC S9(09) COMP-3. DTSBX421 00119 05 W-INCORP-DATE PIC S9(09) COMP-3. DTSBX421 00120 05 W-FIRST-500-QTR PIC S9(05) COMP-3. DTSBX421 00121 05 W-LAST-RPT-DUE PIC S9(05) COMP-3. DTSBX421 00122 05 W-RATE PIC S9V9(04) COMP-3. DTSBX421 00123 05 W-FIELD-ZIP PIC X(10). DTSBX421 00124 05 W-FIELD-STATE PIC X(02). DTSBX421 00125 05 W-PRED-EMP-NO PIC 9(07) VALUE ZERO. DTSBX421 00126 05 W-PRED-FEIN PIC 9(09) VALUE ZERO. DTSBX421 00127 05 W-PRED-EFF-DATE PIC X(10). DTSBX421 00128 05 W-PORTION-EXP-TRNSF-X PIC X(06). DTSBX421 00129 05 W-PORTION-EXP-TRNSF-N REDEFINES DTSBX421 00130 W-PORTION-EXP-TRNSF-X PIC 999.99. DTSBX421 00131 05 W-WAGES-X PIC X(14). DTSBX421 00132 05 W-WAGES-9 REDEFINES W-WAGES-X DTSBX421 00133 PIC 9(11).99. DTSBX421 00134 05 W-REMIT-X PIC X(12). DTSBX421 00135 05 W-REMIT-9 REDEFINES W-REMIT-X DTSBX421 00136 PIC 9(09).99. DTSBX421 00137 05 W-COUNT-X PIC X(07). DTSBX421 00138 05 W-COUNT-9 REDEFINES W-COUNT-X DTSBX421 00139 PIC 9(07). DTSBX421 00140 * 05 W-REPORT-QTR PIC S9(05) COMP-3. DTSBX421 00141 * 05 WRK-REPORT-QTR PIC 9(05). DTSBX421 00142 * 05 W-TOT-WAGE PIC S9(11)V99. DTSBX421 00143 * 05 W-TAX-WAGE PIC S9(11)V99. DTSBX421 00144 * 05 W-WRKR-TOT-WAGE PIC S9(11)V99. DTSBX421 00145 * 05 W-WRKR-TAX-WAGE PIC S9(11)V99. DTSBX421 00146 * 05 W-REMITTANCE PIC S9(09)V99. DTSBX421 00147 * 05 W-RECEIVED-DATE PIC S9(09) COMP-3. DTSBX421 00148 * 05 W-1ST-MNTH-CNT PIC S9(07) COMP-3. DTSBX421 00149 * 05 W-2ND-MNTH-CNT PIC S9(07) COMP-3. DTSBX421 00150 * 05 W-3RD-MNTH-CNT PIC S9(07) COMP-3. DTSBX421 00151 * 05 W-WAGE-QTR PIC S9(05) COMP-3. DTSBX421 00152 * 05 W-SSN PIC S9(09) COMP-3. DTSBX421 00153 * 05 W-EARNINGS-X PIC X(12). DTSBX421 00154 * 05 W-EARNINGS-9 REDEFINES W-EARNINGS-X DTSBX421 00155 * PIC 9(09).99. DTSBX421 00156 * 05 W-EARNINGS PIC S9(09)V99. DTSBX421 00157 * 05 W-NAME-EFF-DATE PIC X(10). DTSBX421 00158 * 05 W-WORKER-NAME. DTSBX421 00159 * 10 W-WRKR-FIRST-NAME PIC X(15). DTSBX421 00160 * 10 W-WRKR-MID-INIT PIC X(01). DTSBX421 00161 * 10 W-WRKR-LAST-NAME PIC X(20). DTSBX421 00162 DTSBX421 00163 05 W-ENTITY-NAME PIC X(40). DTSBX421 00164 05 W-TRADE-NAME PIC X(40). DTSBX421 00165 DTSBX421 00166 * 05 W-RPT-TYPE PIC X(02). DTSBX421 00167 * 88 W-ORIG-88 VALUE 'OR'. DTSBX421 00168 * 88 W-EMP-AMEND-88 VALUE 'EA'. DTSBX421 00169 * 88 W-AUDIT-88 VALUE 'AU'. DTSBX421 00170 * 88 W-FLD-SUP-88 VALUE 'FS'. DTSBX421 00171 * 88 W-ADMIN-CORR-88 VALUE 'AC'. DTSBX421 00172 * 88 W-ESTIM-88 VALUE 'ES'. DTSBX421 00173 * 88 W-WITHDRW-88 VALUE 'WD'. DTSBX421 00174 * 88 W-SUPPLEM-88 VALUE 'EA' 'AU' DTSBX421 00175 * 'FS' 'AC'. DTSBX421 00176 * 88 W-RPT-TYPE-VALID-88 VALUE 'OR' 'EA' 'AU' DTSBX421 00177 * 'FS' 'AC' 'ES' DTSBX421 00178 * 'WD'. DTSBX421 00179 * DTSBX421 00180 * 05 W-PSEUDO-BATCH-NO PIC 9(05) VALUE ZERO. DTSBX421 00181 * 05 FILLER REDEFINES W-PSEUDO-BATCH-NO. DTSBX421 00182 * 10 W-PSEUDO-DAYS PIC 9(03). DTSBX421 00183 * 10 W-PSEUDO-BATCH-SEQ PIC 9(02). DTSBX421 00184 * DTSBX421 00185 * 05 W-START-BATCH PIC 9(05) VALUE ZERO. DTSBX421 00186 * 05 W-END-BATCH PIC 9(05) VALUE ZERO. DTSBX421 00187 * DTSBX421 00188 * 05 W-PSEUDO-ITEM-NO PIC 9(03) VALUE 0. DTSBX421 00189 * DTSBX421 00190 * 05 W-SEQ-NO PIC 9(07) VALUE 0. DTSBX421 00191 DTSBX421 00192 05 ISUB1 PIC S9(04) COMP. DTSBX421 00193 05 ISUB2 PIC S9(04) COMP. DTSBX421 00194 05 ISUB3 PIC S9(04) COMP. DTSBX421 00195 05 ISUB4 PIC S9(04) COMP. DTSBX421 00196 05 W-CURR-FIELD PIC S9(04) COMP. DTSBX421 00197 05 W-LAST-FIELD PIC S9(04) COMP. DTSBX421 00198 05 W-LAST-FIELD-LEN PIC S9(04) COMP. DTSBX421 00199 05 W-INPUT-LENGTH PIC S9(04) COMP DTSBX421 00200 VALUE +502. DTSBX421 00201 05 W-INPUT-LINE PIC X(500). DTSBX421 00202 05 W-PARSE-COMPLETE-IND PIC X(01). DTSBX421 00203 88 W-PARSE-COMPLETE-YES-88 VALUE 'Y'. DTSBX421 00204 88 W-PARSE-COMPLETE-NO-88 VALUE 'N'. DTSBX421 00205 05 W-FIELD-LENGTH PIC S9(04) COMP. DTSBX421 00206 05 W-CONV-LINE PIC X(32). DTSBX421 00207 DTSBX421 00208 05 W-MNTE-SUBJECT PIC X(40). DTSBX421 00209 88 W-MNTE-NOT-LIAB-88 VALUE DTSBX421 00210 'REASON FOR NOT-LIABLE DETERMINATION '. DTSBX421 00211 88 W-MNTE-KEY-WORD-88 VALUE DTSBX421 00212 'FR-500 INDUSTRY DESCRIPTION - KEY WORD '. DTSBX421 00213 88 W-MNTE-DATA-ENTRY-88 VALUE DTSBX421 00214 'FR-500 INDUSTRY DESCRIPTION - DATA ENTRY'. DTSBX421 00215 88 W-MNTE-RELATIONSHIP-88 VALUE DTSBX421 00216 'WEB REGISTRATION RELATED EMPLOYER '. DTSBX421 00217 DTSBX421 00218 05 W-MNTE-COMPLETE-IND PIC X(01) VALUE 'N'. DTSBX421 00219 88 W-MNTE-COMPLETE-YES-88 VALUE 'Y'. DTSBX421 00220 88 W-MNTE-COMPLETE-NO-88 VALUE 'N'. DTSBX421 00221 DTSBX421 00222 05 TSUB1 PIC S9(04) COMP. DTSBX421 00223 05 TSUB2 PIC S9(04) COMP. DTSBX421 00224 05 W-LAST-SPACE PIC S9(04) COMP. DTSBX421 00225 DTSBX421 00226 05 W-MNTE-LINE PIC X(72). DTSBX421 00227 DTSBX421 00228 05 W-TEST-AMT PIC X(06) VALUE SPACES. DTSBX421 00229 DTSBX421 00230 05 W-VALUE PIC S9(7)V9(06) COMP-3. DTSBX421 00231 05 W-DIGIT PIC 9(01). DTSBX421 00232 05 W-DISP-AMT PIC ------9.9(06). DTSBX421 00233 DTSBX421 00234 05 RSUB PIC S9(04) COMP. DTSBX421 00235 05 W-MULTIPLIER PIC S9(07)V9(07) COMP-3. DTSBX421 00236 05 W-DECIMAL-FOUND-IND PIC X(01) VALUE 'N'. DTSBX421 00237 88 W-DECIMAL-FOUND-YES-88 VALUE 'Y'. DTSBX421 00238 88 W-DECIMAL-FOUND-NO-88 VALUE 'N'. DTSBX421 00239 DTSBX421 00240 05 SUB PIC S9(04) COMP. DTSBX421 00241 05 W-RATE-AREA OCCURS 5 TIMES. DTSBX421 00242 10 W-RATE-YEAR PIC S9(05) COMP-3. DTSBX421 00243 10 W-RATE-FOUND-IND PIC X(01). DTSBX421 00244 88 W-RATE-FOUND-YES-88 VALUE 'Y'. DTSBX421 00245 88 W-RATE-FOUND-NO-88 VALUE 'N'. DTSBX421 00246 DTSBX421 00247 05 W-SLASH-DATE PIC X(10). DTSBX421 00248 05 FILLER REDEFINES W-SLASH-DATE. DTSBX421 00249 10 W-SLASH-DT-MM PIC X(02). DTSBX421 00250 10 FILLER PIC X(01). DTSBX421 00251 10 W-SLASH-DT-DD PIC X(02). DTSBX421 00252 10 FILLER PIC X(01). DTSBX421 00253 10 W-SLASH-DT-CCYY PIC X(04). DTSBX421 00254 DTSBX421 00255 05 W-SLASH-QTR PIC X(06). DTSBX421 00256 05 FILLER REDEFINES W-SLASH-QTR. DTSBX421 00257 10 W-SLASH-QTR-CCYY PIC X(04). DTSBX421 00258 10 FILLER PIC X(01). DTSBX421 00259 10 W-SLASH-QTR-Q PIC X(01). DTSBX421 00260 DTSBX421 00261 05 WRK-PHONE PIC X(15) VALUE SPACES. DTSBX421 00262 05 FILLER REDEFINES WRK-PHONE. DTSBX421 00263 10 WRK-AREA-CD PIC X(03). DTSBX421 00264 10 WRK-PREFIX PIC X(03). DTSBX421 00265 10 WRK-SUFFIX PIC X(04). DTSBX421 00266 10 WRK-EXT PIC X(05). DTSBX421 00267 05 WRK-EXT-HYPHEN PIC X(01) VALUE SPACES. DTSBX421 00268 05 WRK-PHONE-TEXT1 PIC X(72) VALUE SPACES. DTSBX421 00269 05 WRK-PHONE-TEXT2 PIC X(72) VALUE SPACES. DTSBX421 00270 DTSBX421 00271 05 W-WEB-IMP-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX421 00272 05 W-EMP-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX421 00273 05 W-EMP-WAGE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX421 00274 05 WRK-EMP-WAGE-CNT PIC 9(07) VALUE 0. DTSBX421 00275 * PROFILE DTSBX421 00276 05 W-X102-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX421 00277 * DETERMINATION DTSBX421 00278 05 W-X104-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX421 00279 * NAME DTSBX421 00280 05 W-X106-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX421 00281 * RATE DTSBX421 00282 05 W-X108-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX421 00283 * ADDRESS DTSBX421 00284 05 W-X110-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX421 00285 * OPO DTSBX421 00286 05 W-X120-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX421 00287 * RELATIONSHIP DTSBX421 00288 05 W-X130-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX421 00289 * INDUSTRY DESCRIPTION DTSBX421 00290 05 W-X132-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX421 00291 * REPORT DTSBX421 00292 05 W-X140-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX421 00293 DTSBX421 00294 05 W-T002-PRF-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX421 00295 05 W-T002-DETERM-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX421 00296 05 W-T002-NAME-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX421 00297 05 W-T002-RATE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX421 00298 05 W-T002-ADDR-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX421 00299 05 W-T002-OPO-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX421 00300 05 W-T002-REL-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX421 00301 05 W-T002-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX421 00302 DTSBX421 00303 05 W-T003-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX421 00304 DTSBX421 00305 05 W-T027-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX421 00306 05 W-W001-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX421 00307 05 W-X140-RPT-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX421 00308 DTSBX421 00309 05 W-WEB-IMP-LENGTH PIC S9(04) COMP. DTSBX421 00310 05 W-X102-LENGTH PIC S9(04) COMP. DTSBX421 00311 05 W-X104-LENGTH PIC S9(04) COMP. DTSBX421 00312 05 W-X106-LENGTH PIC S9(04) COMP. DTSBX421 00313 05 W-X108-LENGTH PIC S9(04) COMP. DTSBX421 00314 05 W-X110-LENGTH PIC S9(04) COMP. DTSBX421 00315 05 W-X120-LENGTH PIC S9(04) COMP. DTSBX421 00316 05 W-X130-LENGTH PIC S9(04) COMP. DTSBX421 00317 05 W-X132-LENGTH PIC S9(04) COMP. DTSBX421 00318 05 W-X140-LENGTH PIC S9(04) COMP. DTSBX421 00319 DTSBX421 00320 05 W-AMT-DISP1 PIC ----------9.99. DTSBX421 00321 05 W-AMT-DISP2 PIC ----------9.99. DTSBX421 00322 *RW1 DTSBX421 00323 05 WRK-R140-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX421 00324 05 DISPLAY-CNT PIC Z(06)9. DTSBX421 00325 DTSBX421 00326 01 MESSAGE-AREA. DTSBX421 00327 05 WRK-MESSAGE PIC X(80). DTSBX421 00328 05 MSG1-INVALID-FEIN. DTSBX421 00329 10 FILLER PIC X(08) DTSBX421 00330 VALUE 'PROFILE:'. DTSBX421 00331 10 FILLER PIC X(02) DTSBX421 00332 VALUE SPACES. DTSBX421 00333 10 FILLER PIC X(18) DTSBX421 00334 VALUE 'NON-NUMERIC FEIN: '. DTSBX421 00335 10 MSG1-FEIN PIC X(09). DTSBX421 00336 05 MSG2-SOURCE-CODE. DTSBX421 00337 10 FILLER PIC X(08) DTSBX421 00338 VALUE 'PROFILE:'. DTSBX421 00339 10 FILLER PIC X(27) DTSBX421 00340 VALUE 'INVALID SOURCE CODE: '. DTSBX421 00341 10 MSG2-SOURCE-CD PIC X(02). DTSBX421 00342 05 MSG3-EMP-ON-FILE. DTSBX421 00343 10 FILLER PIC X(08) DTSBX421 00344 VALUE 'PROFILE:'. DTSBX421 00345 10 FILLER PIC X(29) DTSBX421 00346 VALUE 'EMPLOYER ACCT ALREADY ON FILE'. DTSBX421 00347 05 MSG4-DUP-EMP. DTSBX421 00348 10 FILLER PIC X(14) DTSBX421 00349 VALUE 'PROFILE:'. DTSBX421 00350 10 FILLER PIC X(22) DTSBX421 00351 VALUE 'FEIN ALREADY ON FILE: '. DTSBX421 00352 10 MSG4-FEIN PIC X(09). DTSBX421 00353 05 MSG5-INVALID-LIAB-CD. DTSBX421 00354 10 FILLER PIC X(08) DTSBX421 00355 VALUE 'DETERM: '. DTSBX421 00356 10 FILLER PIC X(24) DTSBX421 00357 VALUE 'INVALID LIABILITY CODE: '. DTSBX421 00358 10 MSG5-LIAB-CD PIC X(02). DTSBX421 00359 05 MSG6-INVALID-ELIG-CD. DTSBX421 00360 10 FILLER PIC X(08) DTSBX421 00361 VALUE 'DETERM: '. DTSBX421 00362 10 FILLER PIC X(26) DTSBX421 00363 VALUE 'INVALID ELIGIBILITY CODE: '. DTSBX421 00364 10 MSG6-ELIG-CD PIC X(02). DTSBX421 00365 05 MSG7-INVALID-ORG-TYPE. DTSBX421 00366 10 FILLER PIC X(08) DTSBX421 00367 VALUE 'DETERM: '. DTSBX421 00368 10 FILLER PIC X(27) DTSBX421 00369 VALUE 'INVALID ORGANIZATION TYPE: '. DTSBX421 00370 10 MSG7-ORG-TYPE PIC X(03). DTSBX421 00371 05 MSG8-INVALID-INCORP-DATE. DTSBX421 00372 10 FILLER PIC X(08) DTSBX421 00373 VALUE 'DETERM: '. DTSBX421 00374 10 FILLER PIC X(28) DTSBX421 00375 VALUE 'INVALID INCORPORATION DATE: '. DTSBX421 00376 10 MSG8-INCORP-DATE PIC X(10). DTSBX421 00377 05 MSG9-INVALID-FILING-SCHED. DTSBX421 00378 10 FILLER PIC X(08) DTSBX421 00379 VALUE 'DETERM: '. DTSBX421 00380 10 FILLER PIC X(25) DTSBX421 00381 VALUE 'INVALID FILING SCHEDULE: '. DTSBX421 00382 10 MSG9-ORG-TYPE PIC X(02). DTSBX421 00383 10 FILLER PIC X(02) DTSBX421 00384 VALUE SPACES. DTSBX421 00385 10 MSG9-FILING-SCHED PIC X(01). DTSBX421 00386 05 MSG10-INCONSISTENT-LIAB-CD. DTSBX421 00387 10 FILLER PIC X(08) DTSBX421 00388 VALUE 'DETERM: '. DTSBX421 00389 10 FILLER PIC X(34) DTSBX421 00390 VALUE 'INCONSISTENT ELIG AND LIAB CODES: '. DTSBX421 00391 10 MSG10-ELIG-CD PIC X(02). DTSBX421 00392 10 FILLER PIC X(02) DTSBX421 00393 VALUE SPACES. DTSBX421 00394 10 MSG10-LIAB-CD PIC X(02). DTSBX421 00395 05 MSG11-WAGES-PAID-QTR. DTSBX421 00396 10 FILLER PIC X(08) DTSBX421 00397 VALUE 'DETERM: '. DTSBX421 00398 10 FILLER PIC X(24) DTSBX421 00399 VALUE 'INVALID WAGES PAID QTR: '. DTSBX421 00400 10 MSG11-QTR PIC X(02). DTSBX421 00401 05 MSG12-FIRST-WAGE-DATE. DTSBX421 00402 10 FILLER PIC X(08) DTSBX421 00403 VALUE 'DETERM: '. DTSBX421 00404 10 FILLER PIC X(31) DTSBX421 00405 VALUE 'INVALID FIRST WAGES PAID DATE: '. DTSBX421 00406 10 MSG12-DATE PIC X(02). DTSBX421 00407 DTSBX421 00408 01 T002-REC. DTSBX421 00409 ++INCLUDE DTSIT002 DTSBX421 00410 DTSBX421 00411 01 Y104-REC. DTSBX421 00412 ++INCLUDE DTSIY104 DTSBX421 00413 DTSBX421 00414 01 Y106-REC. DTSBX421 00415 ++INCLUDE DTSIY106 DTSBX421 00416 DTSBX421 00417 01 Y108-REC. DTSBX421 00418 ++INCLUDE DTSIY108 DTSBX421 00419 DTSBX421 00420 01 Y130-REC. DTSBX421 00421 ++INCLUDE DTSIY130 DTSBX421 00422 DTSBX421 00423 01 T003-REC. DTSBX421 00424 ++INCLUDE DTSIT003 DTSBX421 00425 DTSBX421 00426 01 T027-REC. DTSBX421 00427 ++INCLUDE DTSIT027 DTSBX421 00428 DTSBX421 00429 01 W001-REC. DTSBX421 00430 ++INCLUDE DTSIW001 DTSBX421 00431 DTSBX421 00432 * PROFILE DTSBX421 00433 01 X102-REC. DTSBX421 00434 ++INCLUDE DTSIX102 DTSBX421 00435 DTSBX421 00436 * DETERMINATION DTSBX421 00437 01 X104-REC. DTSBX421 00438 ++INCLUDE DTSIX104 DTSBX421 00439 DTSBX421 00440 * NAME DTSBX421 00441 01 X106-REC. DTSBX421 00442 ++INCLUDE DTSIX106 DTSBX421 00443 DTSBX421 00444 * RATE DTSBX421 00445 01 X108-REC. DTSBX421 00446 ++INCLUDE DTSIX108 DTSBX421 00447 DTSBX421 00448 * ADDRESS DTSBX421 00449 01 X110-REC. DTSBX421 00450 ++INCLUDE DTSIX110 DTSBX421 00451 DTSBX421 00452 * OPO DTSBX421 00453 01 X120-REC. DTSBX421 00454 ++INCLUDE DTSIX120 DTSBX421 00455 DTSBX421 00456 * RELATIONSHIP DTSBX421 00457 01 X130-REC. DTSBX421 00458 ++INCLUDE DTSIX130 DTSBX421 00459 DTSBX421 00460 * INDUSTRY DESCRIPTION DTSBX421 00461 *01 X132-REC. DTSBX421 00462 ***INCLUDE DTSIX132 DTSBX421 00463 DTSBX421 00464 * REPORT DTSBX421 00465 01 X140-REC. DTSBX421 00466 ++INCLUDE DTSIX140 DTSBX421 00467 DTSBX421 00468 DTSBX421 00469 DTSBX421 00470 * ERRORS DTSBX421 00471 *01 X907-REC. DTSBX421 00472 ***INCLUDE DTSIX907 DTSBX421 00473 DTSBX421 00474 01 L001-LINK-AREA. DTSBX421 00475 ++INCLUDE DTSIL001 DTSBX421 00476 DTSBX421 00477 01 L003-LINK-AREA. DTSBX421 00478 ++INCLUDE DTSIL003 DTSBX421 00479 DTSBX421 00480 01 L004-LINK-AREA. DTSBX421 00481 ++INCLUDE DTSIL004 DTSBX421 00482 DTSBX421 00483 01 L072-LINK-AREA. DTSBX421 00484 ++INCLUDE DTSIL072 DTSBX421 00485 DTSBX421 00486 01 L052-LINK-AREA. DTSBX421 00487 ++INCLUDE DTSIL052 DTSBX421 00488 DTSBX421 00489 01 L516-LINK-AREA. DTSBX421 00490 ++INCLUDE DTSIL516 DTSBX421 00491 DTSBX421 00492 01 L600-LINK-AREA. DTSBX421 00493 ++INCLUDE DTSIL600 DTSBX421 00494 DTSBX421 00495 01 L910-LINK-AREA. DTSBX421 00496 ++INCLUDE DTSIL910 DTSBX421 00497 01 MSKL-REC. DTSBX421 00498 ++INCLUDE DTSIMSKL DTSBX421 00499 DTSBX421 00500 01 MHDR-REC. DTSBX421 00501 ++INCLUDE DTSIMHDR DTSBX421 00502 DTSBX421 00503 01 MPRF-REC. DTSBX421 00504 ++INCLUDE DTSIMPRF DTSBX421 00505 DTSBX421 00506 01 MSOL-REC. DTSBX421 00507 ++INCLUDE DTSIMSOL DTSBX421 00508 DTSBX421 00509 01 MQTR-REC. DTSBX421 00510 ++INCLUDE DTSIMQTR DTSBX421 00511 DTSBX421 00512 01 MOPO-REC. DTSBX421 00513 ++INCLUDE DTSIMOPO DTSBX421 00514 DTSBX421 00515 01 MTAD-REC. DTSBX421 00516 ++INCLUDE DTSIMTAD DTSBX421 00517 DTSBX421 00518 01 MNTE-REC. DTSBX421 00519 ++INCLUDE DTSIMNTE DTSBX421 00520 DTSBX421 00521 01 L921-LINK-AREA. DTSBX421 00522 ++INCLUDE DTSIL921 DTSBX421 00523 SKIP3 DTSBX421 00524 01 ISKL-REC. DTSBX421 00525 ++INCLUDE DTSIISKL DTSBX421 00526 SKIP3 DTSBX421 00527 01 IEIN-REC. DTSBX421 00528 ++INCLUDE DTSIIEIN DTSBX421 00529 DTSBX421 00530 01 L927-LINK-AREA. DTSBX421 00531 ++INCLUDE DTSIL927 DTSBX421 00532 DTSBX421 00533 01 L931-LINK-AREA. DTSBX421 00534 ++INCLUDE DTSIL931 DTSBX421 00535 DTSBX421 00536 01 FSKL-REC. DTSBX421 00537 ++INCLUDE DTSIFSKL DTSBX421 00538 DTSBX421 00539 01 R140-REC. DTSBX421 00540 ++INCLUDE DTSIR140 DTSBX421 00541 DTSBX421 00542 LINKAGE SECTION. DTSBX421 00543 DTSBX421 00544 01 LX42-LINK-AREA. DTSBX421 00545 ++INCLUDE DTSILX42 DTSBX421 00546 DTSBX421 00547 PROCEDURE DIVISION USING LX42-LINK-AREA. DTSBX421 00548 DTSBX421 00549 DTSBX421-MAIN. DTSBX421 00550 * DISPLAY 'LX42-LINK-AREA' LX42-LINK-AREA DTSBX421 00551 MOVE LX42-ERROR-IND TO W-ERROR-IND. DTSBX421 00552 DTSBX421 00553 IF W-ERROR-YES-88 DTSBX421 00554 DISPLAY 'BX421 LX42 ERROR ' LX42-EMP-NO DTSBX421 00555 ' ' LX42-ERROR-IND ' ' W-ERROR-IND DTSBX421 00556 ELSE DTSBX421 00557 DISPLAY 'BX421 NO ERROR ' W-ERROR-IND DTSBX421 00558 END-IF. DTSBX421 00559 DTSBX421 00560 EVALUATE TRUE DTSBX421 00561 WHEN LX42-INITIALIZE-88 DTSBX421 00562 PERFORM I0000-INITIATE THRU I0000-EXIT DTSBX421 00563 DTSBX421 00564 WHEN LX42-NEW-EMPLOYER-88 DTSBX421 00565 PERFORM P3000-NEW-EMP THRU P3000-EXIT DTSBX421 00566 DTSBX421 00567 WHEN LX42-PROCESS-88 DTSBX421 00568 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBX421 00569 DTSBX421 00570 WHEN LX42-TERMINATE-88 DTSBX421 00571 PERFORM P3000-NEW-EMP THRU P3000-EXIT DTSBX421 00572 PERFORM T0000-TERMINATE THRU T0000-EXIT DTSBX421 00573 DTSBX421 00574 END-EVALUATE. DTSBX421 00575 DTSBX421 00576 IF LX42-PROCESS-88 DTSBX421 00577 MOVE W-ERROR-IND TO LX42-ERROR-IND DTSBX421 00578 END-IF. DTSBX421 00579 DTSBX421 00580 DTSBX421-MAIN-EXIT. DTSBX421 00581 GOBACK. DTSBX421 00582 DTSBX421 00583 I0000-INITIATE. DTSBX421 00584 *** SET W-ERROR-NO-88 TO TRUE. DTSBX421 00585 SET W-FATAL-ERROR-NO-88 TO TRUE. DTSBX421 00586 DTSBX421 00587 MOVE LENGTH OF X102-REC TO W-X102-LENGTH. DTSBX421 00588 MOVE LENGTH OF X104-REC TO W-X104-LENGTH. DTSBX421 00589 MOVE LENGTH OF X106-REC TO W-X106-LENGTH. DTSBX421 00590 MOVE LENGTH OF X108-REC TO W-X108-LENGTH. DTSBX421 00591 MOVE LENGTH OF X130-REC TO W-X130-LENGTH. DTSBX421 00592 DTSBX421 00593 *RW1 FOR VARIABLE REPORT FILE. DTSBX421 00594 MOVE LENGTH OF R140-REC TO R140-LENGTH. DTSBX421 00595 MOVE '140' TO R140-REC-TYPE. DTSBX421 00596 DTSBX421 00597 PERFORM I2000-OPEN-FILES THRU I2000-EXIT DTSBX421 00598 IF W-FATAL-ERROR-YES-88 DTSBX421 00599 GO TO I0000-EXIT DTSBX421 00600 END-IF. DTSBX421 00601 DTSBX421 00602 I0000-EXIT. DTSBX421 00603 EXIT. DTSBX421 00604 DTSBX421 00605 I2000-OPEN-FILES. DTSBX421 00606 PERFORM S1040-OPEN-TEMP-BTC-OUT THRU S1040-EXIT. DTSBX421 00607 IF W-FATAL-ERROR-YES-88 DTSBX421 00608 DISPLAY 'CANNOT OPEN TEMP BTC FILE ' DTSBX421 00609 TEMP-BTC-STATUS DTSBX421 00610 GO TO I2000-EXIT DTSBX421 00611 END-IF. DTSBX421 00612 DTSBX421 00613 I2000-EXIT. DTSBX421 00614 EXIT. DTSBX421 00615 DTSBX421 00616 DTSBX421 00617 P0000-PROCESS. DTSBX421 00618 *& DTSBX421 00619 DISPLAY SPACE. DTSBX421 00620 * DISPLAY 'BX421 P0000 ' W-EMP-NO ' ' LX42-REC-TYPE. DTSBX421 00621 *& DTSBX421 00622 EVALUATE TRUE DTSBX421 00623 WHEN LX42-REC-TYPE-PRF-88 DTSBX421 00624 PERFORM P1100-PROFILE THRU P1100-EXIT DTSBX421 00625 DTSBX421 00626 WHEN LX42-REC-TYPE-DETERM-88 DTSBX421 00627 PERFORM P1200-DETERM THRU P1200-EXIT DTSBX421 00628 DTSBX421 00629 WHEN LX42-REC-TYPE-NAME-88 DTSBX421 00630 PERFORM P1300-NAME THRU P1300-EXIT DTSBX421 00631 DTSBX421 00632 WHEN LX42-REC-TYPE-RATE-88 DTSBX421 00633 PERFORM P1400-RATE THRU P1400-EXIT DTSBX421 00634 DTSBX421 00635 ** WHEN LX42-REC-TYPE-REL-88 DTSBX421 00636 ** PERFORM P1700-RELATION THRU P1700-EXIT DTSBX421 00637 DTSBX421 00638 END-EVALUATE. DTSBX421 00639 DTSBX421 00640 P0000-EXIT. DTSBX421 00641 EXIT. DTSBX421 00642 DTSBX421 00643 P1100-PROFILE. DTSBX421 00644 SET W-EMP-IN-PROGRESS-YES-88 TO TRUE. DTSBX421 00645 MOVE LX42-DATA-AREA TO X102-REC. DTSBX421 00646 *& DTSBX421 00647 DISPLAY SPACE. DTSBX421 00648 DISPLAY 'PROFILE ' X102-EMP-NO. DTSBX421 00649 ** DISPLAY X102-REC. DTSBX421 00650 DTSBX421 00651 DTSBX421 00652 IF W-PREV-REC-NULL-88 DTSBX421 00653 SET W-PREV-REC-PRF-88 TO TRUE DTSBX421 00654 ADD +1 TO W-X102-CNT DTSBX421 00655 PERFORM P1110-EDIT-PROFILE THRU P1110-EXIT DTSBX421 00656 IF W-ERROR-NO-88 DTSBX421 00657 PERFORM P1120-SAVE-PROFILE THRU P1120-EXIT DTSBX421 00658 END-IF DTSBX421 00659 ELSE DTSBX421 00660 DISPLAY 'PROFILE RECORD FOUND FOLLOWING ' DTSBX421 00661 W-PREV-REC-TYPE ' ' W-EMP-NO DTSBX421 00662 SET W-ERROR-YES-88 TO TRUE DTSBX421 00663 END-IF. DTSBX421 00664 DTSBX421 00665 P1100-EXIT. DTSBX421 00666 EXIT. DTSBX421 00667 DTSBX421 00668 P1110-EDIT-PROFILE. DTSBX421 00669 PERFORM P1111-EDIT-DATA THRU P1111-EXIT. DTSBX421 00670 IF W-ERROR-NO-88 DTSBX421 00671 PERFORM P1112-CHECK-DATABASE THRU P1112-EXIT DTSBX421 00672 END-IF. DTSBX421 00673 DTSBX421 00674 P1110-EXIT. DTSBX421 00675 EXIT. DTSBX421 00676 DTSBX421 00677 P1111-EDIT-DATA. DTSBX421 00678 IF X102-EMP-FEIN NOT NUMERIC DTSBX421 00679 SET W-ERROR-YES-88 TO TRUE DTSBX421 00680 MOVE X102-EMP-FEIN TO MSG1-FEIN DTSBX421 00681 MOVE MSG1-INVALID-FEIN TO R140-MESSAGE DTSBX421 00682 PERFORM S2000-WRITE-RPT THRU S2000-EXIT DTSBX421 00683 ELSE DTSBX421 00684 MOVE X102-EMP-FEIN TO W-FEIN DTSBX421 00685 END-IF. DTSBX421 00686 DTSBX421 00687 IF NOT X102-SOURCE-CD-VALID-88 DTSBX421 00688 SET W-ERROR-YES-88 TO TRUE DTSBX421 00689 MOVE X102-SOURCE-CD TO MSG2-SOURCE-CD DTSBX421 00690 MOVE MSG2-SOURCE-CODE TO R140-MESSAGE DTSBX421 00691 PERFORM S2000-WRITE-RPT THRU S2000-EXIT DTSBX421 00692 END-IF. DTSBX421 00693 DTSBX421 00694 IF NOT X102-CLASS-CD-VALID-88 DTSBX421 00695 SET W-ERROR-YES-88 TO TRUE DTSBX421 00696 MOVE SPACES TO R140-MESSAGE DTSBX421 00697 MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 00698 STRING DTSBX421 00699 'X102 INVALID EMP CLASS CD ' X102-EMP-CLASS DTSBX421 00700 DELIMITED BY SIZE DTSBX421 00701 INTO R140-MESSAGE DTSBX421 00702 END-STRING DTSBX421 00703 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 00704 END-IF. DTSBX421 00705 DTSBX421 00706 IF NOT X102-STATUS-CD-VALID-88 DTSBX421 00707 SET W-ERROR-YES-88 TO TRUE DTSBX421 00708 MOVE SPACES TO R140-MESSAGE DTSBX421 00709 MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 00710 STRING DTSBX421 00711 'X102 INVALID EMP STATUS CD ' X102-EMP-STATUS DTSBX421 00712 DELIMITED BY SIZE DTSBX421 00713 INTO R140-MESSAGE DTSBX421 00714 END-STRING DTSBX421 00715 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 00716 END-IF. DTSBX421 00717 DTSBX421 00718 IF NOT X102-ACTION-CD-VALID-88 DTSBX421 00719 SET W-ERROR-YES-88 TO TRUE DTSBX421 00720 MOVE SPACES TO R140-MESSAGE DTSBX421 00721 MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 00722 STRING DTSBX421 00723 'X102 INVALID ACTION CD ' X102-ACTION-CD DTSBX421 00724 DELIMITED BY SIZE DTSBX421 00725 INTO R140-MESSAGE DTSBX421 00726 END-STRING DTSBX421 00727 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 00728 END-IF. DTSBX421 00729 DTSBX421 00730 DTSBX421 00731 P1111-EXIT. DTSBX421 00732 EXIT. DTSBX421 00733 DTSBX421 00734 P1112-CHECK-DATABASE. DTSBX421 00735 MOVE LOW-VALUE TO MPRF-KEY-AREA. DTSBX421 00736 MOVE W-EMP-NO TO MPRF-EMP-NO. DTSBX421 00737 SET MPRF-PRF-88 TO TRUE. DTSBX421 00738 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSBX421 00739 DTSBX421 00740 PERFORM S910-READ THRU S910-EXIT. DTSBX421 00741 IF L910-NO-REC-88 DTSBX421 00742 NEXT SENTENCE DTSBX421 00743 ELSE DTSBX421 00744 SET W-ERROR-YES-88 TO TRUE DTSBX421 00745 MOVE MSG3-EMP-ON-FILE TO R140-MESSAGE DTSBX421 00746 PERFORM S2000-WRITE-RPT THRU S2000-EXIT DTSBX421 00747 GO TO P1112-EXIT DTSBX421 00748 END-IF. DTSBX421 00749 DTSBX421 00750 ** MOVE ZERO TO W-FEIN-EMP-NO. DTSBX421 00751 SET W-DUP-FEIN-NO-88 TO TRUE. DTSBX421 00752 DTSBX421 00753 MOVE LOW-VALUE TO IEIN-KEY-AREA DTSBX421 00754 SET IEIN-EIN-88 TO TRUE DTSBX421 00755 MOVE W-FEIN TO IEIN-FEIN DTSBX421 00756 MOVE +0 TO IEIN-EMP-NO DTSBX421 00757 MOVE IEIN-KEY-AREA TO ISKL-KEY-AREA DTSBX421 00758 PERFORM S921-START-BROWSE THRU S921-EXIT DTSBX421 00759 MOVE ISKL-REC TO IEIN-REC DTSBX421 00760 PERFORM DTSBX421 00761 UNTIL L921-NO-REC-88 DTSBX421 00762 OR W-DUP-FEIN-YES-88 DTSBX421 00763 IF IEIN-FEIN = W-FEIN DTSBX421 00764 PERFORM P1112A-FIND-MPRF THRU P1112A-EXIT DTSBX421 00765 PERFORM S921-READ-NEXT THRU S921-EXIT DTSBX421 00766 MOVE ISKL-REC TO IEIN-REC DTSBX421 00767 ** IF W-FEIN-EMP-NO = ZERO DTSBX421 00768 * PERFORM S921-READ-NEXT THRU S921-EXIT DTSBX421 00769 * MOVE ISKL-REC TO IEIN-REC DTSBX421 00770 ** END-IF DTSBX421 00771 ELSE DTSBX421 00772 SET L921-NO-REC-88 TO TRUE DTSBX421 00773 END-IF DTSBX421 00774 END-PERFORM. DTSBX421 00775 DTSBX421 00776 * IF W-DUP-FEIN-YES-88 DTSBX421 00777 * DISPLAY 'BX421 DUP FEIN ' W-EMP-NO ' ' W-FEIN DTSBX421 00778 * ELSE DTSBX421 00779 * DISPLAY 'BX421 FEIN OK ' W-EMP-NO ' ' W-FEIN DTSBX421 00780 * END-IF. DTSBX421 00781 P1112-EXIT. DTSBX421 00782 EXIT. DTSBX421 00783 DTSBX421 00784 P1112A-FIND-MPRF. DTSBX421 00785 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSBX421 00786 MOVE IEIN-EMP-NO TO MSKL-EMP-NO. DTSBX421 00787 SET MSKL-PRF-88 TO TRUE. DTSBX421 00788 DTSBX421 00789 PERFORM S910-READ THRU S910-EXIT. DTSBX421 00790 IF L910-NO-REC-88 DTSBX421 00791 NEXT SENTENCE DTSBX421 00792 ELSE DTSBX421 00793 MOVE MSKL-REC TO MPRF-REC DTSBX421 00794 ** MOVE MPRF-EMP-NO TO W-FEIN-EMP-NO DTSBX421 00795 IF MPRF-STATUS-ACT-88 DTSBX421 00796 SET W-ERROR-YES-88 TO TRUE DTSBX421 00797 SET W-DUP-FEIN-YES-88 TO TRUE DTSBX421 00798 MOVE W-FEIN TO MSG4-FEIN DTSBX421 00799 MOVE MSG4-DUP-EMP TO R140-MESSAGE DTSBX421 00800 PERFORM S2000-WRITE-RPT THRU S2000-EXIT DTSBX421 00801 END-IF DTSBX421 00802 END-IF. DTSBX421 00803 DTSBX421 00804 P1112A-EXIT. DTSBX421 00805 EXIT. DTSBX421 00806 DTSBX421 00807 P1120-SAVE-PROFILE. DTSBX421 00808 MOVE X102-EMP-FEIN TO W-FEIN. DTSBX421 00809 MOVE '17' TO W-SOURCE-CD. DTSBX421 00810 DTSBX421 00811 P1120-EXIT. DTSBX421 00812 EXIT. DTSBX421 00813 DTSBX421 00814 P1200-DETERM. DTSBX421 00815 SET W-EMP-IN-PROGRESS-YES-88 TO TRUE. DTSBX421 00816 MOVE LX42-DATA-AREA TO X104-REC. DTSBX421 00817 DTSBX421 00818 DISPLAY 'DETERMINATION ' X104-EMP-NO. DTSBX421 00819 * DISPLAY X104-REC. DTSBX421 00820 DTSBX421 00821 DTSBX421 00822 IF W-PREV-REC-PRF-88 DTSBX421 00823 OR W-PREV-REC-NAME-88 DTSBX421 00824 SET W-PREV-REC-DETERM-88 TO TRUE DTSBX421 00825 ADD +1 TO W-X104-CNT DTSBX421 00826 PERFORM P1210-EDIT-DETERM THRU P1210-EXIT DTSBX421 00827 IF W-ERROR-NO-88 DTSBX421 00828 PERFORM P1230-RATE-YEARS THRU P1230-EXIT DTSBX421 00829 END-IF DTSBX421 00830 ELSE DTSBX421 00831 SET W-ERROR-YES-88 TO TRUE DTSBX421 00832 MOVE SPACES TO R140-MESSAGE DTSBX421 00833 MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 00834 STRING DTSBX421 00835 'X104 DUP REC ' W-PREV-REC-TYPE ' ' W-EMP-NO DTSBX421 00836 DELIMITED BY SIZE DTSBX421 00837 INTO R140-MESSAGE DTSBX421 00838 END-STRING DTSBX421 00839 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 00840 END-IF. DTSBX421 00841 DTSBX421 00842 DTSBX421 00843 P1200-EXIT. DTSBX421 00844 EXIT. DTSBX421 00845 DTSBX421 00846 P1210-EDIT-DETERM. DTSBX421 00847 IF NOT X104-LIAB-VALID-88 DTSBX421 00848 SET W-ERROR-YES-88 TO TRUE DTSBX421 00849 MOVE X104-LIAB-CD TO MSG5-LIAB-CD DTSBX421 00850 MOVE MSG5-INVALID-LIAB-CD TO R140-MESSAGE DTSBX421 00851 PERFORM S2000-WRITE-RPT THRU S2000-EXIT DTSBX421 00852 END-IF. DTSBX421 00853 DTSBX421 00854 IF NOT X104-ELIG-VALID-88 DTSBX421 00855 SET W-ERROR-YES-88 TO TRUE DTSBX421 00856 MOVE X104-ELIG-CD TO MSG6-ELIG-CD DTSBX421 00857 MOVE MSG6-INVALID-ELIG-CD TO R140-MESSAGE DTSBX421 00858 PERFORM S2000-WRITE-RPT THRU S2000-EXIT DTSBX421 00859 END-IF. DTSBX421 00860 DTSBX421 00861 IF X104-NAICS-CD NOT NUMERIC DTSBX421 00862 *** SET W-ERROR-YES-88 TO TRUE DTSBX421 00863 * MOVE SPACES TO R140-MESSAGE DTSBX421 00864 * MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 00865 * STRING DTSBX421 00866 * 'DETERM NON-NUMERIC NAICS ' X104-NAICS-CD DTSBX421 00867 * DELIMITED BY SIZE DTSBX421 00868 * INTO R140-MESSAGE DTSBX421 00869 * END-STRING DTSBX421 00870 * DISPLAY R140-MESSAGE DTSBX421 00871 *** PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 00872 MOVE 999999 TO X104-NAICS-CD DTSBX421 00873 END-IF. DTSBX421 00874 DTSBX421 00875 IF NOT X104-ORG-TYPE-VALID-88 DTSBX421 00876 IF X104-LIAB-NOT-LIABLE-88 DTSBX421 00877 MOVE 'UNK' TO X104-ORG-TYPE DTSBX421 00878 ELSE DTSBX421 00879 SET W-ERROR-YES-88 TO TRUE DTSBX421 00880 MOVE X104-ORG-TYPE TO MSG7-ORG-TYPE DTSBX421 00881 MOVE MSG7-INVALID-ORG-TYPE TO R140-MESSAGE DTSBX421 00882 PERFORM S2000-WRITE-RPT THRU S2000-EXIT DTSBX421 00883 END-IF DTSBX421 00884 END-IF. DTSBX421 00885 DTSBX421 00886 IF X104-ORG-CORPORATION-88 DTSBX421 00887 MOVE X104-INCORP-DATE TO W-SLASH-DATE DTSBX421 00888 MOVE W-SLASH-DT-MM TO L001-FED-8-MO DTSBX421 00889 MOVE W-SLASH-DT-DD TO L001-FED-8-DA DTSBX421 00890 MOVE W-SLASH-DT-CCYY TO L001-FED-8-YR DTSBX421 00891 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBX421 00892 IF NOT L001-VALID-DATE DTSBX421 00893 SET W-ERROR-YES-88 TO TRUE DTSBX421 00894 MOVE X104-INCORP-DATE TO MSG8-INCORP-DATE DTSBX421 00895 MOVE MSG8-INVALID-INCORP-DATE TO R140-MESSAGE DTSBX421 00896 PERFORM S2000-WRITE-RPT THRU S2000-EXIT DTSBX421 00897 ELSE DTSBX421 00898 MOVE L001-FED-8-DATE-9 TO W-INCORP-DATE DTSBX421 00899 END-IF DTSBX421 00900 END-IF. DTSBX421 00901 DTSBX421 00902 DTSBX421 00903 EVALUATE TRUE DTSBX421 00904 WHEN X104-ELIG-NOT-SUBJECT-88 DTSBX421 00905 IF NOT X104-LIAB-NOT-LIABLE-88 DTSBX421 00906 PERFORM P1211-INCONSIST-ELIG-LIAB THRU P1211-EXIT DTSBX421 00907 END-IF DTSBX421 00908 DTSBX421 00909 WHEN X104-ELIG-RATED-88 DTSBX421 00910 IF NOT X104-LIAB-RATED-88 DTSBX421 00911 PERFORM P1211-INCONSIST-ELIG-LIAB THRU P1211-EXIT DTSBX421 00912 END-IF DTSBX421 00913 DTSBX421 00914 WHEN X104-ELIG-SELF-INS-88 DTSBX421 00915 IF NOT X104-LIAB-SELF-INS-88 DTSBX421 00916 PERFORM P1211-INCONSIST-ELIG-LIAB THRU P1211-EXIT DTSBX421 00917 END-IF DTSBX421 00918 DTSBX421 00919 WHEN X104-ELIG-UCX-88 DTSBX421 00920 OR X104-ELIG-UCFE-88 DTSBX421 00921 OR X104-ELIG-INTERSTATE-88 DTSBX421 00922 OR X104-ELIG-DC-GOV-88 DTSBX421 00923 IF NOT X104-LIAB-NOT-LIABLE-88 DTSBX421 00924 PERFORM P1211-INCONSIST-ELIG-LIAB THRU P1211-EXIT DTSBX421 00925 END-IF DTSBX421 00926 END-EVALUATE. DTSBX421 00927 DTSBX421 00928 IF X104-LIAB-NO-DETERM-88 DTSBX421 00929 OR X104-LIAB-NOT-LIABLE-88 DTSBX421 00930 MOVE SPACE TO X104-HOUSEHOLD-FILING DTSBX421 00931 ELSE DTSBX421 00932 IF X104-ORG-HSEHLD-DMSTIC-88 DTSBX421 00933 IF X104-HH-ANNUAL-88 DTSBX421 00934 OR X104-HH-QUARTERLY-88 DTSBX421 00935 NEXT SENTENCE DTSBX421 00936 ELSE DTSBX421 00937 SET W-ERROR-YES-88 TO TRUE DTSBX421 00938 STRING DTSBX421 00939 'X104 INVALID DOMESTIC FILING ' X104-HOUSEHOLD-FILING DTSBX421 00940 DELIMITED BY SIZE DTSBX421 00941 INTO R140-MESSAGE DTSBX421 00942 END-STRING DTSBX421 00943 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 00944 END-IF DTSBX421 00945 ELSE DTSBX421 00946 MOVE SPACE TO X104-HOUSEHOLD-FILING DTSBX421 00947 END-IF DTSBX421 00948 END-IF. DTSBX421 00949 DTSBX421 00950 IF X104-LIAB-RATED-88 DTSBX421 00951 OR X104-LIAB-SELF-INS-88 DTSBX421 00952 PERFORM P1212-WAGES-PAID THRU P1212-EXIT DTSBX421 00953 ELSE DTSBX421 00954 PERFORM P1213-NO-WAGES THRU P1213-EXIT DTSBX421 00955 END-IF. DTSBX421 00956 DTSBX421 00957 IF X104-ORG-HSEHLD-DMSTIC-88 DTSBX421 00958 OR X104-LIAB-NO-DETERM-88 DTSBX421 00959 OR X104-LIAB-NOT-LIABLE-88 DTSBX421 00960 NEXT SENTENCE DTSBX421 00961 ELSE DTSBX421 00962 PERFORM P1217-PRED-SUCC THRU P1217-EXIT DTSBX421 00963 END-IF. DTSBX421 00964 DTSBX421 00965 P1210-EXIT. DTSBX421 00966 EXIT. DTSBX421 00967 DTSBX421 00968 P1211-INCONSIST-ELIG-LIAB. DTSBX421 00969 SET W-ERROR-YES-88 TO TRUE. DTSBX421 00970 MOVE X104-ELIG-CD TO MSG10-ELIG-CD. DTSBX421 00971 MOVE X104-LIAB-CD TO MSG10-LIAB-CD. DTSBX421 00972 MOVE MSG10-INCONSISTENT-LIAB-CD TO R140-MESSAGE. DTSBX421 00973 PERFORM S2000-WRITE-RPT THRU S2000-EXIT. DTSBX421 00974 DTSBX421 00975 P1211-EXIT. DTSBX421 00976 EXIT. DTSBX421 00977 DTSBX421 00978 P1212-WAGES-PAID. DTSBX421 00979 IF X104-ORG-HSEHLD-DMSTIC-88 DTSBX421 00980 PERFORM P1212A-HOUSEHOLD THRU P1212A-EXIT DTSBX421 00981 ELSE DTSBX421 00982 PERFORM P1212B-REGULAR THRU P1212B-EXIT DTSBX421 00983 END-IF. DTSBX421 00984 DTSBX421 00985 P1212-EXIT. DTSBX421 00986 EXIT. DTSBX421 00987 DTSBX421 00988 P1212A-HOUSEHOLD. DTSBX421 00989 MOVE X104-FIRST-500-QTR TO W-SLASH-QTR. DTSBX421 00990 MOVE W-SLASH-QTR-CCYY TO L004-QTR-5-YR. DTSBX421 00991 MOVE W-SLASH-QTR-Q TO L004-QTR-5-Q. DTSBX421 00992 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBX421 00993 IF NOT L004-VALID-QTR DTSBX421 00994 SET W-ERROR-YES-88 TO TRUE DTSBX421 00995 MOVE X104-FIRST-500-QTR TO MSG11-QTR DTSBX421 00996 MOVE MSG11-WAGES-PAID-QTR TO R140-MESSAGE DTSBX421 00997 PERFORM S2000-WRITE-RPT THRU S2000-EXIT DTSBX421 00998 ELSE DTSBX421 00999 MOVE L004-QTR-START-DATE TO W-LIABLE-DATE DTSBX421 01000 MOVE L004-QTR-5-9 TO W-FIRST-500-QTR DTSBX421 01001 END-IF. DTSBX421 01002 DTSBX421 01003 P1212A-EXIT. DTSBX421 01004 EXIT. DTSBX421 01005 DTSBX421 01006 P1212B-REGULAR. DTSBX421 01007 MOVE X104-FIRST-WAGE-DT TO W-SLASH-DATE DTSBX421 01008 MOVE W-SLASH-DT-MM TO L001-FED-8-MO DTSBX421 01009 MOVE W-SLASH-DT-DD TO L001-FED-8-DA DTSBX421 01010 MOVE W-SLASH-DT-CCYY TO L001-FED-8-YR DTSBX421 01011 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBX421 01012 IF NOT L001-VALID-DATE DTSBX421 01013 SET W-ERROR-YES-88 TO TRUE DTSBX421 01014 MOVE X104-FIRST-WAGE-DT TO MSG12-DATE DTSBX421 01015 MOVE MSG12-FIRST-WAGE-DATE TO R140-MESSAGE DTSBX421 01016 PERFORM S2000-WRITE-RPT THRU S2000-EXIT DTSBX421 01017 ELSE DTSBX421 01018 MOVE L001-FED-8-DATE-9 TO W-LIABLE-DATE DTSBX421 01019 END-IF. DTSBX421 01020 DTSBX421 01021 P1212B-EXIT. DTSBX421 01022 EXIT. DTSBX421 01023 DTSBX421 01024 P1213-NO-WAGES. DTSBX421 01025 MOVE SPACES TO X104-FIRST-500-QTR DTSBX421 01026 X104-FIRST-WAGE-DT. DTSBX421 01027 DTSBX421 01028 *** IF X104-FIRST-500-QTR > SPACES DTSBX421 01029 * OR X104-FIRST-WAGE-DT > SPACES DTSBX421 01030 * SET W-ERROR-YES-88 TO TRUE DTSBX421 01031 * MOVE SPACES TO R140-MESSAGE DTSBX421 01032 * MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 01033 * STRING DTSBX421 01034 * 'DETERM WAGE DATES NOT NULL ' DTSBX421 01035 * X104-FIRST-WAGE-DT ' ' X104-FIRST-500-QTR DTSBX421 01036 * DELIMITED BY SIZE DTSBX421 01037 * INTO R140-MESSAGE DTSBX421 01038 * END-STRING DTSBX421 01039 * DISPLAY R140-MESSAGE DTSBX421 01040 * PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 01041 *** END-IF. DTSBX421 01042 DTSBX421 01043 P1213-EXIT. DTSBX421 01044 EXIT. DTSBX421 01045 DTSBX421 01046 P1217-PRED-SUCC. DTSBX421 01047 IF X104-ACQUIRE-IND = SPACES DTSBX421 01048 SET X104-ACQUIRE-NO-88 TO TRUE DTSBX421 01049 ELSE DTSBX421 01050 IF (X104-ACQUIRE-IND NOT = 'Y' AND 'N') DTSBX421 01051 SET W-ERROR-YES-88 TO TRUE DTSBX421 01052 MOVE SPACES TO R140-MESSAGE DTSBX421 01053 MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 01054 STRING DTSBX421 01055 'DETERM INVALID ACQUIRE IND ' DTSBX421 01056 X104-ACQUIRE-IND DTSBX421 01057 DELIMITED BY SIZE DTSBX421 01058 INTO R140-MESSAGE DTSBX421 01059 END-STRING DTSBX421 01060 ** DISPLAY R140-MESSAGE DTSBX421 01061 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 01062 END-IF DTSBX421 01063 END-IF. DTSBX421 01064 DTSBX421 01065 IF X104-MERGER-SPLIT-IND = SPACES DTSBX421 01066 SET X104-MERGE-SPLIT-NO-88 TO TRUE DTSBX421 01067 ELSE DTSBX421 01068 IF (X104-MERGER-SPLIT-IND NOT = 'Y' AND 'N') DTSBX421 01069 SET W-ERROR-YES-88 TO TRUE DTSBX421 01070 MOVE SPACES TO R140-MESSAGE DTSBX421 01071 MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 01072 STRING DTSBX421 01073 'DETERM INVALID MERGER-SPLIT IND ' DTSBX421 01074 X104-MERGER-SPLIT-IND DTSBX421 01075 DELIMITED BY SIZE DTSBX421 01076 INTO R140-MESSAGE DTSBX421 01077 END-STRING DTSBX421 01078 ** DISPLAY R140-MESSAGE DTSBX421 01079 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 01080 END-IF DTSBX421 01081 END-IF. DTSBX421 01082 DTSBX421 01083 IF X104-REORG-IND = SPACES DTSBX421 01084 SET X104-REORG-NO-88 TO TRUE DTSBX421 01085 ELSE DTSBX421 01086 IF (X104-REORG-IND NOT = 'Y' AND 'N') DTSBX421 01087 SET W-ERROR-YES-88 TO TRUE DTSBX421 01088 MOVE SPACES TO R140-MESSAGE DTSBX421 01089 MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 01090 STRING DTSBX421 01091 'DETERM INVALID REORG IND ' DTSBX421 01092 X104-REORG-IND DTSBX421 01093 DELIMITED BY SIZE DTSBX421 01094 INTO R140-MESSAGE DTSBX421 01095 END-STRING DTSBX421 01096 ** DISPLAY R140-MESSAGE DTSBX421 01097 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 01098 END-IF DTSBX421 01099 END-IF. DTSBX421 01100 DTSBX421 01101 IF X104-COMMON-OWN-IND = SPACES DTSBX421 01102 SET X104-COMMON-OWN-NO-88 TO TRUE DTSBX421 01103 ELSE DTSBX421 01104 IF (X104-COMMON-OWN-IND NOT = 'Y' AND 'N') DTSBX421 01105 MOVE SPACES TO R140-MESSAGE DTSBX421 01106 MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 01107 STRING DTSBX421 01108 'DETERM INVALID COMMON OWN IND ' DTSBX421 01109 X104-COMMON-OWN-IND DTSBX421 01110 DELIMITED BY SIZE DTSBX421 01111 INTO R140-MESSAGE DTSBX421 01112 END-STRING DTSBX421 01113 ** DISPLAY R140-MESSAGE DTSBX421 01114 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 01115 SET W-ERROR-YES-88 TO TRUE DTSBX421 01116 END-IF DTSBX421 01117 END-IF. DTSBX421 01118 DTSBX421 01119 IF X104-SALE-TRANSFER-IND = SPACES DTSBX421 01120 SET X104-SALE-TRANSFER-NO-88 TO TRUE DTSBX421 01121 ELSE DTSBX421 01122 IF (X104-SALE-TRANSFER-IND NOT = 'Y' AND 'N') DTSBX421 01123 SET W-ERROR-YES-88 TO TRUE DTSBX421 01124 MOVE SPACES TO R140-MESSAGE DTSBX421 01125 MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 01126 STRING DTSBX421 01127 'DETERM INVALID SALE-TRANS IND ' DTSBX421 01128 X104-SALE-TRANSFER-IND DTSBX421 01129 DELIMITED BY SIZE DTSBX421 01130 INTO R140-MESSAGE DTSBX421 01131 END-STRING DTSBX421 01132 ** DISPLAY R140-MESSAGE DTSBX421 01133 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 01134 END-IF DTSBX421 01135 END-IF. DTSBX421 01136 DTSBX421 01137 P1217-EXIT. DTSBX421 01138 EXIT. DTSBX421 01139 DTSBX421 01140 P1230-RATE-YEARS. DTSBX421 01141 IF W-LIABLE-DATE > ZERO DTSBX421 01142 MOVE W-LIABLE-DATE TO L001-FED-8-DATE-9 DTSBX421 01143 PERFORM DTSBX421 01144 VARYING SUB FROM +1 BY +1 DTSBX421 01145 UNTIL L001-FED-8-YR > LX42-LAST-RATE-YEAR DTSBX421 01146 MOVE L001-FED-8-YR TO W-RATE-YEAR (SUB) DTSBX421 01147 ADD 1 TO L001-FED-8-YR DTSBX421 01148 END-PERFORM DTSBX421 01149 END-IF. DTSBX421 01150 DTSBX421 01151 P1230-EXIT. DTSBX421 01152 EXIT. DTSBX421 01153 DTSBX421 01154 P1300-NAME. DTSBX421 01155 SET W-EMP-IN-PROGRESS-YES-88 TO TRUE. DTSBX421 01156 MOVE LX42-DATA-AREA TO X106-REC. DTSBX421 01157 DTSBX421 01158 * DISPLAY 'NAME ' DTSBX421 01159 * DISPLAY X106-REC. DTSBX421 01160 DTSBX421 01161 DTSBX421 01162 ** IF W-PREV-REC-DETERM-88 DTSBX421 01163 IF W-PREV-REC-PRF-88 DTSBX421 01164 OR W-PREV-REC-NAME-88 DTSBX421 01165 * DISPLAY 'GOOD PREV REC ' DTSBX421 01166 SET W-PREV-REC-NAME-88 TO TRUE DTSBX421 01167 ADD +1 TO W-X106-CNT DTSBX421 01168 PERFORM P1310-EDIT-NAME THRU P1310-EXIT DTSBX421 01169 IF W-ERROR-NO-88 DTSBX421 01170 * DISPLAY 'GOOD P1310 EDIT NAME ' DTSBX421 01171 PERFORM P1320-SAVE-NAME THRU P1320-EXIT DTSBX421 01172 END-IF DTSBX421 01173 ELSE DTSBX421 01174 SET W-ERROR-YES-88 TO TRUE DTSBX421 01175 MOVE SPACES TO R140-MESSAGE DTSBX421 01176 MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 01177 STRING DTSBX421 01178 'X106 - NAME RECORD NOT IN SYNC - DUP REC ' DTSBX421 01179 DELIMITED BY SIZE DTSBX421 01180 INTO R140-MESSAGE DTSBX421 01181 END-STRING DTSBX421 01182 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 01183 END-IF. DTSBX421 01184 DTSBX421 01185 P1300-EXIT. DTSBX421 01186 EXIT. DTSBX421 01187 DTSBX421 01188 P1310-EDIT-NAME. DTSBX421 01189 IF X106-EMP-NAME > SPACES DTSBX421 01190 NEXT SENTENCE DTSBX421 01191 ELSE DTSBX421 01192 SET W-ERROR-YES-88 TO TRUE DTSBX421 01193 MOVE SPACES TO R140-MESSAGE DTSBX421 01194 MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 01195 STRING DTSBX421 01196 'X106 - EMP NAME IS BLANK ' DTSBX421 01197 DELIMITED BY SIZE DTSBX421 01198 INTO R140-MESSAGE DTSBX421 01199 END-STRING DTSBX421 01200 ** DISPLAY R140-MESSAGE DTSBX421 01201 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 01202 END-IF. DTSBX421 01203 DTSBX421 01204 P1310-EXIT. DTSBX421 01205 EXIT. DTSBX421 01206 DTSBX421 01207 P1320-SAVE-NAME. DTSBX421 01208 * DISPLAY 'P1320-SAVE-NAME ' DTSBX421 01209 IF X106-NAME-TYPE-ENTITY-88 DTSBX421 01210 MOVE X106-EMP-NAME TO W-ENTITY-NAME DTSBX421 01211 ELSE DTSBX421 01212 IF X106-NAME-TYPE-TRADE-88 DTSBX421 01213 IF W-TRADE-NAME = SPACES DTSBX421 01214 MOVE X106-EMP-NAME TO W-TRADE-NAME DTSBX421 01215 ELSE DTSBX421 01216 PERFORM P1321-ALT-NAME THRU P1321-EXIT DTSBX421 01217 END-IF DTSBX421 01218 END-IF DTSBX421 01219 END-IF. DTSBX421 01220 DTSBX421 01221 P1320-EXIT. DTSBX421 01222 EXIT. DTSBX421 01223 DTSBX421 01224 P1321-ALT-NAME. DTSBX421 01225 * DISPLAY 'P1321-ALT-NAME' DTSBX421 01226 MOVE LOW-VALUES TO T002-REC. DTSBX421 01227 DTSBX421 01228 SET T002-LENGTH-EMP-NAME-88 TO TRUE. DTSBX421 01229 MOVE '002' TO T002-REC-TYPE. DTSBX421 01230 MOVE X106-EMP-NO TO T002-EMP-NO. DTSBX421 01231 MOVE 'WEB REG ' TO T002-ORIGIN. DTSBX421 01232 MOVE LX42-SYS-DATE TO T002-SYS-DATE. DTSBX421 01233 MOVE LX42-SYS-TIME TO T002-SYS-TIME. DTSBX421 01234 DTSBX421 01235 DTSBX421 01236 MOVE X106-NAME-TYPE TO Y106-EMP-NAME-TYPE. DTSBX421 01237 MOVE X106-EMP-NAME TO Y106-EMP-NAME. DTSBX421 01238 DTSBX421 01239 MOVE Y106-REC TO T002-DATA-AREA. DTSBX421 01240 SET T002-EMP-NAME-88 TO TRUE. DTSBX421 01241 PERFORM S1030-WRITE-TEMP-T002 THRU S1030-EXIT. DTSBX421 01242 DTSBX421 01243 P1321-EXIT. DTSBX421 01244 EXIT. DTSBX421 01245 DTSBX421 01246 P1400-RATE. DTSBX421 01247 SET W-EMP-IN-PROGRESS-YES-88 TO TRUE. DTSBX421 01248 MOVE LX42-DATA-AREA TO X108-REC. DTSBX421 01249 *& DTSBX421 01250 DISPLAY 'RATE ' W-EMP-NO ' ' X108-RATE-YEAR DTSBX421 01251 ' ' X108-RATE. DTSBX421 01252 *& DTSBX421 01253 DTSBX421 01254 ** IF W-PREV-REC-NAME-88 DTSBX421 01255 IF W-PREV-REC-DETERM-88 DTSBX421 01256 OR W-PREV-REC-RATE-88 DTSBX421 01257 SET W-PREV-REC-RATE-88 TO TRUE DTSBX421 01258 ADD +1 TO W-X108-CNT DTSBX421 01259 PERFORM P1410-EDIT-RATE THRU P1410-EXIT DTSBX421 01260 IF W-ERROR-NO-88 DTSBX421 01261 IF W-DUP-RATE-NO-88 DTSBX421 01262 PERFORM P1420-SAVE-RATE THRU P1420-EXIT DTSBX421 01263 END-IF DTSBX421 01264 END-IF DTSBX421 01265 ELSE DTSBX421 01266 SET W-ERROR-YES-88 TO TRUE DTSBX421 01267 MOVE SPACES TO R140-MESSAGE DTSBX421 01268 MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 01269 STRING DTSBX421 01270 'X108 - RATE RECORD OUT OF SYNC - DUP REC ' DTSBX421 01271 DELIMITED BY SIZE DTSBX421 01272 INTO R140-MESSAGE DTSBX421 01273 END-STRING DTSBX421 01274 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 01275 END-IF. DTSBX421 01276 DTSBX421 01277 P1400-EXIT. DTSBX421 01278 EXIT. DTSBX421 01279 DTSBX421 01280 P1410-EDIT-RATE. DTSBX421 01281 SET W-RATE-ERROR-NO-88 TO TRUE. DTSBX421 01282 SET W-DUP-RATE-NO-88 TO TRUE. DTSBX421 01283 DTSBX421 01284 IF X104-STAFF-REVIEW-YES-88 DTSBX421 01285 DISPLAY ' STAFF NEED REVIEW ------- ' W-EMP-NO DTSBX421 01286 GO TO P1410-EXIT DTSBX421 01287 END-IF. DTSBX421 01288 DTSBX421 01289 IF NOT X104-LIAB-RATED-88 DTSBX421 01290 SET W-ERROR-YES-88 TO TRUE DTSBX421 01291 MOVE SPACES TO R140-MESSAGE DTSBX421 01292 MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 01293 STRING DTSBX421 01294 'X108 EMPLOYER IS NOT RATED ' DTSBX421 01295 DELIMITED BY SIZE DTSBX421 01296 INTO R140-MESSAGE DTSBX421 01297 END-STRING DTSBX421 01298 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 01299 GO TO P1410-EXIT DTSBX421 01300 END-IF. DTSBX421 01301 DTSBX421 01302 MOVE X108-RATE-YEAR (1:4) TO L004-QTR-5-YR. DTSBX421 01303 MOVE 1 TO L004-QTR-5-Q. DTSBX421 01304 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBX421 01305 IF NOT L004-VALID-QTR DTSBX421 01306 SET W-ERROR-YES-88 TO TRUE DTSBX421 01307 MOVE SPACES TO R140-MESSAGE DTSBX421 01308 MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 01309 STRING DTSBX421 01310 'X108 INVALID RATE YEAR ' DTSBX421 01311 L004-QTR-5-X DTSBX421 01312 DELIMITED BY SIZE DTSBX421 01313 INTO R140-MESSAGE DTSBX421 01314 END-STRING DTSBX421 01315 ** DISPLAY R140-MESSAGE DTSBX421 01316 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 01317 ELSE DTSBX421 01318 PERFORM P1411-ADD-TO-TBL THRU P1411-EXIT DTSBX421 01319 END-IF. DTSBX421 01320 DTSBX421 01321 * IF W-DUP-RATE-YES-88 DTSBX421 01322 ** DISPLAY 'RATE: DUP IGNORED ' DTSBX421 01323 ** W-EMP-NO ' ' X108-RATE-YEAR DTSBX421 01324 * GO TO P1410-EXIT DTSBX421 01325 * END-IF. DTSBX421 01326 DTSBX421 01327 PERFORM P1415-FORMAT-RATE THRU P1415-EXIT. DTSBX421 01328 IF W-ERROR-YES-88 DTSBX421 01329 GO TO P1410-EXIT DTSBX421 01330 END-IF. DTSBX421 01331 DTSBX421 01332 MOVE L004-QTR-5-9 TO L052-EFF-YRQ. DTSBX421 01333 MOVE W-RATE TO L052-UI-RATE DTSBX421 01334 PERFORM S052-UI-RATE-EDIT THRU S052-EXIT DTSBX421 01335 IF L052-NOT-VALID DTSBX421 01336 SET W-ERROR-YES-88 TO TRUE DTSBX421 01337 MOVE SPACES TO R140-MESSAGE DTSBX421 01338 MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 01339 STRING DTSBX421 01340 'X108 INVALID TAX RATE (BU052) ' DTSBX421 01341 X108-RATE ' ' X108-RATE-YEAR DTSBX421 01342 DELIMITED BY SIZE DTSBX421 01343 INTO R140-MESSAGE DTSBX421 01344 END-STRING DTSBX421 01345 ** DISPLAY R140-MESSAGE DTSBX421 01346 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 01347 END-IF. DTSBX421 01348 * DISPLAY 'X108-REC' X108-REC. DTSBX421 01349 P1410-EXIT. DTSBX421 01350 EXIT. DTSBX421 01351 DTSBX421 01352 P1411-ADD-TO-TBL. DTSBX421 01353 PERFORM DTSBX421 01354 VARYING SUB FROM +1 BY +1 DTSBX421 01355 UNTIL SUB > +5 DTSBX421 01356 IF W-RATE-YEAR (SUB) = L004-QTR-5-YR DTSBX421 01357 IF W-RATE-FOUND-YES-88 (SUB) DTSBX421 01358 SET W-DUP-RATE-YES-88 TO TRUE DTSBX421 01359 ELSE DTSBX421 01360 SET W-RATE-FOUND-YES-88 (SUB) TO TRUE DTSBX421 01361 END-IF DTSBX421 01362 END-IF DTSBX421 01363 END-PERFORM. DTSBX421 01364 DTSBX421 01365 P1411-EXIT. DTSBX421 01366 EXIT. DTSBX421 01367 DTSBX421 01368 P1415-FORMAT-RATE. DTSBX421 01369 MOVE X108-RATE TO W-TEST-AMT. DTSBX421 01370 DTSBX421 01371 SET W-DECIMAL-FOUND-NO-88 TO TRUE. DTSBX421 01372 MOVE +1 TO W-MULTIPLIER. DTSBX421 01373 MOVE +0 TO W-VALUE. DTSBX421 01374 DTSBX421 01375 ** DISPLAY 'INTEGER'. DTSBX421 01376 PERFORM DTSBX421 01377 VARYING RSUB FROM +6 BY -1 DTSBX421 01378 UNTIL RSUB < +1 DTSBX421 01379 IF W-TEST-AMT (RSUB:1) = '.' DTSBX421 01380 SET W-DECIMAL-FOUND-YES-88 TO TRUE DTSBX421 01381 ** DISPLAY 'DECIMAL ' RSUB DTSBX421 01382 ELSE DTSBX421 01383 IF W-DECIMAL-FOUND-YES-88 DTSBX421 01384 PERFORM P1415A-INTEGER THRU P1415A-EXIT DTSBX421 01385 END-IF DTSBX421 01386 END-IF DTSBX421 01387 END-PERFORM. DTSBX421 01388 DTSBX421 01389 IF W-DECIMAL-FOUND-NO-88 DTSBX421 01390 SET W-ERROR-YES-88 TO TRUE DTSBX421 01391 MOVE SPACES TO R140-MESSAGE DTSBX421 01392 MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 01393 STRING DTSBX421 01394 'X108 INVALID RATE NO DEC POINT ' DTSBX421 01395 X108-RATE ' ' X108-RATE-YEAR DTSBX421 01396 DELIMITED BY SIZE DTSBX421 01397 INTO R140-MESSAGE DTSBX421 01398 END-STRING DTSBX421 01399 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 01400 SET W-ERROR-YES-88 TO TRUE DTSBX421 01401 GO TO P1415-EXIT DTSBX421 01402 END-IF. DTSBX421 01403 DTSBX421 01404 SET W-DECIMAL-FOUND-NO-88 TO TRUE. DTSBX421 01405 MOVE +0.1 TO W-MULTIPLIER. DTSBX421 01406 DTSBX421 01407 PERFORM DTSBX421 01408 VARYING RSUB FROM +1 BY +1 DTSBX421 01409 UNTIL RSUB > +6 DTSBX421 01410 IF W-TEST-AMT (RSUB:1) = '.' DTSBX421 01411 SET W-DECIMAL-FOUND-YES-88 TO TRUE DTSBX421 01412 ** DISPLAY 'DECIMAL ' RSUB DTSBX421 01413 ELSE DTSBX421 01414 IF W-DECIMAL-FOUND-YES-88 DTSBX421 01415 PERFORM P1415B-FRACTION THRU P1415B-EXIT DTSBX421 01416 END-IF DTSBX421 01417 END-IF DTSBX421 01418 END-PERFORM. DTSBX421 01419 DTSBX421 01420 COMPUTE W-RATE = (W-VALUE / 100). DTSBX421 01421 DTSBX421 01422 P1415-EXIT. DTSBX421 01423 EXIT. DTSBX421 01424 DTSBX421 01425 P1415A-INTEGER. DTSBX421 01426 MOVE W-TEST-AMT(RSUB:1) TO W-DIGIT. DTSBX421 01427 COMPUTE W-VALUE = W-VALUE + DTSBX421 01428 (W-DIGIT * W-MULTIPLIER). DTSBX421 01429 ** MOVE W-VALUE TO W-DISP-AMT. DTSBX421 01430 ** DISPLAY W-DISP-AMT ' ' W-MULTIPLIER. DTSBX421 01431 COMPUTE W-MULTIPLIER = DTSBX421 01432 (W-MULTIPLIER * +10). DTSBX421 01433 DTSBX421 01434 P1415A-EXIT. DTSBX421 01435 EXIT. DTSBX421 01436 DTSBX421 01437 P1415B-FRACTION. DTSBX421 01438 MOVE W-TEST-AMT(RSUB:1) TO W-DIGIT. DTSBX421 01439 COMPUTE W-VALUE = W-VALUE + DTSBX421 01440 (W-DIGIT * W-MULTIPLIER). DTSBX421 01441 ** MOVE W-VALUE TO W-DISP-AMT. DTSBX421 01442 ** DISPLAY W-DISP-AMT ' ' W-MULTIPLIER. DTSBX421 01443 COMPUTE W-MULTIPLIER = DTSBX421 01444 (W-MULTIPLIER / +10). DTSBX421 01445 DTSBX421 01446 P1415B-EXIT. DTSBX421 01447 EXIT. DTSBX421 01448 DTSBX421 01449 P1420-SAVE-RATE. DTSBX421 01450 DISPLAY 'P1420-SAVE-RATE' DTSBX421 01451 MOVE LOW-VALUES TO T002-REC. DTSBX421 01452 DTSBX421 01453 SET T002-LENGTH-RATE-88 TO TRUE. DTSBX421 01454 MOVE '002' TO T002-REC-TYPE. DTSBX421 01455 MOVE X108-EMP-NO TO T002-EMP-NO. DTSBX421 01456 MOVE 'WEB REG ' TO T002-ORIGIN. DTSBX421 01457 MOVE LX42-SYS-DATE TO T002-SYS-DATE. DTSBX421 01458 MOVE LX42-SYS-TIME TO T002-SYS-TIME. DTSBX421 01459 DTSBX421 01460 DTSBX421 01461 MOVE L052-EFF-YRQ TO Y108-RATE-EFF-YRQ. DTSBX421 01462 MOVE L052-UI-RATE TO Y108-UI-RATE. DTSBX421 01463 DTSBX421 01464 MOVE Y108-REC TO T002-DATA-AREA. DTSBX421 01465 SET T002-EMP-RATE-88 TO TRUE. DTSBX421 01466 PERFORM S1030-WRITE-TEMP-T002 THRU S1030-EXIT. DTSBX421 01467 DTSBX421 01468 *& DTSBX421 01469 * DISPLAY 'BX421 RATE ' X108-EMP-NO ' ' X108-RATE-YEAR DTSBX421 01470 * ' ' X108-RATE. DTSBX421 01471 *& DTSBX421 01472 P1420-EXIT. DTSBX421 01473 EXIT. DTSBX421 01474 DTSBX421 01475 * DTSBX421 01476 *P1700-RELATION. DTSBX421 01477 * SET W-EMP-IN-PROGRESS-YES-88 TO TRUE. DTSBX421 01478 * INITIALIZE X130-REC. DTSBX421 01479 * MOVE +16 TO W-LAST-FIELD. DTSBX421 01480 * MOVE +40 TO W-LAST-FIELD-LEN. DTSBX421 01481 * PERFORM S2000-PARSE-INPUT THRU S2000-EXIT. DTSBX421 01482 *& DTSBX421 01483 * DISPLAY 'RELATIONSHIP'. DTSBX421 01484 ** DISPLAY X130-REC. DTSBX421 01485 *& DTSBX421 01486 * DTSBX421 01487 * IF W-PREV-REC-OPO-88 DTSBX421 01488 * OR W-PREV-REC-REL-88 DTSBX421 01489 * SET W-PREV-REC-REL-88 TO TRUE DTSBX421 01490 * ADD +1 TO W-X130-CNT DTSBX421 01491 * PERFORM P1710-EDIT-RELATION THRU P1710-EXIT DTSBX421 01492 * IF W-ERROR-NO-88 DTSBX421 01493 * PERFORM P1720-SAVE-REL THRU P1720-EXIT DTSBX421 01494 * END-IF DTSBX421 01495 * ELSE DTSBX421 01496 * DISPLAY 'REL RECORD FOUND FOLLOWING ' DTSBX421 01497 * W-PREV-REC-TYPE ' ' W-EMP-NO DTSBX421 01498 * SET W-ERROR-YES-88 TO TRUE DTSBX421 01499 * END-IF. DTSBX421 01500 * DTSBX421 01501 *P1700-EXIT. DTSBX421 01502 * EXIT. DTSBX421 01503 * DTSBX421 01504 *P1710-EDIT-RELATION. DTSBX421 01505 * IF X130-PRED-FEIN NOT NUMERIC DTSBX421 01506 * DISPLAY 'REL: NON-NUMERIC FEIN ' X130-PRED-FEIN DTSBX421 01507 * ' ' W-EMP-NO DTSBX421 01508 * SET W-ERROR-YES-88 TO TRUE DTSBX421 01509 *RW1 DTSBX421 01510 * MOVE SPACES TO R140-MESSAGE DTSBX421 01511 * MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 01512 * STRING DTSBX421 01513 * 'RELATION NON-NUMERIC FEIN ' X130-PRED-FEIN DTSBX421 01514 * DELIMITED BY SIZE DTSBX421 01515 * INTO R140-MESSAGE DTSBX421 01516 * END-STRING DTSBX421 01517 * PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 01518 *RW2 DTSBX421 01519 * ELSE DTSBX421 01520 * MOVE X130-PRED-FEIN TO W-PRED-FEIN DTSBX421 01521 * END-IF. DTSBX421 01522 * DTSBX421 01523 *** DISPLAY 'REL: EMP ' X130-PRED-EMP-NO. DTSBX421 01524 * IF X130-PRED-EMP-NO NOT NUMERIC DTSBX421 01525 * DISPLAY 'REL: NON-NUMERIC PRED EMP ' DTSBX421 01526 * X130-PRED-EMP-NO ' ' W-EMP-NO DTSBX421 01527 *** SET W-ERROR-YES-88 TO TRUE DTSBX421 01528 *RW1 DTSBX421 01529 * MOVE SPACES TO R140-MESSAGE DTSBX421 01530 * MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 01531 * STRING DTSBX421 01532 * 'RELATION NON-NUMERIC PRED EMP ' X130-PRED-EMP-NO DTSBX421 01533 * DELIMITED BY SIZE DTSBX421 01534 * INTO R140-MESSAGE DTSBX421 01535 * END-STRING DTSBX421 01536 * PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 01537 * MOVE ZERO TO W-PRED-EMP-NO DTSBX421 01538 *RW2 DTSBX421 01539 * ELSE DTSBX421 01540 * MOVE X130-PRED-EMP-NO TO W-PRED-EMP-NO DTSBX421 01541 * END-IF. DTSBX421 01542 * DTSBX421 01543 * IF NOT X130-REL-VALID-88 DTSBX421 01544 * DISPLAY 'REL: INVALID RELATIONSHIP CODE ' DTSBX421 01545 * X130-RELATIONSHIP-CD ' ' W-EMP-NO DTSBX421 01546 * SET W-ERROR-YES-88 TO TRUE DTSBX421 01547 * END-IF. DTSBX421 01548 * DTSBX421 01549 * MOVE X130-EFF-DATE TO W-SLASH-DATE DTSBX421 01550 * MOVE W-SLASH-DT-MM TO L001-FED-8-MO DTSBX421 01551 * MOVE W-SLASH-DT-DD TO L001-FED-8-DA DTSBX421 01552 * MOVE W-SLASH-DT-CCYY TO L001-FED-8-YR DTSBX421 01553 * PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBX421 01554 * IF NOT L001-VALID-DATE DTSBX421 01555 * DISPLAY 'REL: INVALID EFFECTIVE DATE ' DTSBX421 01556 * W-EMP-NO ' ' X130-EFF-DATE DTSBX421 01557 * SET W-ERROR-YES-88 TO TRUE DTSBX421 01558 *RW1 DTSBX421 01559 * MOVE SPACES TO R140-MESSAGE DTSBX421 01560 * MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 01561 * STRING DTSBX421 01562 * 'RELATION INVALID EFFECTIVE DATE ' X130-EFF-DATE DTSBX421 01563 * DELIMITED BY SIZE DTSBX421 01564 * INTO R140-MESSAGE DTSBX421 01565 * END-STRING DTSBX421 01566 * PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 01567 *RW2 DTSBX421 01568 * ELSE DTSBX421 01569 * MOVE L001-SLASH-8-DATE TO W-PRED-EFF-DATE DTSBX421 01570 * END-IF. DTSBX421 01571 * DTSBX421 01572 * PERFORM DTSBX421 01573 * VARYING RSUB FROM +1 BY +1 DTSBX421 01574 * UNTIL RSUB > +6 DTSBX421 01575 * IF RSUB = +4 DTSBX421 01576 * IF X130-PORTION-EXP-TRNSF (RSUB:1) = '.' DTSBX421 01577 * NEXT SENTENCE DTSBX421 01578 * ELSE DTSBX421 01579 * DISPLAY 'NON-NUMERIC PERCENT ' DTSBX421 01580 * X130-PORTION-EXP-TRNSF DTSBX421 01581 * SET W-ERROR-YES-88 TO TRUE DTSBX421 01582 *RW1 DTSBX421 01583 * MOVE SPACES TO R140-MESSAGE DTSBX421 01584 * MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 01585 * STRING DTSBX421 01586 * 'RELATION NON-NUMERIC PERCENT ' DTSBX421 01587 * X130-PORTION-EXP-TRNSF DTSBX421 01588 * DELIMITED BY SIZE DTSBX421 01589 * INTO R140-MESSAGE DTSBX421 01590 * END-STRING DTSBX421 01591 * PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 01592 *RW2 DTSBX421 01593 * END-IF DTSBX421 01594 * ELSE DTSBX421 01595 * IF X130-PORTION-EXP-TRNSF (RSUB:1) >= '0' DTSBX421 01596 * OR X130-PORTION-EXP-TRNSF (RSUB:1) <= '9' DTSBX421 01597 * NEXT SENTENCE DTSBX421 01598 * ELSE DTSBX421 01599 * DISPLAY 'NON-NUMERIC PERCENT ' DTSBX421 01600 * X130-PORTION-EXP-TRNSF DTSBX421 01601 * SET W-ERROR-YES-88 TO TRUE DTSBX421 01602 *RW1 DTSBX421 01603 * MOVE SPACES TO R140-MESSAGE DTSBX421 01604 * MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 01605 * STRING DTSBX421 01606 * 'RELATION NON-NUMERIC PERCENT ' DTSBX421 01607 * X130-PORTION-EXP-TRNSF DTSBX421 01608 * DELIMITED BY SIZE DTSBX421 01609 * INTO R140-MESSAGE DTSBX421 01610 * END-STRING DTSBX421 01611 * PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 01612 *RW2 DTSBX421 01613 * END-IF DTSBX421 01614 * END-IF DTSBX421 01615 * END-PERFORM. DTSBX421 01616 * DTSBX421 01617 * MOVE X130-PORTION-EXP-TRNSF TO W-PORTION-EXP-TRNSF-X. DTSBX421 01618 * DTSBX421 01619 * IF W-PRED-EMP-NO > ZERO DTSBX421 01620 * MOVE LOW-VALUE TO MPRF-KEY-AREA DTSBX421 01621 * MOVE X130-PRED-EMP-NO TO MPRF-EMP-NO DTSBX421 01622 * SET MPRF-PRF-88 TO TRUE DTSBX421 01623 * MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA DTSBX421 01624 * PERFORM S910-READ THRU S910-EXIT DTSBX421 01625 * IF L910-NO-REC-88 DTSBX421 01626 * DISPLAY 'PREDECESSOR DOES NOT EXIST ' DTSBX421 01627 * X130-PRED-EMP-NO ' ' W-EMP-NO DTSBX421 01628 *** SET W-ERROR-YES-88 TO TRUE DTSBX421 01629 *RW1 DTSBX421 01630 * MOVE SPACES TO R140-MESSAGE DTSBX421 01631 * MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 01632 * STRING DTSBX421 01633 * 'RELATION PREDECESSOR DOES NOT EXIST ' DTSBX421 01634 * X130-PRED-EMP-NO DTSBX421 01635 * DELIMITED BY SIZE DTSBX421 01636 * INTO R140-MESSAGE DTSBX421 01637 * END-STRING DTSBX421 01638 * PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 01639 *RW2 DTSBX421 01640 * END-IF DTSBX421 01641 * END-IF. DTSBX421 01642 * DTSBX421 01643 *P1710-EXIT. DTSBX421 01644 * EXIT. DTSBX421 01645 * DTSBX421 01646 *P1720-SAVE-REL. DTSBX421 01647 * PERFORM S3000-INIT-T003 THRU S3000-EXIT. DTSBX421 01648 * DTSBX421 01649 * SET W-MNTE-RELATIONSHIP-88 TO TRUE DTSBX421 01650 * MOVE W-MNTE-SUBJECT TO MNTE-SUBJECT DTSBX421 01651 * DTSBX421 01652 * PERFORM P1721-MOVE-TEXT THRU P1721-EXIT. DTSBX421 01653 * DTSBX421 01654 * MOVE MNTE-REC TO T003-MNTE-REC. DTSBX421 01655 * DTSBX421 01656 * PERFORM S1031-WRITE-TEMP-T003 THRU S1031-EXIT. DTSBX421 01657 * DTSBX421 01658 *& DTSBX421 01659 * DISPLAY 'MNTE ' W-EMP-NO. DTSBX421 01660 * PERFORM DTSBX421 01661 * VARYING SUB FROM +1 BY +1 DTSBX421 01662 * UNTIL SUB > MNTE-TEXT-CNT DTSBX421 01663 * DISPLAY MNTE-TEXT (SUB) DTSBX421 01664 * END-PERFORM. DTSBX421 01665 *& DTSBX421 01666 *********************************************** DTSBX421 01667 * MOVE LOW-VALUES TO T002-REC. DTSBX421 01668 * DTSBX421 01669 * SET T002-LENGTH-REL-88 TO TRUE. DTSBX421 01670 * MOVE '002' TO T002-REC-TYPE. DTSBX421 01671 * MOVE W-EMP-NO TO T002-EMP-NO. DTSBX421 01672 * MOVE 'WEB REG ' TO T002-ORIGIN. DTSBX421 01673 * MOVE LX42-SYS-DATE TO T002-SYS-DATE. DTSBX421 01674 * MOVE LX42-SYS-TIME TO T002-SYS-TIME. DTSBX421 01675 * DTSBX421 01676 * SET T002-EMP-REL-88 TO TRUE. DTSBX421 01677 * DTSBX421 01678 * MOVE W-PRED-EMP-NO TO T002-PRED-EMP-NO. DTSBX421 01679 * MOVE W-PRED-FEIN TO T002-PRED-FEIN. DTSBX421 01680 * MOVE X130-RELATIONSHIP-CD TO T002-RELATIONSHIP-CD. DTSBX421 01681 * COMPUTE T002-PORTION-EXP-TRNSF = DTSBX421 01682 * (W-PORTION-EXP-TRNSF / 100). DTSBX421 01683 * MOVE W-PRED-EFF-DATE TO T002-REL-EFF-DATE. DTSBX421 01684 * MOVE X130-SOURCE TO T002-REL-SOURCE. DTSBX421 01685 * MOVE X130-ENTITY-NAME TO T002-REL-NAME. DTSBX421 01686 * DTSBX421 01687 * MOVE X130-ATTENTION TO T002-REL-ATTN. DTSBX421 01688 * MOVE X130-STREET-1 TO T002-REL-DELV1. DTSBX421 01689 * MOVE X130-STREET-2 TO T002-REL-DELV2. DTSBX421 01690 * MOVE X130-CITY TO T002-REL-CITY. DTSBX421 01691 * MOVE X130-STATE TO T002-REL-STATE. DTSBX421 01692 * MOVE X130-ZIP TO T002-REL-ZIP. DTSBX421 01693 * MOVE X130-PHONE TO T002-REL-VOICE. DTSBX421 01694 * MOVE X130-FAX TO T002-REL-FAX. DTSBX421 01695 * MOVE X130-EMAIL TO T002-REL-EMAIL. DTSBX421 01696 * DTSBX421 01697 * PERFORM S1030-WRITE-TEMP-T002 THRU S1030-EXIT. DTSBX421 01698 * DTSBX421 01699 *P1720-EXIT. DTSBX421 01700 * EXIT. DTSBX421 01701 * DTSBX421 01702 *P1721-MOVE-TEXT. DTSBX421 01703 * IF X104-LIAB-RATED-88 DTSBX421 01704 * MOVE 'R' TO W-CLASS DTSBX421 01705 * ELSE DTSBX421 01706 * IF X104-LIAB-SELF-INS-88 DTSBX421 01707 * MOVE 'S' TO W-CLASS DTSBX421 01708 * ELSE DTSBX421 01709 * MOVE 'U' TO W-CLASS DTSBX421 01710 * END-IF DTSBX421 01711 * END-IF. DTSBX421 01712 * DTSBX421 01713 * MOVE +1 TO MNTE-TEXT-CNT. DTSBX421 01714 * MOVE 'SUCCESSOR LIABILITY INFO: ' DTSBX421 01715 * TO MNTE-TEXT (MNTE-TEXT-CNT). DTSBX421 01716 * DTSBX421 01717 * ADD +1 TO MNTE-TEXT-CNT. DTSBX421 01718 * STRING 'CLASS: ' W-CLASS DTSBX421 01719 * ' LIABILITY CODE: ' X104-LIAB-CD DTSBX421 01720 * ' LIABILITY DATE: ' X104-FIRST-WAGE-DT DTSBX421 01721 * DELIMITED BY SIZE DTSBX421 01722 * INTO MNTE-TEXT (MNTE-TEXT-CNT) DTSBX421 01723 * END-STRING. DTSBX421 01724 * DTSBX421 01725 * ADD +1 TO MNTE-TEXT-CNT. DTSBX421 01726 * MOVE SPACES DTSBX421 01727 * TO MNTE-TEXT (MNTE-TEXT-CNT). DTSBX421 01728 * DTSBX421 01729 * ADD +1 TO MNTE-TEXT-CNT. DTSBX421 01730 * MOVE 'PREDECESSOR INFO:' DTSBX421 01731 * TO MNTE-TEXT (MNTE-TEXT-CNT). DTSBX421 01732 * DTSBX421 01733 * ADD +1 TO MNTE-TEXT-CNT. DTSBX421 01734 * STRING 'NAME: ' X130-ENTITY-NAME DTSBX421 01735 * DELIMITED BY SIZE DTSBX421 01736 * INTO MNTE-TEXT (MNTE-TEXT-CNT) DTSBX421 01737 * END-STRING. DTSBX421 01738 * DTSBX421 01739 * ADD +1 TO MNTE-TEXT-CNT. DTSBX421 01740 * STRING 'ACCOUNT ' W-PRED-EMP-NO DTSBX421 01741 * ' FEIN ' W-PRED-FEIN DTSBX421 01742 * ' RELATIONSHIP CODE: ' X130-RELATIONSHIP-CD DTSBX421 01743 * DELIMITED BY SIZE DTSBX421 01744 * INTO MNTE-TEXT (MNTE-TEXT-CNT) DTSBX421 01745 * END-STRING. DTSBX421 01746 * DTSBX421 01747 * ADD +1 TO MNTE-TEXT-CNT. DTSBX421 01748 * STRING 'EXP TRANSFERRED: ' DTSBX421 01749 * W-PORTION-EXP-TRNSF-X DTSBX421 01750 * ' EFF DATE: ' DTSBX421 01751 * W-PRED-EFF-DATE DTSBX421 01752 * DELIMITED BY SIZE DTSBX421 01753 * INTO MNTE-TEXT (MNTE-TEXT-CNT) DTSBX421 01754 * END-STRING. DTSBX421 01755 * DTSBX421 01756 *** ADD +1 TO MNTE-TEXT-CNT. DTSBX421 01757 ** STRING 'TRANSFER EFFECTIVE DATE: ' DTSBX421 01758 ** W-PRED-EFF-DATE DTSBX421 01759 ** DELIMITED BY SIZE DTSBX421 01760 ** INTO MNTE-TEXT (MNTE-TEXT-CNT) DTSBX421 01761 ** END-STRING. DTSBX421 01762 ** DTSBX421 01763 ** IF X130-ATTENTION > SPACES DTSBX421 01764 ** ADD +1 TO MNTE-TEXT-CNT DTSBX421 01765 ** MOVE X130-ATTENTION DTSBX421 01766 ** TO MNTE-TEXT (MNTE-TEXT-CNT) DTSBX421 01767 *** END-IF. DTSBX421 01768 * DTSBX421 01769 * IF X130-STREET-1 > SPACES DTSBX421 01770 * ADD +1 TO MNTE-TEXT-CNT DTSBX421 01771 * MOVE X130-STREET-1 DTSBX421 01772 * TO MNTE-TEXT (MNTE-TEXT-CNT) DTSBX421 01773 * END-IF. DTSBX421 01774 * DTSBX421 01775 * IF X130-STREET-2 > SPACES DTSBX421 01776 * ADD +1 TO MNTE-TEXT-CNT DTSBX421 01777 * MOVE X130-STREET-2 DTSBX421 01778 * TO MNTE-TEXT (MNTE-TEXT-CNT) DTSBX421 01779 * END-IF. DTSBX421 01780 * DTSBX421 01781 * ADD +1 TO MNTE-TEXT-CNT DTSBX421 01782 * STRING X130-CITY ', ' DTSBX421 01783 * X130-STATE ' ' DTSBX421 01784 * X130-ZIP DTSBX421 01785 * DELIMITED BY SIZE DTSBX421 01786 * INTO MNTE-TEXT (MNTE-TEXT-CNT) DTSBX421 01787 * END-STRING. DTSBX421 01788 * DTSBX421 01789 * MOVE SPACES TO WRK-PHONE DTSBX421 01790 * WRK-PHONE-TEXT1 DTSBX421 01791 * WRK-PHONE-TEXT2. DTSBX421 01792 * IF X130-PHONE > SPACES DTSBX421 01793 * MOVE X130-PHONE TO WRK-PHONE DTSBX421 01794 * IF WRK-EXT > SPACES DTSBX421 01795 * MOVE '-' TO WRK-EXT-HYPHEN DTSBX421 01796 * ELSE DTSBX421 01797 * MOVE ' ' TO WRK-EXT-HYPHEN DTSBX421 01798 * END-IF DTSBX421 01799 * STRING DTSBX421 01800 * 'PHONE ' WRK-AREA-CD '-' DTSBX421 01801 * WRK-PREFIX '-' DTSBX421 01802 * WRK-SUFFIX DTSBX421 01803 * WRK-EXT-HYPHEN DTSBX421 01804 * WRK-EXT DTSBX421 01805 * DELIMITED BY SIZE DTSBX421 01806 * INTO WRK-PHONE-TEXT1 DTSBX421 01807 * END-STRING DTSBX421 01808 * END-IF. DTSBX421 01809 * DTSBX421 01810 * IF X130-FAX > SPACES DTSBX421 01811 * MOVE X130-FAX TO WRK-PHONE DTSBX421 01812 * STRING DTSBX421 01813 * 'FAX ' WRK-AREA-CD '-' DTSBX421 01814 * WRK-PREFIX '-' DTSBX421 01815 * WRK-SUFFIX DTSBX421 01816 * DELIMITED BY SIZE DTSBX421 01817 * INTO WRK-PHONE-TEXT2 DTSBX421 01818 * END-STRING DTSBX421 01819 * END-IF. DTSBX421 01820 * DTSBX421 01821 * ADD +1 TO MNTE-TEXT-CNT. DTSBX421 01822 * STRING WRK-PHONE-TEXT1 ' ' DTSBX421 01823 * WRK-PHONE-TEXT2 DTSBX421 01824 * DELIMITED BY SIZE DTSBX421 01825 * INTO MNTE-TEXT (MNTE-TEXT-CNT) DTSBX421 01826 * END-STRING. DTSBX421 01827 * DTSBX421 01828 * ADD +1 TO MNTE-TEXT-CNT. DTSBX421 01829 * MOVE X130-EMAIL DTSBX421 01830 * TO MNTE-TEXT (MNTE-TEXT-CNT). DTSBX421 01831 * DTSBX421 01832 *P1721-EXIT. DTSBX421 01833 * EXIT. DTSBX421 01834 * DTSBX421 01835 *P1800-IND-DESC. DTSBX421 01836 * SET W-EMP-IN-PROGRESS-YES-88 TO TRUE. DTSBX421 01837 * INITIALIZE X132-REC. DTSBX421 01838 * MOVE +4 TO W-LAST-FIELD. DTSBX421 01839 * MOVE +500 TO W-LAST-FIELD-LEN. DTSBX421 01840 * PERFORM S2000-PARSE-INPUT THRU S2000-EXIT. DTSBX421 01841 *& DTSBX421 01842 * DISPLAY 'INDUSTRY DESCRIPTION'. DTSBX421 01843 *& DTSBX421 01844 * DTSBX421 01845 * SET W-PREV-REC-IND-88 TO TRUE. DTSBX421 01846 * ADD +1 TO W-X132-CNT. DTSBX421 01847 * PERFORM P1820-SAVE-IND THRU P1820-EXIT. DTSBX421 01848 * DTSBX421 01849 *P1800-EXIT. DTSBX421 01850 * EXIT. DTSBX421 01851 * DTSBX421 01852 *P1820-SAVE-IND. DTSBX421 01853 * MOVE LOW-VALUES TO MNTE-KEY-AREA. DTSBX421 01854 * MOVE W-EMP-NO TO MNTE-EMP-NO. DTSBX421 01855 * SET MNTE-NTE-88 TO TRUE. DTSBX421 01856 * MOVE +0 TO MNTE-PURGE-DATE. DTSBX421 01857 * SET MNTE-NOT-CONVERTED-88 TO TRUE. DTSBX421 01858 * DTSBX421 01859 * MOVE LX42-SYS-DATE TO MNTE-ESTB-DATE DTSBX421 01860 * MNTE-CHNG-DATE. DTSBX421 01861 * MOVE ZERO TO MNTE-KEY-ESTB-ABSTIME DTSBX421 01862 * MNTE-DATA-ESTB-ABSTIME DTSBX421 01863 * MNTE-CHNG-ABSTIME. DTSBX421 01864 * MOVE 'WEB REG ' TO MNTE-ESTB-OP-ID DTSBX421 01865 * MNTE-CHNG-OP-ID. DTSBX421 01866 * MOVE +0 TO MNTE-TEXT-CNT. DTSBX421 01867 * MOVE SPACES TO MNTE-TEXT-AREA. DTSBX421 01868 * DTSBX421 01869 * IF X132-SOURCE-KEY-WORD-88 DTSBX421 01870 * SET W-MNTE-KEY-WORD-88 TO TRUE DTSBX421 01871 * MOVE W-MNTE-SUBJECT TO MNTE-SUBJECT DTSBX421 01872 * ELSE DTSBX421 01873 * SET W-MNTE-DATA-ENTRY-88 TO TRUE DTSBX421 01874 * MOVE W-MNTE-SUBJECT TO MNTE-SUBJECT DTSBX421 01875 * END-IF. DTSBX421 01876 * DTSBX421 01877 * PERFORM P1821-MOVE-TEXT THRU P1821-EXIT. DTSBX421 01878 * DTSBX421 01879 * MOVE LENGTH OF T003-REC TO T003-LENGTH DTSBX421 01880 * MOVE '003' TO T003-REC-TYPE. DTSBX421 01881 * MOVE W-EMP-NO TO T003-EMP-NO. DTSBX421 01882 * MOVE 'WEB REG ' TO T003-ORIGIN. DTSBX421 01883 * MOVE LX42-SYS-DATE TO T003-SYS-DATE. DTSBX421 01884 * MOVE LX42-SYS-TIME TO T003-SYS-TIME. DTSBX421 01885 * SET T003-ADD-MNTE-88 TO TRUE. DTSBX421 01886 * MOVE MNTE-REC TO T003-MNTE-REC. DTSBX421 01887 * DTSBX421 01888 * PERFORM S1031-WRITE-TEMP-T003 THRU S1031-EXIT. DTSBX421 01889 * DTSBX421 01890 *P1820-EXIT. DTSBX421 01891 * EXIT. DTSBX421 01892 * DTSBX421 01893 *P1821-MOVE-TEXT. DTSBX421 01894 * SET W-MNTE-COMPLETE-NO-88 TO TRUE. DTSBX421 01895 * MOVE SPACES TO W-MNTE-LINE. DTSBX421 01896 * MOVE +0 TO W-LAST-SPACE DTSBX421 01897 * TSUB1 DTSBX421 01898 * TSUB2. DTSBX421 01899 * DTSBX421 01900 * PERFORM DTSBX421 01901 * UNTIL W-MNTE-COMPLETE-YES-88 DTSBX421 01902 * ADD +1 TO TSUB1 DTSBX421 01903 * IF TSUB1 <= +500 DTSBX421 01904 * PERFORM P1821A-MOVE-DATA THRU P1821A-EXIT DTSBX421 01905 * ELSE DTSBX421 01906 * SET W-MNTE-COMPLETE-YES-88 TO TRUE DTSBX421 01907 * END-IF DTSBX421 01908 * END-PERFORM. DTSBX421 01909 * DTSBX421 01910 *P1821-EXIT. DTSBX421 01911 * EXIT. DTSBX421 01912 * DTSBX421 01913 *P1821A-MOVE-DATA. DTSBX421 01914 * IF TSUB2 < +72 DTSBX421 01915 * ADD +1 TO TSUB2 DTSBX421 01916 * MOVE X132-IND-DESC (TSUB1:1) DTSBX421 01917 * TO W-MNTE-LINE (TSUB2:1) DTSBX421 01918 * IF X132-IND-DESC (TSUB1:1) = SPACE DTSBX421 01919 * MOVE TSUB2 TO W-LAST-SPACE DTSBX421 01920 * END-IF DTSBX421 01921 * ELSE DTSBX421 01922 * PERFORM P1821B-RESET THRU P1821B-EXIT DTSBX421 01923 * ADD +1 TO MNTE-TEXT-CNT DTSBX421 01924 * MOVE W-MNTE-LINE TO MNTE-TEXT (MNTE-TEXT-CNT) DTSBX421 01925 * MOVE SPACES TO W-MNTE-LINE DTSBX421 01926 * MOVE +0 TO W-LAST-SPACE DTSBX421 01927 * TSUB2 DTSBX421 01928 * END-IF. DTSBX421 01929 * DTSBX421 01930 *** DISPLAY 'A ' TSUB1 ' ' TSUB2 ' ' W-MNTE-LINE. DTSBX421 01931 *P1821A-EXIT. DTSBX421 01932 * EXIT. DTSBX421 01933 * DTSBX421 01934 *P1821B-RESET. DTSBX421 01935 *** DISPLAY 'B1 ' W-LAST-SPACE ' ' TSUB1 ' ' TSUB2. DTSBX421 01936 ************* DTSBX421 01937 * EXIT IF THE LAST LETTER MOVED IS A SPACE, OR IF THE CURRENT DTSBX421 01938 * LINE DOES NOT CONTAIN ANY SPACES. DTSBX421 01939 ************* DTSBX421 01940 * IF W-MNTE-LINE (72:1) = SPACE DTSBX421 01941 * SUBTRACT +1 FROM TSUB1 DTSBX421 01942 * GO TO P1821B-EXIT DTSBX421 01943 * END-IF. DTSBX421 01944 * DTSBX421 01945 * IF W-LAST-SPACE = ZERO DTSBX421 01946 * GO TO P1821B-EXIT DTSBX421 01947 * END-IF. DTSBX421 01948 * DTSBX421 01949 ************* DTSBX421 01950 * REPLACE THE LAST LETTERS WRITTEN (OCCURRING IN THE MIDDLE OF DTSBX421 01951 * A WORD) WITH SPACES. DTSBX421 01952 ************* DTSBX421 01953 * PERFORM DTSBX421 01954 * VARYING TSUB2 FROM W-LAST-SPACE BY +1 DTSBX421 01955 * UNTIL TSUB2 > +72 DTSBX421 01956 * MOVE SPACE TO W-MNTE-LINE (TSUB2:1) DTSBX421 01957 * END-PERFORM. DTSBX421 01958 * DTSBX421 01959 ************* DTSBX421 01960 * RESET TSUB1 TO POINT TO THE FIRST LETTER OF THE INCOMPLETED DTSBX421 01961 * WORD. DTSBX421 01962 ************* DTSBX421 01963 * COMPUTE TSUB1 = TSUB1 - (73 - W-LAST-SPACE). DTSBX421 01964 * DTSBX421 01965 *** DISPLAY 'B2 ' TSUB1 ' ' TSUB2 ' ' W-MNTE-LINE. DTSBX421 01966 *P1821B-EXIT. DTSBX421 01967 * EXIT. DTSBX421 01968 DTSBX421 01969 P3000-NEW-EMP. DTSBX421 01970 DTSBX421 01971 DISPLAY 'BX421 P3000 OLD ' W-EMP-NO ' NEW ' LX42-EMP-NO. DTSBX421 01972 DISPLAY 'W-ERROR-IND ' W-ERROR-IND DTSBX421 01973 IF W-EMP-IN-PROGRESS-YES-88 DTSBX421 01974 SET W-EMP-IN-PROGRESS-NO-88 TO TRUE DTSBX421 01975 IF W-ERROR-NO-88 DTSBX421 01976 PERFORM P3100-CHK-COMPLETION THRU P3100-EXIT DTSBX421 01977 IF W-ERROR-NO-88 DTSBX421 01978 DISPLAY 'NANCY NO ERROR' W-EMP-NO DTSBX421 01979 PERFORM P3200-DETERM THRU P3200-EXIT DTSBX421 01980 PERFORM P3300-COPY-TO-BTC THRU P3300-EXIT DTSBX421 01981 END-IF DTSBX421 01982 ELSE DTSBX421 01983 DISPLAY 'BX421 DETERMINATION NOT WRITTEN ' W-EMP-NO DTSBX421 01984 END-IF DTSBX421 01985 END-IF. DTSBX421 01986 PERFORM P3400-INIT-NEW-EMP THRU P3400-EXIT. DTSBX421 01987 DTSBX421 01988 DTSBX421 01989 P3000-EXIT. DTSBX421 01990 EXIT. DTSBX421 01991 DTSBX421 01992 P3100-CHK-COMPLETION. DTSBX421 01993 DISPLAY 'P3100-CHK-COMPLETION ' DTSBX421 01994 *** DO NOT CHECK RATES IF PREDECESSORS EXIST DTSBX421 01995 IF X104-STAFF-REVIEW-YES-88 DTSBX421 01996 OR W-ERROR-YES-88 DTSBX421 01997 NEXT SENTENCE DTSBX421 01998 ELSE DTSBX421 01999 IF X104-LIAB-RATED-88 DTSBX421 02000 PERFORM P3111-CHECK-RATES THRU P3111-EXIT DTSBX421 02001 END-IF DTSBX421 02002 END-IF. DTSBX421 02003 ** DISPLAY 'W-ENTITY-NAME' W-ENTITY-NAME DTSBX421 02004 IF W-ENTITY-NAME = SPACES DTSBX421 02005 ** DISPLAY 'NO ENITITY NAME' DTSBX421 02006 SET W-ERROR-YES-88 TO TRUE DTSBX421 02007 MOVE SPACES TO R140-MESSAGE DTSBX421 02008 MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 02009 STRING DTSBX421 02010 'ENTITY NO ENTITY NAME FOUND ' DTSBX421 02011 W-EMP-NO DTSBX421 02012 DELIMITED BY SIZE DTSBX421 02013 INTO R140-MESSAGE DTSBX421 02014 END-STRING DTSBX421 02015 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 02016 END-IF. DTSBX421 02017 DTSBX421 02018 IF W-ERROR-YES-88 DTSBX421 02019 PERFORM S1060-CLOSE-TEMP-BTC THRU S1060-EXIT DTSBX421 02020 IF W-FATAL-ERROR-NO-88 DTSBX421 02021 PERFORM S1040-OPEN-TEMP-BTC-OUT THRU S1040-EXIT DTSBX421 02022 GO TO P3100-EXIT DTSBX421 02023 ELSE DTSBX421 02024 GO TO P3100-EXIT DTSBX421 02025 END-IF DTSBX421 02026 END-IF. DTSBX421 02027 ** DISPLAY 'P3100 - 2 ' W-EMP-NO ' ' W-ERROR-IND. DTSBX421 02028 P3100-EXIT. DTSBX421 02029 EXIT. DTSBX421 02030 DTSBX421 02031 P3111-CHECK-RATES. DTSBX421 02032 DISPLAY 'P3111-CHECK-RATES ' DTSBX421 02033 SET W-RATE-ERROR-NO-88 TO TRUE. DTSBX421 02034 PERFORM DTSBX421 02035 VARYING SUB FROM +1 BY +1 DTSBX421 02036 UNTIL SUB > +5 DTSBX421 02037 IF W-RATE-YEAR (SUB) > ZERO DTSBX421 02038 IF W-RATE-FOUND-NO-88 (SUB) DTSBX421 02039 SET W-RATE-ERROR-YES-88 TO TRUE DTSBX421 02040 SET W-ERROR-YES-88 TO TRUE DTSBX421 02041 END-IF DTSBX421 02042 END-IF DTSBX421 02043 END-PERFORM. DTSBX421 02044 DTSBX421 02045 IF W-RATE-ERROR-YES-88 DTSBX421 02046 MOVE SPACES TO R140-MESSAGE DTSBX421 02047 MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 02048 STRING DTSBX421 02049 'RATE SOME RATES MISSING ' DTSBX421 02050 W-EMP-NO DTSBX421 02051 DELIMITED BY SIZE DTSBX421 02052 INTO R140-MESSAGE DTSBX421 02053 END-STRING DTSBX421 02054 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 02055 ** PERFORM DTSBX421 02056 * VARYING SUB FROM +1 BY +1 DTSBX421 02057 * UNTIL SUB > +5 DTSBX421 02058 * IF W-RATE-YEAR (SUB) > ZERO DTSBX421 02059 * DISPLAY W-RATE-YEAR (SUB) ' ' DTSBX421 02060 * W-RATE-FOUND-IND (SUB) DTSBX421 02061 * END-IF DTSBX421 02062 ** END-PERFORM DTSBX421 02063 END-IF. DTSBX421 02064 DTSBX421 02065 P3111-EXIT. DTSBX421 02066 EXIT. DTSBX421 02067 DTSBX421 02068 P3200-DETERM. DTSBX421 02069 DISPLAY 'P3200-DETERM' DTSBX421 02070 DISPLAY 'BX421 P32 DETERM ' W-EMP-NO ' ' W-ENTITY-NAME. DTSBX421 02071 DTSBX421 02072 MOVE LOW-VALUES TO T002-REC. DTSBX421 02073 DTSBX421 02074 SET T002-LENGTH-DETERM-88 TO TRUE. DTSBX421 02075 MOVE '002' TO T002-REC-TYPE. DTSBX421 02076 MOVE W-EMP-NO TO T002-EMP-NO. DTSBX421 02077 MOVE 'WEB REG ' TO T002-ORIGIN. DTSBX421 02078 MOVE LX42-SYS-DATE TO T002-SYS-DATE. DTSBX421 02079 MOVE LX42-SYS-TIME TO T002-SYS-TIME. DTSBX421 02080 DTSBX421 02081 DTSBX421 02082 MOVE W-FEIN TO Y104-FEIN. DTSBX421 02083 MOVE X104-STAFF-REVIEW-IND TO Y104-STAFF-REVIEW-IND. DTSBX421 02084 MOVE W-ENTITY-NAME TO Y104-ENTITY-NAME. DTSBX421 02085 MOVE W-TRADE-NAME TO Y104-TRADE-NAME. DTSBX421 02086 MOVE W-SOURCE-CD TO Y104-SOURCE-CD. DTSBX421 02087 MOVE X104-LIAB-CD TO Y104-LIAB-CD. DTSBX421 02088 MOVE X104-ELIG-CD TO Y104-ELIG-CD. DTSBX421 02089 MOVE X104-NAICS-CD TO Y104-NAICS. DTSBX421 02090 MOVE SPACES TO Y104-OWN-CD. DTSBX421 02091 MOVE X104-ORG-TYPE TO Y104-ORG-TYPE. DTSBX421 02092 MOVE X104-HOUSEHOLD-FILING TO Y104-HOUSEHOLD-FILING. DTSBX421 02093 MOVE X104-INCORP-STATE TO Y104-CORP-STATE. DTSBX421 02094 MOVE W-INCORP-DATE TO Y104-CORP-DATE. DTSBX421 02095 MOVE W-LIABLE-DATE TO Y104-FIRST-WAGE-DT. DTSBX421 02096 MOVE W-FIRST-500-QTR TO Y104-FIRST-500-QTR. DTSBX421 02097 MOVE ZERO TO Y104-LAST-WAGE-DT. DTSBX421 02098 MOVE X104-ACQUIRE-IND TO Y104-ACQUIRE-IND. DTSBX421 02099 MOVE X104-MERGER-SPLIT-IND TO Y104-MERGE-SPLIT-IND. DTSBX421 02100 MOVE X104-REORG-IND TO Y104-REORG-IND. DTSBX421 02101 MOVE X104-COMMON-OWN-IND TO Y104-COMMON-OWN-IND. DTSBX421 02102 MOVE X104-SALE-TRANSFER-IND TO Y104-SALE-TRANSFER-IND. DTSBX421 02103 DTSBX421 02104 MOVE Y104-REC TO T002-DATA-AREA. DTSBX421 02105 SET T002-DETERM-88 TO TRUE. DTSBX421 02106 PERFORM S1030-WRITE-TEMP-T002 THRU S1030-EXIT. DTSBX421 02107 DTSBX421 02108 *& DTSBX421 02109 * DISPLAY 'BX421 DETERM ' W-EMP-NO. DTSBX421 02110 *& DTSBX421 02111 IF NOT X104-NOT-LIAB-NULL-88 DTSBX421 02112 PERFORM P3210-NOT-LIAB-REASON THRU P3210-EXIT DTSBX421 02113 END-IF. DTSBX421 02114 DTSBX421 02115 P3200-EXIT. DTSBX421 02116 EXIT. DTSBX421 02117 DTSBX421 02118 P3210-NOT-LIAB-REASON. DTSBX421 02119 DISPLAY 'P3210-NOT-LIAB-REASON ' DTSBX421 02120 DISPLAY 'P3210 ' W-EMP-NO ' ' X104-NOT-LIAB-REASON. DTSBX421 02121 DTSBX421 02122 PERFORM S3000-INIT-T003 THRU S3000-EXIT. DTSBX421 02123 DTSBX421 02124 SET W-MNTE-NOT-LIAB-88 TO TRUE DTSBX421 02125 MOVE W-MNTE-SUBJECT TO MNTE-SUBJECT DTSBX421 02126 DTSBX421 02127 MOVE +1 TO MNTE-TEXT-CNT. DTSBX421 02128 MOVE W-ENTITY-NAME DTSBX421 02129 TO MNTE-TEXT (MNTE-TEXT-CNT). DTSBX421 02130 DTSBX421 02131 ADD +1 TO MNTE-TEXT-CNT. DTSBX421 02132 DTSBX421 02133 EVALUATE TRUE DTSBX421 02134 WHEN X104-NOT-LIAB-BUS-ACT-88 DTSBX421 02135 MOVE 'THE TYPE OF EMPLOYMENT IS NOT COVERED' DTSBX421 02136 TO MNTE-TEXT (MNTE-TEXT-CNT) DTSBX421 02137 DTSBX421 02138 WHEN X104-NOT-LIAB-NO-EMPL-88 DTSBX421 02139 STRING 'THE BUSINESS PAYS WAGES ONLY TO ' DTSBX421 02140 'OWNERS OR OFFICERS' DTSBX421 02141 DELIMITED BY SIZE DTSBX421 02142 INTO MNTE-TEXT (MNTE-TEXT-CNT) DTSBX421 02143 END-STRING DTSBX421 02144 DTSBX421 02145 WHEN X104-NOT-LIAB-NO-WAGES-88 DTSBX421 02146 IF X104-ORG-HSEHLD-DMSTIC-88 DTSBX421 02147 STRING 'A HOUSEHOLD EMPLOYER PAYS LESS ' DTSBX421 02148 'THAN $500.00 EACH QUARTER' DTSBX421 02149 DELIMITED BY SIZE DTSBX421 02150 INTO MNTE-TEXT (MNTE-TEXT-CNT) DTSBX421 02151 END-STRING DTSBX421 02152 ELSE DTSBX421 02153 STRING 'THE BUSINESS DOES NOT PAY WAGES ' DTSBX421 02154 'FOR WORK PERFORMED IN DC' DTSBX421 02155 DELIMITED BY SIZE DTSBX421 02156 INTO MNTE-TEXT (MNTE-TEXT-CNT) DTSBX421 02157 END-STRING DTSBX421 02158 END-IF DTSBX421 02159 DTSBX421 02160 WHEN X104-NOT-LIAB-LOCALIZE-88 DTSBX421 02161 MOVE 'THE WORK IS NOT LOCALIZED IN DC ' DTSBX421 02162 TO MNTE-TEXT (MNTE-TEXT-CNT) DTSBX421 02163 DTSBX421 02164 END-EVALUATE. DTSBX421 02165 DTSBX421 02166 DTSBX421 02167 MOVE MNTE-REC TO T003-MNTE-REC. DTSBX421 02168 DTSBX421 02169 PERFORM S1031-WRITE-TEMP-T003 THRU S1031-EXIT. DTSBX421 02170 DTSBX421 02171 *& DTSBX421 02172 * DISPLAY 'NOT LIAB MNTE ' W-EMP-NO. DTSBX421 02173 * PERFORM DTSBX421 02174 * VARYING SUB FROM +1 BY +1 DTSBX421 02175 * UNTIL SUB > MNTE-TEXT-CNT DTSBX421 02176 * DISPLAY MNTE-TEXT (SUB) DTSBX421 02177 * END-PERFORM. DTSBX421 02178 *& DTSBX421 02179 P3210-EXIT. DTSBX421 02180 EXIT. DTSBX421 02181 DTSBX421 02182 P3300-COPY-TO-BTC. DTSBX421 02183 DISPLAY 'P3300-COPY-TO-BTC ' DTSBX421 02184 DISPLAY 'BX421 COMPLETE ' W-EMP-NO. DTSBX421 02185 PERFORM S1060-CLOSE-TEMP-BTC THRU S1060-EXIT. DTSBX421 02186 IF W-FATAL-ERROR-NO-88 DTSBX421 02187 IF W-ERROR-NO-88 DTSBX421 02188 PERFORM P3310-COPY-TO-BTC THRU P3310-EXIT DTSBX421 02189 END-IF DTSBX421 02190 ELSE DTSBX421 02191 DISPLAY 'P3300 FATAL ERR ON CLOSE' DTSBX421 02192 GO TO P3300-EXIT DTSBX421 02193 END-IF. DTSBX421 02194 DTSBX421 02195 IF NOT LX42-TERMINATE-88 DTSBX421 02196 PERFORM S1040-OPEN-TEMP-BTC-OUT THRU S1040-EXIT DTSBX421 02197 END-IF. DTSBX421 02198 DTSBX421 02199 P3300-EXIT. DTSBX421 02200 EXIT. DTSBX421 02201 DTSBX421 02202 P3310-COPY-TO-BTC. DTSBX421 02203 DISPLAY 'P3310-COPY-TO-BTC ' DTSBX421 02204 PERFORM S1050-OPEN-TEMP-BTC-IN THRU S1050-EXIT DTSBX421 02205 IF W-FATAL-ERROR-YES-88 DTSBX421 02206 GO TO P3310-EXIT DTSBX421 02207 END-IF. DTSBX421 02208 DTSBX421 02209 PERFORM S1070-READ-TEMP-BTC THRU S1070-EXIT. DTSBX421 02210 DTSBX421 02211 PERFORM DTSBX421 02212 UNTIL TEMP-BTC-STATUS-EOF-88 DTSBX421 02213 OR W-FATAL-ERROR-YES-88 DTSBX421 02214 PERFORM S927B-WRITE THRU S927B-EXIT DTSBX421 02215 PERFORM P3311-COUNT THRU P3311-EXIT DTSBX421 02216 PERFORM S1070-READ-TEMP-BTC THRU S1070-EXIT DTSBX421 02217 END-PERFORM. DTSBX421 02218 DTSBX421 02219 PERFORM S1060-CLOSE-TEMP-BTC THRU S1060-EXIT. DTSBX421 02220 DTSBX421 02221 P3310-EXIT. DTSBX421 02222 EXIT. DTSBX421 02223 DTSBX421 02224 P3311-COUNT. DTSBX421 02225 IF TSKL-NOTEPAD-88 DTSBX421 02226 ADD +1 TO W-T003-WRITE-CNT DTSBX421 02227 GO TO P3311-EXIT DTSBX421 02228 END-IF. DTSBX421 02229 DTSBX421 02230 MOVE TEMP-BTC-REC TO T002-REC. DTSBX421 02231 ADD +1 TO W-T002-WRITE-CNT. DTSBX421 02232 DTSBX421 02233 EVALUATE TRUE DTSBX421 02234 WHEN T002-DETERM-88 DTSBX421 02235 ADD +1 TO W-T002-DETERM-CNT DTSBX421 02236 DTSBX421 02237 WHEN T002-EMP-NAME-88 DTSBX421 02238 ADD +1 TO W-T002-NAME-CNT DTSBX421 02239 DTSBX421 02240 WHEN T002-EMP-RATE-88 DTSBX421 02241 ADD +1 TO W-T002-RATE-CNT DTSBX421 02242 DTSBX421 02243 WHEN T002-EMP-ADDR-88 DTSBX421 02244 ADD +1 TO W-T002-ADDR-CNT DTSBX421 02245 DTSBX421 02246 WHEN T002-CONTACT-88 DTSBX421 02247 ADD +1 TO W-T002-OPO-CNT DTSBX421 02248 DTSBX421 02249 WHEN T002-EMP-REL-88 DTSBX421 02250 ADD +1 TO W-T002-REL-CNT DTSBX421 02251 DTSBX421 02252 END-EVALUATE. DTSBX421 02253 DTSBX421 02254 P3311-EXIT. DTSBX421 02255 EXIT. DTSBX421 02256 DTSBX421 02257 P3400-INIT-NEW-EMP. DTSBX421 02258 MOVE LX42-EMP-NO TO W-EMP-NO. DTSBX421 02259 SET W-ERROR-NO-88 TO TRUE. DTSBX421 02260 SET W-PREV-REC-NULL-88 TO TRUE. DTSBX421 02261 MOVE ZERO TO W-LIABLE-DATE DTSBX421 02262 W-INCORP-DATE DTSBX421 02263 W-WAGES-PLANNED-DATE DTSBX421 02264 W-FIRST-500-QTR DTSBX421 02265 W-FEIN. DTSBX421 02266 DTSBX421 02267 MOVE SPACES TO W-ENTITY-NAME DTSBX421 02268 W-TRADE-NAME DTSBX421 02269 W-SOURCE-CD DTSBX421 02270 W-FIELD-ZIP DTSBX421 02271 W-FIELD-STATE DTSBX421 02272 DTSBX421 02273 INITIALIZE X102-REC DTSBX421 02274 X104-REC DTSBX421 02275 X106-REC DTSBX421 02276 X108-REC DTSBX421 02277 X110-REC DTSBX421 02278 X120-REC DTSBX421 02279 X130-REC. DTSBX421 02280 PERFORM DTSBX421 02281 VARYING SUB FROM +1 BY +1 DTSBX421 02282 UNTIL SUB > +5 DTSBX421 02283 MOVE ZERO TO W-RATE-YEAR (SUB) DTSBX421 02284 SET W-RATE-FOUND-NO-88 (SUB) TO TRUE DTSBX421 02285 END-PERFORM. DTSBX421 02286 DTSBX421 02287 P3400-EXIT. DTSBX421 02288 EXIT. DTSBX421 02289 DTSBX421 02290 DTSBX421 02291 T0000-TERMINATE. DTSBX421 02292 DISPLAY ' '. DTSBX421 02293 DTSBX421 02294 DISPLAY '*** DTSBX421 TERMINATION STATISTICS ***'. DTSBX421 02295 DTSBX421 02296 DISPLAY ' '. DTSBX421 02297 DTSBX421 02298 DISPLAY '*** EMPLOYER REGISTRATION ***'. DTSBX421 02299 DTSBX421 02300 DISPLAY ' '. DTSBX421 02301 DTSBX421 02302 PERFORM T2000-DISPLAY-TOTALS THRU T2000-EXIT. DTSBX421 02303 DTSBX421 02304 DISPLAY ' '. DTSBX421 02305 DISPLAY '***************************************'. DTSBX421 02306 DTSBX421 02307 CLOSE TEMP-BTC-FILE. DTSBX421 02308 DTSBX421 02309 *RW1 DTSBX421 02310 * DISPLAY ' '. DTSBX421 02311 * MOVE WRK-R140-CNT TO DISPLAY-CNT. DTSBX421 02312 * DISPLAY 'R140 RECORDS WRITTEN : ' DTSBX421 02313 * DISPLAY-CNT. DTSBX421 02314 * DTSBX421 02315 * MOVE LOW-VALUES TO R140-REC. DTSBX421 02316 * MOVE -1 TO R140-LENGTH. DTSBX421 02317 * DTSBX421 02318 * PERFORM S946-WRITE-R140 THRU S946-EXIT. DTSBX421 02319 *RW2 DTSBX421 02320 DTSBX421 02321 T0000-EXIT. DTSBX421 02322 EXIT. DTSBX421 02323 DTSBX421 02324 T2000-DISPLAY-TOTALS. DTSBX421 02325 DISPLAY 'DETERMINATIONS INPUT ' DTSBX421 02326 W-X102-CNT. DTSBX421 02327 DTSBX421 02328 DISPLAY 'DETERMINATIONS WRITTEN ' DTSBX421 02329 W-T002-DETERM-CNT. DTSBX421 02330 DTSBX421 02331 DISPLAY 'NAME RECORDS WRITTEN ' DTSBX421 02332 W-T002-NAME-CNT. DTSBX421 02333 DTSBX421 02334 DISPLAY 'RATE RECORDS WRITTEN ' DTSBX421 02335 W-T002-RATE-CNT. DTSBX421 02336 DTSBX421 02337 DISPLAY 'OUTPUT T002 RECORDS WRITTEN ' DTSBX421 02338 W-T002-WRITE-CNT. DTSBX421 02339 DISPLAY 'OUTPUT T003 RECORDS WRITTEN ' DTSBX421 02340 W-T003-WRITE-CNT. DTSBX421 02341 DTSBX421 02342 DISPLAY ' '. DTSBX421 02343 DTSBX421 02344 T2000-EXIT. DTSBX421 02345 EXIT. DTSBX421 02346 DTSBX421 02347 S001-FROM-FED-8. DTSBX421 02348 SET L001-FROM-FED-8 TO TRUE. DTSBX421 02349 GO TO S001-DATE. DTSBX421 02350 DTSBX421 02351 S001-FROM-CAL-8. DTSBX421 02352 SET L001-FROM-CAL-8 TO TRUE. DTSBX421 02353 GO TO S001-DATE. DTSBX421 02354 DTSBX421 02355 S001-FROM-ABS-DAY. DTSBX421 02356 SET L001-FROM-ABS-DAY TO TRUE. DTSBX421 02357 GO TO S001-DATE. DTSBX421 02358 DTSBX421 02359 S001-DATE. DTSBX421 02360 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBX421 02361 S001-EXIT. DTSBX421 02362 EXIT. DTSBX421 02363 DTSBX421 02364 S003-AGENCY-DAY. DTSBX421 02365 SET L003-AGENCY-DAY TO TRUE. DTSBX421 02366 GO TO S003-WORK-DAY. DTSBX421 02367 DTSBX421 02368 S003-WORK-DAY. DTSBX421 02369 CALL 'DTSBU003' USING L003-LINK-AREA. DTSBX421 02370 S003-EXIT. DTSBX421 02371 EXIT. DTSBX421 02372 DTSBX421 02373 S004-FROM-5. DTSBX421 02374 SET L004-FROM-5 TO TRUE. DTSBX421 02375 GO TO S004-YRQ. DTSBX421 02376 DTSBX421 02377 S004-FROM-DATE. DTSBX421 02378 SET L004-FROM-DATE TO TRUE. DTSBX421 02379 GO TO S004-YRQ. DTSBX421 02380 DTSBX421 02381 S004-FROM-ABS. DTSBX421 02382 SET L004-FROM-ABS TO TRUE. DTSBX421 02383 GO TO S004-YRQ. DTSBX421 02384 DTSBX421 02385 S004-YRQ. DTSBX421 02386 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBX421 02387 DTSBX421 02388 S004-EXIT. DTSBX421 02389 EXIT. DTSBX421 02390 DTSBX421 02391 S052-UI-RATE-EDIT. DTSBX421 02392 CALL 'DTSBU052' USING L052-LINK-AREA. DTSBX421 02393 DTSBX421 02394 S052-EXIT. DTSBX421 02395 EXIT. DTSBX421 02396 DTSBX421 02397 S072-ADDRESS. DTSBX421 02398 CALL 'DTSBU072' USING L072-LINK-AREA. DTSBX421 02399 DTSBX421 02400 S072-EXIT. DTSBX421 02401 EXIT. DTSBX421 02402 DTSBX421 02403 S516-LIABILITY-INFO. DTSBX421 02404 CALL 'DTSBU516' USING L516-LINK-AREA DTSBX421 02405 MPRF-REC. DTSBX421 02406 S516-EXIT. DTSBX421 02407 EXIT. DTSBX421 02408 DTSBX421 02409 *S910-OPEN-READ. DTSBX421 02410 * SET L910-OPEN-READ-88 TO TRUE. DTSBX421 02411 * GO TO S910-MSTR-IO. DTSBX421 02412 DTSBX421 02413 S910-READ. DTSBX421 02414 SET L910-READ-88 TO TRUE. DTSBX421 02415 GO TO S910-MSTR-IO. DTSBX421 02416 DTSBX421 02417 S910-START-BROWSE. DTSBX421 02418 SET L910-START-BROWSE-88 TO TRUE. DTSBX421 02419 GO TO S910-MSTR-IO. DTSBX421 02420 DTSBX421 02421 S910-READ-NEXT. DTSBX421 02422 SET L910-READ-NEXT-88 TO TRUE. DTSBX421 02423 GO TO S910-MSTR-IO. DTSBX421 02424 DTSBX421 02425 *S910-CLOSE. DTSBX421 02426 * SET L910-CLOSE-88 TO TRUE. DTSBX421 02427 * GO TO S910-MSTR-IO. DTSBX421 02428 DTSBX421 02429 S910-MSTR-IO. DTSBX421 02430 CALL 'DTSBU910' USING L910-LINK-AREA DTSBX421 02431 MSKL-REC. DTSBX421 02432 S910-EXIT. DTSBX421 02433 EXIT. DTSBX421 02434 DTSBX421 02435 S921-OPEN-READ. DTSBX421 02436 SET L921-OPEN-READ-88 TO TRUE. DTSBX421 02437 GO TO S921-AIX-IO. DTSBX421 02438 DTSBX421 02439 S921-READ. DTSBX421 02440 SET L921-READ-88 TO TRUE. DTSBX421 02441 GO TO S921-AIX-IO. DTSBX421 02442 DTSBX421 02443 S921-START-BROWSE. DTSBX421 02444 SET L921-START-BROWSE-88 TO TRUE. DTSBX421 02445 GO TO S921-AIX-IO. DTSBX421 02446 DTSBX421 02447 S921-READ-NEXT. DTSBX421 02448 SET L921-READ-NEXT-88 TO TRUE. DTSBX421 02449 GO TO S921-AIX-IO. DTSBX421 02450 DTSBX421 02451 S921-CLOSE. DTSBX421 02452 SET L921-CLOSE-88 TO TRUE. DTSBX421 02453 GO TO S921-AIX-IO. DTSBX421 02454 DTSBX421 02455 S921-AIX-IO. DTSBX421 02456 CALL 'DTSBU921' USING L921-LINK-AREA DTSBX421 02457 ISKL-REC. DTSBX421 02458 S921-EXIT. DTSBX421 02459 EXIT. DTSBX421 02460 DTSBX421 02461 *S927A-OPEN. DTSBX421 02462 * SET L927-OPEN-UPDATE-88 TO TRUE. DTSBX421 02463 * PERFORM S927Z-IO THRU S927Z-EXIT. DTSBX421 02464 * DTSBX421 02465 *S927A-EXIT. DTSBX421 02466 * EXIT. DTSBX421 02467 DTSBX421 02468 S927B-WRITE. DTSBX421 02469 SET L927-WRITE-88 TO TRUE. DTSBX421 02470 PERFORM S927Z-IO THRU S927Z-EXIT. DTSBX421 02471 DTSBX421 02472 S927B-EXIT. DTSBX421 02473 EXIT. DTSBX421 02474 DTSBX421 02475 *S927C-CLOSE. DTSBX421 02476 * SET L927-CLOSE-88 TO TRUE. DTSBX421 02477 * PERFORM S927Z-IO THRU S927Z-EXIT. DTSBX421 02478 * DTSBX421 02479 *S927C-EXIT. DTSBX421 02480 * EXIT. DTSBX421 02481 DTSBX421 02482 S927Z-IO. DTSBX421 02483 CALL 'DTSBU927' USING L927-LINK-AREA DTSBX421 02484 TSKL-REC. DTSBX421 02485 S927Z-EXIT. DTSBX421 02486 EXIT. DTSBX421 02487 DTSBX421 02488 *S931-OPEN-READ. DTSBX421 02489 * SET L931-OPEN-READ-88 TO TRUE. DTSBX421 02490 * GO TO S931-REF-IO. DTSBX421 02491 * DTSBX421 02492 *S931-CLOSE. DTSBX421 02493 * SET L931-CLOSE-88 TO TRUE. DTSBX421 02494 * GO TO S931-REF-IO. DTSBX421 02495 * DTSBX421 02496 *S931-REF-IO. DTSBX421 02497 * CALL 'DTSBU931' USING L931-LINK-AREA DTSBX421 02498 * FSKL-REC. DTSBX421 02499 *S931-EXIT. DTSBX421 02500 * EXIT. DTSBX421 02501 DTSBX421 02502 S946-WRITE-R140. DTSBX421 02503 * MOVE SPACES TO R140-MESSAGE DTSBX421 02504 * MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 02505 * STRING DTSBX421 02506 * MSG1-TYPE ' - ' DTSBX421 02507 * MSG1-MESSAGE ': ' DTSBX421 02508 * X108-RATE-YEAR DTSBX421 02509 * DELIMITED BY SIZE DTSBX421 02510 * INTO R140-MESSAGE DTSBX421 02511 * END-STRING. DTSBX421 02512 DTSBX421 02513 CALL 'DTSBU946' USING R140-REC. DTSBX421 02514 DTSBX421 02515 S946-EXIT. DTSBX421 02516 EXIT. DTSBX421 02517 DTSBX421 02518 S1030-WRITE-TEMP-T002. DTSBX421 02519 DISPLAY 'S1020-WRITE-TEMP-T002' DTSBX421 02520 MOVE T002-LENGTH TO VAR-CHAR-CNT. DTSBX421 02521 MOVE T002-REC TO TEMP-BTC-REC. DTSBX421 02522 WRITE TEMP-BTC-REC. DTSBX421 02523 IF TEMP-BTC-STATUS-OK-88 DTSBX421 02524 DISPLAY 'WROTE T002 ' DTSBX421 02525 ** NEXT SENTENCE DTSBX421 02526 ELSE DTSBX421 02527 SET W-ERROR-YES-88 TO TRUE DTSBX421 02528 DISPLAY 'CANNOT WRITE TEMP T002: ' DTSBX421 02529 TEMP-BTC-STATUS DTSBX421 02530 END-IF. DTSBX421 02531 DTSBX421 02532 S1030-EXIT. DTSBX421 02533 EXIT. DTSBX421 02534 DTSBX421 02535 S1031-WRITE-TEMP-T003. DTSBX421 02536 MOVE T003-LENGTH TO VAR-CHAR-CNT. DTSBX421 02537 MOVE T003-REC TO TEMP-BTC-REC. DTSBX421 02538 WRITE TEMP-BTC-REC. DTSBX421 02539 IF TEMP-BTC-STATUS-OK-88 DTSBX421 02540 NEXT SENTENCE DTSBX421 02541 ELSE DTSBX421 02542 SET W-ERROR-YES-88 TO TRUE DTSBX421 02543 DISPLAY 'CANNOT WRITE TEMP T003: ' DTSBX421 02544 TEMP-BTC-STATUS DTSBX421 02545 END-IF. DTSBX421 02546 DTSBX421 02547 S1031-EXIT. DTSBX421 02548 EXIT. DTSBX421 02549 DTSBX421 02550 S1032-WRITE-TEMP-T027. DTSBX421 02551 MOVE T027-LENGTH TO VAR-CHAR-CNT. DTSBX421 02552 MOVE T027-REC TO TEMP-BTC-REC. DTSBX421 02553 WRITE TEMP-BTC-REC. DTSBX421 02554 IF TEMP-BTC-STATUS-OK-88 DTSBX421 02555 NEXT SENTENCE DTSBX421 02556 ELSE DTSBX421 02557 SET W-ERROR-YES-88 TO TRUE DTSBX421 02558 DISPLAY 'CANNOT WRITE TEMP T027: ' DTSBX421 02559 TEMP-BTC-STATUS DTSBX421 02560 END-IF. DTSBX421 02561 DTSBX421 02562 S1032-EXIT. DTSBX421 02563 EXIT. DTSBX421 02564 DTSBX421 02565 S1040-OPEN-TEMP-BTC-OUT. DTSBX421 02566 OPEN OUTPUT TEMP-BTC-FILE. DTSBX421 02567 IF TEMP-BTC-STATUS-OK-88 DTSBX421 02568 NEXT SENTENCE DTSBX421 02569 *** SET WAGE-TEMP-OPEN-88 TO TRUE DTSBX421 02570 *** DISPLAY 'TEMP BTC OPENED OUTPUT ' DTSBX421 02571 ELSE DTSBX421 02572 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX421 02573 DISPLAY 'CANNOT OPEN TEMP BTC FILE OUTPUT: ' DTSBX421 02574 TEMP-BTC-STATUS DTSBX421 02575 END-IF. DTSBX421 02576 DTSBX421 02577 S1040-EXIT. DTSBX421 02578 EXIT. DTSBX421 02579 DTSBX421 02580 S1050-OPEN-TEMP-BTC-IN. DTSBX421 02581 OPEN INPUT TEMP-BTC-FILE. DTSBX421 02582 IF TEMP-BTC-STATUS-OK-88 DTSBX421 02583 NEXT SENTENCE DTSBX421 02584 *** SET WAGE-TEMP-OPEN-88 TO TRUE DTSBX421 02585 *** DISPLAY 'TEMP BTC OPENED INP ' DTSBX421 02586 ELSE DTSBX421 02587 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX421 02588 DISPLAY 'CANNOT OPEN TEMP BTC FILE INPUT: ' DTSBX421 02589 TEMP-BTC-STATUS DTSBX421 02590 END-IF. DTSBX421 02591 DTSBX421 02592 S1050-EXIT. DTSBX421 02593 EXIT. DTSBX421 02594 DTSBX421 02595 S1060-CLOSE-TEMP-BTC. DTSBX421 02596 CLOSE TEMP-BTC-FILE. DTSBX421 02597 IF TEMP-BTC-STATUS-OK-88 DTSBX421 02598 *** DISPLAY 'TEMP-BTC CLOSED' DTSBX421 02599 NEXT SENTENCE DTSBX421 02600 ELSE DTSBX421 02601 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX421 02602 DISPLAY 'CANNOT CLOSE TEMP BTC FILE: ' DTSBX421 02603 TEMP-BTC-STATUS DTSBX421 02604 END-IF. DTSBX421 02605 DTSBX421 02606 S1060-EXIT. DTSBX421 02607 EXIT. DTSBX421 02608 DTSBX421 02609 S1070-READ-TEMP-BTC. DTSBX421 02610 READ TEMP-BTC-FILE. DTSBX421 02611 IF TEMP-BTC-STATUS-OK-88 DTSBX421 02612 COMPUTE VAR-CHAR-CNT = (RVAR-LENGTH - 2) DTSBX421 02613 ELSE DTSBX421 02614 IF TEMP-BTC-STATUS-EOF-88 DTSBX421 02615 NEXT SENTENCE DTSBX421 02616 ELSE DTSBX421 02617 DISPLAY 'CANNOT READ TEMP-BTC FILE ' DTSBX421 02618 TEMP-BTC-STATUS DTSBX421 02619 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX421 02620 END-IF DTSBX421 02621 END-IF. DTSBX421 02622 DTSBX421 02623 S1070-EXIT. DTSBX421 02624 EXIT. DTSBX421 02625 DTSBX421 02626 S2000-WRITE-RPT. DTSBX421 02627 MOVE W-EMP-NO TO R140-EMP-NO DTSBX421 02628 DISPLAY W-EMP-NO ': ' R140-MESSAGE DTSBX421 02629 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX421 02630 ADD +1 TO WRK-R140-CNT. DTSBX421 02631 DTSBX421 02632 S2000-EXIT. DTSBX421 02633 EXIT. DTSBX421 02634 DTSBX421 02635 DTSBX421 02636 S3000-INIT-T003. DTSBX421 02637 MOVE LOW-VALUES TO MNTE-KEY-AREA. DTSBX421 02638 MOVE W-EMP-NO TO MNTE-EMP-NO. DTSBX421 02639 SET MNTE-NTE-88 TO TRUE. DTSBX421 02640 MOVE +0 TO MNTE-PURGE-DATE. DTSBX421 02641 SET MNTE-NOT-CONVERTED-88 TO TRUE. DTSBX421 02642 DTSBX421 02643 MOVE LX42-SYS-DATE TO MNTE-ESTB-DATE DTSBX421 02644 MNTE-CHNG-DATE. DTSBX421 02645 MOVE ZERO TO MNTE-KEY-ESTB-ABSTIME DTSBX421 02646 MNTE-DATA-ESTB-ABSTIME DTSBX421 02647 MNTE-CHNG-ABSTIME. DTSBX421 02648 MOVE 'WEBESSP ' TO MNTE-ESTB-OP-ID DTSBX421 02649 MNTE-CHNG-OP-ID. DTSBX421 02650 MOVE +0 TO MNTE-TEXT-CNT. DTSBX421 02651 MOVE SPACES TO MNTE-TEXT-AREA. DTSBX421 02652 DTSBX421 02653 MOVE LENGTH OF T003-REC TO T003-LENGTH DTSBX421 02654 MOVE '003' TO T003-REC-TYPE. DTSBX421 02655 MOVE W-EMP-NO TO T003-EMP-NO. DTSBX421 02656 MOVE 'WEB REG ' TO T003-ORIGIN. DTSBX421 02657 MOVE LX42-SYS-DATE TO T003-SYS-DATE. DTSBX421 02658 MOVE LX42-SYS-TIME TO T003-SYS-TIME. DTSBX421 02659 SET T003-ADD-MNTE-88 TO TRUE. DTSBX421 02660 DTSBX421 02661 S3000-EXIT. DTSBX421 02662 EXIT. DTSBX421 02663 DTSBX421 02664 S999-ABEND. DTSBX421 02665 CALL 'DTSBU999' USING W-ABEND-CD. DTSBX421 02666 S999-EXIT. DTSBX421 02667 EXIT. DTSBX421 02668 DTSBX421