00001 IDENTIFICATION DIVISION. 07/04/24 00002 PROGRAM-ID. DTSBS413. DTSBS413 00003 AUTHOR. SC. LV139 00004 DATE-WRITTEN. JUNE 2024. CL129 00005 DATE-COMPILED. DTSBS413 00006 SKIP3 DTSBS413 00007 ***** DTSBS413 00008 * DTSBS413 00009 * DTSBS413 00010 * FUNCTION: CONVERT EMPLOYER DATA FOR SQL SERVER DTSBS413 00011 * DATABASE. DTSBS413 00012 * THIS VERSION PRODUCES THE OUTPUT FILES DTSBS413 00013 * NEEDED FOR THE EMPLOYER REPORTING DTSBS413 00014 * APPLICATION. DTSBS413 00015 * DTSBS413 00016 * DTSBS413 00017 * MODIFICATION LOG: DTSBS413 00018 * DTSBS413 00019 * 11/24/20034 INITIAL DEVELOPMENT. DTSBS413 00020 * REFERENCE: WEB REGISTRATION PROGRAMMER: GD DTSBS413 00021 * DTSBS413 00022 * 08/26/2009 MODIFIED P3820: MOST RECENT AMOUNT PAID NOW DTSBS413 00023 * EQUALS THE SUM OF ALL PAYMENTS MADE DURING THE DTSBS413 00024 * DAY. DTSBS413 00025 * REFERENCE: PROGRAMMER: GD DTSBS413 00026 * DTSBS413 00027 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBS413 00028 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBS413 00029 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBS413 00030 * DTSBS413 00031 * DESCRIPTION: DTSBS413 00032 * DTSBS413 00033 * DTSBS413 00034 * RECORDS READ: DTSBS413 00035 * DTSBS413 00036 * MASTER: DTSBS413 00037 * DTSBS413 00038 * MPRF DTSBS413 00039 * MQTR DTSBS413 00040 * DTSBS413 00041 * ALTERNATE INDEX: DTSBS413 00042 * DTSBS413 00043 * NONE. DTSBS413 00044 * DTSBS413 00045 * REFERENCE: DTSBS413 00046 * DTSBS413 00047 * DTSBS413 00048 * RECORDS UPDATED: DTSBS413 00049 * DTSBS413 00050 * NONE DTSBS413 00051 * DTSBS413 00052 * OUTPUT RECORDS WRITTEN: DTSBS413 00053 * DTSBS413 00054 * DTSBS413 00055 * DTSBS413 00056 * REPORT RECORDS WRITTEN: DTSBS413 00057 * DTSBS413 00058 * NONE. DTSBS413 00059 * DTSBS413 00060 * BATCH TRANSACTION COLLECTION RECORDS WRITTEN: DTSBS413 00061 * DTSBS413 00062 * NONE. DTSBS413 00063 * DTSBS413 00064 * DTSBS413 00065 * MODULES CALLED: DTSBS413 00066 * DTSBS413 00067 * DTSBU910 MASTER FILE I/O DRIVER. DTSBS413 00068 * DTSBU946 WRITE VARIABLE OUTPUT RECORD(S). DTSBS413 00069 * DTSBU004 QUARTER CONVERSION/EDIT. DTSBS413 00070 * DTSBU516 DETERMINE LIABILITY, DUE DATE, DTSBS413 00071 * AND RATE FOR A GIVEN QUARTER. DTSBS413 00072 * DTSBU981 VSAM WAGES FILE I/O DRIVER. DTSBS413 00073 * DTSBU982 VSAM SSN-NAME FILE I/O DRIVER. DTSBS413 00074 * DTSBS413 00075 ***** DTSBS413 00076 DTSBS413 00077 ENVIRONMENT DIVISION. DTSBS413 00078 INPUT-OUTPUT SECTION. DTSBS413 00079 DTSBS413 00080 FILE-CONTROL. DTSBS413 00081 DTSBS413 00082 SELECT EMPLOYER-TEMP ASSIGN TO BX411TMP DTSBS413 00083 FILE STATUS IS TEMP-STATUS. DTSBS413 00084 DTSBS413 00085 SELECT X100-REF-FILE ASSIGN TO EXPBX100 DTSBS413 00086 FILE STATUS IS X100-STATUS. DTSBS413 00087 DTSBS413 00088 SELECT X102-PRF-FILE ASSIGN TO EXPBX102 DTSBS413 00089 FILE STATUS IS X102-STATUS. DTSBS413 00090 DTSBS413 00091 SELECT X104-DETERM-FILE ASSIGN TO EXPBX104 CL**2 00092 FILE STATUS IS X104-STATUS. CL**2 00093 DTSBS413 00094 SELECT X106-NAME-FILE ASSIGN TO EXPBX106 DTSBS413 00095 FILE STATUS IS X106-STATUS. DTSBS413 00096 DTSBS413 00097 SELECT X108-RATE-FILE ASSIGN TO EXPBX108 CL**2 00098 FILE STATUS IS X108-STATUS. CL**2 00099 DTSBS413 00100 SELECT X110-ADDR-FILE ASSIGN TO EXPBX110 DTSBS413 00101 FILE STATUS IS X110-STATUS. DTSBS413 00102 DTSBS413 00103 SELECT X120-OPO-FILE ASSIGN TO EXPBX120 CL**2 00104 FILE STATUS IS X120-STATUS. CL**2 00105 DTSBS413 00106 SELECT X131-REL-FILE ASSIGN TO EXPBX131 DTSBS413 00107 FILE STATUS IS X131-STATUS. DTSBS413 00108 DTSBS413 00109 SELECT X140-REPORT-FILE ASSIGN TO EXPBX140 CL**2 00110 FILE STATUS IS X140-STATUS. CL**2 00111 DTSBS413 00112 SELECT X141-QTR-STATUS-FILE ASSIGN TO EXPBX141 DTSBS413 00113 FILE STATUS IS X141-STATUS. DTSBS413 00114 DTSBS413 00115 SELECT X142-LAST-RPT-PAY-FILE ASSIGN TO EXPBX142 DTSBS413 00116 FILE STATUS IS X142-STATUS. DTSBS413 00117 DTSBS413 00118 SELECT X145-PAYMENT-FILE ASSIGN TO EXPBX145 CL**2 00119 FILE STATUS IS X145-STATUS. CL**2 00120 CL*56 00121 * SELECT DSKFILE ASSIGN TO EXPBX149 CL127 00122 SELECT DSKFILE ASSIGN TO DSKFILE CL127 00123 FILE STATUS IS DSKFILE-STATUS. CL*56 00124 CL*56 00125 SELECT SENT-MINI-FILE ASSIGN TO DTSFSENT CL129 00126 FILE STATUS IS SENT-MINI-STATUS. CL129 00127 CL129 00128 DTSBS413 00129 DATA DIVISION. DTSBS413 00130 FILE SECTION. DTSBS413 00131 CL*55 00132 FD DSKFILE CL*52 00133 RECORDING MODE IS F CL*52 00134 BLOCK CONTAINS 0 RECORDS CL*52 00135 DATA RECORD IS DSKREC. CL*52 00136 01 DSKREC PIC X(477). CL*52 00137 CL*52 00138 FD EMPLOYER-TEMP DTSBS413 00139 RECORDING MODE IS F. DTSBS413 00140 01 EMPLOYER-TEMP-REC. DTSBS413 00141 05 TEMP-REC-TYPE PIC X(03). DTSBS413 00142 05 FILLER PIC X(01). DTSBS413 00143 05 TEMP-EMP-NO PIC 9(06). DTSBS413 00144 05 FILLER PIC X(502). DTSBS413 00145 DTSBS413 00146 FD X100-REF-FILE DTSBS413 00147 RECORDING MODE IS F. DTSBS413 00148 01 X100-REC PIC X(30). DTSBS413 00149 DTSBS413 00150 FD X102-PRF-FILE DTSBS413 00151 RECORDING MODE IS F. DTSBS413 00152 01 X102-REC PIC X(29). DTSBS413 00153 DTSBS413 00154 FD X104-DETERM-FILE CL**2 00155 RECORDING MODE IS F. CL**2 00156 01 X104-REC PIC X(108). CL**2 00157 DTSBS413 00158 FD X106-NAME-FILE DTSBS413 00159 RECORDING MODE IS F. DTSBS413 00160 01 X106-REC PIC X(53). DTSBS413 00161 DTSBS413 00162 FD X108-RATE-FILE CL**2 00163 RECORDING MODE IS F. CL**2 00164 01 X108-REC PIC X(24). CL**2 00165 DTSBS413 00166 FD X110-ADDR-FILE DTSBS413 00167 RECORDING MODE IS F. DTSBS413 00168 01 X110-REC PIC X(249). CL121 00169 DTSBS413 00170 FD X120-OPO-FILE CL**2 00171 RECORDING MODE IS F. CL**2 00172 01 X120-REC PIC X(385). CL**2 00173 DTSBS413 00174 FD X131-REL-FILE DTSBS413 00175 RECORDING MODE IS F. DTSBS413 00176 01 X131-REC PIC X(28). DTSBS413 00177 DTSBS413 00178 FD X140-REPORT-FILE CL**2 00179 RECORDING MODE IS F. CL**2 00180 01 X140-REC PIC X(143). CL**2 00181 DTSBS413 00182 FD X141-QTR-STATUS-FILE DTSBS413 00183 RECORDING MODE IS F. DTSBS413 00184 01 X141-REC PIC X(102). DTSBS413 00185 DTSBS413 00186 FD X142-LAST-RPT-PAY-FILE DTSBS413 00187 RECORDING MODE IS F. DTSBS413 00188 01 X142-REC PIC X(54). DTSBS413 00189 DTSBS413 00190 FD X145-PAYMENT-FILE CL**2 00191 RECORDING MODE IS F. CL**2 00192 01 X145-REC PIC X(512). CL*70 00193 DTSBS413 00194 FD SENT-MINI-FILE CL129 00195 RECORDING MODE IS F CL129 00196 LABEL RECORDS ARE STANDARD CL129 00197 BLOCK CONTAINS 0 CHARACTERS. CL129 00198 CL129 00199 01 SENT-MINI-REC PIC X(80). CL129 00200 CL129 00201 WORKING-STORAGE SECTION. DTSBS413 002015 77 PAN-VALET PICTURE X(24) VALUE '139DTSBS413 07/04/24'. DTSBS413 00202 77 PAN-VALET PICTURE X(24) VALUE '004DTSBX411 10/02/09'. DTSBS413 00203 DTSBS413 00204 01 WRK-AREA. DTSBS413 00205 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +411.DTSBS413 00206 05 ABEND-MSG PIC X(60). DTSBS413 00207 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBX411'.DTSBS413 00208 05 WRK-TRACE-IND PIC X(01) VALUE ' '. DTSBS413 00209 DTSBS413 00210 05 PSUB PIC S9(04) COMP. DTSBS413 00211 05 PAY-MAX PIC S9(04) COMP DTSBS413 00212 VALUE +500. DTSBS413 00213 05 PAY-LAST PIC S9(04) COMP DTSBS413 00214 VALUE +0. DTSBS413 00215 05 MAX-PAY-DATE PIC S9(09) COMP-3. DTSBS413 00216 05 MAX-PAY-BATCH PIC S9(05) COMP-3. DTSBS413 00217 05 MAX-PAY-ITEM PIC S9(03) COMP-3. DTSBS413 00218 05 MAX-PAY-AMT PIC S9(09)V99 COMP-3. DTSBS413 00219 DTSBS413 00220 05 PAY-TABLE OCCURS 500 TIMES. DTSBS413 00221 10 PAY-BATCH PIC S9(05) COMP-3. DTSBS413 00222 10 PAY-ITEM PIC S9(03) COMP-3. DTSBS413 00223 10 PAY-RCVD-DATE PIC S9(09) COMP-3. DTSBS413 00224 10 PAY-PROCESS-DATE PIC S9(09) COMP-3. DTSBS413 00225 10 PAY-ORIG-AMT PIC S9(09)V99 COMP-3. DTSBS413 00226 10 PAY-ADJ-AMT PIC S9(09)V99 COMP-3. DTSBS413 00227 DTSBS413 00228 05 RSUB PIC S9(04) COMP. DTSBS413 00229 05 RPT-MAX PIC S9(04) COMP DTSBS413 00230 VALUE +400. DTSBS413 00231 05 MAX-RPT-DATE PIC S9(09) COMP-3. DTSBS413 00232 05 MAX-RPT-YRQ PIC S9(05) COMP-3. DTSBS413 00233 05 MAX-RPT-TYPE PIC X(02). DTSBS413 00234 DTSBS413 00235 05 RPT-TABLE OCCURS 400 TIMES. DTSBS413 00236 10 RPT-YRQ PIC S9(05) COMP-3. DTSBS413 00237 10 RPT-TYPE PIC X(02). DTSBS413 00238 10 RPT-RCVD-DATE PIC S9(09) COMP-3. DTSBS413 00239 10 RPT-PROCESS-DATE PIC S9(09) COMP-3. DTSBS413 00240 DTSBS413 00241 05 GLOBAL-DATA-AREA. DTSBS413 00242 10 WRK-CURR-RUN-DATE PIC S9(09) COMP-3 VALUE +0. DTSBS413 00243 10 WRK-CURR-QTR PIC S9(05) COMP-3 VALUE +0. DTSBS413 00244 10 WRK-CURR-QTR-START PIC S9(09) COMP-3 VALUE +0. DTSBS413 00245 10 WRK-PRIOR-QTR PIC S9(05) COMP-3 VALUE +0. DTSBS413 00246 10 WRK-FIRST-RPT-QTR PIC S9(05) COMP-3 VALUE +0. DTSBS413 00247 10 WRK-FIRST-WAGE-QTR PIC S9(05) COMP-3 VALUE +0. DTSBS413 00248 10 WRK-START-QTR PIC S9(04) COMP VALUE +0. DTSBS413 00249 10 WRK-END-QTR PIC S9(04) COMP VALUE +0. DTSBS413 00250 10 WRK-ABS-QTR PIC S9(04) COMP VALUE +0. DTSBS413 00251 10 WRK-RATE-YRQ-1 PIC 9(05). DTSBS413 00252 10 FILLER REDEFINES WRK-RATE-YRQ-1. DTSBS413 00253 15 WRK-RATE-YRQ-1-CCYY PIC 9(04). DTSBS413 00254 15 WRK-RATE-YRQ-1-Q PIC 9(01). DTSBS413 00255 10 WRK-NEW-EMP-RATE-1 PIC 9.9999. DTSBS413 00256 10 WRK-TAX-TABLE-1 PIC X(05). DTSBS413 00257 10 WRK-TAX-WAGE-BASE-1 PIC 9(05).99. DTSBS413 00258 10 WRK-RATE-YRQ-2 PIC 9(05). DTSBS413 00259 10 FILLER REDEFINES WRK-RATE-YRQ-2. DTSBS413 00260 15 WRK-RATE-YRQ-2-CCYY PIC 9(04). DTSBS413 00261 15 WRK-RATE-YRQ-2-Q PIC 9(01). DTSBS413 00262 10 WRK-NEW-EMP-RATE-2 PIC 9.9999. DTSBS413 00263 10 WRK-TAX-TABLE-2 PIC X(05). DTSBS413 00264 10 WRK-TAX-WAGE-BASE-2 PIC 9(05).99. DTSBS413 00265 10 WRK-RATE-YRQ-3 PIC 9(05). DTSBS413 00266 10 FILLER REDEFINES WRK-RATE-YRQ-3. DTSBS413 00267 15 WRK-RATE-YRQ-3-CCYY PIC 9(04). DTSBS413 00268 15 WRK-RATE-YRQ-3-Q PIC 9(01). DTSBS413 00269 10 WRK-NEW-EMP-RATE-3 PIC 9.9999. DTSBS413 00270 10 WRK-TAX-TABLE-3 PIC X(05). DTSBS413 00271 10 WRK-TAX-WAGE-BASE-3 PIC 9(05).99. DTSBS413 00272 DTSBS413 00273 05 WRK-YRQ PIC 9(05). DTSBS413 00274 05 FILLER REDEFINES WRK-YRQ. DTSBS413 00275 10 WRK-YRQ-CCYY PIC 9(04). DTSBS413 00276 10 WRK-YRQ-Q PIC 9(01). DTSBS413 00277 DTSBS413 00278 05 WRK-3-YEARS-AGO PIC S9(09) COMP-3 VALUE +0. DTSBS413 00279 05 WRK-3-YEARS-AGO-YRQ PIC S9(05) COMP-3 VALUE +0. DTSBS413 00280 05 WRK-CURR-QTR-MINUS-8 PIC S9(05) COMP-3 VALUE +0. DTSBS413 00281 05 FIRST-QTR-WRK-DAY PIC S9(09) COMP-3 VALUE +0. DTSBS413 00282 05 WRK-LIAB-DATE PIC S9(09) COMP-3 VALUE +0. DTSBS413 00283 05 WRK-LIAB-ENTER-DATE PIC S9(09) COMP-3 VALUE +0. DTSBS413 00284 05 WRK-INACT-ENTR-DATE PIC S9(09) COMP-3 VALUE +0. DTSBS413 00285 05 WRK-LIAB-YRQ PIC S9(05) COMP-3 VALUE +0. DTSBS413 00286 05 WRK-LAST-LIAB-YRQ PIC S9(05) COMP-3 VALUE +0. DTSBS413 00287 05 WRK-INACT-DATE PIC S9(09) COMP-3 VALUE +0. DTSBS413 00288 05 WRK-INACT-CUTOFF PIC S9(09) COMP-3 VALUE +0. DTSBS413 00289 05 WRK-ALL-NINES-DATE PIC S9(09) COMP-3 DTSBS413 00290 VALUE +999999999. DTSBS413 00291 05 WRK-UI-RATE PIC S9V9(04) COMP-3. DTSBS413 00292 DTSBS413 00293 05 WRK-HOLD-EMP-NO PIC S9(07) COMP-3. DTSBS413 00294 DTSBS413 00295 05 WRK-LAST-RATE-YRQ PIC 9(05). DTSBS413 00296 05 FILLER REDEFINES WRK-LAST-RATE-YRQ. DTSBS413 00297 10 WRK-LAST-RATE-YEAR PIC 9(04). DTSBS413 00298 10 WRK-LAST-RATE-QTR PIC 9(01). DTSBS413 00299 DTSBS413 00300 05 WRK-SOURCE-CD PIC X(02) VALUE ' '. DTSBS413 00301 DTSBS413 00302 05 WRK-LIAB-CD PIC X(02) VALUE ' '. DTSBS413 00303 88 WRK-LIAB-RATED-REG-88 VALUE '01'. DTSBS413 00304 88 WRK-LIAB-RATED-DOMESTIC-88 VALUE '04'. DTSBS413 00305 88 WRK-LIAB-RATED-SUCC-88 VALUE '05'. DTSBS413 00306 88 WRK-LIAB-RATED-FUTA-88 VALUE '06'. DTSBS413 00307 88 WRK-LIAB-RATED-FOREIGN-88 VALUE '07'. DTSBS413 00308 88 WRK-LIAB-RATED-VOLUNT-88 VALUE '08'. DTSBS413 00309 88 WRK-LIAB-RATED-OTH-88 VALUE '09'. DTSBS413 00310 88 WRK-LIAB-RATED-CONV-88 VALUE '10'. DTSBS413 00311 88 WRK-LIAB-RATED-UNK-88 VALUE '11'. DTSBS413 00312 88 WRK-LIAB-SELF-INS-SCHOOL-88 VALUE '21'. DTSBS413 00313 88 WRK-LIAB-SELF-INS-CITY-88 VALUE '22'. DTSBS413 00314 88 WRK-LIAB-SELF-INS-COUNTY-88 VALUE '23'. DTSBS413 00315 88 WRK-LIAB-SELF-INS-STATE-88 VALUE '24'. DTSBS413 00316 88 WRK-LIAB-SELF-INS-CHURCH-88 VALUE '25'. DTSBS413 00317 88 WRK-LIAB-SELF-INS-NON-PROF-88 VALUE '26'. DTSBS413 00318 88 WRK-LIAB-SELF-INS-OTH-88 VALUE '27'. DTSBS413 00319 88 WRK-LIAB-SELF-INS-CONV-88 VALUE '28'. DTSBS413 00320 88 WRK-LIAB-SELF-INS-UNK-88 VALUE '29'. DTSBS413 00321 88 WRK-LIAB-SELF-INS-VOLUNT-88 VALUE '30'. DTSBS413 00322 DTSBS413 00323 05 WRK-ERROR-IND PIC X(01). DTSBS413 00324 88 WRK-ERROR-YES-88 VALUE 'Y'. DTSBS413 00325 88 WRK-ERROR-NO-88 VALUE 'N'. DTSBS413 00326 DTSBS413 00327 05 WRK-SELECT-EMP-IND PIC X(01). DTSBS413 00328 88 WRK-SELECT-EMP-ALL-88 VALUE '0'. DTSBS413 00329 88 WRK-SELECT-EMP-PRF-88 VALUE '1'. DTSBS413 00330 88 WRK-SELECT-EMP-NO-88 VALUE '2'. DTSBS413 00331 DTSBS413 00332 05 WRK-CURR-QTR-IND PIC X(01). DTSBS413 00333 88 WRK-CURR-QTR-YES-88 VALUE 'Y'. DTSBS413 00334 88 WRK-CURR-QTR-NO-88 VALUE 'N'. DTSBS413 00335 DTSBS413 00336 05 WRK-PRIOR-QTR-IND PIC X(01). DTSBS413 00337 88 WRK-PRIOR-QTR-YES-88 VALUE 'Y'. DTSBS413 00338 88 WRK-PRIOR-QTR-NO-88 VALUE 'N'. DTSBS413 00339 DTSBS413 00340 05 WRK-MOPO-IND PIC X(01). DTSBS413 00341 88 WRK-MOPO-FOUND-YES-88 VALUE 'Y'. DTSBS413 00342 88 WRK-MOPO-FOUND-NO-88 VALUE 'N'. DTSBS413 00343 DTSBS413 00344 05 WRK-SUBJ-EMP-IND PIC X(01). DTSBS413 00345 88 WRK-SUBJ-EMP-YES-88 VALUE 'Y'. DTSBS413 00346 88 WRK-SUBJ-EMP-NO-88 VALUE 'N'. DTSBS413 00347 DTSBS413 00348 05 PARM-STATUS PIC X(02). DTSBS413 00349 88 PARM-STATUS-OK-88 VALUE '00'. DTSBS413 00350 05 DSKFILE-STATUS PIC X(02). CL*57 00351 88 DSKFILE-STATUS-OK-88 VALUE '00'. CL*57 00352 05 TEMP-STATUS PIC X(02). DTSBS413 00353 88 TEMP-STATUS-OK-88 VALUE '00'. DTSBS413 00354 88 TEMP-STATUS-EOF-88 VALUE '10'. DTSBS413 00355 05 X100-STATUS PIC X(02). DTSBS413 00356 88 X100-STATUS-OK-88 VALUE '00'. DTSBS413 00357 05 X102-STATUS PIC X(02). DTSBS413 00358 88 X102-STATUS-OK-88 VALUE '00'. DTSBS413 00359 05 X104-STATUS PIC X(02). DTSBS413 00360 88 X104-STATUS-OK-88 VALUE '00'. DTSBS413 00361 05 X106-STATUS PIC X(02). DTSBS413 00362 88 X106-STATUS-OK-88 VALUE '00'. DTSBS413 00363 05 X108-STATUS PIC X(02). DTSBS413 00364 88 X108-STATUS-OK-88 VALUE '00'. DTSBS413 00365 05 X110-STATUS PIC X(02). DTSBS413 00366 88 X110-STATUS-OK-88 VALUE '00'. DTSBS413 00367 05 X120-STATUS PIC X(02). DTSBS413 00368 88 X120-STATUS-OK-88 VALUE '00'. DTSBS413 00369 05 X130-STATUS PIC X(02). DTSBS413 00370 88 X130-STATUS-OK-88 VALUE '00'. DTSBS413 00371 05 X131-STATUS PIC X(02). DTSBS413 00372 88 X131-STATUS-OK-88 VALUE '00'. DTSBS413 00373 05 X140-STATUS PIC X(02). DTSBS413 00374 88 X140-STATUS-OK-88 VALUE '00'. DTSBS413 00375 05 X141-STATUS PIC X(02). DTSBS413 00376 88 X141-STATUS-OK-88 VALUE '00'. DTSBS413 00377 05 X142-STATUS PIC X(02). DTSBS413 00378 88 X142-STATUS-OK-88 VALUE '00'. DTSBS413 00379 05 X145-STATUS PIC X(02). DTSBS413 00380 88 X145-STATUS-OK-88 VALUE '00'. DTSBS413 00381 05 SENT-MINI-STATUS PIC X(02). CL130 00382 88 SENT-MINI-STATUS-OK-88 VALUE '00'. CL130 00383 88 SENT-MINI-STATUS-EOF-88 VALUE '10'. CL130 00384 CL130 00385 DTSBS413 00386 05 WRK-ACQUIRED-IND PIC X(01). DTSBS413 00387 88 WRK-ACQUIRED-YES-88 VALUE 'Y'. DTSBS413 00388 88 WRK-ACQUIRED-NO-88 VALUE 'N'. DTSBS413 00389 DTSBS413 00390 05 WRK-MERGER-SPLIT-IND PIC X(01). DTSBS413 00391 88 WRK-MERGER-SPLIT-YES-88 VALUE 'Y'. DTSBS413 00392 88 WRK-MERGER-SPLIT-NO-88 VALUE 'N'. DTSBS413 00393 DTSBS413 00394 05 WRK-REORG-IND PIC X(01). DTSBS413 00395 88 WRK-REORG-YES-88 VALUE 'Y'. DTSBS413 00396 88 WRK-REORG-NO-88 VALUE 'N'. DTSBS413 00397 DTSBS413 00398 05 WRK-ADDRESS. DTSBS413 00399 10 WRK-ATTN-LINE PIC X(40). DTSBS413 00400 10 WRK-DELIV-LINE-1 PIC X(40). DTSBS413 00401 10 WRK-DELIV-LINE-2 PIC X(40). DTSBS413 00402 10 WRK-CITY PIC X(25). DTSBS413 00403 10 WRK-ST PIC X(02). DTSBS413 00404 10 WRK-ZIP PIC X(10). DTSBS413 00405 10 WRK-ADVANCED-BARCODE DTSBS413 00406 PIC X(14). DTSBS413 00407 DTSBS413 00408 05 WRK-PHONE PIC X(15). DTSBS413 00409 05 WRK-FAX PIC X(15). DTSBS413 00410 05 WRK-EMAIL PIC X(40). DTSBS413 00411 DTSBS413 00412 05 WRK-CURR-RATE PIC 9.9999. DTSBS413 00413 DTSBS413 00414 05 WRK-ANNUAL-STATUS. DTSBS413 00415 10 WRK-ANN-YEAR PIC S9(04) COMP-3 VALUE +0.DTSBS413 00416 10 WRK-FILING-SCHED PIC X(01). DTSBS413 00417 88 WRK-FILE-QTRLY-88 VALUE '0'. DTSBS413 00418 88 WRK-FILE-ANN-LIAB-88 VALUE '1'. DTSBS413 00419 88 WRK-FILE-ANN-NOT-LIAB-88 VALUE '2'. DTSBS413 00420 DTSBS413 00421 05 WRK-TAX-BAL PIC S9(09)V99 COMP-3 DTSBS413 00422 VALUE +0. DTSBS413 00423 05 WRK-SUR-BAL PIC S9(09)V99 COMP-3 DTSBS413 00424 VALUE +0. DTSBS413 00425 05 WRK-INT-BAL PIC S9(09)V99 COMP-3 DTSBS413 00426 VALUE +0. DTSBS413 00427 05 WRK-PEN-BAL PIC S9(09)V99 COMP-3 DTSBS413 00428 VALUE +0. DTSBS413 00429 DTSBS413 00430 05 WRK-LEN PIC S9(04) COMP VALUE +0. DTSBS413 00431 DTSBS413 00432 05 WRK-MPRF-CNT PIC S9(07) COMP-3 VALUE +0. DTSBS413 00433 05 WRK-TEST-CNT PIC S9(07) COMP-3 VALUE +0. DTSBS413 00434 05 TEMP-CNT PIC S9(07) COMP-3 VALUE +0. DTSBS413 00435 05 X102-CNT PIC S9(07) COMP-3 VALUE +0. DTSBS413 00436 05 X104-CNT PIC S9(07) COMP-3 VALUE +0. DTSBS413 00437 05 X106-CNT PIC S9(07) COMP-3 VALUE +0. DTSBS413 00438 05 X110-CNT PIC S9(07) COMP-3 VALUE +0. DTSBS413 00439 05 X108-CNT PIC S9(07) COMP-3 VALUE +0. DTSBS413 00440 05 X120-CNT PIC S9(07) COMP-3 VALUE +0. DTSBS413 00441 05 X130-CNT PIC S9(07) COMP-3 VALUE +0. DTSBS413 00442 05 X131-CNT PIC S9(07) COMP-3 VALUE +0. DTSBS413 00443 05 X140-CNT PIC S9(07) COMP-3 VALUE +0. DTSBS413 00444 05 X141-CNT PIC S9(07) COMP-3 VALUE +0. DTSBS413 00445 05 X142-CNT PIC S9(07) COMP-3 VALUE +0. DTSBS413 00446 05 X145-CNT PIC S9(07) COMP-3 VALUE +0. DTSBS413 00447 05 W-SENT-MINI-CNT PIC S9(07) COMP-3 VALUE +0. CL130 00448 05 OUTWRITE-CNT PIC 9(06) VALUE 0. CL*65 00449 05 WRK-SSN-ERROR-DISP PIC --,---,--9. DTSBS413 00450 05 WRK-AMT-DISP PIC --,---,---,--9.99. DTSBS413 00451 05 WRK-AMT-DISP1 PIC --,---,---,--9.99. DTSBS413 00452 05 WRK-PCT-DISP PIC ZZ9.9999-. DTSBS413 00453 DTSBS413 00454 01 WS-SENT-REC. CL130 00455 05 WS-SENT-EMP-NO PIC 9(06) VALUE 0. CL130 00456 05 WS-SENT-EMP-STATUS PIC X(01) VALUE SPACES. CL130 00457 05 WS-SENT-CURR-DATE PIC 9(08) VALUE 0. CL130 00458 05 WS-SENT-LIAB-DATE PIC 9(08) VALUE 0. CL130 00459 05 WS-SENT-ESTB-DATE PIC 9(08) VALUE 0. CL130 00460 05 WS-SENT-CHNG-DATE PIC 9(08) VALUE 0. CL130 00461 05 FILLER PIC X(41). CL130 00462 CL130 00463 DTSBS413 00464 01 MSG-AREA. DTSBS413 00465 05 MSG1-AREA. DTSBS413 00466 10 MSG1-ID PIC X(03) VALUE '800'. DTSBS413 00467 10 MSG1-TEXT. DTSBS413 00468 15 FILLER PIC X(40) DTSBS413 00469 VALUE ' '. DTSBS413 00470 15 FILLER PIC X(40) DTSBS413 00471 VALUE ' '. DTSBS413 00472 DTSBS413 00473 01 TALLY-AREA. DTSBS413 00474 05 SLASH-NAME. DTSBS413 00475 10 SLASH-NAME-CHAR OCCURS 40 TIMES PIC X(01). DTSBS413 00476 05 FIRST-NAME PIC X(40) VALUE SPACE. DTSBS413 00477 05 MIDDLE-INIT PIC X(01) VALUE SPACE. DTSBS413 00478 05 LAST-NAME PIC X(40) VALUE SPACE. DTSBS413 00479 05 NSUB PIC S9(04) COMP. DTSBS413 00480 05 FSUB PIC S9(04) COMP. DTSBS413 00481 05 LSUB PIC S9(04) COMP. DTSBS413 00482 05 LAST-NAME-COMPLETE-IND PIC X(01). DTSBS413 00483 88 LAST-NAME-COMPLETE-YES-88 VALUE 'Y'. DTSBS413 00484 88 LAST-NAME-COMPLETE-NO-88 VALUE 'N'. DTSBS413 00485 05 FIRST-NAME-COMPLETE-IND PIC X(01). DTSBS413 00486 88 FIRST-NAME-COMPLETE-YES-88 VALUE 'Y'. DTSBS413 00487 88 FIRST-NAME-COMPLETE-NO-88 VALUE 'N'. DTSBS413 00488 05 MID-INIT-COMPLETE-IND PIC X(01). DTSBS413 00489 88 MID-INIT-COMPLETE-YES-88 VALUE 'Y'. DTSBS413 00490 88 MID-INIT-COMPLETE-NO-88 VALUE 'N'. DTSBS413 00491 05 D-S PIC X(02) VALUE SPACE. DTSBS413 00492 05 SLASH-TALLY PIC S9(04) COMP. DTSBS413 00493 05 LAST-NAME-LEN PIC S9(04) COMP. DTSBS413 00494 05 FIRST-MID-LEN PIC S9(04) COMP. DTSBS413 00495 05 FIRST-NAME-LEN PIC S9(04) COMP. DTSBS413 00496 05 TOTAL-LEN PIC S9(04) COMP. DTSBS413 00497 01 OUT-RECORD-HEADER. CL*52 00498 05 FILLER PIC X(07) VALUE 'EMPNUM'. CL*52 00499 05 FILLER PIC X(01) VALUE ','. CL*52 00500 05 FILLER PIC X(10) VALUE 'STATUSDATE'. CL*52 00501 05 FILLER PIC X(01) VALUE ','. CL*52 00502 05 FILLER PIC X(01) VALUE 'I'. CL*52 00503 05 FILLER PIC X(01) VALUE ','. CL*52 00504 05 FILLER PIC X(01) VALUE 'I'. CL*52 00505 05 FILLER PIC X(01) VALUE ','. CL*52 00506 05 FILLER PIC X(10) VALUE 'NAICSEFDT'. CL*52 00507 05 FILLER PIC X(01) VALUE ','. CL*52 00508 05 FILLER PIC X(10) VALUE 'CREATE DT'. CL*52 00509 05 FILLER PIC X(01) VALUE ','. CL*52 00510 05 FILLER PIC X(15) VALUE 'CREATED BY'. CL*52 00511 05 FILLER PIC X(01) VALUE ','. CL*52 00512 05 FILLER PIC X(01) VALUE 'A'. CL*52 00513 05 FILLER PIC X(01) VALUE ','. CL*52 00514 05 FILLER PIC X(01) VALUE 'P'. CL*52 00515 05 FILLER PIC X(01) VALUE ','. CL*52 00516 05 FILLER PIC X(01) VALUE 'I'. CL*52 00517 05 FILLER PIC X(01) VALUE ','. CL*52 00518 05 FILLER PIC X(10) VALUE 'EA PH NUM'. CL*52 00519 05 FILLER PIC X(01) VALUE ','. CL*52 00520 05 FILLER PIC X(10) VALUE 'EA CRE DT'. CL*52 00521 05 FILLER PIC X(01) VALUE ','. CL*52 00522 05 FILLER PIC X(15) VALUE 'EA CRE BY'. CL*52 00523 05 FILLER PIC X(01) VALUE ','. CL*52 00524 05 FILLER PIC X(10) VALUE 'EC CRE DT'. CL*52 00525 05 FILLER PIC X(01) VALUE ','. CL*52 00526 05 FILLER PIC X(15) VALUE 'EC CRE BY'. CL*52 00527 05 FILLER PIC X(01) VALUE ','. CL*52 00528 05 FILLER PIC X(10) VALUE 'ES CRE DT'. CL*52 00529 05 FILLER PIC X(01) VALUE ','. CL*52 00530 05 FILLER PIC X(15) VALUE 'ES CRE BY'. CL*52 00531 05 FILLER PIC X(01) VALUE ','. CL*52 00532 05 FILLER PIC X(01) VALUE 'F'. CL*52 00533 05 FILLER PIC X(01) VALUE ','. CL*52 00534 05 FILLER PIC X(01) VALUE 'P'. CL*52 00535 05 FILLER PIC X(01) VALUE ','. CL*52 00536 05 FILLER PIC X(10) VALUE 'EOO PH NUM'. CL*52 00537 05 FILLER PIC X(01) VALUE ','. CL*52 00538 05 FILLER PIC X(10) VALUE 'EOO FAXNUM'. CL*52 00539 05 FILLER PIC X(01) VALUE ','. CL*52 00540 05 FILLER PIC X(40) VALUE 'EOO E-MAIL'. CL*52 00541 05 FILLER PIC X(01) VALUE ','. CL*52 00542 05 FILLER PIC X(10) VALUE 'EOO CRE DT'. CL*52 00543 05 FILLER PIC X(01) VALUE ','. CL*52 00544 05 FILLER PIC X(15) VALUE 'EOO CREATED BY '. CL*52 00545 05 FILLER PIC X(01) VALUE ','. CL*52 00546 05 FILLER PIC X(10) VALUE 'EWH EMPNUM'. CL*52 00547 05 FILLER PIC X(01) VALUE ','. CL*52 00548 05 FILLER PIC X(01) VALUE 'I'. CL*52 00549 05 FILLER PIC X(01) VALUE ','. CL*52 00550 05 FILLER PIC X(10) VALUE 'EWH FIL DT'. CL*52 00551 05 FILLER PIC X(01) VALUE ','. CL*52 00552 05 FILLER PIC X(03) VALUE 'FIT'. CL*52 00553 05 FILLER PIC X(01) VALUE ','. CL*52 00554 05 FILLER PIC X(02) VALUE 'RC'. CL*52 00555 05 FILLER PIC X(01) VALUE ','. CL*52 00556 05 FILLER PIC X(02) VALUE 'T '. CL*52 00557 05 FILLER PIC X(01) VALUE ','. CL*52 00558 05 FILLER PIC X(01) VALUE 'E'. CL*52 00559 05 FILLER PIC X(01) VALUE ','. CL*52 00560 05 FILLER PIC X(09) VALUE 'TRFEMPRAT'. CL*52 00561 05 FILLER PIC X(01) VALUE ','. CL*52 00562 05 FILLER PIC X(01) VALUE 'S'. CL*52 00563 05 FILLER PIC X(01) VALUE ','. CL*52 00564 05 FILLER PIC X(10) VALUE 'ERWAGERES'. CL*52 00565 05 FILLER PIC X(01) VALUE ','. CL*52 00566 05 FILLER PIC X(02) VALUE 'RC'. CL*52 00567 05 FILLER PIC X(01) VALUE ','. CL*52 00568 05 FILLER PIC X(01) VALUE 'N'. CL*52 00569 05 FILLER PIC X(01) VALUE ','. CL*52 00570 05 FILLER PIC X(10) VALUE 'ERSTATUSDT'. CL*52 00571 05 FILLER PIC X(01) VALUE ','. CL*52 00572 05 FILLER PIC X(10) VALUE 'ERCREADT'. CL*52 00573 05 FILLER PIC X(01) VALUE ','. CL*52 00574 05 FILLER PIC X(15) VALUE 'ERCREABY'. CL*52 00575 05 FILLER PIC X(01) VALUE ','. CL*52 00576 CL*52 00577 05 FILLER PIC X(10) VALUE 'ESUS SADT'. CL*52 00578 05 FILLER PIC X(01) VALUE ','. CL*52 00579 05 FILLER PIC X(02) VALUE 'RC'. CL*52 00580 05 FILLER PIC X(01) VALUE ','. CL*52 00581 05 FILLER PIC X(15) VALUE CL*52 00582 'ESUS FIRST NAME'. CL*52 00583 05 FILLER PIC X(01) VALUE ','. CL*52 00584 05 FILLER PIC X(15) VALUE CL*52 00585 'ESUS LAST NAME'. CL*52 00586 05 FILLER PIC X(01) VALUE ','. CL*52 00587 05 FILLER PIC X(02) VALUE 'SC'. CL*52 00588 05 FILLER PIC X(01) VALUE ','. CL*52 00589 05 FILLER PIC X(10) VALUE 'ESUSSTATDT'. CL*52 00590 05 FILLER PIC X(01) VALUE ','. CL*52 00591 05 FILLER PIC X(10) VALUE 'ESUSCRDT'. CL*52 00592 05 FILLER PIC X(01) VALUE ','. CL*52 00593 05 FILLER PIC X(15) VALUE 'ESUSCRBY'. CL*52 00594 05 FILLER PIC X(01) VALUE ','. CL*52 00595 05 FILLER PIC X(35) VALUE CL*52 00596 'EOO BUSINESS NAME '. CL*52 00597 * CL*52 00598 01 OUT-RECORD. CL*52 00599 05 E_EMPLOYEE_PAID_NUM PIC X(07) VALUE SPACES. CL136 00600 05 FILLER PIC X(01) VALUE ','. CL*52 00601 05 E_STATUS_DATE PIC X(10) VALUE SPACES. CL136 00602 05 FILLER PIC X(01) VALUE ','. CL*52 00603 05 E_SERVICE_BEGIN_IND PIC X(01) VALUE SPACES. CL136 00604 05 FILLER PIC X(01) VALUE ','. CL*52 00605 05 E_IRS_501C3_IND PIC X(01) VALUE SPACES. CL*52 00606 05 FILLER PIC X(01) VALUE ','. CL*52 00607 05 E_NAICS_EFFECTIVE_DATE PIC X(10) VALUE SPACES. CL136 00608 05 FILLER PIC X(01) VALUE ','. CL*52 00609 05 E_CREATED_DATE PIC X(10) VALUE SPACES. CL136 00610 05 FILLER PIC X(01) VALUE ','. CL*52 00611 05 E_CREATED_BY PIC X(15) VALUE SPACES. CL136 00612 05 FILLER PIC X(01) VALUE ','. CL*52 00613 05 E_ANNUAL_FILER_INDICATOR PIC X(01) VALUE SPACES. CL136 00614 05 FILLER PIC X(01) VALUE ','. CL*52 00615 05 E_PAY_51_101_2E_EXMPT_WRK_IND PIC X(01) VALUE SPACES. CL*52 00616 05 FILLER PIC X(01) VALUE ','. CL*52 00617 05 E_ISSUE_1099_FORM_IND PIC X(01) VALUE SPACES. CL*52 00618 05 FILLER PIC X(01) VALUE ','. CL*52 00619 * CL*52 00620 05 EA_PHONE_NUM PIC X(10) VALUE SPACES. CL136 00621 05 FILLER PIC X(01) VALUE ','. CL*52 00622 05 EA_CREATED_DATE PIC X(10) VALUE SPACES. CL136 00623 05 FILLER PIC X(01) VALUE ','. CL*52 00624 05 EA_CREATED_BY PIC X(15) VALUE SPACES. CL136 00625 05 FILLER PIC X(01) VALUE ','. CL*52 00626 CL*52 00627 05 EC_CREATED_DATE PIC X(10) VALUE SPACES. CL136 00628 05 FILLER PIC X(01) VALUE ','. CL*52 00629 05 EC_CREATED_BY PIC X(15) VALUE SPACES. CL136 00630 05 FILLER PIC X(01) VALUE ','. CL*52 00631 * CL*52 00632 05 ES_CREATED_DATE PIC X(10) VALUE SPACES. CL136 00633 05 FILLER PIC X(01) VALUE ','. CL*52 00634 05 ES_CREATED_BY PIC X(15) VALUE SPACES. CL136 00635 05 FILLER PIC X(01) VALUE ','. CL*52 00636 05 ES_FUTA_IND PIC X(01) VALUE SPACES. CL136 00637 05 FILLER PIC X(01) VALUE ','. CL*52 00638 05 ES_HSHOLD_EMP_PAID_500_WG_IND PIC X(01) VALUE SPACES. CL136 00639 05 FILLER PIC X(01) VALUE ','. CL*52 00640 CL*52 00641 05 EOO_PHONE_NUM PIC X(10) VALUE SPACES. CL138 00642 05 FILLER PIC X(01) VALUE ','. CL*52 00643 05 EOO_FAX_NUM PIC X(10) VALUE SPACES. CL138 00644 05 FILLER PIC X(01) VALUE ','. CL*52 00645 05 EOO_EMAIL PIC X(40) VALUE SPACES. CL136 00646 05 FILLER PIC X(01) VALUE ','. CL*52 00647 05 EOO_CREATED_DATE PIC X(10) VALUE SPACES. CL136 00648 05 FILLER PIC X(01) VALUE ','. CL*52 00649 05 EOO_CREATED_BY PIC X(15) VALUE SPACES. CL136 00650 05 FILLER PIC X(01) VALUE ','. CL*52 00651 * CL*52 00652 05 EWH_EMPLOYEE_NUM PIC X(10) VALUE SPACES. CL136 00653 05 FILLER PIC X(01) VALUE ','. CL*52 00654 05 EWH_STATUS_CODE_VALUE PIC X(01) VALUE SPACES. CL136 00655 05 FILLER PIC X(01) VALUE ','. CL*52 00656 05 EWH_FILING_DATE PIC X(10) VALUE SPACES. CL136 00657 05 FILLER PIC X(01) VALUE ','. CL*52 00658 * CL*52 00659 05 EWUD_FILING_METHOD PIC X(03) VALUE SPACES. CL136 00660 05 FILLER PIC X(01) VALUE ','. CL*52 00661 05 EWUD_ADJUSTMENT_REASON_CODE_ID PIC X(02) VALUE SPACES. CL136 00662 05 FILLER PIC X(01) VALUE ','. CL*52 00663 * CL*52 00664 05 EWPD_TYPE_CODE_VALUE PIC X(02) VALUE SPACES. CL136 00665 05 FILLER PIC X(01) VALUE ','. CL*52 00666 * CL*52 00667 05 EXR_EXPERIENCE_RATE_CODE_VALUE PIC X(01) VALUE SPACES. CL136 00668 05 FILLER PIC X(01) VALUE ','. CL*52 00669 * CL*52 00670 05 TRF_NEW_EMPLOYER_RATE PIC 9(07)V99. CL*52 00671 05 FILLER PIC X(01) VALUE ','. CL*52 00672 * CL*52 00673 05 ER_PURCHASE_SALE_IND PIC X(01) VALUE SPACES. CL136 00674 05 FILLER PIC X(01) VALUE ','. CL*52 00675 05 ER_WAGES_RESUMED_DATE PIC X(10) VALUE SPACES. CL136 00676 05 FILLER PIC X(01) VALUE ','. CL*52 00677 05 ER_REASON_CODE_VALUE PIC X(02) VALUE SPACES. CL136 00678 05 FILLER PIC X(01) VALUE ','. CL*52 00679 05 ER_NAICS_CD PIC X(01) VALUE SPACES. CL136 00680 05 FILLER PIC X(01) VALUE ','. CL*52 00681 05 ER_STATUS_DATE PIC X(10) VALUE SPACES. CL136 00682 05 FILLER PIC X(01) VALUE ','. CL*52 00683 05 ER_CREATED_DATE PIC X(10) VALUE SPACES. CL136 00684 05 FILLER PIC X(01) VALUE ','. CL*52 00685 05 ER_CREATED_BY PIC X(15) VALUE SPACES. CL136 00686 05 FILLER PIC X(01) VALUE ','. CL*52 00687 * CL*52 00688 05 ESUS_SUSPEND_ACTION_DATE PIC X(10) VALUE SPACES. CL136 00689 05 FILLER PIC X(01) VALUE ','. CL*52 00690 05 ESUS_REASON_CODE_VALUE PIC X(02) VALUE SPACES. CL136 00691 05 FILLER PIC X(01) VALUE ','. CL*52 00692 05 ESUS_SUSPEND_FIRST_NAME PIC X(15) VALUE SPACES. CL136 00693 05 FILLER PIC X(01) VALUE ','. CL*52 00694 05 ESUS_SUSPEND_LAST_NAME PIC X(15) VALUE SPACES. CL136 00695 05 FILLER PIC X(01) VALUE ','. CL*52 00696 05 ESUS_STATUS_CODE_VALUE PIC X(02) VALUE SPACES. CL136 00697 05 FILLER PIC X(01) VALUE ','. CL*52 00698 05 ESUS_STATUS_DATE PIC X(10) VALUE SPACES. CL136 00699 05 FILLER PIC X(01) VALUE ','. CL*52 00700 05 ESUS_CREATED_DATE PIC X(10) VALUE SPACES. CL136 00701 05 FILLER PIC X(01) VALUE ','. CL*52 00702 05 ESUS_CREATED_BY PIC X(15) VALUE SPACES. CL136 00703 05 FILLER PIC X(01) VALUE ','. CL*52 00704 05 EOO_BUSINESS_NAME PIC X(35) VALUE SPACES. CL136 00705 * CL*52 00706 01 CMB-WORK-AREA. CL*52 00707 05 WRK-EMP-NO PIC S9(07) COMP-3 VALUE +0. CL*52 00708 05 COMP-ZERO PIC S9(09) COMP-3 VALUE 0. CL*52 00709 05 COMP-ZERO-A REDEFINES COMP-ZERO. CL*52 00710 10 COMP-ZERO-LV PIC X(05). CL*52 00711 05 LIAB-ESTB-DATE-INT PIC 9(09). CL*52 00712 05 CEILING-DATE PIC 9(09). CL*52 00713 05 COMP18-DATE PIC 9(07) COMP-3 VALUE 0182770. CL*94 00714 05 COMP19-DATE PIC 9(07) COMP-3 VALUE 0182780. CL*96 00715 05 OUTWRITE-SW PIC X(01) VALUE 'Y'. CL118 00716 * CL*52 00717 CL*52 00718 EJECT DTSBS413 00719 01 WRK-X100-REC. DTSBS413 00720 ++INCLUDE DTSIX100 DTSBS413 00721 DTSBS413 00722 01 WRK-X102-REC. DTSBS413 00723 ++INCLUDE DTSIX102 DTSBS413 00724 DTSBS413 00725 01 WRK-X104-REC. DTSBS413 00726 ++INCLUDE DTSIX104 DTSBS413 00727 DTSBS413 00728 01 WRK-X106-REC. DTSBS413 00729 ++INCLUDE DTSIX106 DTSBS413 00730 DTSBS413 00731 01 WRK-X108-REC. DTSBS413 00732 ++INCLUDE DTSIX108 DTSBS413 00733 DTSBS413 00734 01 WRK-X110-REC. DTSBS413 00735 ++INCLUDE DTSIX110 DTSBS413 00736 DTSBS413 00737 01 WRK-X120-REC. DTSBS413 00738 ++INCLUDE DTSIX120 DTSBS413 00739 DTSBS413 00740 *01 WRK-X130-REC. CL**3 00741 *++INCLUDE DTSIX130 CL**3 00742 DTSBS413 00743 01 WRK-X131-REC. DTSBS413 00744 ++INCLUDE DTSIX131 DTSBS413 00745 DTSBS413 00746 01 WRK-X140-REC. DTSBS413 00747 ++INCLUDE DTSIX140 DTSBS413 00748 DTSBS413 00749 01 WRK-X141-REC. DTSBS413 00750 ++INCLUDE DTSIX141 DTSBS413 00751 DTSBS413 00752 01 WRK-X142-REC. DTSBS413 00753 ++INCLUDE DTSIX142 DTSBS413 00754 DTSBS413 00755 01 WRK-X145-REC. DTSBS413 00756 ++INCLUDE DTSIX145 DTSBS413 00757 DTSBS413 00758 01 L001-LINK-AREA. DTSBS413 00759 ++INCLUDE DTSIL001 DTSBS413 00760 DTSBS413 00761 01 L003-LINK-AREA. DTSBS413 00762 ++INCLUDE DTSIL003 DTSBS413 00763 DTSBS413 00764 01 L004-LINK-AREA. DTSBS413 00765 ++INCLUDE DTSIL004 DTSBS413 00766 DTSBS413 00767 01 L005-LINK-AREA. DTSBS413 00768 ++INCLUDE DTSIL005 DTSBS413 00769 DTSBS413 00770 01 L410-LINK-AREA. DTSBS413 00771 ++INCLUDE DTSIL410 DTSBS413 00772 DTSBS413 00773 01 L516-LINK-AREA. DTSBS413 00774 ++INCLUDE DTSIL516 DTSBS413 00775 DTSBS413 00776 01 L600-LINK-AREA. DTSBS413 00777 ++INCLUDE DTSIL600 DTSBS413 00778 DTSBS413 00779 01 L101-LINK-AREA. DTSBS413 00780 ++INCLUDE DTSIL101 DTSBS413 00781 DTSBS413 00782 01 L910-LINK-AREA. DTSBS413 00783 ++INCLUDE DTSIL910 DTSBS413 00784 SKIP3 DTSBS413 00785 01 MSKL-REC. DTSBS413 00786 ++INCLUDE DTSIMSKL DTSBS413 00787 SKIP3 DTSBS413 00788 01 MHDR-REC. DTSBS413 00789 ++INCLUDE DTSIMHDR DTSBS413 00790 SKIP3 DTSBS413 00791 01 MPRF-REC. DTSBS413 00792 ++INCLUDE DTSIMPRF DTSBS413 00793 DTSBS413 00794 01 MSOL-REC. DTSBS413 00795 ++INCLUDE DTSIMSOL DTSBS413 00796 DTSBS413 00797 01 MERA-REC. DTSBS413 00798 ++INCLUDE DTSIMERA DTSBS413 00799 DTSBS413 00800 01 MQTR-REC. DTSBS413 00801 ++INCLUDE DTSIMQTR DTSBS413 00802 DTSBS413 00803 01 MRPT-REC. DTSBS413 00804 ++INCLUDE DTSIMRPT DTSBS413 00805 DTSBS413 00806 01 MPAY-REC. DTSBS413 00807 ++INCLUDE DTSIMPAY DTSBS413 00808 DTSBS413 00809 01 MFAE-REC. DTSBS413 00810 ++INCLUDE DTSIMFAE DTSBS413 00811 DTSBS413 00812 01 MOPO-REC. DTSBS413 00813 ++INCLUDE DTSIMOPO DTSBS413 00814 DTSBS413 00815 01 MTAD-REC. DTSBS413 00816 ++INCLUDE DTSIMTAD DTSBS413 00817 DTSBS413 00818 01 MTAA-REC. DTSBS413 00819 ++INCLUDE DTSIMTAA DTSBS413 00820 DTSBS413 00821 01 MREL-REC. DTSBS413 00822 ++INCLUDE DTSIMREL DTSBS413 00823 DTSBS413 00824 01 MRTE-REC. DTSBS413 00825 ++INCLUDE DTSIMRTE DTSBS413 00826 DTSBS413 00827 01 L921-LINK-AREA. DTSBS413 00828 ++INCLUDE DTSIL921 DTSBS413 00829 DTSBS413 00830 01 ISKL-REC. DTSBS413 00831 ++INCLUDE DTSIISKL DTSBS413 00832 DTSBS413 00833 01 IEIN-REC. DTSBS413 00834 ++INCLUDE DTSIIEIN DTSBS413 00835 DTSBS413 00836 01 L931-LINK-AREA. DTSBS413 00837 ++INCLUDE DTSIL931 DTSBS413 00838 EJECT DTSBS413 00839 01 FSKL-REC. DTSBS413 00840 ++INCLUDE DTSIFSKL DTSBS413 00841 EJECT DTSBS413 00842 01 FCYR-REC. DTSBS413 00843 ++INCLUDE DTSIFCYR DTSBS413 00844 DTSBS413 00845 01 FUIR-REC. DTSBS413 00846 ++INCLUDE DTSIFUIR DTSBS413 00847 CL*64 00848 01 MJRN-REC. CL*64 00849 ++INCLUDE DTSIMJRN CL*64 00850 DTSBS413 00851 DTSBS413 00852 PROCEDURE DIVISION. DTSBS413 00853 DTSBS413 00854 PERFORM I0000-INITIALIZE THRU I0000-EXIT. DTSBS413 00855 IF WRK-ERROR-NO-88 DTSBS413 00856 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBS413 00857 PERFORM T0000-TERMINATE THRU T0000-EXIT DTSBS413 00858 END-IF. DTSBS413 00859 DTSBS413 00860 GOBACK. DTSBS413 00861 EJECT DTSBS413 00862 I0000-INITIALIZE. DTSBS413 00863 MOVE WRK-TRACE-IND TO L910-TRACE-IND. DTSBS413 00864 MOVE WRK-MOD-NAME TO L910-MOD-NAME. DTSBS413 00865 SET WRK-ERROR-NO-88 TO TRUE. DTSBS413 00866 DTSBS413 00867 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. DTSBS413 00868 IF WRK-ERROR-YES-88 DTSBS413 00869 GO TO I0000-EXIT DTSBS413 00870 END-IF. DTSBS413 00871 DTSBS413 00872 PERFORM I3000-GLOBAL-DATA THRU I3000-EXIT. DTSBS413 00873 DTSBS413 00874 I0000-EXIT. DTSBS413 00875 EXIT. DTSBS413 00876 DTSBS413 00877 I2000-OPEN-FILES. DTSBS413 00878 DTSBS413 00879 OPEN OUTPUT EMPLOYER-TEMP. DTSBS413 00880 IF TEMP-STATUS-OK-88 DTSBS413 00881 NEXT SENTENCE DTSBS413 00882 ELSE DTSBS413 00883 DISPLAY 'OPEN ERROR ON TEMP FILE ' TEMP-STATUS DTSBS413 00884 SET WRK-ERROR-YES-88 TO TRUE DTSBS413 00885 GO TO I2000-EXIT DTSBS413 00886 END-IF. DTSBS413 00887 DTSBS413 00888 OPEN OUTPUT X100-REF-FILE. DTSBS413 00889 IF X100-STATUS-OK-88 DTSBS413 00890 NEXT SENTENCE DTSBS413 00891 ELSE DTSBS413 00892 DISPLAY 'OPEN ERROR ON X100 FILE ' X100-STATUS DTSBS413 00893 SET WRK-ERROR-YES-88 TO TRUE DTSBS413 00894 GO TO I2000-EXIT DTSBS413 00895 END-IF. DTSBS413 00896 DTSBS413 00897 OPEN OUTPUT X102-PRF-FILE. DTSBS413 00898 IF X102-STATUS-OK-88 DTSBS413 00899 NEXT SENTENCE DTSBS413 00900 ELSE DTSBS413 00901 DISPLAY 'OPEN ERROR ON X102 FILE ' X102-STATUS DTSBS413 00902 SET WRK-ERROR-YES-88 TO TRUE DTSBS413 00903 GO TO I2000-EXIT DTSBS413 00904 END-IF. DTSBS413 00905 DTSBS413 00906 OPEN OUTPUT X104-DETERM-FILE. CL**2 00907 IF X104-STATUS-OK-88 CL**2 00908 NEXT SENTENCE CL**2 00909 ELSE CL**2 00910 DISPLAY 'OPEN ERROR ON X104 FILE ' X104-STATUS CL**2 00911 SET WRK-ERROR-YES-88 TO TRUE CL**2 00912 GO TO I2000-EXIT CL**2 00913 END-IF. CL**2 00914 DTSBS413 00915 OPEN OUTPUT X106-NAME-FILE. DTSBS413 00916 IF X106-STATUS-OK-88 DTSBS413 00917 NEXT SENTENCE DTSBS413 00918 ELSE DTSBS413 00919 DISPLAY 'OPEN ERROR ON X106 FILE ' X106-STATUS DTSBS413 00920 SET WRK-ERROR-YES-88 TO TRUE DTSBS413 00921 GO TO I2000-EXIT DTSBS413 00922 END-IF. DTSBS413 00923 DTSBS413 00924 OPEN OUTPUT X108-RATE-FILE. CL**2 00925 IF X108-STATUS-OK-88 CL**2 00926 NEXT SENTENCE CL**2 00927 ELSE CL**2 00928 DISPLAY 'OPEN ERROR ON X108 FILE ' X108-STATUS CL**2 00929 SET WRK-ERROR-YES-88 TO TRUE CL**2 00930 GO TO I2000-EXIT CL**2 00931 END-IF. CL**4 00932 DTSBS413 00933 OPEN OUTPUT X110-ADDR-FILE. DTSBS413 00934 IF X110-STATUS-OK-88 DTSBS413 00935 NEXT SENTENCE DTSBS413 00936 ELSE DTSBS413 00937 DISPLAY 'OPEN ERROR ON X110 FILE ' X110-STATUS DTSBS413 00938 SET WRK-ERROR-YES-88 TO TRUE DTSBS413 00939 GO TO I2000-EXIT DTSBS413 00940 END-IF. DTSBS413 00941 DTSBS413 00942 OPEN OUTPUT X120-OPO-FILE. CL**2 00943 IF X120-STATUS-OK-88 CL**2 00944 NEXT SENTENCE CL**2 00945 ELSE CL**2 00946 DISPLAY 'OPEN ERROR ON X120 FILE ' X120-STATUS CL**2 00947 SET WRK-ERROR-YES-88 TO TRUE CL**2 00948 GO TO I2000-EXIT CL**2 00949 END-IF. CL**2 00950 DTSBS413 00951 OPEN OUTPUT X131-REL-FILE. DTSBS413 00952 IF X131-STATUS-OK-88 DTSBS413 00953 NEXT SENTENCE DTSBS413 00954 ELSE DTSBS413 00955 DISPLAY 'OPEN ERROR ON X131 FILE ' X131-STATUS DTSBS413 00956 SET WRK-ERROR-YES-88 TO TRUE DTSBS413 00957 GO TO I2000-EXIT DTSBS413 00958 END-IF. DTSBS413 00959 DTSBS413 00960 OPEN OUTPUT X140-REPORT-FILE. CL**2 00961 IF X140-STATUS-OK-88 CL**2 00962 NEXT SENTENCE CL**2 00963 ELSE CL**2 00964 DISPLAY 'OPEN ERROR ON X140 FILE ' X140-STATUS CL**2 00965 SET WRK-ERROR-YES-88 TO TRUE CL**2 00966 GO TO I2000-EXIT CL**2 00967 END-IF. CL**2 00968 DTSBS413 00969 OPEN OUTPUT X141-QTR-STATUS-FILE. DTSBS413 00970 IF X141-STATUS-OK-88 DTSBS413 00971 NEXT SENTENCE DTSBS413 00972 ELSE DTSBS413 00973 DISPLAY 'OPEN ERROR ON X141 FILE ' X141-STATUS DTSBS413 00974 SET WRK-ERROR-YES-88 TO TRUE DTSBS413 00975 GO TO I2000-EXIT DTSBS413 00976 END-IF. DTSBS413 00977 DTSBS413 00978 OPEN OUTPUT X142-LAST-RPT-PAY-FILE. DTSBS413 00979 IF X142-STATUS-OK-88 DTSBS413 00980 NEXT SENTENCE DTSBS413 00981 ELSE DTSBS413 00982 DISPLAY 'OPEN ERROR ON X142 FILE ' X142-STATUS DTSBS413 00983 SET WRK-ERROR-YES-88 TO TRUE DTSBS413 00984 GO TO I2000-EXIT DTSBS413 00985 END-IF. DTSBS413 00986 DTSBS413 00987 OPEN OUTPUT X145-PAYMENT-FILE. CL**2 00988 IF X145-STATUS-OK-88 CL**2 00989 NEXT SENTENCE CL**2 00990 ELSE CL**2 00991 DISPLAY 'OPEN ERROR ON X145 FILE ' X145-STATUS CL**2 00992 SET WRK-ERROR-YES-88 TO TRUE CL**2 00993 GO TO I2000-EXIT CL**2 00994 END-IF. CL**2 00995 DTSBS413 00996 * CL*66 00997 OPEN OUTPUT DSKFILE. CL*66 00998 IF NOT DSKFILE-STATUS-OK-88 CL*66 00999 DISPLAY 'OPEN ERROR ON DSK FILE ' DSKFILE-STATUS CL*66 01000 SET WRK-ERROR-YES-88 TO TRUE CL*66 01001 GO TO I2000-EXIT CL*66 01002 END-IF. CL*66 01003 CL130 01004 OPEN INPUT SENT-MINI-FILE. CL130 01005 IF SENT-MINI-STATUS-OK-88 CL130 01006 NEXT SENTENCE CL130 01007 ELSE CL130 01008 DISPLAY 'OPEN ERROR ON SENT MINI FILE ' SENT-MINI-STATUS CL130 01009 SET WRK-ERROR-YES-88 TO TRUE CL130 01010 GO TO I2000-EXIT CL130 01011 END-IF. CL130 01012 CL130 01013 PERFORM S910A-OPEN-READ THRU S910A-EXIT. DTSBS413 01014 PERFORM S921A-OPEN-READ THRU S921A-EXIT. DTSBS413 01015 PERFORM S931A-OPEN-READ THRU S931A-EXIT. DTSBS413 01016 DTSBS413 01017 I2000-EXIT. DTSBS413 01018 EXIT. DTSBS413 01019 DTSBS413 01020 I3000-GLOBAL-DATA. DTSBS413 01021 PERFORM I3100-TAX-HEADER THRU I3100-EXIT. DTSBS413 01022 IF WRK-ERROR-NO-88 DTSBS413 01023 PERFORM I3200-TAX-REF THRU I3200-EXIT DTSBS413 01024 IF WRK-ERROR-NO-88 DTSBS413 01025 PERFORM I3300-BUILD-X100 THRU I3300-EXIT DTSBS413 01026 END-IF DTSBS413 01027 END-IF. DTSBS413 01028 DTSBS413 01029 I3000-EXIT. DTSBS413 01030 EXIT. DTSBS413 01031 DTSBS413 01032 I3100-TAX-HEADER. DTSBS413 01033 MOVE LOW-VALUES TO MSKL-REC. DTSBS413 01034 MOVE +0 TO MSKL-EMP-NO. DTSBS413 01035 SET MSKL-HDR-88 TO TRUE. DTSBS413 01036 DTSBS413 01037 PERFORM S910B-READ THRU S910B-EXIT. DTSBS413 01038 IF L910-NO-REC-88 DTSBS413 01039 DISPLAY 'DTSBX411: MHDR RECORD IS MISSING' DTSBS413 01040 SET WRK-ERROR-YES-88 TO TRUE DTSBS413 01041 GO TO I3100-EXIT DTSBS413 01042 ELSE DTSBS413 01043 MOVE MSKL-REC TO MHDR-REC DTSBS413 01044 END-IF. DTSBS413 01045 DTSBS413 01046 MOVE MHDR-CURR-RUN-DATE TO WRK-CURR-RUN-DATE DTSBS413 01047 L004-DATE. DTSBS413 01048 PERFORM S004-FROM-DATE THRU S004-EXIT. DTSBS413 01049 MOVE L004-QTR-5-9 TO WRK-CURR-QTR. DTSBS413 01050 MOVE L004-QTR-START-DATE TO WRK-CURR-QTR-START. DTSBS413 01051 DTSBS413 01052 MOVE MHDR-CURR-RUN-DATE TO L004-DATE. DTSBS413 01053 PERFORM S004-FROM-DATE THRU S004-EXIT. DTSBS413 01054 SUBTRACT +8 FROM L004-ABS-QTR. DTSBS413 01055 PERFORM S004-FROM-ABS THRU S004-EXIT. DTSBS413 01056 MOVE L004-QTR-5-9 TO WRK-CURR-QTR-MINUS-8. DTSBS413 01057 DTSBS413 01058 MOVE MHDR-CURR-RUN-DATE TO L004-DATE. DTSBS413 01059 PERFORM S004-FROM-DATE THRU S004-EXIT. DTSBS413 01060 SUBTRACT +2 FROM L004-ABS-QTR. DTSBS413 01061 PERFORM S004-FROM-ABS THRU S004-EXIT. DTSBS413 01062 MOVE L004-QTR-START-DATE TO WRK-INACT-CUTOFF. DTSBS413 01063 DTSBS413 01064 MOVE WRK-CURR-RUN-DATE TO L001-FED-8-DATE-9. DTSBS413 01065 SUBTRACT 4 FROM L001-FED-8-YR CL*27 01066 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBS413 01067 MOVE L001-FED-8-DATE-9 TO WRK-3-YEARS-AGO DTSBS413 01068 L004-DATE. DTSBS413 01069 PERFORM S004-FROM-DATE THRU S004-EXIT. DTSBS413 01070 MOVE L004-QTR-5-9 TO WRK-3-YEARS-AGO-YRQ. DTSBS413 01071 DTSBS413 01072 MOVE MHDR-LAST-RATE-END-YRQ TO WRK-YRQ. DTSBS413 01073 MOVE 1 TO WRK-YRQ-Q. DTSBS413 01074 MOVE WRK-YRQ TO WRK-RATE-YRQ-1. DTSBS413 01075 SUBTRACT 1 FROM WRK-YRQ-CCYY. DTSBS413 01076 MOVE WRK-YRQ TO WRK-RATE-YRQ-2. DTSBS413 01077 SUBTRACT 1 FROM WRK-YRQ-CCYY. DTSBS413 01078 MOVE WRK-YRQ TO WRK-RATE-YRQ-3. DTSBS413 01079 DTSBS413 01080 ***** DTSBS413 01081 ** WRK-PRIOR-QTR IS THE MOST RECENTLY COMPLETED DTSBS413 01082 ** QUARTER. DTSBS413 01083 ** WRK-CURR-QTR IS THE QUARTER IN WHICH DTSBS413 01084 ** MHDR-CURR-RUN-DATE FALLS. DTSBS413 01085 ** THESE FIELDS ARE USED IN P3700 WHICH EXTRACTS DTSBS413 01086 ** QUARTER INFORMATION. DTSBS413 01087 ***** DTSBS413 01088 DTSBS413 01089 MOVE MHDR-LAST-PEN-ASSESSED-YRQ DTSBS413 01090 TO L004-QTR-5-9. DTSBS413 01091 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBS413 01092 ADD +1 TO L004-ABS-QTR. DTSBS413 01093 PERFORM S004-FROM-ABS THRU S004-EXIT. DTSBS413 01094 MOVE L004-QTR-5-9 TO WRK-PRIOR-QTR. DTSBS413 01095 DTSBS413 01096 MOVE MHDR-CURR-RUN-DATE TO L004-DATE. DTSBS413 01097 PERFORM S004-FROM-DATE THRU S004-EXIT. DTSBS413 01098 SUBTRACT +1 FROM L004-ABS-QTR. DTSBS413 01099 PERFORM S004-FROM-ABS THRU S004-EXIT. DTSBS413 01100 IF WRK-PRIOR-QTR < L004-QTR-5-9 DTSBS413 01101 DISPLAY '>>> MORE THAN 1 QUARTER NOT DELINQUENT ' DTSBS413 01102 WRK-PRIOR-QTR ' ' L004-QTR-5-9 DTSBS413 01103 DISPLAY 'BX410 ABENDING ' DTSBS413 01104 PERFORM S999-ABEND THRU S999-EXIT DTSBS413 01105 END-IF. DTSBS413 01106 DTSBS413 01107 DISPLAY SPACE. DTSBS413 01108 DISPLAY 'DTSBX411 DATES:' DTSBS413 01109 DISPLAY ' CURR RUN DATE ' WRK-CURR-RUN-DATE. DTSBS413 01110 DISPLAY ' 3 YEARS AGO ' WRK-3-YEARS-AGO. DTSBS413 01111 DISPLAY ' 4 YEARS AGO QTR ' WRK-3-YEARS-AGO-YRQ. CL*27 01112 DISPLAY ' RATE YEAR 1 ' WRK-RATE-YRQ-1. DTSBS413 01113 DISPLAY ' RATE YEAR 2 ' WRK-RATE-YRQ-2. DTSBS413 01114 DISPLAY ' RATE YEAR 3 ' WRK-RATE-YRQ-3. DTSBS413 01115 DISPLAY ' START QTR ' WRK-FIRST-WAGE-QTR. DTSBS413 01116 DISPLAY ' FIRST RPT QTR ' WRK-FIRST-RPT-QTR. DTSBS413 01117 DTSBS413 01118 I3100-EXIT. DTSBS413 01119 EXIT. DTSBS413 01120 DTSBS413 01121 I3200-TAX-REF. DTSBS413 01122 MOVE LOW-VALUES TO FCYR-KEY-AREA. DTSBS413 01123 SET FCYR-CYR-88 TO TRUE. DTSBS413 01124 MOVE WRK-RATE-YRQ-3-CCYY TO FCYR-YR. DTSBS413 01125 MOVE FCYR-KEY-AREA TO FSKL-KEY-AREA. DTSBS413 01126 DTSBS413 01127 PERFORM S931B-START-BROWSE THRU S931B-EXIT. DTSBS413 01128 IF L931-NO-REC-88 DTSBS413 01129 DISPLAY 'DTSBX411: FCYR RECORD IS MISSING' DTSBS413 01130 SET WRK-ERROR-YES-88 TO TRUE DTSBS413 01131 GO TO I3200-EXIT DTSBS413 01132 ELSE DTSBS413 01133 PERFORM DTSBS413 01134 UNTIL L931-NO-REC-88 DTSBS413 01135 MOVE FSKL-REC TO FCYR-REC DTSBS413 01136 PERFORM I3210-WAGE-BASE THRU I3210-EXIT DTSBS413 01137 PERFORM S931C-READ-NEXT THRU S931C-EXIT DTSBS413 01138 END-PERFORM DTSBS413 01139 END-IF. DTSBS413 01140 DTSBS413 01141 MOVE LOW-VALUE TO FUIR-KEY-AREA. DTSBS413 01142 SET FUIR-UIR-88 TO TRUE. DTSBS413 01143 MOVE WRK-RATE-YRQ-3 TO FUIR-EFF-YRQ. DTSBS413 01144 MOVE FUIR-KEY-AREA TO FSKL-KEY-AREA. DTSBS413 01145 PERFORM S931B-START-BROWSE THRU S931B-EXIT. DTSBS413 01146 IF L931-OK-88 DTSBS413 01147 PERFORM DTSBS413 01148 UNTIL L931-NO-REC-88 DTSBS413 01149 MOVE FSKL-REC TO FUIR-REC DTSBS413 01150 PERFORM I3220-RATES THRU I3220-EXIT DTSBS413 01151 PERFORM S931C-READ-NEXT THRU S931C-EXIT DTSBS413 01152 END-PERFORM DTSBS413 01153 END-IF. DTSBS413 01154 DTSBS413 01155 DISPLAY SPACE. DTSBS413 01156 DISPLAY 'DTSBX411 RATES: ' DTSBS413 01157 DISPLAY ' YEAR 1 ' WRK-RATE-YRQ-1 DTSBS413 01158 ' ' WRK-NEW-EMP-RATE-1 DTSBS413 01159 ' ' WRK-TAX-TABLE-1. DTSBS413 01160 DISPLAY ' YEAR 2 ' WRK-RATE-YRQ-2 DTSBS413 01161 ' ' WRK-NEW-EMP-RATE-2 DTSBS413 01162 ' ' WRK-TAX-TABLE-3. DTSBS413 01163 DISPLAY ' YEAR 3 ' WRK-RATE-YRQ-3 DTSBS413 01164 ' ' WRK-NEW-EMP-RATE-3 DTSBS413 01165 ' ' WRK-TAX-TABLE-3. DTSBS413 01166 DTSBS413 01167 I3200-EXIT. DTSBS413 01168 EXIT. DTSBS413 01169 DTSBS413 01170 I3210-WAGE-BASE. DTSBS413 01171 EVALUATE TRUE DTSBS413 01172 WHEN FCYR-YR = WRK-RATE-YRQ-1-CCYY DTSBS413 01173 MOVE FCYR-TAXABLE-WAGE-BASE TO WRK-TAX-WAGE-BASE-1 DTSBS413 01174 DTSBS413 01175 WHEN FCYR-YR = WRK-RATE-YRQ-2-CCYY DTSBS413 01176 MOVE FCYR-TAXABLE-WAGE-BASE TO WRK-TAX-WAGE-BASE-2 DTSBS413 01177 DTSBS413 01178 WHEN FCYR-YR = WRK-RATE-YRQ-3-CCYY DTSBS413 01179 MOVE FCYR-TAXABLE-WAGE-BASE TO WRK-TAX-WAGE-BASE-3 DTSBS413 01180 DTSBS413 01181 END-EVALUATE. DTSBS413 01182 DTSBS413 01183 I3210-EXIT. DTSBS413 01184 EXIT. DTSBS413 01185 DTSBS413 01186 I3220-RATES. DTSBS413 01187 EVALUATE TRUE DTSBS413 01188 WHEN FUIR-EFF-YRQ = WRK-RATE-YRQ-1 DTSBS413 01189 MOVE FUIR-DEFAULT-NEW-EMP-RATE TO WRK-NEW-EMP-RATE-1 DTSBS413 01190 MOVE FUIR-RATE-TABLE TO WRK-TAX-TABLE-1 DTSBS413 01191 DTSBS413 01192 WHEN FUIR-EFF-YRQ = WRK-RATE-YRQ-2 DTSBS413 01193 MOVE FUIR-DEFAULT-NEW-EMP-RATE TO WRK-NEW-EMP-RATE-2 DTSBS413 01194 MOVE FUIR-RATE-TABLE TO WRK-TAX-TABLE-2 DTSBS413 01195 DTSBS413 01196 WHEN FUIR-EFF-YRQ = WRK-RATE-YRQ-3 DTSBS413 01197 MOVE FUIR-DEFAULT-NEW-EMP-RATE TO WRK-NEW-EMP-RATE-3 DTSBS413 01198 MOVE FUIR-RATE-TABLE TO WRK-TAX-TABLE-3 DTSBS413 01199 DTSBS413 01200 END-EVALUATE. DTSBS413 01201 DTSBS413 01202 I3220-EXIT. DTSBS413 01203 EXIT. DTSBS413 01204 DTSBS413 01205 I3300-BUILD-X100. DTSBS413 01206 MOVE WRK-RATE-YRQ-1-CCYY TO X100-RATE-YEAR. DTSBS413 01207 MOVE WRK-NEW-EMP-RATE-1 TO X100-NEW-EMP-RATE. DTSBS413 01208 MOVE WRK-TAX-TABLE-1 TO X100-TAX-TABLE. DTSBS413 01209 MOVE WRK-TAX-WAGE-BASE-1 TO X100-TAX-WAGE-BASE. DTSBS413 01210 DTSBS413 01211 WRITE X100-REC FROM WRK-X100-REC. DTSBS413 01212 IF NOT X100-STATUS-OK-88 DTSBS413 01213 DISPLAY 'CANNOT WRITE X100 ' X100-STATUS DTSBS413 01214 SET WRK-ERROR-YES-88 TO TRUE DTSBS413 01215 END-IF. DTSBS413 01216 DTSBS413 01217 MOVE WRK-RATE-YRQ-2-CCYY TO X100-RATE-YEAR. DTSBS413 01218 MOVE WRK-NEW-EMP-RATE-2 TO X100-NEW-EMP-RATE. DTSBS413 01219 MOVE WRK-TAX-TABLE-2 TO X100-TAX-TABLE. DTSBS413 01220 MOVE WRK-TAX-WAGE-BASE-2 TO X100-TAX-WAGE-BASE. DTSBS413 01221 DTSBS413 01222 WRITE X100-REC FROM WRK-X100-REC. DTSBS413 01223 IF NOT X100-STATUS-OK-88 DTSBS413 01224 DISPLAY 'CANNOT WRITE X100 ' X100-STATUS DTSBS413 01225 SET WRK-ERROR-YES-88 TO TRUE DTSBS413 01226 END-IF. DTSBS413 01227 DTSBS413 01228 MOVE WRK-RATE-YRQ-3-CCYY TO X100-RATE-YEAR. DTSBS413 01229 MOVE WRK-NEW-EMP-RATE-3 TO X100-NEW-EMP-RATE. DTSBS413 01230 MOVE WRK-TAX-TABLE-3 TO X100-TAX-TABLE. DTSBS413 01231 MOVE WRK-TAX-WAGE-BASE-3 TO X100-TAX-WAGE-BASE. DTSBS413 01232 DTSBS413 01233 WRITE X100-REC FROM WRK-X100-REC. DTSBS413 01234 IF NOT X100-STATUS-OK-88 DTSBS413 01235 DISPLAY 'CANNOT WRITE X100 ' X100-STATUS DTSBS413 01236 SET WRK-ERROR-YES-88 TO TRUE DTSBS413 01237 END-IF. DTSBS413 01238 DTSBS413 01239 I3300-EXIT. DTSBS413 01240 EXIT. DTSBS413 01241 DTSBS413 01242 DTSBS413 01243 P0000-PROCESS. DTSBS413 01244 DTSBS413 01245 PERFORM S1010-READ-SENT-MINI THRU S1010-EXIT. CL130 01246 CL130 01247 IF SENT-MINI-STATUS-EOF-88 CL130 01248 DISPLAY 'SENT MINI FILE IS EMPTY' CL130 01249 GO TO P0000-EXIT CL130 01250 END-IF. CL130 01251 CL130 01252 IF E_EMPLOYEE_PAID_NUM = 182773 CL125 01253 DISPLAY '***$$ MPRF-EMP-NO = ', MPRF-EMP-NO CL126 01254 END-IF. CL125 01255 DTSBS413 01256 PERFORM UNTIL SENT-MINI-STATUS-EOF-88 CL130 01257 OR WRK-ERROR-YES-88 DTSBS413 01258 CL130 01259 MOVE LOW-VALUES TO MSKL-KEY-AREA CL130 01260 MOVE WS-SENT-EMP-NO TO MSKL-EMP-NO CL130 01261 SET MSKL-PRF-88 TO TRUE CL130 01262 CL130 01263 PERFORM S910B-READ THRU S910B-EXIT CL130 01264 CL130 01265 IF L910-NO-REC-88 CL139 01266 DISPLAY 'EMP NO NOT IN USE ' MSKL-EMP-NO CL130 01267 PERFORM S999-ABEND THRU S999-EXIT CL130 01268 END-IF CL130 01269 CL130 01270 DISPLAY '***$$ PO MPRF-EMP-NO = ', MPRF-EMP-NO , CL130 01271 ' MSOL-INACT-CD: ', MSOL-INACT-CD CL130 01272 CL130 01273 PERFORM P1000-PROCESS-EMP THRU P1000-EXIT CL130 01274 PERFORM S1010-READ-SENT-MINI THRU S1010-EXIT CL130 01275 CL130 01276 END-PERFORM. DTSBS413 01277 DTSBS413 01278 P0000-EXIT. DTSBS413 01279 EXIT. DTSBS413 01280 DTSBS413 01281 P1000-PROCESS-EMP. DTSBS413 01282 MOVE MSKL-REC TO MPRF-REC. DTSBS413 01283 PERFORM P1005-INITIALIZE-EMP THRU P1005-EXIT. DTSBS413 01284 DTSBS413 01285 IF MPRF-CLASS-SUB-88 DTSBS413 01286 PERFORM P1100-SELECT-EMP THRU P1100-EXIT DTSBS413 01287 IF WRK-SELECT-EMP-PRF-88 OR CL*42 01288 WRK-SELECT-EMP-NO-88 CL*42 01289 GO TO P1000-EXIT CL*34 01290 PERFORM P2000-PROFILE THRU P2000-EXIT CL124 01291 PERFORM P2100-NAMES THRU P2100-EXIT CL124 01292 ELSE DTSBS413 01293 PERFORM P2000-PROFILE THRU P2000-EXIT DTSBS413 01294 PERFORM P2100-NAMES THRU P2100-EXIT DTSBS413 01295 PERFORM P2300-EMP-ADDR THRU P2300-EXIT CL124 01296 PERFORM P3600-REPORT THRU P3600-EXIT CL124 01297 PERFORM P3700-QTRS-DUE THRU P3700-EXIT CL124 01298 PERFORM P3800-PAYMENT THRU P3800-EXIT CL124 01299 PERFORM P3000-REL THRU P3000-EXIT CL124 01300 PERFORM P3200-DETERM THRU P3200-EXIT CL124 01301 PERFORM P2500-OPO THRU P2500-EXIT CL124 01302 PERFORM P3400-RATE THRU P3400-EXIT CL124 01303 END-IF DTSBS413 01304 END-IF. DTSBS413 01305 DTSBS413 01306 IF TEMP-CNT > ZERO DTSBS413 01307 CLOSE EMPLOYER-TEMP DTSBS413 01308 PERFORM P1010-WRITE-OUTPUT THRU P1010-EXIT DTSBS413 01309 OPEN OUTPUT EMPLOYER-TEMP DTSBS413 01310 IF NOT TEMP-STATUS-OK-88 DTSBS413 01311 DISPLAY 'P1000 OPEN ERROR ON TEMP FILE ' DTSBS413 01312 TEMP-STATUS DTSBS413 01313 SET WRK-ERROR-YES-88 TO TRUE DTSBS413 01314 GO TO P1000-EXIT DTSBS413 01315 END-IF DTSBS413 01316 END-IF. DTSBS413 01317 DTSBS413 01318 IF X142-EMP-NO > ZERO DTSBS413 01319 WRITE X142-REC FROM WRK-X142-REC DTSBS413 01320 IF X142-STATUS-OK-88 DTSBS413 01321 ADD +1 TO X142-CNT DTSBS413 01322 ELSE DTSBS413 01323 DISPLAY 'CANNOT WRITE X142 ' MPRF-EMP-NO DTSBS413 01324 SET WRK-ERROR-YES-88 TO TRUE DTSBS413 01325 END-IF DTSBS413 01326 END-IF. DTSBS413 01327 DTSBS413 01328 P1000-EXIT. DTSBS413 01329 EXIT. DTSBS413 01330 DTSBS413 01331 P1005-INITIALIZE-EMP. DTSBS413 01332 MOVE ZERO TO TEMP-CNT DTSBS413 01333 WRK-LAST-LIAB-YRQ DTSBS413 01334 WRK-INACT-DATE DTSBS413 01335 WRK-INACT-ENTR-DATE. DTSBS413 01336 DTSBS413 01337 SET WRK-SELECT-EMP-ALL-88 TO TRUE. DTSBS413 01338 DTSBS413 01339 MOVE ZERO TO X142-EMP-NO DTSBS413 01340 X142-PAY-DATE DTSBS413 01341 X142-PAY-AMT. DTSBS413 01342 MOVE SPACES TO X142-RPT-TYPE DTSBS413 01343 X142-REPORT-QTR DTSBS413 01344 X142-REPORT-YEAR. DTSBS413 01345 DTSBS413 01346 MOVE +0 TO PAY-LAST DTSBS413 01347 MAX-PAY-DATE DTSBS413 01348 MAX-PAY-BATCH DTSBS413 01349 MAX-PAY-ITEM DTSBS413 01350 MAX-PAY-AMT. DTSBS413 01351 DTSBS413 01352 PERFORM DTSBS413 01353 VARYING PSUB FROM +1 BY +1 DTSBS413 01354 UNTIL PSUB > PAY-MAX DTSBS413 01355 MOVE +0 TO PAY-BATCH (PSUB) DTSBS413 01356 PAY-ITEM (PSUB) DTSBS413 01357 PAY-RCVD-DATE (PSUB) DTSBS413 01358 PAY-PROCESS-DATE (PSUB) DTSBS413 01359 PAY-ORIG-AMT (PSUB) DTSBS413 01360 PAY-ADJ-AMT (PSUB) DTSBS413 01361 END-PERFORM. DTSBS413 01362 DTSBS413 01363 MOVE +0 TO MAX-RPT-DATE DTSBS413 01364 MAX-RPT-YRQ. DTSBS413 01365 MOVE SPACES TO MAX-RPT-TYPE. DTSBS413 01366 PERFORM DTSBS413 01367 VARYING RSUB FROM +1 BY +1 DTSBS413 01368 UNTIL RSUB > RPT-MAX DTSBS413 01369 MOVE +0 TO RPT-YRQ (RSUB) DTSBS413 01370 RPT-TYPE (RSUB) DTSBS413 01371 RPT-RCVD-DATE (RSUB) DTSBS413 01372 RPT-PROCESS-DATE (RSUB) DTSBS413 01373 END-PERFORM. DTSBS413 01374 DTSBS413 01375 P1005-EXIT. DTSBS413 01376 EXIT. DTSBS413 01377 DTSBS413 01378 P1010-WRITE-OUTPUT. DTSBS413 01379 OPEN INPUT EMPLOYER-TEMP. DTSBS413 01380 IF TEMP-STATUS-OK-88 DTSBS413 01381 NEXT SENTENCE DTSBS413 01382 ELSE DTSBS413 01383 DISPLAY 'P1010 OPEN ERROR ON TEMP FILE ' DTSBS413 01384 TEMP-STATUS DTSBS413 01385 SET WRK-ERROR-YES-88 TO TRUE DTSBS413 01386 GO TO P1010-EXIT DTSBS413 01387 END-IF. DTSBS413 01388 DTSBS413 01389 READ EMPLOYER-TEMP. DTSBS413 01390 PERFORM DTSBS413 01391 UNTIL TEMP-STATUS-EOF-88 DTSBS413 01392 EVALUATE TRUE DTSBS413 01393 WHEN TEMP-REC-TYPE = '102' DTSBS413 01394 PERFORM P1010A-WRITE-102 THRU P1010A-EXIT DTSBS413 01395 DISPLAY '***++ 102 MPRF-EMP-NO = ', MPRF-EMP-NO CL125 01396 DTSBS413 01397 WHEN TEMP-REC-TYPE = '104' CL122 01398 PERFORM P1010B-WRITE-104 THRU P1010B-EXIT CL122 01399 DISPLAY '***++ 104 MPRF-EMP-NO = ', MPRF-EMP-NO CL125 01400 DTSBS413 01401 WHEN TEMP-REC-TYPE = '106' CL122 01402 PERFORM P1010C-WRITE-106 THRU P1010C-EXIT CL122 01403 DISPLAY '***++ 106 MPRF-EMP-NO = ', MPRF-EMP-NO CL125 01404 DTSBS413 01405 WHEN TEMP-REC-TYPE = '108' CL122 01406 PERFORM P1010D-WRITE-108 THRU P1010D-EXIT CL122 01407 DISPLAY '***++ 108 MPRF-EMP-NO = ', MPRF-EMP-NO CL125 01408 DTSBS413 01409 WHEN TEMP-REC-TYPE = '110' CL122 01410 PERFORM P1010E-WRITE-110 THRU P1010E-EXIT CL122 01411 DISPLAY '***++ 110 MPRF-EMP-NO = ', MPRF-EMP-NO CL122 01412 DTSBS413 01413 WHEN TEMP-REC-TYPE = '120' CL122 01414 PERFORM P1010F-WRITE-120 THRU P1010F-EXIT CL122 01415 DISPLAY '***++ 120 MPRF-EMP-NO = ', MPRF-EMP-NO CL125 01416 DTSBS413 01417 ** WHEN TEMP-REC-TYPE = '130' CL126 01418 ** PERFORM P1010G-WRITE-130 THRU P1010G-EXIT CL126 01419 DTSBS413 01420 WHEN TEMP-REC-TYPE = '140' CL122 01421 PERFORM P1010H-WRITE-140 THRU P1010H-EXIT CL122 01422 DISPLAY '***++ 140 MPRF-EMP-NO = ', MPRF-EMP-NO CL125 01423 DTSBS413 01424 WHEN TEMP-REC-TYPE = '141' CL122 01425 PERFORM P1010I-WRITE-141 THRU P1010I-EXIT CL122 01426 DISPLAY '***++ 141 MPRF-EMP-NO = ', MPRF-EMP-NO CL122 01427 DTSBS413 01428 WHEN TEMP-REC-TYPE = '131' CL122 01429 PERFORM P1010J-WRITE-131 THRU P1010J-EXIT CL122 01430 DISPLAY '***++ 131 MPRF-EMP-NO = ', MPRF-EMP-NO CL125 01431 DTSBS413 01432 WHEN TEMP-REC-TYPE = '142' CL122 01433 PERFORM P1010K-WRITE-142 THRU P1010K-EXIT CL122 01434 DISPLAY '***++ 142 MPRF-EMP-NO = ', MPRF-EMP-NO CL125 01435 DTSBS413 01436 END-EVALUATE DTSBS413 01437 READ EMPLOYER-TEMP DTSBS413 01438 END-PERFORM. DTSBS413 01439 DTSBS413 01440 CLOSE EMPLOYER-TEMP. DTSBS413 01441 DTSBS413 01442 P1010-EXIT. DTSBS413 01443 EXIT. DTSBS413 01444 DTSBS413 01445 P1010A-WRITE-102. DTSBS413 01446 DISPLAY '***$$ 102 MPRF-EMP-NO = ', MPRF-EMP-NO , CL125 01447 ' MSOL-INACT-CD: ', MSOL-INACT-CD. CL125 01448 PERFORM CP2000-MOVE-FIELDS THRU CP2000-EXIT. CL*96 01449 MOVE LENGTH OF WRK-X102-REC TO WRK-LEN. DTSBS413 01450 MOVE EMPLOYER-TEMP-REC (1:WRK-LEN) TO X102-REC. DTSBS413 01451 WRITE X102-REC. DTSBS413 01452 IF X102-STATUS-OK-88 DTSBS413 01453 ADD +1 TO X102-CNT DTSBS413 01454 ELSE DTSBS413 01455 DISPLAY 'CANNOT WRITE X102 ' MPRF-EMP-NO DTSBS413 01456 SET WRK-ERROR-YES-88 TO TRUE DTSBS413 01457 END-IF. DTSBS413 01458 CL*95 01459 CL*63 01460 P1010A-EXIT. DTSBS413 01461 EXIT. DTSBS413 01462 DTSBS413 01463 P1010B-WRITE-104. CL**2 01464 MOVE LENGTH OF WRK-X104-REC TO WRK-LEN. CL**2 01465 MOVE EMPLOYER-TEMP-REC (1:WRK-LEN) TO X104-REC. CL**2 01466 WRITE X104-REC. CL**2 01467 IF X104-STATUS-OK-88 CL**2 01468 ADD +1 TO X104-CNT CL**2 01469 ELSE CL**2 01470 DISPLAY 'CANNOT WRITE X104 ' MPRF-EMP-NO CL**2 01471 SET WRK-ERROR-YES-88 TO TRUE CL**2 01472 END-IF. CL**2 01473 CL**2 01474 P1010B-EXIT. CL**2 01475 EXIT. CL**2 01476 DTSBS413 01477 P1010C-WRITE-106. DTSBS413 01478 MOVE LENGTH OF WRK-X106-REC TO WRK-LEN. DTSBS413 01479 MOVE EMPLOYER-TEMP-REC (1:WRK-LEN) TO X106-REC. DTSBS413 01480 WRITE X106-REC. DTSBS413 01481 IF X106-STATUS-OK-88 DTSBS413 01482 ADD +1 TO X106-CNT DTSBS413 01483 ELSE DTSBS413 01484 DISPLAY 'CANNOT WRITE X106 ' MPRF-EMP-NO DTSBS413 01485 SET WRK-ERROR-YES-88 TO TRUE DTSBS413 01486 END-IF. DTSBS413 01487 DTSBS413 01488 P1010C-EXIT. DTSBS413 01489 EXIT. DTSBS413 01490 DTSBS413 01491 P1010D-WRITE-108. CL**2 01492 MOVE LENGTH OF WRK-X108-REC TO WRK-LEN. CL**2 01493 MOVE EMPLOYER-TEMP-REC (1:WRK-LEN) TO X108-REC. CL**2 01494 WRITE X108-REC. CL**2 01495 IF X108-STATUS-OK-88 CL**2 01496 ADD +1 TO X108-CNT CL**2 01497 ELSE CL**2 01498 DISPLAY 'CANNOT WRITE X108 ' MPRF-EMP-NO CL**2 01499 SET WRK-ERROR-YES-88 TO TRUE CL**2 01500 END-IF. CL**2 01501 CL**2 01502 P1010D-EXIT. CL**2 01503 EXIT. CL**2 01504 DTSBS413 01505 P1010E-WRITE-110. DTSBS413 01506 MOVE LENGTH OF WRK-X110-REC TO WRK-LEN. DTSBS413 01507 MOVE EMPLOYER-TEMP-REC (1:WRK-LEN) TO X110-REC. DTSBS413 01508 WRITE X110-REC. DTSBS413 01509 IF X110-STATUS-OK-88 DTSBS413 01510 ADD +1 TO X110-CNT DTSBS413 01511 ELSE DTSBS413 01512 DISPLAY 'CANNOT WRITE X110 ' MPRF-EMP-NO DTSBS413 01513 SET WRK-ERROR-YES-88 TO TRUE DTSBS413 01514 END-IF. DTSBS413 01515 DTSBS413 01516 P1010E-EXIT. DTSBS413 01517 EXIT. DTSBS413 01518 DTSBS413 01519 P1010F-WRITE-120. CL**2 01520 MOVE LENGTH OF WRK-X120-REC TO WRK-LEN. CL**2 01521 MOVE EMPLOYER-TEMP-REC (1:WRK-LEN) TO X120-REC. CL**2 01522 WRITE X120-REC. CL**2 01523 IF X120-STATUS-OK-88 CL**2 01524 ADD +1 TO X120-CNT CL**2 01525 ELSE CL**2 01526 DISPLAY 'CANNOT WRITE X120 ' MPRF-EMP-NO CL**2 01527 SET WRK-ERROR-YES-88 TO TRUE CL**2 01528 END-IF. CL**2 01529 CL**2 01530 P1010F-EXIT. CL**2 01531 EXIT. CL**2 01532 DTSBS413 01533 DTSBS413 01534 P1010H-WRITE-140. CL**2 01535 MOVE LENGTH OF WRK-X140-REC TO WRK-LEN. CL**2 01536 MOVE EMPLOYER-TEMP-REC (1:WRK-LEN) TO X140-REC. CL**2 01537 WRITE X140-REC. CL**2 01538 IF X140-STATUS-OK-88 CL**2 01539 ADD +1 TO X140-CNT CL**2 01540 ELSE CL**2 01541 DISPLAY 'CANNOT WRITE X140 ' MPRF-EMP-NO CL**2 01542 SET WRK-ERROR-YES-88 TO TRUE CL**2 01543 END-IF. CL**2 01544 CL**2 01545 P1010H-EXIT. CL**2 01546 EXIT. CL**2 01547 DTSBS413 01548 P1010I-WRITE-141. DTSBS413 01549 MOVE LENGTH OF WRK-X141-REC TO WRK-LEN. DTSBS413 01550 MOVE EMPLOYER-TEMP-REC (1:WRK-LEN) TO X141-REC. DTSBS413 01551 WRITE X141-REC. DTSBS413 01552 IF X141-STATUS-OK-88 DTSBS413 01553 ADD +1 TO X141-CNT DTSBS413 01554 ELSE DTSBS413 01555 DISPLAY 'CANNOT WRITE X141 ' MPRF-EMP-NO DTSBS413 01556 SET WRK-ERROR-YES-88 TO TRUE DTSBS413 01557 END-IF. DTSBS413 01558 DTSBS413 01559 P1010I-EXIT. DTSBS413 01560 EXIT. DTSBS413 01561 DTSBS413 01562 P1010J-WRITE-131. DTSBS413 01563 MOVE LENGTH OF WRK-X131-REC TO WRK-LEN. DTSBS413 01564 MOVE EMPLOYER-TEMP-REC (1:WRK-LEN) TO X131-REC. DTSBS413 01565 WRITE X131-REC. DTSBS413 01566 IF X131-STATUS-OK-88 DTSBS413 01567 ADD +1 TO X131-CNT DTSBS413 01568 ELSE DTSBS413 01569 DISPLAY 'CANNOT WRITE X131 ' MPRF-EMP-NO DTSBS413 01570 SET WRK-ERROR-YES-88 TO TRUE DTSBS413 01571 END-IF. DTSBS413 01572 DTSBS413 01573 P1010J-EXIT. DTSBS413 01574 EXIT. DTSBS413 01575 DTSBS413 01576 P1010K-WRITE-142. CL**2 01577 MOVE LENGTH OF WRK-X142-REC TO WRK-LEN. CL**2 01578 MOVE EMPLOYER-TEMP-REC (1:WRK-LEN) TO X142-REC. CL**2 01579 WRITE X142-REC. CL**2 01580 IF X142-STATUS-OK-88 CL**2 01581 ADD +1 TO X142-CNT CL**2 01582 ELSE CL**2 01583 DISPLAY 'CANNOT WRITE X142 ' MPRF-EMP-NO CL**2 01584 SET WRK-ERROR-YES-88 TO TRUE CL**2 01585 END-IF. CL**2 01586 CL**2 01587 P1010K-EXIT. CL**2 01588 EXIT. CL**2 01589 DTSBS413 01590 P1100-SELECT-EMP. DTSBS413 01591 CL*27 01592 IF MPRF-SUSPEND-COLL-YES-88 DTSBS413 01593 OR MPRF-WRITE-OFF-DATE > ZERO DTSBS413 01594 SET WRK-SELECT-EMP-NO-88 TO TRUE DTSBS413 01595 GO TO P1100-EXIT DTSBS413 01596 END-IF. DTSBS413 01597 CL*27 01598 IF MPRF-STATUS-INACT-88 DTSBS413 01599 PERFORM P1110-INACT-DATES THRU P1110-EXIT DTSBS413 01600 IF MPRF-TOT-BALANCE-AMT = ZERO CL*49 01601 AND WRK-LAST-LIAB-YRQ < 20101 CL*49 01602 SET WRK-SELECT-EMP-NO-88 TO TRUE CL*49 01603 GO TO P1100-EXIT CL*49 01604 END-IF CL*49 01605 IF WRK-LAST-LIAB-YRQ > 20094 CL*45 01606 IF MPRF-TOT-CREDIT-AMT > ZERO CL*27 01607 OR MPRF-PURSUED-RPT-CNT > ZERO DTSBS413 01608 OR WRK-INACT-DATE >= 020100101 CL*40 01609 SET WRK-SELECT-EMP-ALL-88 TO TRUE DTSBS413 01610 ELSE CL139 01611 SET WRK-SELECT-EMP-NO-88 TO TRUE CL139 01612 END-IF CL139 01613 END-IF. DTSBS413 01614 DTSBS413 01615 IF (MPRF-STATUS-NEVERSUB-88 CL*33 01616 OR MPRF-STATUS-UNK-88) CL*33 01617 AND MPRF-FEIN > ZERO CL*33 01618 PERFORM P1120-NOT-SUBJECT THRU P1120-EXIT CL*33 01619 IF WRK-SUBJ-EMP-NO-88 CL*33 01620 SET WRK-SELECT-EMP-NO-88 TO TRUE CL*35 01621 END-IF CL*33 01622 END-IF. CL*33 01623 DTSBS413 01624 P1100-EXIT. DTSBS413 01625 EXIT. DTSBS413 01626 DTSBS413 01627 P1110-INACT-DATES. DTSBS413 01628 * DISPLAY 'INACT - 1 ' MPRF-EMP-NO ' ' WRK-LIAB-DATE. DTSBS413 01629 MOVE LOW-VALUES TO MSOL-REC. DTSBS413 01630 MOVE MPRF-EMP-NO TO MSOL-EMP-NO. DTSBS413 01631 SET MSOL-SOL-88 TO TRUE. DTSBS413 01632 MOVE MSOL-KEY-AREA TO MSKL-KEY-AREA. DTSBS413 01633 PERFORM S910C-START-BROWSE THRU S910C-EXIT. DTSBS413 01634 DTSBS413 01635 PERFORM UNTIL L910-NO-REC-88 DTSBS413 01636 MOVE MSKL-REC TO MSOL-REC DTSBS413 01637 IF NOT MSOL-INACT-WITHDRAWN-88 DTSBS413 01638 IF MSOL-INACT-INACTIVE-88 DTSBS413 01639 IF MSOL-LAST-LIAB-YRQ > WRK-LAST-LIAB-YRQ DTSBS413 01640 MOVE MSOL-LAST-LIAB-YRQ TO DTSBS413 01641 WRK-LAST-LIAB-YRQ DTSBS413 01642 MOVE MSOL-INACT-DATE TO WRK-INACT-DATE DTSBS413 01643 MOVE MSOL-INACT-ENTER-DATE TO DTSBS413 01644 WRK-INACT-ENTR-DATE DTSBS413 01645 END-IF DTSBS413 01646 END-IF DTSBS413 01647 END-IF DTSBS413 01648 PERFORM S910D-READ-NEXT THRU S910D-EXIT DTSBS413 01649 END-PERFORM. DTSBS413 01650 DTSBS413 01651 P1110-EXIT. DTSBS413 01652 EXIT. DTSBS413 01653 DTSBS413 01654 P1120-NOT-SUBJECT. DTSBS413 01655 MOVE MPRF-EMP-NO TO WRK-HOLD-EMP-NO. DTSBS413 01656 SET WRK-SUBJ-EMP-NO-88 TO TRUE. DTSBS413 01657 DTSBS413 01658 MOVE LOW-VALUE TO IEIN-KEY-AREA. DTSBS413 01659 SET IEIN-EIN-88 TO TRUE DTSBS413 01660 MOVE MPRF-FEIN TO IEIN-FEIN DTSBS413 01661 MOVE +0 TO IEIN-EMP-NO DTSBS413 01662 MOVE IEIN-KEY-AREA TO ISKL-KEY-AREA DTSBS413 01663 PERFORM S921C-START-BROWSE THRU S921C-EXIT DTSBS413 01664 MOVE ISKL-REC TO IEIN-REC DTSBS413 01665 PERFORM DTSBS413 01666 UNTIL L921-NO-REC-88 DTSBS413 01667 OR WRK-SUBJ-EMP-YES-88 DTSBS413 01668 IF IEIN-FEIN = MPRF-FEIN DTSBS413 01669 PERFORM P1121-FIND-MPRF THRU P1121-EXIT DTSBS413 01670 IF WRK-SUBJ-EMP-NO-88 DTSBS413 01671 PERFORM S921D-READ-NEXT THRU S921D-EXIT DTSBS413 01672 MOVE ISKL-REC TO IEIN-REC DTSBS413 01673 END-IF DTSBS413 01674 ELSE DTSBS413 01675 SET L921-NO-REC-88 TO TRUE DTSBS413 01676 END-IF DTSBS413 01677 END-PERFORM. DTSBS413 01678 DTSBS413 01679 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBS413 01680 MOVE WRK-HOLD-EMP-NO TO MSKL-EMP-NO. DTSBS413 01681 SET MSKL-PRF-88 TO TRUE. DTSBS413 01682 DTSBS413 01683 PERFORM S910C-START-BROWSE THRU S910C-EXIT. DTSBS413 01684 DTSBS413 01685 P1120-EXIT. DTSBS413 01686 EXIT. DTSBS413 01687 DTSBS413 01688 P1121-FIND-MPRF. DTSBS413 01689 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBS413 01690 MOVE IEIN-EMP-NO TO MSKL-EMP-NO. DTSBS413 01691 SET MSKL-PRF-88 TO TRUE. DTSBS413 01692 DTSBS413 01693 PERFORM S910B-READ THRU S910B-EXIT. DTSBS413 01694 IF L910-OK-88 DTSBS413 01695 MOVE MSKL-REC TO MPRF-REC DTSBS413 01696 IF MPRF-STATUS-SUB-88 DTSBS413 01697 SET WRK-SUBJ-EMP-YES-88 TO TRUE DTSBS413 01698 END-IF DTSBS413 01699 END-IF. DTSBS413 01700 DTSBS413 01701 P1121-EXIT. DTSBS413 01702 EXIT. DTSBS413 01703 DTSBS413 01704 DTSBS413 01705 P2000-PROFILE. DTSBS413 01706 PERFORM P2010-MERA THRU P2010-EXIT. DTSBS413 01707 DTSBS413 01708 MOVE MPRF-EMP-NO TO X102-EMP-NO. DTSBS413 01709 MOVE MPRF-FEIN TO X102-EMP-FEIN. DTSBS413 01710 MOVE MPRF-EMP-CLASS TO X102-EMP-CLASS. DTSBS413 01711 MOVE MPRF-EMP-STATUS TO X102-EMP-STATUS. DTSBS413 01712 MOVE WRK-SOURCE-CD TO X102-SOURCE-CD. DTSBS413 01713 SET X102-ACTION-INSERT-88 TO TRUE. DTSBS413 01714 DTSBS413 01715 *& DISPLAY 'P2000 ' X102-EMP-NO. DTSBS413 01716 WRITE EMPLOYER-TEMP-REC FROM WRK-X102-REC. DTSBS413 01717 IF TEMP-STATUS-OK-88 DTSBS413 01718 ADD +1 TO TEMP-CNT DTSBS413 01719 ELSE DTSBS413 01720 DISPLAY 'CANNOT WRITE X102 TEMP ' MPRF-EMP-NO DTSBS413 01721 SET WRK-ERROR-YES-88 TO TRUE DTSBS413 01722 END-IF. DTSBS413 01723 DTSBS413 01724 P2000-EXIT. DTSBS413 01725 EXIT. DTSBS413 01726 DTSBS413 01727 P2010-MERA. DTSBS413 01728 MOVE LOW-VALUES TO MERA-REC. DTSBS413 01729 MOVE MPRF-EMP-NO TO MERA-EMP-NO. DTSBS413 01730 SET MERA-ERA-88 TO TRUE. DTSBS413 01731 MOVE MERA-KEY-AREA TO MSKL-KEY-AREA. DTSBS413 01732 PERFORM S910B-READ THRU S910B-EXIT. DTSBS413 01733 IF L910-OK-88 DTSBS413 01734 MOVE MSKL-REC TO MERA-REC DTSBS413 01735 IF MERA-SOURCE-OTH-88 DTSBS413 01736 OR MERA-SOURCE-UNK-88 DTSBS413 01737 OR MERA-SOURCE-CD = LOW-VALUES DTSBS413 01738 OR MERA-SOURCE-CD = SPACES DTSBS413 01739 MOVE '03' TO MERA-SOURCE-CD DTSBS413 01740 END-IF DTSBS413 01741 MOVE MERA-SOURCE-CD TO WRK-SOURCE-CD DTSBS413 01742 ELSE DTSBS413 01743 MOVE '03' TO WRK-SOURCE-CD DTSBS413 01744 END-IF. DTSBS413 01745 DTSBS413 01746 P2010-EXIT. DTSBS413 01747 EXIT. DTSBS413 01748 DTSBS413 01749 P2100-NAMES. DTSBS413 01750 IF MPRF-PRIMARY-IS-ENTITY-88 DTSBS413 01751 SET X106-NAME-TYPE-ENTITY-88 TO TRUE DTSBS413 01752 MOVE MPRF-PRIMARY-NAME TO X106-EMP-NAME DTSBS413 01753 PERFORM P2190-WRITE-X106 THRU P2190-EXIT DTSBS413 01754 ELSE DTSBS413 01755 IF MPRF-ENTITY-NAME > SPACES DTSBS413 01756 SET X106-NAME-TYPE-ENTITY-88 TO TRUE DTSBS413 01757 MOVE MPRF-ENTITY-NAME TO X106-EMP-NAME DTSBS413 01758 PERFORM P2190-WRITE-X106 THRU P2190-EXIT DTSBS413 01759 ELSE DTSBS413 01760 SET X106-NAME-TYPE-TRADE-88 TO TRUE DTSBS413 01761 MOVE MPRF-PRIMARY-NAME TO X106-EMP-NAME DTSBS413 01762 PERFORM P2190-WRITE-X106 THRU P2190-EXIT DTSBS413 01763 END-IF DTSBS413 01764 END-IF. DTSBS413 01765 DTSBS413 01766 *** PERFORM P2110-ALT-NAMES THRU P2110-EXIT. DTSBS413 01767 DTSBS413 01768 P2100-EXIT. DTSBS413 01769 EXIT. DTSBS413 01770 DTSBS413 01771 P2110-ALT-NAMES. DTSBS413 01772 MOVE LOW-VALUES TO MTAA-REC. DTSBS413 01773 MOVE MPRF-EMP-NO TO MTAA-EMP-NO. DTSBS413 01774 SET MTAA-TAA-88 TO TRUE. DTSBS413 01775 MOVE MTAA-KEY-AREA TO MSKL-KEY-AREA. DTSBS413 01776 PERFORM S910C-START-BROWSE THRU S910C-EXIT. DTSBS413 01777 PERFORM DTSBS413 01778 UNTIL L910-NO-REC-88 DTSBS413 01779 MOVE MSKL-REC TO MTAA-REC DTSBS413 01780 IF MTAA-NAME > SPACES DTSBS413 01781 SET X106-NAME-TYPE-TRADE-88 TO TRUE DTSBS413 01782 MOVE MTAA-NAME TO X106-EMP-NAME DTSBS413 01783 PERFORM P2190-WRITE-X106 THRU P2190-EXIT DTSBS413 01784 END-IF DTSBS413 01785 PERFORM S910D-READ-NEXT THRU S910D-EXIT DTSBS413 01786 END-PERFORM. DTSBS413 01787 DTSBS413 01788 P2110-EXIT. DTSBS413 01789 EXIT. DTSBS413 01790 DTSBS413 01791 P2190-WRITE-X106. DTSBS413 01792 MOVE MPRF-EMP-NO TO X106-EMP-NO. DTSBS413 01793 INSPECT X106-EMP-NAME REPLACING ALL ',' BY SPACE. DTSBS413 01794 DTSBS413 01795 WRITE EMPLOYER-TEMP-REC FROM WRK-X106-REC. DTSBS413 01796 IF TEMP-STATUS-OK-88 DTSBS413 01797 ADD +1 TO TEMP-CNT DTSBS413 01798 ELSE DTSBS413 01799 DISPLAY 'CANNOT WRITE TEMP X106 ' MPRF-EMP-NO DTSBS413 01800 SET WRK-ERROR-YES-88 TO TRUE DTSBS413 01801 END-IF. DTSBS413 01802 DTSBS413 01803 P2190-EXIT. DTSBS413 01804 EXIT. DTSBS413 01805 DTSBS413 01806 P2300-EMP-ADDR. DTSBS413 01807 PERFORM P2310-MTAD THRU P2310-EXIT. DTSBS413 01808 *** PERFORM P2320-MTAA THRU P2320-EXIT. DTSBS413 01809 P2300-EXIT. DTSBS413 01810 EXIT. DTSBS413 01811 DTSBS413 01812 P2310-MTAD. DTSBS413 01813 MOVE LOW-VALUES TO MTAD-KEY-AREA. DTSBS413 01814 MOVE MPRF-EMP-NO TO MTAD-EMP-NO. DTSBS413 01815 SET MTAD-TAD-88 TO TRUE. DTSBS413 01816 SET MTAD-ID-TAX-MAILING-ADDR-88 TO TRUE. DTSBS413 01817 DTSBS413 01818 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. DTSBS413 01819 DTSBS413 01820 PERFORM S910B-READ THRU S910B-EXIT. DTSBS413 01821 DTSBS413 01822 IF L910-NO-REC-88 DTSBS413 01823 GO TO P2310-EXIT DTSBS413 01824 ELSE DTSBS413 01825 MOVE MSKL-REC TO MTAD-REC DTSBS413 01826 MOVE MTAD-ADDRESS TO WRK-ADDRESS DTSBS413 01827 SET X110-ADDR-TYPE-MAIL-88 TO TRUE DTSBS413 01828 MOVE MTAD-VOICE-1 TO WRK-PHONE DTSBS413 01829 MOVE MTAD-FAX TO WRK-FAX DTSBS413 01830 MOVE MTAD-EMAIL-ADDRESS TO WRK-EMAIL DTSBS413 01831 PERFORM P2390-WRITE-X110 THRU P2390-EXIT DTSBS413 01832 END-IF. DTSBS413 01833 DTSBS413 01834 DTSBS413 01835 P2310-EXIT. DTSBS413 01836 EXIT. DTSBS413 01837 DTSBS413 01838 DTSBS413 01839 P2390-WRITE-X110. DTSBS413 01840 MOVE MPRF-EMP-NO TO X110-EMP-NO. DTSBS413 01841 MOVE WRK-ATTN-LINE TO X110-ATTENTION. DTSBS413 01842 MOVE WRK-DELIV-LINE-1 TO X110-STREET-1. DTSBS413 01843 MOVE WRK-DELIV-LINE-2 TO X110-STREET-2. DTSBS413 01844 MOVE WRK-CITY TO X110-CITY. DTSBS413 01845 MOVE WRK-ST TO X110-STATE. DTSBS413 01846 MOVE WRK-ZIP TO X110-ZIP. DTSBS413 01847 MOVE WRK-PHONE TO X110-PHONE. DTSBS413 01848 MOVE WRK-FAX TO X110-FAX. DTSBS413 01849 IF WRK-EMAIL = LOW-VALUES DTSBS413 01850 MOVE SPACES TO X110-EMAIL DTSBS413 01851 ELSE DTSBS413 01852 MOVE WRK-EMAIL TO X110-EMAIL DTSBS413 01853 END-IF. DTSBS413 01854 DTSBS413 01855 INSPECT X110-ATTENTION REPLACING ALL ',' BY SPACE. DTSBS413 01856 INSPECT X110-STREET-1 REPLACING ALL ',' BY SPACE. DTSBS413 01857 INSPECT X110-STREET-2 REPLACING ALL ',' BY SPACE. DTSBS413 01858 INSPECT X110-EMAIL REPLACING ALL ',' BY SPACE. DTSBS413 01859 DTSBS413 01860 WRITE EMPLOYER-TEMP-REC FROM WRK-X110-REC DTSBS413 01861 IF TEMP-STATUS-OK-88 DTSBS413 01862 ADD +1 TO TEMP-CNT DTSBS413 01863 ELSE DTSBS413 01864 DISPLAY 'CANNOT WRITE TEMP X110 ' MPRF-EMP-NO DTSBS413 01865 SET WRK-ERROR-YES-88 TO TRUE DTSBS413 01866 END-IF. DTSBS413 01867 DTSBS413 01868 P2390-EXIT. DTSBS413 01869 EXIT. DTSBS413 01870 DTSBS413 01871 P2500-OPO. DTSBS413 01872 IF MSOL-LIAB-RATED-DOMESTIC-88 DTSBS413 01873 GO TO P2500-EXIT DTSBS413 01874 END-IF. DTSBS413 01875 DTSBS413 01876 MOVE LOW-VALUES TO MOPO-KEY-AREA. DTSBS413 01877 MOVE MPRF-EMP-NO TO MOPO-EMP-NO. DTSBS413 01878 SET MOPO-OPO-88 TO TRUE. DTSBS413 01879 MOVE MOPO-KEY-AREA TO MSKL-KEY-AREA. DTSBS413 01880 DTSBS413 01881 SET WRK-MOPO-FOUND-NO-88 TO TRUE. DTSBS413 01882 PERFORM S910C-START-BROWSE THRU S910C-EXIT. DTSBS413 01883 IF L910-NO-REC-88 DTSBS413 01884 NEXT SENTENCE DTSBS413 01885 ELSE DTSBS413 01886 PERFORM DTSBS413 01887 UNTIL L910-NO-REC-88 DTSBS413 01888 MOVE MSKL-REC TO MOPO-REC DTSBS413 01889 SET WRK-MOPO-FOUND-YES-88 TO TRUE CL137 01890 PERFORM P2510-PARSE-NAME THRU P2510-EXIT DTSBS413 01891 PERFORM P2590-WRITE-X120 THRU P2590-EXIT DTSBS413 01892 PERFORM S910D-READ-NEXT THRU S910D-EXIT DTSBS413 01893 END-PERFORM DTSBS413 01894 END-IF. DTSBS413 01895 DTSBS413 01896 DTSBS413 01897 P2500-EXIT. DTSBS413 01898 EXIT. DTSBS413 01899 DTSBS413 01900 P2510-PARSE-NAME. DTSBS413 01901 MOVE +0 TO FSUB DTSBS413 01902 LSUB. DTSBS413 01903 MOVE SPACES TO FIRST-NAME DTSBS413 01904 MIDDLE-INIT DTSBS413 01905 LAST-NAME. DTSBS413 01906 SET FIRST-NAME-COMPLETE-NO-88 TO TRUE. DTSBS413 01907 SET LAST-NAME-COMPLETE-NO-88 TO TRUE. DTSBS413 01908 SET MID-INIT-COMPLETE-NO-88 TO TRUE. DTSBS413 01909 DTSBS413 01910 MOVE MOPO-NAME TO SLASH-NAME. DTSBS413 01911 PERFORM DTSBS413 01912 VARYING NSUB FROM +1 BY +1 DTSBS413 01913 UNTIL NSUB > +40 DTSBS413 01914 OR MID-INIT-COMPLETE-YES-88 DTSBS413 01915 IF FIRST-NAME-COMPLETE-YES-88 DTSBS413 01916 PERFORM P2513-MID-INIT THRU P2513-EXIT DTSBS413 01917 ELSE DTSBS413 01918 IF LAST-NAME-COMPLETE-YES-88 DTSBS413 01919 PERFORM P2512-FIRST-NAME THRU P2512-EXIT DTSBS413 01920 ELSE DTSBS413 01921 PERFORM P2511-LAST-NAME THRU P2511-EXIT DTSBS413 01922 END-IF DTSBS413 01923 END-IF DTSBS413 01924 END-PERFORM. DTSBS413 01925 DTSBS413 01926 DTSBS413 01927 P2510-EXIT. DTSBS413 01928 EXIT. DTSBS413 01929 DTSBS413 01930 P2511-LAST-NAME. DTSBS413 01931 IF SLASH-NAME-CHAR (NSUB) = '/' DTSBS413 01932 SET LAST-NAME-COMPLETE-YES-88 TO TRUE DTSBS413 01933 GO TO P2511-EXIT DTSBS413 01934 ELSE DTSBS413 01935 IF LSUB < +40 DTSBS413 01936 ADD +1 TO LSUB DTSBS413 01937 MOVE SLASH-NAME-CHAR (NSUB) TO LAST-NAME (LSUB:1) DTSBS413 01938 END-IF DTSBS413 01939 END-IF. DTSBS413 01940 DTSBS413 01941 P2511-EXIT. DTSBS413 01942 EXIT. DTSBS413 01943 DTSBS413 01944 P2512-FIRST-NAME. DTSBS413 01945 IF SLASH-NAME-CHAR (NSUB) = SPACE DTSBS413 01946 SET FIRST-NAME-COMPLETE-YES-88 TO TRUE DTSBS413 01947 GO TO P2512-EXIT DTSBS413 01948 ELSE DTSBS413 01949 IF FSUB < +20 DTSBS413 01950 ADD +1 TO FSUB DTSBS413 01951 MOVE SLASH-NAME-CHAR (NSUB) TO FIRST-NAME (FSUB:1) DTSBS413 01952 END-IF DTSBS413 01953 END-IF. DTSBS413 01954 DTSBS413 01955 P2512-EXIT. DTSBS413 01956 EXIT. DTSBS413 01957 DTSBS413 01958 P2513-MID-INIT. DTSBS413 01959 IF MID-INIT-COMPLETE-NO-88 DTSBS413 01960 MOVE SLASH-NAME-CHAR (NSUB) TO MIDDLE-INIT (1:1) DTSBS413 01961 SET MID-INIT-COMPLETE-YES-88 TO TRUE DTSBS413 01962 END-IF. DTSBS413 01963 DTSBS413 01964 P2513-EXIT. DTSBS413 01965 EXIT. DTSBS413 01966 DTSBS413 01967 P2590-WRITE-X120. DTSBS413 01968 IF LAST-NAME = SPACES DTSBS413 01969 GO TO P2590-EXIT DTSBS413 01970 END-IF. DTSBS413 01971 DTSBS413 01972 MOVE MPRF-EMP-NO TO X120-EMP-NO. DTSBS413 01973 IF FIRST-NAME = SPACES DTSBS413 01974 MOVE LAST-NAME (1:20) TO X120-OPO-FIRST-NAME DTSBS413 01975 MOVE LAST-NAME (21:1) TO X120-OPO-MID-INIT DTSBS413 01976 MOVE LAST-NAME (22:19) TO X120-OPO-LAST-NAME DTSBS413 01977 ELSE DTSBS413 01978 MOVE FIRST-NAME (1:20) TO X120-OPO-FIRST-NAME DTSBS413 01979 MOVE MIDDLE-INIT TO X120-OPO-MID-INIT DTSBS413 01980 MOVE LAST-NAME (1:20) TO X120-OPO-LAST-NAME DTSBS413 01981 END-IF. DTSBS413 01982 MOVE SPACES TO X120-OPO-MEMBER-NAME. DTSBS413 01983 MOVE MOPO-SSN TO X120-OPO-SSN. DTSBS413 01984 MOVE MOPO-TITLE TO X120-OPO-TITLE. DTSBS413 01985 MOVE MOPO-TYPE-IND TO X120-TYPE-IND. DTSBS413 01986 IF MOPO-ATTN-LINE = LOW-VALUES DTSBS413 01987 MOVE SPACES TO X120-OPO-ATTENTION DTSBS413 01988 ELSE DTSBS413 01989 MOVE MOPO-ATTN-LINE TO X120-OPO-ATTENTION DTSBS413 01990 END-IF. DTSBS413 01991 MOVE MOPO-DELIV-LINE-1 TO X120-OPO-STREET-1. DTSBS413 01992 MOVE MOPO-DELIV-LINE-2 TO X120-OPO-STREET-2. DTSBS413 01993 MOVE MOPO-CITY TO X120-OPO-CITY. DTSBS413 01994 MOVE MOPO-ST TO X120-OPO-STATE. DTSBS413 01995 MOVE MOPO-ZIP TO X120-OPO-ZIP. DTSBS413 01996 MOVE MOPO-VOICE-1 TO X120-OPO-PHONE. DTSBS413 01997 MOVE MOPO-FAX TO X120-OPO-FAX. DTSBS413 01998 IF MOPO-EMAIL-ADDRESS = LOW-VALUES DTSBS413 01999 MOVE SPACES TO X120-OPO-EMAIL DTSBS413 02000 ELSE DTSBS413 02001 MOVE MOPO-EMAIL-ADDRESS TO X120-OPO-EMAIL DTSBS413 02002 END-IF. DTSBS413 02003 DTSBS413 02004 INSPECT X120-OPO-FIRST-NAME REPLACING ALL ',' BY SPACE. DTSBS413 02005 INSPECT X120-OPO-MID-INIT REPLACING ALL ',' BY SPACE. DTSBS413 02006 INSPECT X120-OPO-LAST-NAME REPLACING ALL ',' BY SPACE. DTSBS413 02007 INSPECT X120-OPO-TITLE REPLACING ALL ',' BY SPACE. DTSBS413 02008 INSPECT X120-OPO-ATTENTION REPLACING ALL ',' BY SPACE. DTSBS413 02009 INSPECT X120-OPO-STREET-1 REPLACING ALL ',' BY SPACE. DTSBS413 02010 INSPECT X120-OPO-STREET-2 REPLACING ALL ',' BY SPACE. DTSBS413 02011 INSPECT X120-OPO-EMAIL REPLACING ALL ',' BY SPACE. DTSBS413 02012 DTSBS413 02013 WRITE EMPLOYER-TEMP-REC FROM WRK-X120-REC DTSBS413 02014 IF TEMP-STATUS-OK-88 DTSBS413 02015 ADD +1 TO TEMP-CNT DTSBS413 02016 ELSE DTSBS413 02017 DISPLAY 'CANNOT WRITE TEMP X120 ' MPRF-EMP-NO DTSBS413 02018 SET WRK-ERROR-YES-88 TO TRUE DTSBS413 02019 END-IF. DTSBS413 02020 DTSBS413 02021 P2590-EXIT. DTSBS413 02022 EXIT. DTSBS413 02023 DTSBS413 02024 P3000-REL. DTSBS413 02025 MOVE LOW-VALUES TO MREL-KEY-AREA. DTSBS413 02026 MOVE MPRF-EMP-NO TO MREL-EMP-NO. DTSBS413 02027 SET MREL-REL-88 TO TRUE. DTSBS413 02028 MOVE MREL-KEY-AREA TO MSKL-KEY-AREA. DTSBS413 02029 DTSBS413 02030 PERFORM S910C-START-BROWSE THRU S910C-EXIT. DTSBS413 02031 IF L910-NO-REC-88 DTSBS413 02032 NEXT SENTENCE DTSBS413 02033 ELSE DTSBS413 02034 PERFORM DTSBS413 02035 UNTIL L910-NO-REC-88 DTSBS413 02036 MOVE MSKL-REC TO MREL-REC DTSBS413 02037 IF MREL-REL-REC-VOID-88 DTSBS413 02038 OR MREL-REL-REC-TRNSF-88 DTSBS413 02039 NEXT SENTENCE DTSBS413 02040 ELSE DTSBS413 02041 IF MREL-EXP-TRNSF-YES-88 DTSBS413 02042 PERFORM P3010-WRITE-X131 THRU P3010-EXIT DTSBS413 02043 END-IF DTSBS413 02044 END-IF DTSBS413 02045 PERFORM S910D-READ-NEXT THRU S910D-EXIT DTSBS413 02046 END-PERFORM DTSBS413 02047 END-IF. DTSBS413 02048 P3000-EXIT. DTSBS413 02049 EXIT. DTSBS413 02050 DTSBS413 02051 P3010-WRITE-X131. DTSBS413 02052 MOVE MPRF-EMP-NO TO X131-SUCC-EMP-NO. DTSBS413 02053 DTSBS413 02054 MOVE MREL-EFF-DATE TO L001-FED-8-DATE-9. DTSBS413 02055 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBS413 02056 MOVE L001-SLASH-8-DATE TO X131-EFF-DATE. DTSBS413 02057 DTSBS413 02058 MOVE MREL-PRED-EMP-NO TO X131-PRED-EMP-NO. DTSBS413 02059 DTSBS413 02060 WRITE EMPLOYER-TEMP-REC FROM WRK-X131-REC DTSBS413 02061 IF TEMP-STATUS-OK-88 DTSBS413 02062 ADD +1 TO TEMP-CNT DTSBS413 02063 ELSE DTSBS413 02064 DISPLAY 'CANNOT WRITE TEMP X131 ' MPRF-EMP-NO DTSBS413 02065 SET WRK-ERROR-YES-88 TO TRUE DTSBS413 02066 END-IF. DTSBS413 02067 DTSBS413 02068 P3010-EXIT. DTSBS413 02069 EXIT. DTSBS413 02070 DTSBS413 02071 DTSBS413 02072 P3200-DETERM. CL**2 02073 MOVE LOW-VALUES TO MSOL-REC. CL**2 02074 MOVE MPRF-EMP-NO TO MSOL-EMP-NO. CL**2 02075 SET MSOL-SOL-88 TO TRUE. CL**2 02076 MOVE MSOL-KEY-AREA TO MSKL-KEY-AREA. CL**2 02077 PERFORM S910C-START-BROWSE THRU S910C-EXIT. CL**2 02078 CL**2 02079 PERFORM CL**2 02080 UNTIL L910-NO-REC-88 CL**2 02081 MOVE MSKL-REC TO MSOL-REC CL**2 02082 IF NOT MSOL-INACT-WITHDRAWN-88 CL**2 02083 PERFORM P3210-BUILD-X104 THRU P3210-EXIT CL**2 02084 END-IF CL**2 02085 PERFORM S910D-READ-NEXT THRU S910D-EXIT CL**2 02086 END-PERFORM. CL**2 02087 CL**2 02088 P3200-EXIT. CL**2 02089 EXIT. CL**2 02090 CL**2 02091 P3210-BUILD-X104. CL**2 02092 MOVE MPRF-EMP-NO TO X104-EMP-NO. CL**2 02093 CL**2 02094 SET X104-STAFF-REVIEW-NO-88 TO TRUE. CL**2 02095 CL**2 02096 EVALUATE TRUE CL**2 02097 WHEN MSOL-LIAB-RATED-REG-88 CL**2 02098 SET X104-ELIG-RATED-88 TO TRUE CL**2 02099 CL**2 02100 WHEN MSOL-LIAB-RATED-SUCC-88 CL**2 02101 OR MSOL-LIAB-RATED-FUTA-88 CL**2 02102 OR MSOL-LIAB-RATED-VOLUNT-88 CL**2 02103 OR MSOL-LIAB-RATED-OTH-88 CL**2 02104 OR MSOL-LIAB-RATED-CONV-88 CL**2 02105 OR MSOL-LIAB-RATED-UNK-88 CL**2 02106 SET MSOL-LIAB-RATED-REG-88 TO TRUE CL**2 02107 SET X104-ELIG-RATED-88 TO TRUE CL**2 02108 CL**2 02109 WHEN MSOL-LIAB-RATED-DOMESTIC-88 CL**2 02110 SET X104-ELIG-RATED-88 TO TRUE CL**2 02111 CL**2 02112 WHEN MSOL-LIAB-SELF-INS-OTH-88 CL**2 02113 OR MSOL-LIAB-SELF-INS-CONV-88 CL**2 02114 OR MSOL-LIAB-SELF-INS-UNK-88 CL**2 02115 OR MSOL-LIAB-SELF-INS-VOLUNT-88 CL**2 02116 SET MSOL-LIAB-SELF-INS-NON-PROF-88 TO TRUE CL**2 02117 SET X104-ELIG-SELF-INS-88 TO TRUE CL**2 02118 CL**2 02119 WHEN MSOL-LIAB-SELF-INS-NON-PROF-88 CL**2 02120 OR MSOL-LIAB-SELF-INS-SCHOOL-88 CL**2 02121 OR MSOL-LIAB-SELF-INS-CITY-88 CL**2 02122 OR MSOL-LIAB-SELF-INS-COUNTY-88 CL**2 02123 OR MSOL-LIAB-SELF-INS-STATE-88 CL**2 02124 OR MSOL-LIAB-SELF-INS-CHURCH-88 CL**2 02125 SET X104-ELIG-SELF-INS-88 TO TRUE CL**2 02126 END-EVALUATE. CL**2 02127 CL**2 02128 MOVE MSOL-LIAB-CD TO X104-LIAB-CD. CL**2 02129 CL**2 02130 MOVE MPRF-NAICS-CD TO X104-NAICS-CD. CL**2 02131 CL**2 02132 IF X104-ELIG-SELF-INS-88 CL**2 02133 IF NOT MPRF-ORG-CORPORATION-88 CL**2 02134 DISPLAY 'P3210 SI/ORG INCONSISTENT ' MPRF-EMP-NO CL**2 02135 SET MPRF-ORG-CORPORATION-88 TO TRUE CL**2 02136 END-IF CL**2 02137 END-IF. CL**2 02138 CL**2 02139 MOVE MPRF-ORG-TYPE TO X104-ORG-TYPE. CL**2 02140 CL**2 02141 IF MSOL-LIAB-RATED-DOMESTIC-88 CL**2 02142 PERFORM P3211-FILE-SCHED THRU P3211-EXIT CL**2 02143 ELSE CL**2 02144 MOVE SPACES TO X104-HOUSEHOLD-FILING CL**2 02145 END-IF. CL**2 02146 CL**2 02147 MOVE SPACES TO X104-INCORP-STATE CL**2 02148 X104-INCORP-DATE. CL**2 02149 CL**2 02150 IF MSOL-LIAB-RATED-DOMESTIC-88 CL**2 02151 MOVE SPACES TO X104-FIRST-WAGE-DT CL**2 02152 MOVE MSOL-FIRST-LIAB-YRQ TO L004-QTR-5-9 CL**2 02153 PERFORM S004-FROM-5 THRU S004-EXIT CL**2 02154 MOVE L004-SLASH-5-QTR TO X104-FIRST-500-QTR CL**2 02155 ELSE CL**2 02156 MOVE SPACES TO X104-FIRST-500-QTR CL**2 02157 MOVE MSOL-LIAB-DATE TO L001-FED-8-DATE-9 CL**2 02158 PERFORM S001-FROM-FED-8 THRU S001-EXIT CL**2 02159 MOVE L001-SLASH-8-DATE TO X104-FIRST-WAGE-DT CL**2 02160 END-IF. CL**2 02161 CL**2 02162 MOVE WRK-ACQUIRED-IND TO X104-ACQUIRE-IND. CL**2 02163 MOVE WRK-MERGER-SPLIT-IND TO X104-MERGER-SPLIT-IND. CL**2 02164 MOVE WRK-REORG-IND TO X104-REORG-IND. CL**2 02165 SET X104-COMMON-OWN-NO-88 TO TRUE. CL**2 02166 SET X104-SALE-TRANSFER-NO-88 TO TRUE. CL**2 02167 SET X104-NOT-LIAB-NULL-88 TO TRUE. CL**2 02168 CL**2 02169 WRITE EMPLOYER-TEMP-REC FROM WRK-X104-REC. CL**2 02170 IF TEMP-STATUS-OK-88 CL**2 02171 ADD +1 TO TEMP-CNT CL**2 02172 ELSE CL**2 02173 DISPLAY 'CANNOT WRITE TEMP X104 ' MPRF-EMP-NO CL**2 02174 SET WRK-ERROR-YES-88 TO TRUE CL**2 02175 END-IF. CL**2 02176 CL**2 02177 P3210-EXIT. CL**2 02178 EXIT. CL**2 02179 CL**2 02180 P3211-FILE-SCHED. CL**2 02181 SET L410-MODE-INPUT-YRQ-88 TO TRUE CL**2 02182 MOVE MPRF-EMP-NO TO L410-EMP-NO CL**2 02183 MOVE WRK-CURR-QTR TO L410-YRQ CL**2 02184 PERFORM S410-FILE-SCHED THRU S410-EXIT CL**2 02185 IF L410-ANN-SCHED-88 CL**2 02186 SET X104-HH-ANNUAL-88 TO TRUE CL**2 02187 ELSE CL**2 02188 SET X104-HH-QUARTERLY-88 TO TRUE CL**2 02189 END-IF. CL**2 02190 CL**2 02191 P3211-EXIT. CL**2 02192 EXIT. CL**2 02193 DTSBS413 02194 P3400-RATE. DTSBS413 02195 IF NOT MPRF-CLASS-RATED-88 DTSBS413 02196 GO TO P3400-EXIT DTSBS413 02197 END-IF. DTSBS413 02198 DTSBS413 02199 MOVE LOW-VALUES TO MRTE-KEY-AREA. DTSBS413 02200 MOVE MPRF-EMP-NO TO MRTE-EMP-NO. DTSBS413 02201 MOVE WRK-RATE-YRQ-3 TO MRTE-EFF-YRQ. CL*30 02202 SET MRTE-RTE-88 TO TRUE. DTSBS413 02203 MOVE MRTE-KEY-AREA TO MSKL-KEY-AREA. DTSBS413 02204 DTSBS413 02205 PERFORM S910C-START-BROWSE THRU S910C-EXIT. DTSBS413 02206 IF L910-NO-REC-88 DTSBS413 02207 DISPLAY 'P3400 RATE MISSING ' MPRF-EMP-NO DTSBS413 02208 SET WRK-SELECT-EMP-NO-88 TO TRUE DTSBS413 02209 ELSE DTSBS413 02210 PERFORM DTSBS413 02211 UNTIL L910-NO-REC-88 DTSBS413 02212 MOVE MSKL-REC TO MRTE-REC DTSBS413 02213 PERFORM P3410-WRITE-X108 THRU P3410-EXIT DTSBS413 02214 PERFORM S910D-READ-NEXT THRU S910D-EXIT CL*26 02215 END-PERFORM DTSBS413 02216 END-IF. DTSBS413 02217 DTSBS413 02218 P3400-EXIT. DTSBS413 02219 EXIT. DTSBS413 02220 DTSBS413 02221 P3410-WRITE-X108. DTSBS413 02222 MOVE MPRF-EMP-NO TO X108-EMP-NO. DTSBS413 02223 DTSBS413 02224 MOVE MRTE-EFF-YRQ TO L004-QTR-5-9. DTSBS413 02225 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBS413 02226 MOVE L004-SLASH-5-QTR TO X108-RATE-YEAR. DTSBS413 02227 DTSBS413 02228 COMPUTE MRTE-UI-RATE = (MRTE-UI-RATE * 100). DTSBS413 02229 MOVE MRTE-UI-RATE TO X108-RATE. DTSBS413 02230 DTSBS413 02231 WRITE EMPLOYER-TEMP-REC FROM WRK-X108-REC. DTSBS413 02232 IF TEMP-STATUS-OK-88 DTSBS413 02233 ADD +1 TO TEMP-CNT DTSBS413 02234 ELSE DTSBS413 02235 DISPLAY 'CANNOT WRITE TEMP X108 ' MPRF-EMP-NO DTSBS413 02236 SET WRK-ERROR-YES-88 TO TRUE DTSBS413 02237 END-IF. DTSBS413 02238 DTSBS413 02239 P3410-EXIT. DTSBS413 02240 EXIT. DTSBS413 02241 DTSBS413 02242 P3600-REPORT. DTSBS413 02243 MOVE LOW-VALUES TO MRPT-KEY-AREA. DTSBS413 02244 MOVE MPRF-EMP-NO TO MRPT-EMP-NO. DTSBS413 02245 SET MRPT-RPT-88 TO TRUE. DTSBS413 02246 MOVE MRPT-KEY-AREA TO MSKL-KEY-AREA. DTSBS413 02247 DTSBS413 02248 PERFORM S910C-START-BROWSE THRU S910C-EXIT. DTSBS413 02249 PERFORM UNTIL L910-NO-REC-88 DTSBS413 02250 MOVE MSKL-REC TO MRPT-REC DTSBS413 02251 IF NOT MRPT-ESTIM-88 DTSBS413 02252 PERFORM P3620-RECENT-REPORT THRU P3620-EXIT DTSBS413 02253 END-IF DTSBS413 02254 PERFORM S910D-READ-NEXT THRU S910D-EXIT DTSBS413 02255 END-PERFORM. DTSBS413 02256 DTSBS413 02257 PERFORM P3630-LAST-REPORT THRU P3630-EXIT. DTSBS413 02258 DTSBS413 02259 P3600-EXIT. DTSBS413 02260 EXIT. DTSBS413 02261 CL**2 02262 P3610-WRITE-X140. CL**2 02263 MOVE MPRF-EMP-NO TO X140-EMP-NO. CL**2 02264 CL**2 02265 MOVE MRPT-YRQ TO L004-QTR-5-9. CL**2 02266 PERFORM S004-FROM-5 THRU S004-EXIT. CL**2 02267 MOVE L004-SLASH-5-QTR TO X140-QUARTER. CL**2 02268 MOVE MRPT-RPT-TYPE TO X140-REPORT-TYPE. CL*10 02269 MOVE MRPT-TOT-WAGE TO X140-TOTAL-WAGES. CL**2 02270 MOVE MRPT-TAX-WAGE TO X140-TAX-WAGES. CL**2 02271 MOVE MRPT-REMIT-AMT TO X140-REMITTANCE. CL**2 02272 MOVE MRPT-RECEIVED-DATE TO L001-FED-8-DATE-9. CL**2 02273 PERFORM S001-FROM-FED-8 THRU S001-EXIT. CL**2 02274 MOVE L001-SLASH-8-DATE TO X140-RCVD-DATE. CL**2 02275 MOVE MRPT-1ST-MTH-EMPL-CNT TO X140-WRKR-CNT-1ST-MNTH. CL**2 02276 MOVE MRPT-2ND-MTH-EMPL-CNT TO X140-WRKR-CNT-2ND-MNTH. CL**2 02277 MOVE MRPT-3RD-MTH-EMPL-CNT TO X140-WRKR-CNT-3RD-MNTH. CL**2 02278 CL**2 02279 WRITE EMPLOYER-TEMP-REC FROM WRK-X140-REC. CL**2 02280 IF TEMP-STATUS-OK-88 CL**2 02281 ADD +1 TO TEMP-CNT CL**2 02282 ELSE CL**2 02283 DISPLAY 'CANNOT WRITE TEMP X140 ' MPRF-EMP-NO CL**2 02284 SET WRK-ERROR-YES-88 TO TRUE CL**2 02285 END-IF. CL**2 02286 CL**2 02287 P3610-EXIT. CL**2 02288 EXIT. CL**2 02289 DTSBS413 02290 P3620-RECENT-REPORT. DTSBS413 02291 MOVE MRPT-YRQ TO L004-QTR-5-9. DTSBS413 02292 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBS413 02293 MOVE L004-ABS-QTR TO RSUB. DTSBS413 02294 DTSBS413 02295 IF MRPT-ESTB-DATE > RPT-PROCESS-DATE (RSUB) DTSBS413 02296 MOVE MRPT-YRQ TO RPT-YRQ (RSUB) DTSBS413 02297 MOVE MRPT-RPT-TYPE TO RPT-TYPE (RSUB) DTSBS413 02298 MOVE MRPT-RECEIVED-DATE TO RPT-RCVD-DATE (RSUB) DTSBS413 02299 MOVE MRPT-ESTB-DATE TO RPT-PROCESS-DATE (RSUB) DTSBS413 02300 END-IF. DTSBS413 02301 DTSBS413 02302 P3620-EXIT. DTSBS413 02303 EXIT. DTSBS413 02304 DTSBS413 02305 P3630-LAST-REPORT. DTSBS413 02306 PERFORM DTSBS413 02307 VARYING RSUB FROM +1 BY +1 DTSBS413 02308 UNTIL RSUB > RPT-MAX DTSBS413 02309 IF RPT-PROCESS-DATE (RSUB) > MAX-RPT-DATE DTSBS413 02310 IF RPT-TYPE (RSUB) NOT = 'WD' DTSBS413 02311 MOVE RPT-YRQ (RSUB) TO MAX-RPT-YRQ DTSBS413 02312 MOVE RPT-PROCESS-DATE (RSUB) TO MAX-RPT-DATE DTSBS413 02313 MOVE RPT-TYPE (RSUB) TO MAX-RPT-TYPE DTSBS413 02314 END-IF DTSBS413 02315 END-IF DTSBS413 02316 END-PERFORM. DTSBS413 02317 DTSBS413 02318 IF MAX-RPT-DATE NOT = ZERO DTSBS413 02319 MOVE MPRF-EMP-NO TO X142-EMP-NO DTSBS413 02320 MOVE MAX-RPT-YRQ TO L004-QTR-5-9 DTSBS413 02321 MOVE L004-QTR-5-YR TO X142-REPORT-YEAR DTSBS413 02322 MOVE L004-QTR-5-Q TO X142-REPORT-QTR DTSBS413 02323 MOVE MAX-RPT-DATE TO L001-FED-8-DATE-9 DTSBS413 02324 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBS413 02325 MOVE L001-SLASH-8-DATE TO X142-REPORT-DATE DTSBS413 02326 IF MAX-RPT-TYPE = 'OR' DTSBS413 02327 SET X142-RPT-TYPE-ORIG-88 TO TRUE DTSBS413 02328 ELSE DTSBS413 02329 SET X142-RPT-TYPE-AMND-88 TO TRUE DTSBS413 02330 END-IF DTSBS413 02331 END-IF. DTSBS413 02332 DTSBS413 02333 P3630-EXIT. DTSBS413 02334 EXIT. DTSBS413 02335 DTSBS413 02336 P3700-QTRS-DUE. DTSBS413 02337 SET WRK-CURR-QTR-NO-88 TO TRUE. DTSBS413 02338 SET WRK-PRIOR-QTR-NO-88 TO TRUE. DTSBS413 02339 DTSBS413 02340 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSBS413 02341 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBS413 02342 SET MQTR-QTR-88 TO TRUE. DTSBS413 02343 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBS413 02344 DTSBS413 02345 PERFORM S910C-START-BROWSE THRU S910C-EXIT. DTSBS413 02346 PERFORM UNTIL L910-NO-REC-88 DTSBS413 02347 MOVE MSKL-REC TO MQTR-REC DTSBS413 02348 IF MQTR-YRQ > WRK-CURR-QTR-MINUS-8 DTSBS413 02349 IF MPRF-ORG-HSEHLD-DMSTIC-88 DTSBS413 02350 PERFORM P3705-HOUSEHOLD THRU P3705-EXIT DTSBS413 02351 ELSE DTSBS413 02352 PERFORM P3710-WRITE-X141 THRU P3710-EXIT DTSBS413 02353 END-IF DTSBS413 02354 END-IF DTSBS413 02355 IF L910-OK-88 DTSBS413 02356 PERFORM S910D-READ-NEXT THRU S910D-EXIT DTSBS413 02357 END-IF DTSBS413 02358 END-PERFORM. DTSBS413 02359 DTSBS413 02360 PERFORM P3720-CURR-QUARTERS THRU P3720-EXIT. DTSBS413 02361 DTSBS413 02362 P3700-EXIT. DTSBS413 02363 EXIT. DTSBS413 02364 DTSBS413 02365 P3705-HOUSEHOLD. DTSBS413 02366 MOVE MQTR-YRQ TO L004-QTR-5-9 DTSBS413 02367 DTSBS413 02368 MOVE 1 TO L004-QTR-5-Q. DTSBS413 02369 MOVE L004-QTR-5-9 TO L516-YRQ DTSBS413 02370 PERFORM S516-LIABILITY THRU S516-EXIT DTSBS413 02371 IF L516-ANN-SCHED-88 DTSBS413 02372 NEXT SENTENCE DTSBS413 02373 ELSE DTSBS413 02374 SET WRK-FILE-QTRLY-88 TO TRUE DTSBS413 02375 PERFORM P3710-WRITE-X141 THRU P3710-EXIT DTSBS413 02376 END-IF. DTSBS413 02377 DTSBS413 02378 IF L516-LIABLE-88 DTSBS413 02379 SET WRK-FILE-ANN-LIAB-88 TO TRUE DTSBS413 02380 ELSE DTSBS413 02381 SET WRK-FILE-ANN-NOT-LIAB-88 TO TRUE DTSBS413 02382 END-IF. DTSBS413 02383 DTSBS413 02384 MOVE L004-QTR-5-9 TO MQTR-YRQ. DTSBS413 02385 MOVE MQTR-REC TO MSKL-REC. DTSBS413 02386 PERFORM S910B-READ THRU S910B-EXIT. DTSBS413 02387 IF L910-OK-88 DTSBS413 02388 MOVE MSKL-REC TO MQTR-REC DTSBS413 02389 PERFORM P3710-WRITE-X141 THRU P3710-EXIT DTSBS413 02390 END-IF. DTSBS413 02391 DTSBS413 02392 MOVE 2 TO L004-QTR-5-Q. DTSBS413 02393 MOVE L004-QTR-5-9 TO L516-YRQ DTSBS413 02394 PERFORM S516-LIABILITY THRU S516-EXIT DTSBS413 02395 IF L516-LIABLE-88 DTSBS413 02396 SET WRK-FILE-ANN-LIAB-88 TO TRUE DTSBS413 02397 ELSE DTSBS413 02398 SET WRK-FILE-ANN-NOT-LIAB-88 TO TRUE DTSBS413 02399 END-IF. DTSBS413 02400 DTSBS413 02401 MOVE L004-QTR-5-9 TO MQTR-YRQ. DTSBS413 02402 MOVE MQTR-REC TO MSKL-REC. DTSBS413 02403 PERFORM S910B-READ THRU S910B-EXIT. DTSBS413 02404 IF L910-OK-88 DTSBS413 02405 MOVE MSKL-REC TO MQTR-REC DTSBS413 02406 PERFORM P3710-WRITE-X141 THRU P3710-EXIT DTSBS413 02407 END-IF. DTSBS413 02408 DTSBS413 02409 MOVE 3 TO L004-QTR-5-Q. DTSBS413 02410 MOVE L004-QTR-5-9 TO L516-YRQ DTSBS413 02411 PERFORM S516-LIABILITY THRU S516-EXIT DTSBS413 02412 IF L516-LIABLE-88 DTSBS413 02413 SET WRK-FILE-ANN-LIAB-88 TO TRUE DTSBS413 02414 ELSE DTSBS413 02415 SET WRK-FILE-ANN-NOT-LIAB-88 TO TRUE DTSBS413 02416 END-IF. DTSBS413 02417 DTSBS413 02418 MOVE L004-QTR-5-9 TO MQTR-YRQ. DTSBS413 02419 MOVE MQTR-REC TO MSKL-REC. DTSBS413 02420 PERFORM S910B-READ THRU S910B-EXIT. DTSBS413 02421 IF L910-OK-88 DTSBS413 02422 MOVE MSKL-REC TO MQTR-REC DTSBS413 02423 PERFORM P3710-WRITE-X141 THRU P3710-EXIT DTSBS413 02424 END-IF. DTSBS413 02425 DTSBS413 02426 MOVE 4 TO L004-QTR-5-Q. DTSBS413 02427 MOVE L004-QTR-5-9 TO L516-YRQ DTSBS413 02428 PERFORM S516-LIABILITY THRU S516-EXIT DTSBS413 02429 IF L516-LIABLE-88 DTSBS413 02430 SET WRK-FILE-ANN-LIAB-88 TO TRUE DTSBS413 02431 ELSE DTSBS413 02432 SET WRK-FILE-ANN-NOT-LIAB-88 TO TRUE DTSBS413 02433 END-IF. DTSBS413 02434 DTSBS413 02435 MOVE L004-QTR-5-9 TO MQTR-YRQ. DTSBS413 02436 MOVE MQTR-REC TO MSKL-REC. DTSBS413 02437 PERFORM S910B-READ THRU S910B-EXIT. DTSBS413 02438 IF L910-OK-88 DTSBS413 02439 MOVE MSKL-REC TO MQTR-REC DTSBS413 02440 PERFORM P3710-WRITE-X141 THRU P3710-EXIT DTSBS413 02441 END-IF. DTSBS413 02442 DTSBS413 02443 MOVE L004-QTR-5-9 TO MQTR-YRQ. DTSBS413 02444 MOVE MQTR-REC TO MSKL-REC. DTSBS413 02445 PERFORM S910C-START-BROWSE THRU S910C-EXIT. DTSBS413 02446 DTSBS413 02447 P3705-EXIT. DTSBS413 02448 EXIT. DTSBS413 02449 DTSBS413 02450 P3710-WRITE-X141. DTSBS413 02451 IF MQTR-YRQ = WRK-PRIOR-QTR DTSBS413 02452 SET WRK-PRIOR-QTR-YES-88 TO TRUE DTSBS413 02453 ELSE DTSBS413 02454 IF MQTR-YRQ = WRK-CURR-QTR DTSBS413 02455 SET WRK-CURR-QTR-YES-88 TO TRUE DTSBS413 02456 END-IF DTSBS413 02457 END-IF. DTSBS413 02458 DTSBS413 02459 MOVE ZERO TO DTSBS413 02460 WRK-TAX-BAL DTSBS413 02461 WRK-SUR-BAL DTSBS413 02462 WRK-INT-BAL DTSBS413 02463 WRK-PEN-BAL. DTSBS413 02464 DTSBS413 02465 MOVE MPRF-EMP-NO TO X141-EMP-NO. DTSBS413 02466 DTSBS413 02467 MOVE MQTR-YRQ TO L004-QTR-5-9. DTSBS413 02468 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBS413 02469 MOVE L004-SLASH-5-QTR TO X141-QUARTER. DTSBS413 02470 DTSBS413 02471 EVALUATE TRUE DTSBS413 02472 WHEN MQTR-CURR-RCVD-88 DTSBS413 02473 SET X141-QTR-RECEIVED-88 TO TRUE DTSBS413 02474 WHEN MQTR-CURR-MISSING-88 DTSBS413 02475 SET X141-QTR-DELINQUENT-88 TO TRUE DTSBS413 02476 WHEN MQTR-CURR-NOT-LIABLE-88 DTSBS413 02477 SET X141-QTR-NOT-LIABLE-88 TO TRUE DTSBS413 02478 WHEN OTHER DTSBS413 02479 SET X141-QTR-CURRENT-88 TO TRUE DTSBS413 02480 END-EVALUATE. DTSBS413 02481 DTSBS413 02482 IF MPRF-ORG-HSEHLD-DMSTIC-88 DTSBS413 02483 MOVE WRK-FILING-SCHED TO X141-FILING-SCHEDULE DTSBS413 02484 ELSE DTSBS413 02485 SET X141-FILE-QTRLY-88 TO TRUE DTSBS413 02486 END-IF. DTSBS413 02487 DTSBS413 02488 IF MQTR-NO-UI-RATE-88 DTSBS413 02489 MOVE ZERO TO X141-RATE DTSBS413 02490 ELSE DTSBS413 02491 COMPUTE WRK-UI-RATE = (MQTR-UI-RATE * 100) DTSBS413 02492 MOVE WRK-UI-RATE TO X141-RATE DTSBS413 02493 END-IF. DTSBS413 02494 DTSBS413 02495 PERFORM P3711-BALANCES THRU P3711-EXIT. DTSBS413 02496 MOVE WRK-TAX-BAL TO X141-UI-TAX-BAL. DTSBS413 02497 MOVE WRK-SUR-BAL TO X141-SUR-BAL. DTSBS413 02498 MOVE WRK-INT-BAL TO X141-INT-BAL. DTSBS413 02499 MOVE WRK-PEN-BAL TO X141-PEN-BAL. DTSBS413 02500 DTSBS413 02501 MOVE MQTR-RPT-DUE-DATE TO L001-FED-8-DATE-9. DTSBS413 02502 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBS413 02503 MOVE L001-SLASH-8-DATE TO X141-REPORT-DUE-DATE. DTSBS413 02504 DTSBS413 02505 MOVE MQTR-TAX-DUE-DATE TO L001-FED-8-DATE-9. DTSBS413 02506 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBS413 02507 MOVE L001-SLASH-8-DATE TO X141-TAX-DUE-DATE. DTSBS413 02508 DTSBS413 02509 DTSBS413 02510 WRITE EMPLOYER-TEMP-REC FROM WRK-X141-REC. DTSBS413 02511 IF TEMP-STATUS-OK-88 DTSBS413 02512 ADD +1 TO TEMP-CNT DTSBS413 02513 ELSE DTSBS413 02514 DISPLAY 'CANNOT WRITE TEMP X141 ' MPRF-EMP-NO DTSBS413 02515 SET WRK-ERROR-YES-88 TO TRUE DTSBS413 02516 END-IF. DTSBS413 02517 DTSBS413 02518 P3710-EXIT. DTSBS413 02519 EXIT. DTSBS413 02520 DTSBS413 02521 P3711-BALANCES. DTSBS413 02522 PERFORM DTSBS413 02523 VARYING MQTR-ACCT-IDX FROM +1 BY +1 DTSBS413 02524 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT DTSBS413 02525 EVALUATE TRUE DTSBS413 02526 WHEN MQTR-ACCT-UI-88 (MQTR-ACCT-IDX) DTSBS413 02527 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSBS413 02528 TO WRK-TAX-BAL DTSBS413 02529 DTSBS413 02530 WHEN MQTR-ACCT-SUR-88 (MQTR-ACCT-IDX) DTSBS413 02531 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSBS413 02532 TO WRK-SUR-BAL DTSBS413 02533 DTSBS413 02534 WHEN MQTR-ACCT-LATE-PEN-88 (MQTR-ACCT-IDX) DTSBS413 02535 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSBS413 02536 TO WRK-PEN-BAL DTSBS413 02537 DTSBS413 02538 WHEN MQTR-ACCT-MISC-PEN-88 (MQTR-ACCT-IDX) DTSBS413 02539 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSBS413 02540 TO WRK-PEN-BAL DTSBS413 02541 DTSBS413 02542 WHEN MQTR-ACCT-NSF-PEN-88 (MQTR-ACCT-IDX) DTSBS413 02543 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSBS413 02544 TO WRK-PEN-BAL DTSBS413 02545 DTSBS413 02546 WHEN MQTR-ACCT-INT-88 (MQTR-ACCT-IDX) DTSBS413 02547 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSBS413 02548 TO WRK-INT-BAL DTSBS413 02549 DTSBS413 02550 END-EVALUATE DTSBS413 02551 END-PERFORM. DTSBS413 02552 DTSBS413 02553 P3711-EXIT. DTSBS413 02554 EXIT. DTSBS413 02555 DTSBS413 02556 DTSBS413 02557 P3720-CURR-QUARTERS. DTSBS413 02558 MOVE ZERO TO WRK-ANN-YEAR. DTSBS413 02559 DTSBS413 02560 IF WRK-PRIOR-QTR-NO-88 DTSBS413 02561 MOVE WRK-PRIOR-QTR TO L516-YRQ DTSBS413 02562 PERFORM S516-LIABILITY THRU S516-EXIT DTSBS413 02563 IF L516-LIABLE-88 DTSBS413 02564 IF MPRF-ORG-HSEHLD-DMSTIC-88 DTSBS413 02565 PERFORM P3722-BUILD-HH THRU P3722-EXIT DTSBS413 02566 ELSE DTSBS413 02567 PERFORM P3721-BUILD-QTR THRU P3721-EXIT DTSBS413 02568 END-IF DTSBS413 02569 END-IF DTSBS413 02570 END-IF. DTSBS413 02571 DTSBS413 02572 IF MPRF-STATUS-INACT-88 DTSBS413 02573 IF WRK-INACT-DATE > WRK-CURR-QTR-START DTSBS413 02574 IF WRK-CURR-QTR-NO-88 DTSBS413 02575 MOVE WRK-CURR-QTR TO L516-YRQ DTSBS413 02576 PERFORM S516-LIABILITY THRU S516-EXIT DTSBS413 02577 IF L516-LIABLE-88 DTSBS413 02578 IF MPRF-ORG-HSEHLD-DMSTIC-88 DTSBS413 02579 DISPLAY 'P3720 INACT HH ' MPRF-EMP-NO DTSBS413 02580 PERFORM P3722-BUILD-HH THRU P3722-EXIT DTSBS413 02581 ELSE DTSBS413 02582 PERFORM P3721-BUILD-QTR THRU P3721-EXIT DTSBS413 02583 END-IF DTSBS413 02584 END-IF DTSBS413 02585 END-IF DTSBS413 02586 END-IF DTSBS413 02587 END-IF. DTSBS413 02588 DTSBS413 02589 DTSBS413 02590 P3720-EXIT. DTSBS413 02591 EXIT. DTSBS413 02592 DTSBS413 02593 P3721-BUILD-QTR. DTSBS413 02594 MOVE MPRF-EMP-NO TO X141-EMP-NO. DTSBS413 02595 DTSBS413 02596 MOVE L516-YRQ TO L004-QTR-5-9. DTSBS413 02597 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBS413 02598 MOVE L004-SLASH-5-QTR TO X141-QUARTER. DTSBS413 02599 DTSBS413 02600 SET X141-QTR-CURRENT-88 TO TRUE. DTSBS413 02601 DTSBS413 02602 IF MPRF-ORG-HSEHLD-DMSTIC-88 DTSBS413 02603 MOVE WRK-FILING-SCHED TO X141-FILING-SCHEDULE DTSBS413 02604 ELSE DTSBS413 02605 SET X141-FILE-QTRLY-88 TO TRUE DTSBS413 02606 END-IF. DTSBS413 02607 DTSBS413 02608 MOVE ZERO TO X141-UI-TAX-BAL DTSBS413 02609 X141-SUR-BAL DTSBS413 02610 X141-INT-BAL DTSBS413 02611 X141-PEN-BAL. DTSBS413 02612 DTSBS413 02613 MOVE L516-DEFAULT-RPT-DUE-DATE TO L001-FED-8-DATE-9. DTSBS413 02614 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBS413 02615 MOVE L001-SLASH-8-DATE TO X141-REPORT-DUE-DATE. DTSBS413 02616 DTSBS413 02617 MOVE L516-DEFAULT-TAX-DUE-DATE TO L001-FED-8-DATE-9. DTSBS413 02618 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBS413 02619 MOVE L001-SLASH-8-DATE TO X141-TAX-DUE-DATE. DTSBS413 02620 DTSBS413 02621 WRITE EMPLOYER-TEMP-REC FROM WRK-X141-REC. DTSBS413 02622 IF TEMP-STATUS-OK-88 DTSBS413 02623 ADD +1 TO TEMP-CNT DTSBS413 02624 ELSE DTSBS413 02625 DISPLAY 'CANNOT WRITE TEMP X141 ' MPRF-EMP-NO DTSBS413 02626 SET WRK-ERROR-YES-88 TO TRUE DTSBS413 02627 END-IF. DTSBS413 02628 DTSBS413 02629 P3721-EXIT. DTSBS413 02630 EXIT. DTSBS413 02631 DTSBS413 02632 P3722-BUILD-HH. DTSBS413 02633 MOVE L516-YRQ TO L004-QTR-5-9. DTSBS413 02634 IF L004-QTR-5-YR = WRK-ANN-YEAR DTSBS413 02635 GO TO P3722-EXIT DTSBS413 02636 END-IF. DTSBS413 02637 DTSBS413 02638 IF MPRF-STATUS-INACT-88 DTSBS413 02639 NEXT SENTENCE DTSBS413 02640 ELSE DTSBS413 02641 MOVE L516-DEFAULT-RPT-DUE-DATE TO L001-FED-8-DATE-9 DTSBS413 02642 MOVE 01 TO L001-FED-8-MO DTSBS413 02643 MOVE 01 TO L001-FED-8-DA DTSBS413 02644 IF WRK-CURR-RUN-DATE < L001-FED-8-DATE-9 DTSBS413 02645 ** REPORT CAN NOT YET BE FILED ** DTSBS413 02646 GO TO P3722-EXIT DTSBS413 02647 END-IF DTSBS413 02648 END-IF. DTSBS413 02649 DTSBS413 02650 MOVE L516-YRQ TO L004-QTR-5-9. DTSBS413 02651 MOVE L004-QTR-5-YR TO WRK-ANN-YEAR. DTSBS413 02652 DTSBS413 02653 MOVE 1 TO L004-QTR-5-Q. DTSBS413 02654 MOVE L004-QTR-5-9 TO L516-YRQ DTSBS413 02655 PERFORM S516-LIABILITY THRU S516-EXIT DTSBS413 02656 IF L516-ANN-SCHED-88 DTSBS413 02657 NEXT SENTENCE DTSBS413 02658 ELSE DTSBS413 02659 SET WRK-FILE-QTRLY-88 TO TRUE DTSBS413 02660 PERFORM P3721-BUILD-QTR THRU P3721-EXIT DTSBS413 02661 END-IF. DTSBS413 02662 DTSBS413 02663 IF L516-LIABLE-88 DTSBS413 02664 SET WRK-FILE-ANN-LIAB-88 TO TRUE DTSBS413 02665 ELSE DTSBS413 02666 SET WRK-FILE-ANN-NOT-LIAB-88 TO TRUE DTSBS413 02667 END-IF. DTSBS413 02668 DTSBS413 02669 MOVE L004-QTR-5-9 TO MQTR-YRQ. DTSBS413 02670 MOVE MQTR-REC TO MSKL-REC. DTSBS413 02671 PERFORM S910B-READ THRU S910B-EXIT. DTSBS413 02672 IF L910-OK-88 DTSBS413 02673 NEXT SENTENCE DTSBS413 02674 ELSE DTSBS413 02675 MOVE MSKL-REC TO MQTR-REC DTSBS413 02676 PERFORM P3721-BUILD-QTR THRU P3721-EXIT DTSBS413 02677 END-IF. DTSBS413 02678 DTSBS413 02679 MOVE 2 TO L004-QTR-5-Q. DTSBS413 02680 MOVE L004-QTR-5-9 TO L516-YRQ DTSBS413 02681 PERFORM S516-LIABILITY THRU S516-EXIT DTSBS413 02682 IF L516-LIABLE-88 DTSBS413 02683 SET WRK-FILE-ANN-LIAB-88 TO TRUE DTSBS413 02684 ELSE DTSBS413 02685 SET WRK-FILE-ANN-NOT-LIAB-88 TO TRUE DTSBS413 02686 END-IF. DTSBS413 02687 DTSBS413 02688 MOVE L004-QTR-5-9 TO MQTR-YRQ. DTSBS413 02689 MOVE MQTR-REC TO MSKL-REC. DTSBS413 02690 PERFORM S910B-READ THRU S910B-EXIT. DTSBS413 02691 IF L910-OK-88 DTSBS413 02692 NEXT SENTENCE DTSBS413 02693 ELSE DTSBS413 02694 MOVE MSKL-REC TO MQTR-REC DTSBS413 02695 PERFORM P3721-BUILD-QTR THRU P3721-EXIT DTSBS413 02696 END-IF. DTSBS413 02697 DTSBS413 02698 MOVE 3 TO L004-QTR-5-Q. DTSBS413 02699 MOVE L004-QTR-5-9 TO L516-YRQ DTSBS413 02700 PERFORM S516-LIABILITY THRU S516-EXIT DTSBS413 02701 IF L516-LIABLE-88 DTSBS413 02702 SET WRK-FILE-ANN-LIAB-88 TO TRUE DTSBS413 02703 ELSE DTSBS413 02704 SET WRK-FILE-ANN-NOT-LIAB-88 TO TRUE DTSBS413 02705 END-IF. DTSBS413 02706 DTSBS413 02707 MOVE L004-QTR-5-9 TO MQTR-YRQ. DTSBS413 02708 MOVE MQTR-REC TO MSKL-REC. DTSBS413 02709 PERFORM S910B-READ THRU S910B-EXIT. DTSBS413 02710 IF L910-OK-88 DTSBS413 02711 NEXT SENTENCE DTSBS413 02712 ELSE DTSBS413 02713 MOVE MSKL-REC TO MQTR-REC DTSBS413 02714 PERFORM P3721-BUILD-QTR THRU P3721-EXIT DTSBS413 02715 END-IF. DTSBS413 02716 DTSBS413 02717 MOVE 4 TO L004-QTR-5-Q. DTSBS413 02718 MOVE L004-QTR-5-9 TO L516-YRQ DTSBS413 02719 PERFORM S516-LIABILITY THRU S516-EXIT DTSBS413 02720 IF L516-LIABLE-88 DTSBS413 02721 SET WRK-FILE-ANN-LIAB-88 TO TRUE DTSBS413 02722 ELSE DTSBS413 02723 SET WRK-FILE-ANN-NOT-LIAB-88 TO TRUE DTSBS413 02724 END-IF. DTSBS413 02725 DTSBS413 02726 MOVE L004-QTR-5-9 TO MQTR-YRQ. DTSBS413 02727 MOVE MQTR-REC TO MSKL-REC. DTSBS413 02728 PERFORM S910B-READ THRU S910B-EXIT. DTSBS413 02729 IF L910-OK-88 DTSBS413 02730 NEXT SENTENCE DTSBS413 02731 ELSE DTSBS413 02732 MOVE MSKL-REC TO MQTR-REC DTSBS413 02733 PERFORM P3721-BUILD-QTR THRU P3721-EXIT DTSBS413 02734 END-IF. DTSBS413 02735 DTSBS413 02736 P3722-EXIT. DTSBS413 02737 EXIT. DTSBS413 02738 DTSBS413 02739 P3750-REPORTS. CL**2 02740 MOVE LOW-VALUES TO MRPT-KEY-AREA. CL**2 02741 MOVE MPRF-EMP-NO TO MRPT-EMP-NO. CL**2 02742 MOVE MQTR-YRQ TO MRPT-YRQ. CL**2 02743 SET MRPT-RPT-88 TO TRUE. CL**2 02744 MOVE MRPT-KEY-AREA TO MSKL-KEY-AREA. CL**2 02745 CL**2 02746 PERFORM S910C-START-BROWSE THRU S910C-EXIT. CL**2 02747 IF L910-NO-REC-88 CL**2 02748 NEXT SENTENCE CL**2 02749 ELSE CL**2 02750 PERFORM CL**2 02751 UNTIL L910-NO-REC-88 CL**2 02752 MOVE MSKL-REC TO MRPT-REC CL**2 02753 PERFORM P3751-WRITE-X140 THRU P3751-EXIT CL**2 02754 PERFORM S910D-READ-NEXT THRU S910D-EXIT CL**2 02755 END-PERFORM CL**2 02756 END-IF. CL**2 02757 CL**2 02758 P3750-EXIT. CL**2 02759 EXIT. CL**2 02760 CL**2 02761 P3751-WRITE-X140. CL**2 02762 MOVE MPRF-EMP-NO TO X140-EMP-NO. CL**2 02763 CL**2 02764 MOVE MRPT-YRQ TO L004-QTR-5-9. CL**2 02765 PERFORM S004-FROM-5 THRU S004-EXIT. CL**2 02766 MOVE L004-SLASH-5-QTR TO X140-QUARTER. CL**2 02767 CL**2 02768 MOVE MRPT-RPT-TYPE TO X140-REPORT-TYPE. CL*12 02769 MOVE MRPT-TOT-WAGE TO X140-TOTAL-WAGES. CL**2 02770 MOVE MRPT-TAX-WAGE TO X140-TAX-WAGES. CL**2 02771 MOVE MRPT-REMIT-AMT TO X140-REMITTANCE. CL**2 02772 MOVE MRPT-TRACE-NO TO X140-CONFIRMATION. CL**2 02773 MOVE MRPT-RECEIVED-DATE TO L001-FED-8-DATE-9. CL**2 02774 PERFORM S001-FROM-FED-8 THRU S001-EXIT. CL**2 02775 MOVE L001-SLASH-8-DATE TO X140-RCVD-DATE. CL**2 02776 MOVE MRPT-ESTB-DATE TO L001-FED-8-DATE-9. CL**2 02777 PERFORM S001-FROM-FED-8 THRU S001-EXIT. CL**2 02778 MOVE L001-SLASH-8-DATE TO X140-RCVD-DATE. CL*11 02779 MOVE MRPT-1ST-MTH-EMPL-CNT TO X140-WRKR-CNT-1ST-MNTH. CL**2 02780 MOVE MRPT-2ND-MTH-EMPL-CNT TO X140-WRKR-CNT-2ND-MNTH. CL**2 02781 MOVE MRPT-3RD-MTH-EMPL-CNT TO X140-WRKR-CNT-3RD-MNTH. CL**2 02782 CL**2 02783 WRITE EMPLOYER-TEMP-REC FROM WRK-X140-REC. CL**2 02784 IF TEMP-STATUS-OK-88 CL**2 02785 ADD +1 TO TEMP-CNT CL**2 02786 ELSE CL**2 02787 DISPLAY 'CANNOT WRITE TEMP X140 ' MPRF-EMP-NO CL**2 02788 SET WRK-ERROR-YES-88 TO TRUE CL**2 02789 END-IF. CL**2 02790 CL**2 02791 P3751-EXIT. CL**2 02792 EXIT. CL**2 02793 DTSBS413 02794 P3800-PAYMENT. DTSBS413 02795 MOVE LOW-VALUES TO MPAY-KEY-AREA. DTSBS413 02796 MOVE MPRF-EMP-NO TO MPAY-EMP-NO. DTSBS413 02797 SET MPAY-PAY-88 TO TRUE. DTSBS413 02798 MOVE MPAY-KEY-AREA TO MSKL-KEY-AREA. DTSBS413 02799 DTSBS413 02800 PERFORM S910C-START-BROWSE THRU S910C-EXIT. DTSBS413 02801 PERFORM UNTIL L910-NO-REC-88 DTSBS413 02802 MOVE MSKL-REC TO MPAY-REC DTSBS413 02803 PERFORM P3820-RECENT-PAYMENT THRU P3820-EXIT DTSBS413 02804 IF L910-OK-88 DTSBS413 02805 PERFORM S910D-READ-NEXT THRU S910D-EXIT DTSBS413 02806 END-IF DTSBS413 02807 END-PERFORM. DTSBS413 02808 DTSBS413 02809 IF PAY-LAST > ZERO DTSBS413 02810 PERFORM P3830-UPDATE-X142 THRU P3830-EXIT DTSBS413 02811 END-IF. DTSBS413 02812 DTSBS413 02813 P3800-EXIT. DTSBS413 02814 EXIT. DTSBS413 02815 DTSBS413 02816 P3820-RECENT-PAYMENT. DTSBS413 02817 IF MPAY-APPLIC-BATCH-NO = ZERO DTSBS413 02818 AND MPAY-PAYMENT-88 DTSBS413 02819 PERFORM P3821-PAYMENTS THRU P3821-EXIT DTSBS413 02820 ELSE DTSBS413 02821 PERFORM P3822-ADJUSTMENTS THRU P3822-EXIT DTSBS413 02822 END-IF. DTSBS413 02823 DTSBS413 02824 P3820-EXIT. DTSBS413 02825 EXIT. DTSBS413 02826 DTSBS413 02827 P3821-PAYMENTS. DTSBS413 02828 IF PAY-LAST < PAY-MAX DTSBS413 02829 ADD +1 TO PAY-LAST DTSBS413 02830 MOVE PAY-LAST TO PSUB DTSBS413 02831 ELSE DTSBS413 02832 DISPLAY 'P3821 PAY TABLE LENGTH EXCEEDED' DTSBS413 02833 GO TO P3821-EXIT DTSBS413 02834 END-IF. DTSBS413 02835 DTSBS413 02836 MOVE MPAY-BATCH-NO TO PAY-BATCH (PSUB). DTSBS413 02837 MOVE MPAY-ITEM-NO TO PAY-ITEM (PSUB). DTSBS413 02838 MOVE MPAY-ESTB-DATE TO PAY-PROCESS-DATE (PSUB). DTSBS413 02839 MOVE MPAY-RECEIVED-DATE TO PAY-RCVD-DATE (PSUB). DTSBS413 02840 MOVE MPAY-REMIT-AMT TO PAY-ORIG-AMT (PSUB) DTSBS413 02841 PAY-ADJ-AMT (PSUB). DTSBS413 02842 DTSBS413 02843 P3821-EXIT. DTSBS413 02844 EXIT. DTSBS413 02845 DTSBS413 02846 P3822-ADJUSTMENTS. DTSBS413 02847 PERFORM DTSBS413 02848 VARYING PSUB FROM +1 BY +1 DTSBS413 02849 UNTIL PSUB > PAY-LAST DTSBS413 02850 IF MPAY-APPLIC-BATCH-NO = PAY-BATCH (PSUB) DTSBS413 02851 AND MPAY-APPLIC-ITEM-NO = PAY-ITEM (PSUB) DTSBS413 02852 ADD MPAY-REMIT-AMT TO PAY-ADJ-AMT (PSUB) DTSBS413 02853 END-IF DTSBS413 02854 END-PERFORM. DTSBS413 02855 DTSBS413 02856 P3822-EXIT. DTSBS413 02857 EXIT. DTSBS413 02858 DTSBS413 02859 P3830-UPDATE-X142. DTSBS413 02860 PERFORM DTSBS413 02861 VARYING PSUB FROM +1 BY +1 DTSBS413 02862 UNTIL PSUB > PAY-LAST DTSBS413 02863 IF PAY-ADJ-AMT (PSUB) > ZERO DTSBS413 02864 IF PAY-PROCESS-DATE (PSUB) > MAX-PAY-DATE DTSBS413 02865 MOVE PAY-PROCESS-DATE (PSUB) TO MAX-PAY-DATE DTSBS413 02866 END-IF DTSBS413 02867 END-IF DTSBS413 02868 END-PERFORM. DTSBS413 02869 DTSBS413 02870 IF MAX-PAY-DATE NOT = ZERO DTSBS413 02871 PERFORM DTSBS413 02872 VARYING PSUB FROM +1 BY +1 DTSBS413 02873 UNTIL PSUB > PAY-LAST DTSBS413 02874 IF PAY-PROCESS-DATE (PSUB) = MAX-PAY-DATE DTSBS413 02875 ADD PAY-ADJ-AMT (PSUB) TO MAX-PAY-AMT DTSBS413 02876 END-IF DTSBS413 02877 END-PERFORM DTSBS413 02878 MOVE MPRF-EMP-NO TO X142-EMP-NO DTSBS413 02879 MOVE MAX-PAY-DATE TO L001-FED-8-DATE-9 DTSBS413 02880 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBS413 02881 MOVE L001-SLASH-8-DATE TO X142-PAY-DATE DTSBS413 02882 MOVE MAX-PAY-AMT TO X142-PAY-AMT DTSBS413 02883 END-IF. DTSBS413 02884 DTSBS413 02885 P3830-EXIT. DTSBS413 02886 EXIT. DTSBS413 02887 DTSBS413 02888 S1010-READ-SENT-MINI. CL132 02889 READ SENT-MINI-FILE INTO WS-SENT-REC CL132 02890 IF SENT-MINI-STATUS-OK-88 CL132 02891 ADD +1 TO W-SENT-MINI-CNT CL132 02892 ELSE CL132 02893 IF SENT-MINI-STATUS-EOF-88 CL132 02894 DISPLAY 'SENT MINI EOF' CL132 02895 ELSE CL132 02896 DISPLAY 'CANNOT READ SENT MINI ' SENT-MINI-STATUS CL132 02897 PERFORM S999-ABEND THRU S999-EXIT CL132 02898 END-IF CL132 02899 END-IF. CL132 02900 CL132 02901 S1010-EXIT. CL132 02902 EXIT. CL132 02903 CL132 02904 T0000-TERMINATE. DTSBS413 02905 DTSBS413 02906 DISPLAY '*********************************************'. DTSBS413 02907 DISPLAY '* DTSBS413 TERMINATION STATISTICS'. CL139 02908 DISPLAY '* '. DTSBS413 02909 DISPLAY '* MPRF RECORDS READ : ' DTSBS413 02910 WRK-MPRF-CNT. DTSBS413 02911 DISPLAY '* SENT FILE RECORDS READ : ' CL132 02912 W-SENT-MINI-CNT. CL132 02913 DISPLAY '* TEMP RECORDS WRITTEN : ' DTSBS413 02914 TEMP-CNT. DTSBS413 02915 DISPLAY '* PROFILE RECORDS WRITTEN : ' DTSBS413 02916 X102-CNT. DTSBS413 02917 ** DISPLAY '* DETERMINATION RECS WRITTEN : ' DTSBS413 02918 ** X104-CNT. DTSBS413 02919 DISPLAY '* NAME RECORDS WRITTEN : ' DTSBS413 02920 X106-CNT. DTSBS413 02921 DISPLAY '* EMP ADDRESS RECS WRITTEN : ' DTSBS413 02922 X110-CNT. DTSBS413 02923 DISPLAY '* EMP RATE RECS WRITTEN : ' CL**2 02924 X108-CNT. CL**2 02925 DISPLAY '* OPO RECORDS WRITTEN : ' CL**2 02926 X120-CNT. CL**2 02927 DISPLAY '* REL RECORDS WRITTEN : ' CL**2 02928 X130-CNT. CL**2 02929 DISPLAY '* RPT RECORDS WRITTEN : ' CL**2 02930 X140-CNT. CL**2 02931 DISPLAY '* REL RECORDS WRITTEN : ' DTSBS413 02932 X131-CNT. DTSBS413 02933 DISPLAY '* QTR STATUS RECS WRITTEN : ' DTSBS413 02934 X141-CNT. DTSBS413 02935 DISPLAY '* LAST RPT PAY RECS WRITTEN : ' DTSBS413 02936 X142-CNT. DTSBS413 02937 DISPLAY '*********************************************'. DTSBS413 02938 DTSBS413 02939 DTSBS413 02940 CLOSE X100-REF-FILE DTSBS413 02941 X102-PRF-FILE DTSBS413 02942 X104-DETERM-FILE CL**2 02943 X106-NAME-FILE DTSBS413 02944 X110-ADDR-FILE DTSBS413 02945 X108-RATE-FILE CL**2 02946 X120-OPO-FILE CL**2 02947 ** X130-REL-FILE CL*12 02948 X140-REPORT-FILE CL**2 02949 X131-REL-FILE DTSBS413 02950 X141-QTR-STATUS-FILE DTSBS413 02951 X142-LAST-RPT-PAY-FILE. DTSBS413 02952 DTSBS413 02953 PERFORM S910E-CLOSE THRU S910E-EXIT. DTSBS413 02954 PERFORM S921E-CLOSE THRU S921E-EXIT. DTSBS413 02955 PERFORM S931D-CLOSE THRU S931D-EXIT. DTSBS413 02956 DTSBS413 02957 T0000-EXIT. DTSBS413 02958 EXIT. DTSBS413 02959 DTSBS413 02960 S001-FROM-FED-8. DTSBS413 02961 SET L001-FROM-FED-8 TO TRUE. DTSBS413 02962 GO TO S001-DATE. DTSBS413 02963 DTSBS413 02964 S001-FROM-ABS-DAY. DTSBS413 02965 SET L001-FROM-ABS-DAY TO TRUE. DTSBS413 02966 GO TO S001-DATE. DTSBS413 02967 DTSBS413 02968 S001-DATE. DTSBS413 02969 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBS413 02970 S001-EXIT. DTSBS413 02971 EXIT. DTSBS413 02972 DTSBS413 02973 S003-AGENCY-DAY. DTSBS413 02974 SET L003-AGENCY-DAY TO TRUE. DTSBS413 02975 GO TO S003-WORK-DAY. DTSBS413 02976 DTSBS413 02977 S003-WORK-DAY. DTSBS413 02978 CALL 'DTSBU003' USING L003-LINK-AREA. DTSBS413 02979 S003-EXIT. DTSBS413 02980 EXIT. DTSBS413 02981 DTSBS413 02982 S004-FROM-DATE. DTSBS413 02983 SET L004-FROM-DATE TO TRUE. DTSBS413 02984 GO TO S004-QTR. DTSBS413 02985 DTSBS413 02986 S004-FROM-5. DTSBS413 02987 SET L004-FROM-5 TO TRUE. DTSBS413 02988 GO TO S004-QTR. DTSBS413 02989 DTSBS413 02990 S004-FROM-ABS. DTSBS413 02991 SET L004-FROM-ABS TO TRUE. DTSBS413 02992 GO TO S004-QTR. DTSBS413 02993 DTSBS413 02994 S004-FROM-3. DTSBS413 02995 SET L004-FROM-3 TO TRUE. DTSBS413 02996 GO TO S004-QTR. DTSBS413 02997 DTSBS413 02998 S004-QTR. DTSBS413 02999 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBS413 03000 S004-EXIT. DTSBS413 03001 EXIT. DTSBS413 03002 DTSBS413 03003 S005-SYS-DATE. DTSBS413 03004 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBS413 03005 DTSBS413 03006 S005-EXIT. DTSBS413 03007 EXIT. DTSBS413 03008 DTSBS413 03009 S101-PER-MONTH-NO. DTSBS413 03010 SET L101-PER-MONTH-NO-88 TO TRUE. DTSBS413 03011 GO TO S101-INT-CHARGE. DTSBS413 03012 DTSBS413 03013 S101-INT-CHARGE. DTSBS413 03014 CALL 'DTSBU101' USING L101-LINK-AREA. DTSBS413 03015 S101-EXIT. DTSBS413 03016 EXIT. DTSBS413 03017 DTSBS413 03018 S410-FILE-SCHED. DTSBS413 03019 CALL 'DTSBU410' USING L410-LINK-AREA. DTSBS413 03020 S410-EXIT. DTSBS413 03021 EXIT. DTSBS413 03022 DTSBS413 03023 S516-LIABILITY. DTSBS413 03024 CALL 'DTSBU516' USING L516-LINK-AREA DTSBS413 03025 MPRF-REC. DTSBS413 03026 S516-EXIT. DTSBS413 03027 EXIT. DTSBS413 03028 DTSBS413 03029 S910A-OPEN-READ. DTSBS413 03030 SET L910-OPEN-READ-88 TO TRUE. DTSBS413 03031 PERFORM S910Z-MSTR-IO THRU S910Z-EXIT. DTSBS413 03032 DTSBS413 03033 S910A-EXIT. DTSBS413 03034 EXIT. DTSBS413 03035 DTSBS413 03036 S910B-READ. DTSBS413 03037 SET L910-READ-88 TO TRUE. DTSBS413 03038 PERFORM S910Z-MSTR-IO THRU S910Z-EXIT. DTSBS413 03039 DTSBS413 03040 S910B-EXIT. DTSBS413 03041 EXIT. DTSBS413 03042 DTSBS413 03043 S910C-START-BROWSE. DTSBS413 03044 SET L910-START-BROWSE-88 TO TRUE. DTSBS413 03045 PERFORM S910Z-MSTR-IO THRU S910Z-EXIT. DTSBS413 03046 DTSBS413 03047 S910C-EXIT. DTSBS413 03048 EXIT. DTSBS413 03049 DTSBS413 03050 S910D-READ-NEXT. DTSBS413 03051 SET L910-READ-NEXT-88 TO TRUE. DTSBS413 03052 PERFORM S910Z-MSTR-IO THRU S910Z-EXIT. DTSBS413 03053 DTSBS413 03054 S910D-EXIT. DTSBS413 03055 EXIT. DTSBS413 03056 DTSBS413 03057 S910E-CLOSE. DTSBS413 03058 SET L910-CLOSE-88 TO TRUE. DTSBS413 03059 PERFORM S910Z-MSTR-IO THRU S910Z-EXIT. DTSBS413 03060 DTSBS413 03061 S910E-EXIT. DTSBS413 03062 EXIT. DTSBS413 03063 DTSBS413 03064 S910Z-MSTR-IO. CL110 03065 CALL 'DTSBU910' USING L910-LINK-AREA DTSBS413 03066 MSKL-REC. DTSBS413 03067 IF MPRF-EMP-NO NOT NUMERIC CL*89 03068 NEXT SENTENCE. CL111 03069 ** ELSE CL109 03070 * IF MPRF-EMP-NO >= COMP18-DATE CL102 03071 * AND MPRF-EMP-NO <= COMP19-DATE CL102 03072 *** DISPLAY '***&& MPRF-EMP-NO = ', MPRF-EMP-NO CL107 03073 * END-IF CL102 03074 ** END-IF. CL109 03075 * DISPLAY '***&& MPRF-EMP-NO = ', MPRF-EMP-NO. CL*81 03076 S910Z-EXIT. DTSBS413 03077 EXIT. DTSBS413 03078 DTSBS413 03079 S921A-OPEN-READ. DTSBS413 03080 SET L921-OPEN-READ-88 TO TRUE. DTSBS413 03081 PERFORM S921Z-AIX-IO THRU S921Z-EXIT. DTSBS413 03082 DTSBS413 03083 S921A-EXIT. DTSBS413 03084 EXIT. DTSBS413 03085 DTSBS413 03086 S921C-START-BROWSE. DTSBS413 03087 SET L921-START-BROWSE-88 TO TRUE. DTSBS413 03088 PERFORM S921Z-AIX-IO THRU S921Z-EXIT. DTSBS413 03089 DTSBS413 03090 S921C-EXIT. DTSBS413 03091 EXIT. DTSBS413 03092 DTSBS413 03093 S921D-READ-NEXT. DTSBS413 03094 SET L921-READ-NEXT-88 TO TRUE. DTSBS413 03095 PERFORM S921Z-AIX-IO THRU S921Z-EXIT. DTSBS413 03096 DTSBS413 03097 S921D-EXIT. DTSBS413 03098 EXIT. DTSBS413 03099 DTSBS413 03100 S921E-CLOSE. DTSBS413 03101 SET L921-CLOSE-88 TO TRUE. DTSBS413 03102 PERFORM S921Z-AIX-IO THRU S921Z-EXIT. DTSBS413 03103 DTSBS413 03104 S921E-EXIT. DTSBS413 03105 EXIT. DTSBS413 03106 DTSBS413 03107 S921Z-AIX-IO. DTSBS413 03108 CALL 'DTSBU921' USING L921-LINK-AREA DTSBS413 03109 ISKL-REC. DTSBS413 03110 S921Z-EXIT. DTSBS413 03111 EXIT. DTSBS413 03112 DTSBS413 03113 S931A-OPEN-READ. DTSBS413 03114 SET L931-OPEN-READ-88 TO TRUE. DTSBS413 03115 PERFORM S931Z-REF-IO THRU S931Z-EXIT. DTSBS413 03116 DTSBS413 03117 S931A-EXIT. DTSBS413 03118 EXIT. DTSBS413 03119 DTSBS413 03120 S931B-START-BROWSE. DTSBS413 03121 SET L931-START-BROWSE-88 TO TRUE. DTSBS413 03122 PERFORM S931Z-REF-IO THRU S931Z-EXIT. DTSBS413 03123 DTSBS413 03124 S931B-EXIT. DTSBS413 03125 EXIT. DTSBS413 03126 DTSBS413 03127 S931C-READ-NEXT. DTSBS413 03128 SET L931-READ-NEXT-88 TO TRUE. DTSBS413 03129 PERFORM S931Z-REF-IO THRU S931Z-EXIT. DTSBS413 03130 DTSBS413 03131 S931C-EXIT. DTSBS413 03132 EXIT. DTSBS413 03133 DTSBS413 03134 S931D-CLOSE. DTSBS413 03135 SET L931-CLOSE-88 TO TRUE. DTSBS413 03136 PERFORM S931Z-REF-IO THRU S931Z-EXIT. DTSBS413 03137 DTSBS413 03138 S931D-EXIT. DTSBS413 03139 EXIT. DTSBS413 03140 DTSBS413 03141 S931Z-REF-IO. DTSBS413 03142 CALL 'DTSBU931' USING L931-LINK-AREA DTSBS413 03143 FSKL-REC. DTSBS413 03144 S931Z-EXIT. EXIT. DTSBS413 03145 DTSBS413 03146 S999-ABEND. DTSBS413 03147 DISPLAY '*** DTSBX411 ABENDING. ' DTSBS413 03148 ABEND-MSG. DTSBS413 03149 DTSBS413 03150 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBS413 03151 S999-EXIT. DTSBS413 03152 EXIT. DTSBS413 03153 * CL*60 03154 CP3000-WRITE-RECORD. CL*60 03155 IF OUTWRITE-CNT < 110000 CL*60 03156 * IF OUTWRITE-SW = 'Y' CL119 03157 * MOVE OUT-RECORD-HEADER TO DSKREC CL119 03158 * MOVE 'N' TO OUTWRITE-SW CL119 03159 * WRITE DSKREC CL119 03160 * ADD 1 TO OUTWRITE-CNT CL119 03161 * ELSE CL119 03162 MOVE OUT-RECORD TO DSKREC CL*60 03163 WRITE DSKREC CL*60 03164 ADD 1 TO OUTWRITE-CNT CL*60 03165 INITIALIZE OUT-RECORD CL*60 03166 * END-IF CL*60 03167 ELSE CL*60 03168 IF OUTWRITE-CNT = 110000 CL*60 03169 CLOSE DSKFILE CL*60 03170 ADD 1 TO OUTWRITE-CNT CL*60 03171 END-IF CL*60 03172 END-IF. CL*60 03173 * CL*60 03174 * CL*61 03175 CP3000-EXIT. CL*61 03176 EXIT. CL*61 03177 * CL*61 03178 CP2000-MOVE-FIELDS. CL*61 03179 MOVE MPRF-EMP-NO TO E_EMPLOYEE_PAID_NUM. CL*61 03180 MOVE MSOL-LIAB-ESTB-DATE TO E_STATUS_DATE. CL*61 03181 IF MSOL-LIAB-ESTB-DATE IS NUMERIC CL*61 03182 MOVE 'Y' TO E_SERVICE_BEGIN_IND CL*61 03183 ELSE CL*61 03184 MOVE 'N' TO E_SERVICE_BEGIN_IND CL*61 03185 END-IF. CL*61 03186 MOVE SPACES TO E_IRS_501C3_IND. CL*61 03187 MOVE MSOL-LIAB-ESTB-DATE TO E_NAICS_EFFECTIVE_DATE. CL*61 03188 IF MSOL-ESTB-DATE IS NUMERIC CL*61 03189 MOVE MSOL-ESTB-DATE TO E_CREATED_DATE CL*61 03190 ELSE CL*61 03191 MOVE MSOL-LIAB-ESTB-DATE TO E_CREATED_DATE CL*61 03192 END-IF. CL*61 03193 MOVE MRPT-RESPONSIBLE-OP-ID TO E_CREATED_BY. CL*61 03194 MOVE X141-FILING-SCHEDULE TO E_ANNUAL_FILER_INDICATOR. CL*61 03195 MOVE SPACES TO E_PAY_51_101_2E_EXMPT_WRK_IND. CL*61 03196 MOVE SPACES TO E_ISSUE_1099_FORM_IND. CL*61 03197 * CL*61 03198 MOVE MTAD-VOICE-1 TO EA_PHONE_NUM. CL*61 03199 MOVE MTAD-ESTB-DATE TO EA_CREATED_DATE. CL*61 03200 MOVE MERA-RESPONSIBLE-OP-ID TO EA_CREATED_BY. CL*61 03201 * CL*61 03202 MOVE MTAD-ESTB-DATE TO EC_CREATED_DATE. CL*61 03203 MOVE MERA-RESPONSIBLE-OP-ID TO EC_CREATED_BY. CL*61 03204 * CL*61 03205 MOVE MERA-MAIL-DATE-1 TO ES_CREATED_DATE. CL*61 03206 MOVE MERA-RESPONSIBLE-OP-ID TO ES_CREATED_BY. CL*61 03207 MOVE SPACES TO ES_FUTA_IND. CL*61 03208 CL139 03209 IF MSOL-LIAB-ESTB-DATE IS NUMERIC CL*61 03210 MOVE 'Y' TO ES_HSHOLD_EMP_PAID_500_WG_IND CL*61 03211 ELSE CL*61 03212 MOVE 'N' TO ES_HSHOLD_EMP_PAID_500_WG_IND CL*61 03213 END-IF. CL*61 03214 * CL136 03215 IF WRK-MOPO-FOUND-YES-88 CL136 03216 MOVE MOPO-VOICE-1 TO EOO_PHONE_NUM CL136 03217 MOVE MOPO-FAX TO EOO_FAX_NUM CL136 03218 MOVE MOPO-EMAIL-ADDRESS TO EOO_EMAIL CL136 03219 MOVE MOPO-ESTB-DATE TO EOO_CREATED_DATE CL136 03220 END-IF. CL136 03221 CL136 03222 MOVE MERA-RESPONSIBLE-OP-ID TO EOO_CREATED_BY. CL*61 03223 MOVE MPRF-PRIMARY-NAME TO EOO_BUSINESS_NAME. CL136 03224 * CL*61 03225 MOVE 'L1 ' TO EWH_EMPLOYEE_NUM. CL*61 03226 MOVE 'P' TO EWH_STATUS_CODE_VALUE. CL*61 03227 MOVE MERA-RECEIVED-DATE TO EWH_FILING_DATE. CL*61 03228 * CL*61 03229 MOVE MERA-RESPONSIBLE-OP-ID TO EWUD_FILING_METHOD. CL*61 03230 MOVE MJRN-TRAN-TYPE TO EWUD_ADJUSTMENT_REASON_CODE_ID. CL*61 03231 * CL*61 03232 * CL*61 03233 MOVE MRTE-RATE-TYPE-IND TO EXR_EXPERIENCE_RATE_CODE_VALUE. CL*61 03234 * CL*61 03235 MOVE 2.7 TO TRF_NEW_EMPLOYER_RATE. CL*61 03236 * CL*61 03237 MOVE SPACES TO ER_PURCHASE_SALE_IND. CL*61 03238 IF (MSOL-INACT-CD = 4 OR MSOL-INACT-CD = 5) CL*61 03239 MOVE MSOL-INACT-REVERSE-DATE TO ER_WAGES_RESUMED_DATE CL*61 03240 MOVE MSOL-INACT-CD TO ER_REASON_CODE_VALUE CL*61 03241 ELSE CL*61 03242 MOVE SPACES TO ER_WAGES_RESUMED_DATE CL*61 03243 MOVE SPACES TO ER_REASON_CODE_VALUE CL*61 03244 END-IF. CL*61 03245 MOVE 'L' TO ER_NAICS_CD. CL*61 03246 MOVE MSOL-LIAB-ESTB-DATE TO ER_STATUS_DATE. CL*61 03247 MOVE MSOL-LIAB-ESTB-DATE TO ER_CREATED_DATE. CL*61 03248 MOVE MERA-RESPONSIBLE-OP-ID TO ER_CREATED_BY. CL*61 03249 * CL*61 03250 MOVE MSOL-INACT-DATE TO ESUS_SUSPEND_ACTION_DATE. CL*61 03251 MOVE MSOL-INACT-CD TO ESUS_REASON_CODE_VALUE. CL*61 03252 MOVE SPACES TO ESUS_SUSPEND_FIRST_NAME. CL*61 03253 MOVE SPACES TO ESUS_SUSPEND_LAST_NAME. CL*61 03254 MOVE MSOL-INACT-CD TO ESUS_STATUS_CODE_VALUE. CL*61 03255 MOVE MSOL-INACT-ENTER-DATE TO ESUS_STATUS_DATE. CL*61 03256 MOVE MSOL-LIAB-ESTB-DATE TO ESUS_CREATED_DATE. CL*61 03257 MOVE MERA-RESPONSIBLE-OP-ID TO ESUS_CREATED_BY. CL*61 03258 CL*61 03259 PERFORM CP3000-WRITE-RECORD THRU CP3000-EXIT. CL*61 03260 CP2000-EXIT. CL*61 03261 EXIT. CL*61 03262 * CL*61 03263 * CL*61