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