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