giteaadmin/DUTAS
4
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
2a54f65e13ffdac7ccbe8ea99bd8eb7cbb392cec
DUTAS/Batch/DTSBS412.cob

2885 lines
228 KiB
COBOL
Raw Blame History

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