2670 lines
211 KiB
COBOL
2670 lines
211 KiB
COBOL
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
|