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