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