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