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