giteaadmin/DUTAS
4
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
ef98c08de5fbfa133def68d439cb1d035e2bc620
DUTAS/Batch/DTSBS413.cob
faizana ef98c08de5 Two missing Batch Programms are added, 
DTSBS413.cob and DTSBU985.cob
2025-08-23 14:20:01 -04:00

3265 lines
258 KiB
COBOL
Raw Blame History

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
Reference in New Issue View Git Blame Copy Permalink