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