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

3117 lines
246 KiB
COBOL
Raw Blame History

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