00001 IDENTIFICATION DIVISION. 11/03/11 00002 PROGRAM-ID. DTSBX341. DTSBX341 00003 AUTHOR. NGC. LV021 00004 DATE-WRITTEN. NOVEMBER 2007. DTSBX341 00005 DATE-COMPILED. DTSBX341 00006 SKIP3 DTSBX341 00007 ***** DTSBX341 00008 * >>> CURRENT WORKING VERSION <<< DTSBX341 00009 * DTSBX341 00010 * FUNCTION: INTERNAL WEB MAINFRAME EXTRACT - STATUS DTSBX341 00011 * DTSBX341 00012 * DTSBX341 00013 * MODIFICATION LOG: DTSBX341 00014 * DTSBX341 00015 * 11/16/2007 INITIAL DEVELOPMENT. DTSBX341 00016 * REFERENCE: PROGRAMMER: GD DTSBX341 00017 * DTSBX341 00018 * 08/21/2008 ADDED PROCESSING FOR MREL (RELATIONSHIP) RECORDS DTSBX341 00019 * REFERENCE: PROGRAMMER: GD DTSBX341 00020 * DTSBX341 00021 * 04/01/2009 MODIFIED TO SELECT ALL BUSINESS NAMES. DTSBX341 00022 * REFERENCE: PROGRAMMER: GD DTSBX341 00023 * DTSBX341 00024 * 04/15/2009 MODIFIED P4100 - ADDED TEST TO REPLACE DTSBX341 00025 * LOW-VALUES WITH SPACES. BINARY ZEROS WERE DTSBX341 00026 * CAUSING PROBLEMS ON THE WEB SIDE. DTSBX341 00027 * REFERENCE: PROGRAMMER: GD DTSBX341 00028 * DTSBX341 00029 * 07/10/2009 MODIFIED P7000 - CHANGED CODE TO INCLUDE PRIMARY DTSBX341 00030 * IF IT IS A TRADE NAME, AND AN ENTITY NAME IS DTSBX341 00031 * ALSO PRESENT. DTSBX341 00032 * REFERENCE: PROGRAMMER: GD DTSBX341 00033 * DTSBX341 00034 * 07/14/2009 MODIFIED P2100 - SET DETERMINATION PROCESS DATE DTSBX341 00035 * BASED ON STATUS OF SPAN OF LIABILITY. IF INACTIVEDTSBX341 00036 * USE INACTIVE ENTER DATE. DTSBX341 00037 * IF ACTIVE, FIND THE MOST RECENT FROM ESTB-DATE, DTSBX341 00038 * CHNG-DATE, INACT-REVERSE-DATE. DTSBX341 00039 * REFERENCE: PROGRAMMER: GD DTSBX341 00040 * DTSBX341 00041 * 04/15/2010 CHANGED HANDLING OF PROFILE-ONLY EMPLOYERS. DTSBX341 00042 * IN ADDITION TO THE PROFIILE RECORD, THE ADDRESS DTSBX341 00043 * RECORDS WILL ALSO BE SELECTED. DTSBX341 00044 * REFERENCE: PROGRAMMER: GD DTSBX341 00045 * DTSBX341 00046 * 04/05/2010 MODIFIED P1000 - ADDED ORG TYPE, SIC AND NAICS DTSBX341 00047 * ADDED PROCESSING FOR OPO DATA. DTSBX341 00048 * MODIFIED P6000 - ADDED TAX DUE DATE. DTSBX341 00049 * REFERENCE: PROGRAMMER: GD DTSBX341 00050 * DTSBX341 00051 * 05/14/2010 CORRECTED ORDER OF FIELDS IN W-QTR-REC TO DTSBX341 00052 * MATCH ORDER EXPECTED IN SQL SERVER DATABASE. DTSBX341 00053 * REFERENCE: PROGRAMMER: GD DTSBX341 00054 * DTSBX341 00055 * 11/02/2011 ADDED CODE TO P4100 AND P8200 TO REMOVE COMMAS DTSBX341 00056 * FROM THE CITY FIELD IN ADDRESSES. DTSBX341 00057 * REFERENCE: PROGRAMMER: GD DTSBX341 00058 * DTSBX341 00059 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBX341 00060 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBX341 00061 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBX341 00062 * DTSBX341 00063 * DTSBX341 00064 * DESCRIPTION: DTSBX341 00065 * DTSBX341 00066 * DTSBX341 00067 * INITIATION: DTSBX341 00068 * DTSBX341 00069 * SET LECM-MST-OPEN-READ-88 TO TRUE. DTSBX341 00070 * SET LECM-REF-OPEN-READ-88 TO TRUE. DTSBX341 00071 * DTSBX341 00072 * EDIT AND DEFAULT PARAMETERS. DTSBX341 00073 * DTSBX341 00074 * DTSBX341 00075 * PROCESSING: DTSBX341 00076 * DTSBX341 00077 * DTSBX341 00078 * TERMINATION: DTSBX341 00079 * DTSBX341 00080 * DTSBX341 00081 * DTSBX341 00082 * RECORDS READ: DTSBX341 00083 * DTSBX341 00084 * MASTER: DTSBX341 00085 * DTSBX341 00086 * MSOL DTSBX341 00087 * MQTR DTSBX341 00088 * DTSBX341 00089 * DTSBX341 00090 * ALTERNATE INDEX: DTSBX341 00091 * DTSBX341 00092 * NONE. DTSBX341 00093 * DTSBX341 00094 * DTSBX341 00095 * REFERENCE: DTSBX341 00096 * DTSBX341 00097 * DTSBX341 00098 * DTSBX341 00099 * RECORDS UPDATED: DTSBX341 00100 * DTSBX341 00101 * NONE DTSBX341 00102 * DTSBX341 00103 * DTSBX341 00104 * OUTPUT RECORDS WRITTEN: DTSBX341 00105 * DTSBX341 00106 * DTSBX331 DTSBX341 00107 * DTSBX341 00108 * DTSBX341 00109 * BATCH TRANSACTION COLLECTION RECORDS WRITTEN: DTSBX341 00110 * DTSBX341 00111 * NONE. DTSBX341 00112 * DTSBX341 00113 * DTSBX341 00114 * MODULES CALLED: DTSBX341 00115 * DTSBX341 00116 * DTSBU001 DATE EDIT/CONVERSION. DTSBX341 00117 * DTSBU004 QUARTER EDIT/CONVERSION. DTSBX341 00118 * DTSBU910 MASTER FILE I/O. DTSBX341 00119 * DTSBX341 00120 * DTSBX341 00121 * DTSBX341 00122 ***** DTSBX341 00123 SKIP3 DTSBX341 00124 ENVIRONMENT DIVISION. DTSBX341 00125 INPUT-OUTPUT SECTION. DTSBX341 00126 FILE-CONTROL. DTSBX341 00127 SELECT PARM-FILE ASSIGN TO DTSFPARM DTSBX341 00128 FILE STATUS IS PARM-STATUS. DTSBX341 00129 DTSBX341 00130 SELECT PROFILE-FILE ASSIGN TO DTSFPRF DTSBX341 00131 FILE STATUS IS PROFILE-STATUS. DTSBX341 00132 DTSBX341 00133 SELECT DETERM-FILE ASSIGN TO DTSFDET DTSBX341 00134 FILE STATUS IS DETERM-STATUS. DTSBX341 00135 DTSBX341 00136 SELECT FSCHED-FILE ASSIGN TO DTSFFSC DTSBX341 00137 FILE STATUS IS FSC-STATUS. DTSBX341 00138 DTSBX341 00139 SELECT ADDRESS-FILE ASSIGN TO DTSFADR DTSBX341 00140 FILE STATUS IS ADR-STATUS. DTSBX341 00141 DTSBX341 00142 SELECT RATE-FILE ASSIGN TO DTSFRATE DTSBX341 00143 FILE STATUS IS RATE-STATUS. DTSBX341 00144 DTSBX341 00145 SELECT QTR-FILE ASSIGN TO DTSFQTR3 DTSBX341 00146 FILE STATUS IS QTR-STATUS. DTSBX341 00147 DTSBX341 00148 SELECT REL-FILE ASSIGN TO DTSFREL DTSBX341 00149 FILE STATUS IS REL-STATUS. DTSBX341 00150 DTSBX341 00151 SELECT NAME-FILE ASSIGN TO DTSFNAM DTSBX341 00152 FILE STATUS IS NAME-STATUS. DTSBX341 00153 DTSBX341 00154 SELECT OPO-FILE ASSIGN TO DTSFOPO DTSBX341 00155 FILE STATUS IS OPO-STATUS. DTSBX341 00156 DTSBX341 00157 DATA DIVISION. DTSBX341 00158 FILE SECTION. DTSBX341 00159 FD PARM-FILE DTSBX341 00160 RECORDING MODE IS F DTSBX341 00161 LABEL RECORDS ARE STANDARD DTSBX341 00162 BLOCK CONTAINS 0 CHARACTERS. DTSBX341 00163 DTSBX341 00164 01 PARM-REC. DTSBX341 00165 05 PARM-START-YRQ PIC S9(05) COMP-3. DTSBX341 00166 05 PARM-SUBJECT-YRQ PIC S9(05) COMP-3. DTSBX341 00167 05 PARM-PRIOR-RUN-DT PIC S9(09) COMP-3. DTSBX341 00168 05 FILLER PIC X(05). DTSBX341 00169 DTSBX341 00170 FD PROFILE-FILE DTSBX341 00171 RECORDING MODE IS F DTSBX341 00172 LABEL RECORDS ARE STANDARD DTSBX341 00173 BLOCK CONTAINS 0 CHARACTERS. DTSBX341 00174 DTSBX341 00175 01 PROFILE-REC PIC X(88). DTSBX341 00176 DTSBX341 00177 FD DETERM-FILE DTSBX341 00178 RECORDING MODE IS F DTSBX341 00179 LABEL RECORDS ARE STANDARD DTSBX341 00180 BLOCK CONTAINS 0 CHARACTERS. DTSBX341 00181 DTSBX341 00182 01 DETERM-REC PIC X(59). DTSBX341 00183 DTSBX341 00184 FD FSCHED-FILE DTSBX341 00185 RECORDING MODE IS F DTSBX341 00186 LABEL RECORDS ARE STANDARD DTSBX341 00187 BLOCK CONTAINS 0 CHARACTERS. DTSBX341 00188 DTSBX341 00189 01 FSCHED-REC PIC X(22). DTSBX341 00190 DTSBX341 00191 FD ADDRESS-FILE DTSBX341 00192 RECORDING MODE IS F DTSBX341 00193 LABEL RECORDS ARE STANDARD DTSBX341 00194 BLOCK CONTAINS 0 CHARACTERS. DTSBX341 00195 DTSBX341 00196 01 ADDRESS-REC PIC X(249). DTSBX341 00197 DTSBX341 00198 FD RATE-FILE DTSBX341 00199 RECORDING MODE IS F DTSBX341 00200 LABEL RECORDS ARE STANDARD DTSBX341 00201 BLOCK CONTAINS 0 CHARACTERS. DTSBX341 00202 DTSBX341 00203 01 RATE-REC PIC X(29). DTSBX341 00204 DTSBX341 00205 FD QTR-FILE DTSBX341 00206 RECORDING MODE IS F DTSBX341 00207 LABEL RECORDS ARE STANDARD DTSBX341 00208 BLOCK CONTAINS 0 CHARACTERS. DTSBX341 00209 DTSBX341 00210 01 QTR-REC PIC X(63). DTSBX341 00211 DTSBX341 00212 FD REL-FILE DTSBX341 00213 RECORDING MODE IS F DTSBX341 00214 LABEL RECORDS ARE STANDARD DTSBX341 00215 BLOCK CONTAINS 0 CHARACTERS. DTSBX341 00216 DTSBX341 00217 01 REL-REC PIC X(47). DTSBX341 00218 DTSBX341 00219 FD NAME-FILE DTSBX341 00220 RECORDING MODE IS F DTSBX341 00221 LABEL RECORDS ARE STANDARD DTSBX341 00222 BLOCK CONTAINS 0 CHARACTERS. DTSBX341 00223 DTSBX341 00224 01 NAME-REC PIC X(53). DTSBX341 00225 DTSBX341 00226 FD OPO-FILE DTSBX341 00227 RECORDING MODE IS F DTSBX341 00228 LABEL RECORDS ARE STANDARD DTSBX341 00229 BLOCK CONTAINS 0 CHARACTERS. DTSBX341 00230 DTSBX341 00231 01 OPO-REC PIC X(385). DTSBX341 00232 DTSBX341 00233 WORKING-STORAGE SECTION. DTSBX341 002335 77 PAN-VALET PICTURE X(24) VALUE '021DTSBX341 11/03/11'. DTSBX341 00234 SKIP3 DTSBX341 00235 01 W-AREA. DTSBX341 00236 05 W-ABEND-CD PIC S9(04) COMP VALUE +341.DTSBX341 00237 DTSBX341 00238 DTSBX341 00239 05 ABEND-MSG PIC X(60). DTSBX341 00240 DTSBX341 00241 05 PARM-STATUS PIC X(02). DTSBX341 00242 88 PARM-STATUS-OK-88 VALUE '00'. DTSBX341 00243 05 PROFILE-STATUS PIC X(02). DTSBX341 00244 88 PROFILE-STATUS-OK-88 VALUE '00'. DTSBX341 00245 88 PROFILE-STATUS-EOF-88 VALUE '10'. DTSBX341 00246 05 DETERM-STATUS PIC X(02). DTSBX341 00247 88 DETERM-STATUS-OK-88 VALUE '00'. DTSBX341 00248 05 FSC-STATUS PIC X(02). DTSBX341 00249 88 FSC-STATUS-OK-88 VALUE '00'. DTSBX341 00250 05 ADR-STATUS PIC X(02). DTSBX341 00251 88 ADR-STATUS-OK-88 VALUE '00'. DTSBX341 00252 05 RATE-STATUS PIC X(02). DTSBX341 00253 88 RATE-STATUS-OK-88 VALUE '00'. DTSBX341 00254 05 QTR-STATUS PIC X(02). DTSBX341 00255 88 QTR-STATUS-OK-88 VALUE '00'. DTSBX341 00256 05 REL-STATUS PIC X(02). DTSBX341 00257 88 REL-STATUS-OK-88 VALUE '00'. DTSBX341 00258 05 NAME-STATUS PIC X(02). DTSBX341 00259 88 NAME-STATUS-OK-88 VALUE '00'. DTSBX341 00260 05 OPO-STATUS PIC X(02). DTSBX341 00261 88 OPO-STATUS-OK-88 VALUE '00'. DTSBX341 00262 DTSBX341 00263 05 W-ERROR-IND PIC X(01) VALUE 'N'. DTSBX341 00264 88 W-ERROR-YES-88 VALUE 'Y'. DTSBX341 00265 88 W-ERROR-NO-88 VALUE 'N'. DTSBX341 00266 DTSBX341 00267 05 W-CHK-QTRS-IND PIC X(01). DTSBX341 00268 88 W-CHK-QTRS-YES-88 VALUE 'Y'. DTSBX341 00269 88 W-CHK-QTRS-NO-88 VALUE 'N'. DTSBX341 00270 DTSBX341 00271 05 W-LAST-LIAB-YRQ PIC S9(05) COMP-3 VALUE +0. DTSBX341 00272 05 W-INACT-DATE PIC S9(09) COMP-3 VALUE +0. DTSBX341 00273 05 W-HOLD-EMP-NO PIC S9(07) COMP-3 VALUE +0. DTSBX341 00274 05 W-MERA-SOURCE-CD PIC X(02) VALUE ' '. DTSBX341 00275 DTSBX341 00276 05 W-ADDRESS. DTSBX341 00277 10 W-ATTN-LINE PIC X(40). DTSBX341 00278 10 W-DELIV-LINE-1 PIC X(40). DTSBX341 00279 10 W-DELIV-LINE-2 PIC X(40). DTSBX341 00280 10 W-CITY PIC X(25). DTSBX341 00281 10 W-ST PIC X(02). DTSBX341 00282 10 W-ZIP PIC X(10). DTSBX341 00283 10 W-ADVANCED-BARCODE PIC X(14). DTSBX341 00284 DTSBX341 00285 05 W-PHONE PIC X(15). DTSBX341 00286 05 W-FAX PIC X(15). DTSBX341 00287 05 W-EMAIL PIC X(40). DTSBX341 00288 DTSBX341 00289 05 W-PRF-REC. DTSBX341 00290 10 PRF-EMP-NO PIC 9(06). DTSBX341 00291 10 FILLER PIC X(01) VALUE ','. DTSBX341 00292 10 PRF-EMP-CLASS PIC X(01). DTSBX341 00293 10 FILLER PIC X(01) VALUE ','. DTSBX341 00294 10 PRF-EMP-NAME PIC X(40). DTSBX341 00295 10 FILLER PIC X(01) VALUE ','. DTSBX341 00296 10 PRF-FEIN PIC 9(09). DTSBX341 00297 10 FILLER PIC X(01) VALUE ','. DTSBX341 00298 10 PRF-EMP-STATUS PIC X(01). DTSBX341 00299 10 FILLER PIC X(01) VALUE ','. DTSBX341 00300 10 PRF-PROCESS-DT PIC X(10). DTSBX341 00301 10 FILLER PIC X(01) VALUE ','. DTSBX341 00302 10 PRF-ORG-TYPE PIC X(03). DTSBX341 00303 10 FILLER PIC X(01) VALUE ','. DTSBX341 00304 10 PRF-SIC PIC X(04). DTSBX341 00305 10 FILLER PIC X(01) VALUE ','. DTSBX341 00306 10 PRF-NAICS PIC X(06). DTSBX341 00307 DTSBX341 00308 05 W-DET-REC. DTSBX341 00309 10 DET-EMP-NO PIC 9(06). DTSBX341 00310 10 FILLER PIC X(01) VALUE ','. DTSBX341 00311 10 DET-LIABLE-START-DT PIC X(10). DTSBX341 00312 10 FILLER PIC X(01) VALUE ','. DTSBX341 00313 10 DET-LIABLE-START-QTR PIC X(06). DTSBX341 00314 10 FILLER PIC X(01) VALUE ','. DTSBX341 00315 10 DET-LIABLE-END-DT PIC X(10). DTSBX341 00316 10 FILLER PIC X(01) VALUE ','. DTSBX341 00317 10 DET-LIABLE-END-QTR PIC X(06). DTSBX341 00318 10 FILLER PIC X(01) VALUE ','. DTSBX341 00319 10 DET-LIABLE-CD PIC X(02). DTSBX341 00320 10 FILLER PIC X(01) VALUE ','. DTSBX341 00321 10 DET-INACTIVE-CD PIC X(02). DTSBX341 00322 10 FILLER PIC X(01) VALUE ','. DTSBX341 00323 10 DET-PROCESS-DT PIC X(10). DTSBX341 00324 DTSBX341 00325 05 W-FSC-REC. DTSBX341 00326 10 FSC-EMP-NO PIC 9(06). DTSBX341 00327 10 FILLER PIC X(01) VALUE ','. DTSBX341 00328 10 FSC-SCHEDULE PIC X(01). DTSBX341 00329 10 FILLER PIC X(01) VALUE ','. DTSBX341 00330 10 FSC-START-QTR PIC X(06). DTSBX341 00331 10 FILLER PIC X(01) VALUE ','. DTSBX341 00332 10 FSC-END-QTR PIC X(06). DTSBX341 00333 DTSBX341 00334 05 W-ADDRESS-REC. DTSBX341 00335 ++INCLUDE DTSIX110 DTSBX341 00336 DTSBX341 00337 05 W-NAME-REC. DTSBX341 00338 ++INCLUDE DTSIX106 DTSBX341 00339 DTSBX341 00340 05 W-OPO-REC. DTSBX341 00341 ++INCLUDE DTSIX120 DTSBX341 00342 DTSBX341 00343 05 W-RATE-REC. DTSBX341 00344 10 RATE-EMP-NO PIC 9(06). DTSBX341 00345 10 FILLER PIC X(01) VALUE ','. DTSBX341 00346 10 RATE-EFF-QTR PIC X(06). DTSBX341 00347 10 FILLER PIC X(01) VALUE ','. DTSBX341 00348 10 RATE-UI-RATE PIC Z9.9. DTSBX341 00349 10 RATE-UI-RATE-X REDEFINES RATE-UI-RATE DTSBX341 00350 PIC X(04). DTSBX341 00351 10 FILLER PIC X(01) VALUE ','. DTSBX341 00352 10 RATE-PROCESS-DT PIC X(10). DTSBX341 00353 DTSBX341 00354 05 W-QTR-REC. DTSBX341 00355 10 QTR-EMP-NO PIC 9(06). DTSBX341 00356 10 FILLER PIC X(01) VALUE ','. DTSBX341 00357 10 QTR-QUARTER PIC X(06). DTSBX341 00358 10 FILLER PIC X(01) VALUE ','. DTSBX341 00359 10 QTR-RPT-STATUS PIC X(01). DTSBX341 00360 10 FILLER PIC X(01) VALUE ','. DTSBX341 00361 10 QTR-RPT-DUE-DT PIC X(10). DTSBX341 00362 10 FILLER PIC X(01) VALUE ','. DTSBX341 00363 10 QTR-PROCESS-DT PIC X(10). DTSBX341 00364 10 FILLER PIC X(01) VALUE ','. DTSBX341 00365 10 QTR-BAL-DUE PIC ----------9.99. DTSBX341 00366 10 FILLER PIC X(01) VALUE ','. DTSBX341 00367 10 QTR-TAX-DUE-DT PIC X(10). DTSBX341 00368 DTSBX341 00369 05 W-REL-REC. DTSBX341 00370 10 REL-SUCC PIC 9(06). DTSBX341 00371 10 FILLER PIC X(01) VALUE ','. DTSBX341 00372 10 REL-PRED PIC 9(06). DTSBX341 00373 10 FILLER PIC X(01) VALUE ','. DTSBX341 00374 10 REL-PERCENT PIC 9.9(04). DTSBX341 00375 10 FILLER PIC X(01) VALUE ','. DTSBX341 00376 10 REL-TYPE-CODE PIC X(02). DTSBX341 00377 10 FILLER PIC X(01) VALUE ','. DTSBX341 00378 10 REL-EXP-TRANS-IND PIC X(01). DTSBX341 00379 88 EXP-TRANS-YES-88 VALUE 'Y'. DTSBX341 00380 88 EXP-TRANS-NO-88 VALUE 'N'. DTSBX341 00381 10 FILLER PIC X(01) VALUE ','. DTSBX341 00382 10 REL-EFF-DATE PIC X(10). DTSBX341 00383 10 FILLER PIC X(01) VALUE ','. DTSBX341 00384 10 REL-ESTB-DATE PIC X(10). DTSBX341 00385 DTSBX341 00386 05 SLASH-NAME. DTSBX341 00387 10 SLASH-NAME-CHAR OCCURS 40 TIMES PIC X(01). DTSBX341 00388 05 FIRST-NAME PIC X(40) VALUE SPACE. DTSBX341 00389 05 MIDDLE-INIT PIC X(01) VALUE SPACE. DTSBX341 00390 05 LAST-NAME PIC X(40) VALUE SPACE. DTSBX341 00391 05 NSUB PIC S9(04) COMP. DTSBX341 00392 05 FSUB PIC S9(04) COMP. DTSBX341 00393 05 LSUB PIC S9(04) COMP. DTSBX341 00394 05 LAST-NAME-COMPLETE-IND PIC X(01). DTSBX341 00395 88 LAST-NAME-COMPLETE-YES-88 VALUE 'Y'. DTSBX341 00396 88 LAST-NAME-COMPLETE-NO-88 VALUE 'N'. DTSBX341 00397 05 FIRST-NAME-COMPLETE-IND PIC X(01). DTSBX341 00398 88 FIRST-NAME-COMPLETE-YES-88 VALUE 'Y'. DTSBX341 00399 88 FIRST-NAME-COMPLETE-NO-88 VALUE 'N'. DTSBX341 00400 05 MID-INIT-COMPLETE-IND PIC X(01). DTSBX341 00401 88 MID-INIT-COMPLETE-YES-88 VALUE 'Y'. DTSBX341 00402 88 MID-INIT-COMPLETE-NO-88 VALUE 'N'. DTSBX341 00403 05 SLASH-FOUND-IND PIC X(01). DTSBX341 00404 88 SLASH-FOUND-YES-88 VALUE 'Y'. DTSBX341 00405 88 SLASH-FOUND-NO-88 VALUE 'N'. DTSBX341 00406 DTSBX341 00407 05 W-DEFAULT-DATE PIC X(10) DTSBX341 00408 VALUE '01/01/1994'. DTSBX341 00409 DTSBX341 00410 05 ALL-NINES-DT PIC S9(09) COMP-3 DTSBX341 00411 VALUE +999999999. DTSBX341 00412 05 ALL-NINES-DT-DISP PIC X(10) VALUE '12/31/9999'. DTSBX341 00413 05 ALL-NINES-QTR PIC S9(05) COMP-3 DTSBX341 00414 VALUE +99999. DTSBX341 00415 05 ALL-NINES-QTR-DISP PIC X(06) VALUE '9999/9'. DTSBX341 00416 DTSBX341 00417 05 W-QTR-BAL PIC S9(11)V99 COMP-3. DTSBX341 00418 05 W-ESTB-DATE PIC S9(09)V99 COMP-3. DTSBX341 00419 05 W-CHNG-DATE PIC S9(09)V99 COMP-3. DTSBX341 00420 05 W-PROCESS-DATE PIC S9(09)V99 COMP-3. DTSBX341 00421 DTSBX341 00422 05 W-ERROR-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX341 00423 05 W-PRF-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX341 00424 05 W-DET-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX341 00425 05 W-FSC-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX341 00426 05 W-QTR-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX341 00427 05 W-REL-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX341 00428 05 W-RATE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX341 00429 05 W-OPO-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX341 00430 05 W-X110-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX341 00431 05 W-NAME-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX341 00432 05 W-ALT-NAME-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX341 00433 05 W-RATE PIC S99V9 COMP-3. DTSBX341 00434 05 W-PCT PIC S9V9(04) COMP-3. DTSBX341 00435 05 SUB PIC S9(04) COMP. DTSBX341 00436 DTSBX341 00437 05 DISPLAY-CNT PIC Z(06)9. DTSBX341 00438 DTSBX341 00439 05 DISPLAY-AMT1-X PIC X(14). DTSBX341 00440 05 DISPLAY-AMT1 REDEFINES DISPLAY-AMT1-X DTSBX341 00441 PIC ---,---,--9.99. DTSBX341 00442 05 DISPLAY-AMT2-X PIC X(14). DTSBX341 00443 05 DISPLAY-AMT2 REDEFINES DISPLAY-AMT2-X DTSBX341 00444 PIC ---,---,--9.99. DTSBX341 00445 05 DISPLAY-AMT3-X PIC X(14). DTSBX341 00446 05 DISPLAY-AMT3 REDEFINES DISPLAY-AMT3-X DTSBX341 00447 PIC ---,---,--9.99. DTSBX341 00448 05 DISPLAY-AMT4-X PIC X(14). DTSBX341 00449 05 DISPLAY-AMT4 REDEFINES DISPLAY-AMT4-X DTSBX341 00450 PIC ---,---,--9.99. DTSBX341 00451 EJECT DTSBX341 00452 01 L001-LINK-AREA. DTSBX341 00453 ++INCLUDE DTSIL001 DTSBX341 00454 EJECT DTSBX341 00455 01 L004-LINK-AREA. DTSBX341 00456 ++INCLUDE DTSIL004 DTSBX341 00457 EJECT DTSBX341 00458 01 L005-LINK-AREA. DTSBX341 00459 ++INCLUDE DTSIL005 DTSBX341 00460 DTSBX341 00461 01 L910-LINK-AREA. DTSBX341 00462 ++INCLUDE DTSIL910 DTSBX341 00463 SKIP3 DTSBX341 00464 01 MSKL-REC. DTSBX341 00465 ++INCLUDE DTSIMSKL DTSBX341 00466 SKIP3 DTSBX341 00467 01 MHDR-REC. DTSBX341 00468 ++INCLUDE DTSIMHDR DTSBX341 00469 SKIP3 DTSBX341 00470 01 MERA-REC. DTSBX341 00471 ++INCLUDE DTSIMERA DTSBX341 00472 SKIP3 DTSBX341 00473 01 MLOG-REC. DTSBX341 00474 ++INCLUDE DTSIMLOG DTSBX341 00475 SKIP3 DTSBX341 00476 01 MOPO-REC. DTSBX341 00477 ++INCLUDE DTSIMOPO DTSBX341 00478 SKIP3 DTSBX341 00479 01 MSOL-REC. DTSBX341 00480 ++INCLUDE DTSIMSOL DTSBX341 00481 SKIP3 DTSBX341 00482 01 MRTE-REC. DTSBX341 00483 ++INCLUDE DTSIMRTE DTSBX341 00484 SKIP3 DTSBX341 00485 01 MTAD-REC. DTSBX341 00486 ++INCLUDE DTSIMTAD DTSBX341 00487 SKIP3 DTSBX341 00488 01 MTAA-REC. DTSBX341 00489 ++INCLUDE DTSIMTAA DTSBX341 00490 SKIP3 DTSBX341 00491 01 MFSC-REC. DTSBX341 00492 ++INCLUDE DTSIMFSC DTSBX341 00493 SKIP3 DTSBX341 00494 01 MQTR-REC. DTSBX341 00495 ++INCLUDE DTSIMQTR DTSBX341 00496 SKIP3 DTSBX341 00497 01 MREL-REC. DTSBX341 00498 ++INCLUDE DTSIMREL DTSBX341 00499 SKIP3 DTSBX341 00500 01 L921-LINK-AREA. DTSBX341 00501 ++INCLUDE DTSIL921 DTSBX341 00502 SKIP3 DTSBX341 00503 01 ISKL-REC. DTSBX341 00504 ++INCLUDE DTSIISKL DTSBX341 00505 SKIP3 DTSBX341 00506 01 IEIN-REC. DTSBX341 00507 ++INCLUDE DTSIIEIN DTSBX341 00508 DTSBX341 00509 01 L931-LINK-AREA. DTSBX341 00510 ++INCLUDE DTSIL931 DTSBX341 00511 SKIP3 DTSBX341 00512 01 FSKL-REC. DTSBX341 00513 ++INCLUDE DTSIFSKL DTSBX341 00514 SKIP3 DTSBX341 00515 01 FQTR-REC. DTSBX341 00516 ++INCLUDE DTSIFQTR DTSBX341 00517 DTSBX341 00518 LINKAGE SECTION. DTSBX341 00519 DTSBX341 00520 01 LX34-LINK-AREA. DTSBX341 00521 ++INCLUDE DTSILX34 DTSBX341 00522 DTSBX341 00523 01 MPRF-REC. DTSBX341 00524 ++INCLUDE DTSIMPRF DTSBX341 00525 EJECT DTSBX341 00526 PROCEDURE DIVISION USING LX34-LINK-AREA DTSBX341 00527 MPRF-REC. DTSBX341 00528 DTSBX341 00529 EVALUATE TRUE DTSBX341 00530 WHEN LX34-INITIALIZE-88 DTSBX341 00531 PERFORM I0000-INITIALIZE THRU I0000-EXIT DTSBX341 00532 WHEN LX34-PROCESS-88 DTSBX341 00533 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBX341 00534 WHEN LX34-TERMINATE-88 DTSBX341 00535 PERFORM T0000-TERMINATE THRU T0000-EXIT DTSBX341 00536 END-EVALUATE. DTSBX341 00537 DTSBX341 00538 GOBACK. DTSBX341 00539 DTSBX341 00540 I0000-INITIALIZE. DTSBX341 00541 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. DTSBX341 00542 DTSBX341 00543 DTSBX341 00544 I0000-EXIT. DTSBX341 00545 EXIT. DTSBX341 00546 DTSBX341 00547 I2000-OPEN-FILES. DTSBX341 00548 OPEN OUTPUT PROFILE-FILE. DTSBX341 00549 IF NOT PROFILE-STATUS-OK-88 DTSBX341 00550 DISPLAY 'PROFILE FILE OPEN ERROR: ' PROFILE-STATUS DTSBX341 00551 MOVE 'FILE OPEN ERROR' DTSBX341 00552 TO ABEND-MSG DTSBX341 00553 PERFORM S999-ABEND THRU S999-EXIT DTSBX341 00554 END-IF. DTSBX341 00555 DTSBX341 00556 OPEN OUTPUT DETERM-FILE. DTSBX341 00557 IF NOT DETERM-STATUS-OK-88 DTSBX341 00558 DISPLAY 'DETERM FILE OPEN ERROR: ' DETERM-STATUS DTSBX341 00559 MOVE 'FILE OPEN ERROR' DTSBX341 00560 TO ABEND-MSG DTSBX341 00561 PERFORM S999-ABEND THRU S999-EXIT DTSBX341 00562 END-IF. DTSBX341 00563 DTSBX341 00564 OPEN OUTPUT FSCHED-FILE. DTSBX341 00565 IF NOT FSC-STATUS-OK-88 DTSBX341 00566 DISPLAY 'FSCHED FILE OPEN ERROR: ' FSC-STATUS DTSBX341 00567 MOVE 'FILE OPEN ERROR' DTSBX341 00568 TO ABEND-MSG DTSBX341 00569 PERFORM S999-ABEND THRU S999-EXIT DTSBX341 00570 END-IF. DTSBX341 00571 DTSBX341 00572 OPEN OUTPUT ADDRESS-FILE DTSBX341 00573 IF NOT ADR-STATUS-OK-88 DTSBX341 00574 DISPLAY 'ADDRESS FILE OPEN ERROR: ' ADR-STATUS DTSBX341 00575 MOVE 'FILE OPEN ERROR' DTSBX341 00576 TO ABEND-MSG DTSBX341 00577 PERFORM S999-ABEND THRU S999-EXIT DTSBX341 00578 END-IF. DTSBX341 00579 DTSBX341 00580 OPEN OUTPUT RATE-FILE DTSBX341 00581 IF NOT RATE-STATUS-OK-88 DTSBX341 00582 DISPLAY 'RATE FILE OPEN ERROR: ' RATE-STATUS DTSBX341 00583 MOVE 'FILE OPEN ERROR' DTSBX341 00584 TO ABEND-MSG DTSBX341 00585 PERFORM S999-ABEND THRU S999-EXIT DTSBX341 00586 END-IF. DTSBX341 00587 DTSBX341 00588 OPEN OUTPUT QTR-FILE. DTSBX341 00589 IF NOT QTR-STATUS-OK-88 DTSBX341 00590 DISPLAY 'BX341 QTR FILE OPEN ERROR: ' QTR-STATUS DTSBX341 00591 MOVE 'FILE OPEN ERROR' DTSBX341 00592 TO ABEND-MSG DTSBX341 00593 PERFORM S999-ABEND THRU S999-EXIT DTSBX341 00594 END-IF. DTSBX341 00595 DTSBX341 00596 OPEN OUTPUT REL-FILE. DTSBX341 00597 IF NOT REL-STATUS-OK-88 DTSBX341 00598 DISPLAY 'BX341 REL FILE OPEN ERROR: ' REL-STATUS DTSBX341 00599 MOVE 'FILE OPEN ERROR' DTSBX341 00600 TO ABEND-MSG DTSBX341 00601 PERFORM S999-ABEND THRU S999-EXIT DTSBX341 00602 END-IF. DTSBX341 00603 DTSBX341 00604 OPEN OUTPUT NAME-FILE. DTSBX341 00605 IF NOT NAME-STATUS-OK-88 DTSBX341 00606 DISPLAY 'BX341 NAME FILE OPEN ERROR: ' NAME-STATUS DTSBX341 00607 MOVE 'FILE OPEN ERROR' DTSBX341 00608 TO ABEND-MSG DTSBX341 00609 PERFORM S999-ABEND THRU S999-EXIT DTSBX341 00610 END-IF. DTSBX341 00611 DTSBX341 00612 OPEN OUTPUT OPO-FILE. DTSBX341 00613 IF NOT OPO-STATUS-OK-88 DTSBX341 00614 DISPLAY 'BX341 OPO FILE OPEN ERROR: ' OPO-STATUS DTSBX341 00615 MOVE 'FILE OPEN ERROR' DTSBX341 00616 TO ABEND-MSG DTSBX341 00617 PERFORM S999-ABEND THRU S999-EXIT DTSBX341 00618 END-IF. DTSBX341 00619 DTSBX341 00620 I2000-EXIT. DTSBX341 00621 EXIT. DTSBX341 00622 DTSBX341 00623 P0000-PROCESS. DTSBX341 00624 IF LX34-SELECT-PRF-88 DTSBX341 00625 PERFORM P1000-PROFILE THRU P1000-EXIT DTSBX341 00626 PERFORM P4000-ADDRESS THRU P4000-EXIT DTSBX341 00627 PERFORM P7000-NAMES THRU P7000-EXIT DTSBX341 00628 ELSE DTSBX341 00629 PERFORM P1000-PROFILE THRU P1000-EXIT DTSBX341 00630 PERFORM P2000-DETERM THRU P2000-EXIT DTSBX341 00631 PERFORM P3000-FILING-SCHED THRU P3000-EXIT DTSBX341 00632 PERFORM P4000-ADDRESS THRU P4000-EXIT DTSBX341 00633 PERFORM P5000-RATE THRU P5000-EXIT DTSBX341 00634 IF W-CHK-QTRS-YES-88 DTSBX341 00635 PERFORM P6000-CHK-QTRS THRU P6000-EXIT DTSBX341 00636 END-IF DTSBX341 00637 PERFORM P7000-NAMES THRU P7000-EXIT DTSBX341 00638 PERFORM P8000-OPO THRU P8000-EXIT DTSBX341 00639 END-IF. DTSBX341 00640 DTSBX341 00641 P0000-EXIT. DTSBX341 00642 EXIT. DTSBX341 00643 DTSBX341 00644 DTSBX341 00645 P1000-PROFILE. DTSBX341 00646 IF LX34-RUN-INCREMENTAL-88 DTSBX341 00647 IF LX34-SELECT-UPD-88 DTSBX341 00648 IF LX34-SELECT-NAME-YES-88 DTSBX341 00649 OR LX34-SELECT-SOL-YES-88 DTSBX341 00650 NEXT SENTENCE DTSBX341 00651 ELSE DTSBX341 00652 GO TO P1000-EXIT DTSBX341 00653 END-IF DTSBX341 00654 END-IF DTSBX341 00655 END-IF. DTSBX341 00656 DTSBX341 00657 MOVE MPRF-EMP-NO TO PRF-EMP-NO. DTSBX341 00658 MOVE MPRF-EMP-CLASS TO PRF-EMP-CLASS. DTSBX341 00659 MOVE MPRF-PRIMARY-NAME TO PRF-EMP-NAME. DTSBX341 00660 INSPECT PRF-EMP-NAME REPLACING ALL ',' BY SPACE. DTSBX341 00661 INSPECT PRF-EMP-NAME REPLACING ALL QUOTE BY SPACE. DTSBX341 00662 INSPECT PRF-EMP-NAME REPLACING ALL '"' BY SPACE. DTSBX341 00663 MOVE MPRF-FEIN TO PRF-FEIN. DTSBX341 00664 MOVE MPRF-EMP-STATUS TO PRF-EMP-STATUS. DTSBX341 00665 IF MPRF-ESTB-DATE NOT = ZERO DTSBX341 00666 MOVE MPRF-ESTB-DATE TO L001-FED-8-DATE-9 DTSBX341 00667 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBX341 00668 IF L001-VALID-DATE DTSBX341 00669 MOVE L001-SLASH-8-DATE TO PRF-PROCESS-DT DTSBX341 00670 ELSE DTSBX341 00671 MOVE W-DEFAULT-DATE TO PRF-PROCESS-DT DTSBX341 00672 END-IF DTSBX341 00673 ELSE DTSBX341 00674 MOVE W-DEFAULT-DATE TO PRF-PROCESS-DT DTSBX341 00675 END-IF. DTSBX341 00676 DTSBX341 00677 IF PRF-PROCESS-DT = W-DEFAULT-DATE DTSBX341 00678 MOVE MPRF-CHNG-DATE TO L001-FED-8-DATE-9 DTSBX341 00679 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBX341 00680 IF L001-VALID-DATE DTSBX341 00681 MOVE L001-SLASH-8-DATE TO PRF-PROCESS-DT DTSBX341 00682 END-IF DTSBX341 00683 END-IF. DTSBX341 00684 DTSBX341 00685 MOVE MPRF-ORG-TYPE TO PRF-ORG-TYPE. DTSBX341 00686 MOVE MPRF-SIC-CD TO PRF-SIC. DTSBX341 00687 MOVE MPRF-NAICS-CD TO PRF-NAICS. DTSBX341 00688 DTSBX341 00689 WRITE PROFILE-REC FROM W-PRF-REC. DTSBX341 00690 IF PROFILE-STATUS-OK-88 DTSBX341 00691 ADD +1 TO W-PRF-CNT DTSBX341 00692 ELSE DTSBX341 00693 DISPLAY 'CANNOT WRITE PROFILE ' MPRF-EMP-NO DTSBX341 00694 END-IF. DTSBX341 00695 DTSBX341 00696 P1000-EXIT. DTSBX341 00697 EXIT. DTSBX341 00698 DTSBX341 00699 P2000-DETERM. DTSBX341 00700 SET W-CHK-QTRS-NO-88 TO TRUE. DTSBX341 00701 DTSBX341 00702 IF LX34-RUN-INCREMENTAL-88 DTSBX341 00703 IF LX34-SELECT-UPD-88 DTSBX341 00704 IF LX34-SELECT-SOL-YES-88 DTSBX341 00705 NEXT SENTENCE DTSBX341 00706 ELSE DTSBX341 00707 GO TO P2000-EXIT DTSBX341 00708 END-IF DTSBX341 00709 END-IF DTSBX341 00710 END-IF. DTSBX341 00711 DTSBX341 00712 MOVE LOW-VALUES TO MSOL-REC. DTSBX341 00713 MOVE MPRF-EMP-NO TO MSOL-EMP-NO. DTSBX341 00714 SET MSOL-SOL-88 TO TRUE. DTSBX341 00715 MOVE MSOL-KEY-AREA TO MSKL-KEY-AREA. DTSBX341 00716 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBX341 00717 DTSBX341 00718 PERFORM DTSBX341 00719 UNTIL L910-NO-REC-88 DTSBX341 00720 MOVE MSKL-REC TO MSOL-REC DTSBX341 00721 IF NOT MSOL-INACT-WITHDRAWN-88 DTSBX341 00722 IF LX34-RUN-INCREMENTAL-88 DTSBX341 00723 IF MSOL-ESTB-DATE = LX34-PRIOR-RUN-DATE DTSBX341 00724 OR MSOL-CHNG-DATE = LX34-PRIOR-RUN-DATE DTSBX341 00725 SET W-CHK-QTRS-YES-88 TO TRUE DTSBX341 00726 PERFORM P2100-WRITE THRU P2100-EXIT DTSBX341 00727 END-IF DTSBX341 00728 ELSE DTSBX341 00729 PERFORM P2100-WRITE THRU P2100-EXIT DTSBX341 00730 END-IF DTSBX341 00731 END-IF DTSBX341 00732 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBX341 00733 END-PERFORM. DTSBX341 00734 DTSBX341 00735 P2000-EXIT. DTSBX341 00736 EXIT. DTSBX341 00737 DTSBX341 00738 P2100-WRITE. DTSBX341 00739 MOVE MPRF-EMP-NO TO DET-EMP-NO. DTSBX341 00740 MOVE MSOL-LIAB-DATE TO L001-FED-8-DATE-9 DTSBX341 00741 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBX341 00742 IF L001-VALID-DATE DTSBX341 00743 MOVE L001-SLASH-8-DATE TO DET-LIABLE-START-DT DTSBX341 00744 ELSE DTSBX341 00745 DISPLAY 'INVALID LIABLE START DT ' MPRF-EMP-NO DTSBX341 00746 GO TO P2100-EXIT DTSBX341 00747 END-IF. DTSBX341 00748 DTSBX341 00749 MOVE MSOL-FIRST-LIAB-YRQ TO L004-QTR-5-9 DTSBX341 00750 PERFORM S004-FROM-5 THRU S004-EXIT DTSBX341 00751 IF L004-VALID-QTR DTSBX341 00752 MOVE L004-SLASH-5-QTR TO DET-LIABLE-START-QTR DTSBX341 00753 ELSE DTSBX341 00754 DISPLAY 'INVALID LIABLE START QTR ' MPRF-EMP-NO DTSBX341 00755 GO TO P2100-EXIT DTSBX341 00756 END-IF. DTSBX341 00757 DTSBX341 00758 ** IF MSOL-INACT-WITHDRAWN-88 DTSBX341 00759 * MOVE SPACES TO DET-LIABLE-START-QTR DTSBX341 00760 * ELSE DTSBX341 00761 * MOVE MSOL-FIRST-LIAB-YRQ TO L004-QTR-5-9 DTSBX341 00762 * PERFORM S004-FROM-5 THRU S004-EXIT DTSBX341 00763 * IF L004-VALID-QTR DTSBX341 00764 * MOVE L004-SLASH-5-QTR TO DET-LIABLE-START-QTR DTSBX341 00765 * ELSE DTSBX341 00766 * DISPLAY 'INVALID LIABLE START QTR ' MPRF-EMP-NO DTSBX341 00767 * GO TO P2100-EXIT DTSBX341 00768 * END-IF DTSBX341 00769 ** END-IF. DTSBX341 00770 DTSBX341 00771 MOVE MSOL-LIAB-CD TO DET-LIABLE-CD. DTSBX341 00772 DTSBX341 00773 IF MSOL-INACT-DATE = ALL-NINES-DT DTSBX341 00774 MOVE ALL-NINES-DT-DISP TO DET-LIABLE-END-DT DTSBX341 00775 ELSE DTSBX341 00776 MOVE MSOL-INACT-DATE TO L001-FED-8-DATE-9 DTSBX341 00777 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBX341 00778 IF L001-VALID-DATE DTSBX341 00779 MOVE L001-SLASH-8-DATE TO DET-LIABLE-END-DT DTSBX341 00780 ELSE DTSBX341 00781 GO TO P2100-EXIT DTSBX341 00782 END-IF DTSBX341 00783 END-IF. DTSBX341 00784 DTSBX341 00785 IF MSOL-LAST-LIAB-YRQ = ALL-NINES-QTR DTSBX341 00786 MOVE ALL-NINES-QTR-DISP TO DET-LIABLE-END-QTR DTSBX341 00787 ELSE DTSBX341 00788 MOVE MSOL-LAST-LIAB-YRQ TO L004-QTR-5-9 DTSBX341 00789 PERFORM S004-FROM-5 THRU S004-EXIT DTSBX341 00790 IF L004-VALID-QTR DTSBX341 00791 MOVE L004-SLASH-5-QTR TO DET-LIABLE-END-QTR DTSBX341 00792 ELSE DTSBX341 00793 GO TO P2100-EXIT DTSBX341 00794 END-IF DTSBX341 00795 END-IF. DTSBX341 00796 DTSBX341 00797 ** IF MSOL-INACT-WITHDRAWN-88 DTSBX341 00798 * MOVE SPACES TO DET-LIABLE-END-QTR DTSBX341 00799 * ELSE DTSBX341 00800 * IF MSOL-LAST-LIAB-YRQ = ALL-NINES-QTR DTSBX341 00801 * MOVE ALL-NINES-QTR-DISP TO DET-LIABLE-END-QTR DTSBX341 00802 * ELSE DTSBX341 00803 * MOVE MSOL-LAST-LIAB-YRQ TO L004-QTR-5-9 DTSBX341 00804 * PERFORM S004-FROM-5 THRU S004-EXIT DTSBX341 00805 * IF L004-VALID-QTR DTSBX341 00806 * MOVE L004-SLASH-5-QTR TO DET-LIABLE-END-QTR DTSBX341 00807 * ELSE DTSBX341 00808 * GO TO P2100-EXIT DTSBX341 00809 * END-IF DTSBX341 00810 * END-IF DTSBX341 00811 ** END-IF. DTSBX341 00812 DTSBX341 00813 MOVE MSOL-INACT-CD TO DET-INACTIVE-CD. DTSBX341 00814 DTSBX341 00815 IF MSOL-INACT-INACTIVE-88 DTSBX341 00816 MOVE MSOL-INACT-ENTER-DATE TO L001-FED-8-DATE-9 DTSBX341 00817 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBX341 00818 IF L001-VALID-DATE DTSBX341 00819 MOVE L001-SLASH-8-DATE TO DET-PROCESS-DT DTSBX341 00820 ELSE DTSBX341 00821 MOVE W-DEFAULT-DATE TO DET-PROCESS-DT DTSBX341 00822 END-IF DTSBX341 00823 END-IF. DTSBX341 00824 DTSBX341 00825 IF MSOL-INACT-ACTIVE-88 DTSBX341 00826 PERFORM P2110-MOST-RECENT-DT THRU P2110-EXIT DTSBX341 00827 MOVE W-PROCESS-DATE TO L001-FED-8-DATE-9 DTSBX341 00828 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBX341 00829 IF L001-VALID-DATE DTSBX341 00830 MOVE L001-SLASH-8-DATE TO DET-PROCESS-DT DTSBX341 00831 ELSE DTSBX341 00832 MOVE W-DEFAULT-DATE TO DET-PROCESS-DT DTSBX341 00833 END-IF DTSBX341 00834 END-IF. DTSBX341 00835 DTSBX341 00836 WRITE DETERM-REC FROM W-DET-REC. DTSBX341 00837 IF DETERM-STATUS-OK-88 DTSBX341 00838 ADD +1 TO W-DET-CNT DTSBX341 00839 ELSE DTSBX341 00840 DISPLAY 'CANNOT WRITE DETERM ' MPRF-EMP-NO DTSBX341 00841 END-IF. DTSBX341 00842 DTSBX341 00843 P2100-EXIT. DTSBX341 00844 EXIT. DTSBX341 00845 DTSBX341 00846 P2110-MOST-RECENT-DT. DTSBX341 00847 MOVE MSOL-ESTB-DATE TO W-PROCESS-DATE. DTSBX341 00848 IF MSOL-CHNG-DATE > W-PROCESS-DATE DTSBX341 00849 MOVE MSOL-CHNG-DATE TO W-PROCESS-DATE DTSBX341 00850 END-IF. DTSBX341 00851 DTSBX341 00852 IF MSOL-INACT-REVERSE-DATE > W-PROCESS-DATE DTSBX341 00853 MOVE MSOL-INACT-REVERSE-DATE TO W-PROCESS-DATE DTSBX341 00854 END-IF. DTSBX341 00855 DTSBX341 00856 P2110-EXIT. DTSBX341 00857 EXIT. DTSBX341 00858 DTSBX341 00859 P3000-FILING-SCHED. DTSBX341 00860 IF LX34-RUN-INCREMENTAL-88 DTSBX341 00861 IF LX34-SELECT-UPD-88 DTSBX341 00862 IF LX34-SELECT-FSC-YES-88 DTSBX341 00863 NEXT SENTENCE DTSBX341 00864 ELSE DTSBX341 00865 GO TO P3000-EXIT DTSBX341 00866 END-IF DTSBX341 00867 END-IF DTSBX341 00868 END-IF. DTSBX341 00869 DTSBX341 00870 MOVE LOW-VALUES TO MFSC-REC. DTSBX341 00871 MOVE MPRF-EMP-NO TO MFSC-EMP-NO. DTSBX341 00872 SET MFSC-FSC-88 TO TRUE. DTSBX341 00873 MOVE MFSC-KEY-AREA TO MSKL-KEY-AREA. DTSBX341 00874 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBX341 00875 DTSBX341 00876 PERFORM DTSBX341 00877 UNTIL L910-NO-REC-88 DTSBX341 00878 MOVE MSKL-REC TO MFSC-REC DTSBX341 00879 IF MFSC-STATUS-OPEN-88 DTSBX341 00880 PERFORM P3100-WRITE THRU P3100-EXIT DTSBX341 00881 END-IF DTSBX341 00882 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBX341 00883 END-PERFORM. DTSBX341 00884 DTSBX341 00885 P3000-EXIT. DTSBX341 00886 EXIT. DTSBX341 00887 DTSBX341 00888 P3100-WRITE. DTSBX341 00889 MOVE MPRF-EMP-NO TO FSC-EMP-NO. DTSBX341 00890 DTSBX341 00891 MOVE MFSC-FILING-SCHEDULE-CD TO FSC-SCHEDULE. DTSBX341 00892 DTSBX341 00893 MOVE MFSC-START-YRQ TO L004-QTR-5-9. DTSBX341 00894 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBX341 00895 IF L004-VALID-QTR DTSBX341 00896 MOVE L004-SLASH-5-QTR TO FSC-START-QTR DTSBX341 00897 ELSE DTSBX341 00898 DISPLAY 'INVALID START QTR ' MPRF-EMP-NO DTSBX341 00899 GO TO P3100-EXIT DTSBX341 00900 END-IF. DTSBX341 00901 DTSBX341 00902 IF MFSC-END-YRQ = ALL-NINES-QTR DTSBX341 00903 MOVE ALL-NINES-QTR-DISP TO FSC-END-QTR DTSBX341 00904 ELSE DTSBX341 00905 MOVE MFSC-END-YRQ TO L004-QTR-5-9 DTSBX341 00906 PERFORM S004-FROM-5 THRU S004-EXIT DTSBX341 00907 IF L004-VALID-QTR DTSBX341 00908 MOVE L004-SLASH-5-QTR TO FSC-END-QTR DTSBX341 00909 ELSE DTSBX341 00910 DISPLAY 'INVALID END QTR ' MPRF-EMP-NO DTSBX341 00911 GO TO P3100-EXIT DTSBX341 00912 END-IF DTSBX341 00913 END-IF. DTSBX341 00914 DTSBX341 00915 WRITE FSCHED-REC FROM W-FSC-REC. DTSBX341 00916 IF FSC-STATUS-OK-88 DTSBX341 00917 ADD +1 TO W-FSC-CNT DTSBX341 00918 ELSE DTSBX341 00919 DISPLAY 'CANNOT WRITE FILING SCHEDULE ' MPRF-EMP-NO DTSBX341 00920 END-IF. DTSBX341 00921 DTSBX341 00922 P3100-EXIT. DTSBX341 00923 EXIT. DTSBX341 00924 DTSBX341 00925 P4000-ADDRESS. DTSBX341 00926 IF LX34-RUN-INCREMENTAL-88 DTSBX341 00927 IF LX34-SELECT-UPD-88 DTSBX341 00928 IF LX34-SELECT-ADDR-YES-88 DTSBX341 00929 NEXT SENTENCE DTSBX341 00930 ELSE DTSBX341 00931 GO TO P4000-EXIT DTSBX341 00932 END-IF DTSBX341 00933 END-IF DTSBX341 00934 END-IF. DTSBX341 00935 DTSBX341 00936 MOVE LOW-VALUES TO MTAD-KEY-AREA. DTSBX341 00937 MOVE MPRF-EMP-NO TO MTAD-EMP-NO. DTSBX341 00938 SET MTAD-TAD-88 TO TRUE. DTSBX341 00939 SET MTAD-ID-TAX-MAILING-ADDR-88 TO TRUE. DTSBX341 00940 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. DTSBX341 00941 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBX341 00942 PERFORM UNTIL L910-NO-REC-88 DTSBX341 00943 MOVE MSKL-REC TO MTAD-REC DTSBX341 00944 MOVE MTAD-ADDRESS TO W-ADDRESS DTSBX341 00945 IF MTAD-ID-TAX-MAILING-ADDR-88 DTSBX341 00946 SET X110-ADDR-TYPE-MAIL-88 TO TRUE DTSBX341 00947 ELSE DTSBX341 00948 SET X110-ADDR-TYPE-RECS-88 TO TRUE DTSBX341 00949 END-IF DTSBX341 00950 MOVE MTAD-VOICE-1 TO W-PHONE DTSBX341 00951 MOVE MTAD-FAX TO W-FAX DTSBX341 00952 MOVE MTAD-EMAIL-ADDRESS TO W-EMAIL DTSBX341 00953 PERFORM P4100-WRITE-X110 THRU P4100-EXIT DTSBX341 00954 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBX341 00955 END-PERFORM. DTSBX341 00956 DTSBX341 00957 MOVE LOW-VALUES TO MTAA-KEY-AREA. DTSBX341 00958 MOVE MPRF-EMP-NO TO MTAA-EMP-NO. DTSBX341 00959 SET MTAA-TAA-88 TO TRUE. DTSBX341 00960 MOVE MTAA-KEY-AREA TO MSKL-KEY-AREA. DTSBX341 00961 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBX341 00962 PERFORM UNTIL L910-NO-REC-88 DTSBX341 00963 MOVE MSKL-REC TO MTAA-REC DTSBX341 00964 MOVE MTAA-ADDRESS TO W-ADDRESS DTSBX341 00965 SET X110-ADDR-TYPE-WORK-88 TO TRUE DTSBX341 00966 MOVE MTAA-VOICE-1 TO W-PHONE DTSBX341 00967 MOVE MTAA-FAX TO W-FAX DTSBX341 00968 MOVE MTAA-EMAIL-ADDRESS TO W-EMAIL DTSBX341 00969 PERFORM P4100-WRITE-X110 THRU P4100-EXIT DTSBX341 00970 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBX341 00971 END-PERFORM. DTSBX341 00972 DTSBX341 00973 P4000-EXIT. DTSBX341 00974 EXIT. DTSBX341 00975 DTSBX341 00976 P4100-WRITE-X110. DTSBX341 00977 MOVE MPRF-EMP-NO TO X110-EMP-NO. DTSBX341 00978 MOVE W-ATTN-LINE TO X110-ATTENTION. DTSBX341 00979 MOVE W-DELIV-LINE-1 TO X110-STREET-1. DTSBX341 00980 MOVE W-DELIV-LINE-2 TO X110-STREET-2. DTSBX341 00981 MOVE W-CITY TO X110-CITY. DTSBX341 00982 MOVE W-ST TO X110-STATE. DTSBX341 00983 MOVE W-ZIP TO X110-ZIP. DTSBX341 00984 MOVE W-PHONE TO X110-PHONE. DTSBX341 00985 MOVE W-FAX TO X110-FAX. DTSBX341 00986 IF W-EMAIL = LOW-VALUES DTSBX341 00987 MOVE SPACES TO X110-EMAIL DTSBX341 00988 ELSE DTSBX341 00989 MOVE W-EMAIL TO X110-EMAIL DTSBX341 00990 END-IF. DTSBX341 00991 DTSBX341 00992 INSPECT X110-ATTENTION REPLACING ALL ',' BY SPACE. DTSBX341 00993 INSPECT X110-STREET-1 REPLACING ALL ',' BY SPACE. DTSBX341 00994 INSPECT X110-STREET-2 REPLACING ALL ',' BY SPACE. DTSBX341 00995 INSPECT X110-STREET-2 DTSBX341 00996 REPLACING ALL LOW-VALUES BY SPACE. DTSBX341 00997 INSPECT X110-CITY REPLACING ALL ',' BY SPACE. DTSBX341 00998 INSPECT X110-EMAIL REPLACING ALL ',' BY SPACE. DTSBX341 00999 DTSBX341 01000 ** PERFORM DTSBX341 01001 * VARYING SUB FROM +1 BY +1 DTSBX341 01002 * UNTIL SUB > +40 DTSBX341 01003 * IF X110-STREET-2(SUB:1) < SPACE DTSBX341 01004 * DISPLAY 'P4100 ' MPRF-EMP-NO ' ' X110-ADDR-TYPE DTSBX341 01005 * MOVE SPACE TO X110-STREET-2 (SUB:1) DTSBX341 01006 * END-IF DTSBX341 01007 ** END-PERFORM. DTSBX341 01008 DTSBX341 01009 WRITE ADDRESS-REC FROM W-ADDRESS-REC DTSBX341 01010 IF ADR-STATUS-OK-88 DTSBX341 01011 ADD +1 TO W-X110-CNT DTSBX341 01012 ELSE DTSBX341 01013 DISPLAY 'CANNOT WRITE X110 ' MPRF-EMP-NO DTSBX341 01014 END-IF. DTSBX341 01015 DTSBX341 01016 P4100-EXIT. DTSBX341 01017 EXIT. DTSBX341 01018 DTSBX341 01019 P5000-RATE. DTSBX341 01020 IF LX34-RUN-INCREMENTAL-88 DTSBX341 01021 IF LX34-SELECT-UPD-88 DTSBX341 01022 IF LX34-SELECT-RATE-YES-88 DTSBX341 01023 NEXT SENTENCE DTSBX341 01024 ELSE DTSBX341 01025 GO TO P5000-EXIT DTSBX341 01026 END-IF DTSBX341 01027 END-IF DTSBX341 01028 END-IF. DTSBX341 01029 DTSBX341 01030 MOVE LOW-VALUES TO MRTE-KEY-AREA. DTSBX341 01031 MOVE MPRF-EMP-NO TO MRTE-EMP-NO. DTSBX341 01032 SET MRTE-RTE-88 TO TRUE. DTSBX341 01033 MOVE MRTE-KEY-AREA TO MSKL-KEY-AREA. DTSBX341 01034 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBX341 01035 PERFORM UNTIL L910-NO-REC-88 DTSBX341 01036 MOVE MSKL-REC TO MRTE-REC DTSBX341 01037 PERFORM P5100-BUILD-RATE THRU P5100-EXIT DTSBX341 01038 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBX341 01039 END-PERFORM. DTSBX341 01040 DTSBX341 01041 P5000-EXIT. DTSBX341 01042 EXIT. DTSBX341 01043 DTSBX341 01044 P5100-BUILD-RATE. DTSBX341 01045 MOVE MPRF-EMP-NO TO RATE-EMP-NO. DTSBX341 01046 MOVE MRTE-EFF-YRQ TO L004-QTR-5-9. DTSBX341 01047 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBX341 01048 MOVE L004-SLASH-5-QTR TO RATE-EFF-QTR. DTSBX341 01049 COMPUTE W-RATE = (MRTE-UI-RATE * 100). DTSBX341 01050 MOVE W-RATE TO RATE-UI-RATE. DTSBX341 01051 MOVE MRTE-ESTB-DATE TO L001-FED-8-DATE-9. DTSBX341 01052 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX341 01053 IF L001-VALID-DATE DTSBX341 01054 MOVE L001-SLASH-8-DATE TO RATE-PROCESS-DT DTSBX341 01055 ELSE DTSBX341 01056 MOVE W-DEFAULT-DATE TO RATE-PROCESS-DT DTSBX341 01057 END-IF. DTSBX341 01058 DTSBX341 01059 IF RATE-PROCESS-DT = W-DEFAULT-DATE DTSBX341 01060 MOVE MRTE-CHNG-DATE TO L001-FED-8-DATE-9 DTSBX341 01061 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBX341 01062 IF L001-VALID-DATE DTSBX341 01063 MOVE L001-SLASH-8-DATE TO RATE-PROCESS-DT DTSBX341 01064 END-IF DTSBX341 01065 END-IF. DTSBX341 01066 DTSBX341 01067 WRITE RATE-REC FROM W-RATE-REC DTSBX341 01068 IF NOT RATE-STATUS-OK-88 DTSBX341 01069 DISPLAY 'CANNOT WRITE TO RATE FILE ' DTSBX341 01070 ' ' RATE-STATUS ' ' RATE-EMP-NO DTSBX341 01071 ELSE DTSBX341 01072 ADD +1 TO W-RATE-CNT DTSBX341 01073 END-IF. DTSBX341 01074 DTSBX341 01075 P5100-EXIT. DTSBX341 01076 EXIT. DTSBX341 01077 DTSBX341 01078 P6000-CHK-QTRS. DTSBX341 01079 DISPLAY 'BX341 P6000 ' MPRF-EMP-NO. DTSBX341 01080 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSBX341 01081 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBX341 01082 SET MQTR-QTR-88 TO TRUE. DTSBX341 01083 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBX341 01084 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBX341 01085 PERFORM UNTIL L910-NO-REC-88 DTSBX341 01086 MOVE MSKL-REC TO MQTR-REC DTSBX341 01087 IF MQTR-ESTB-DATE = LX34-PRIOR-RUN-DATE DTSBX341 01088 OR MQTR-CHNG-DATE = LX34-PRIOR-RUN-DATE DTSBX341 01089 PERFORM P6100-BUILD-QTR THRU P6100-EXIT DTSBX341 01090 END-IF DTSBX341 01091 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBX341 01092 END-PERFORM. DTSBX341 01093 DTSBX341 01094 P6000-EXIT. DTSBX341 01095 EXIT. DTSBX341 01096 DTSBX341 01097 P6100-BUILD-QTR. DTSBX341 01098 DISPLAY 'BX341 P6100 ' MPRF-EMP-NO ' ' MQTR-YRQ. DTSBX341 01099 MOVE MQTR-YRQ TO L004-QTR-5-9. DTSBX341 01100 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBX341 01101 MOVE L004-ABS-QTR TO LX34-SUB. DTSBX341 01102 IF LX34-QTR-EXISTS-YES-88 (LX34-SUB) DTSBX341 01103 GO TO P6100-EXIT DTSBX341 01104 ELSE DTSBX341 01105 SET LX34-QTR-EXISTS-YES-88 (LX34-SUB) TO TRUE DTSBX341 01106 END-IF. DTSBX341 01107 DTSBX341 01108 MOVE ZERO TO W-QTR-BAL. DTSBX341 01109 IF MPRF-TOT-BALANCE-AMT > ZERO DTSBX341 01110 PERFORM P6110-BAL-DUE THRU P6110-EXIT DTSBX341 01111 END-IF. DTSBX341 01112 DTSBX341 01113 MOVE MQTR-EMP-NO TO QTR-EMP-NO. DTSBX341 01114 MOVE MQTR-YRQ TO L004-QTR-5-9. DTSBX341 01115 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBX341 01116 IF L004-VALID-QTR DTSBX341 01117 MOVE L004-SLASH-5-QTR TO QTR-QUARTER DTSBX341 01118 ELSE DTSBX341 01119 GO TO P6100-EXIT DTSBX341 01120 END-IF. DTSBX341 01121 DTSBX341 01122 MOVE MQTR-CURR-RPT-TYPE TO QTR-RPT-STATUS. DTSBX341 01123 MOVE MQTR-RPT-DUE-DATE TO L001-FED-8-DATE-9. DTSBX341 01124 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX341 01125 MOVE L001-SLASH-8-DATE TO QTR-RPT-DUE-DT. DTSBX341 01126 MOVE MQTR-TAX-DUE-DATE TO L001-FED-8-DATE-9. DTSBX341 01127 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX341 01128 MOVE L001-SLASH-8-DATE TO QTR-TAX-DUE-DT. DTSBX341 01129 MOVE W-QTR-BAL TO QTR-BAL-DUE. DTSBX341 01130 DTSBX341 01131 MOVE MQTR-ESTB-DATE TO L001-FED-8-DATE-X. DTSBX341 01132 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX341 01133 IF L001-VALID-DATE DTSBX341 01134 MOVE L001-SLASH-8-DATE TO QTR-PROCESS-DT DTSBX341 01135 ELSE DTSBX341 01136 MOVE W-DEFAULT-DATE TO QTR-PROCESS-DT DTSBX341 01137 END-IF. DTSBX341 01138 DTSBX341 01139 IF QTR-PROCESS-DT = W-DEFAULT-DATE DTSBX341 01140 MOVE MQTR-CHNG-DATE TO L001-FED-8-DATE-9 DTSBX341 01141 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBX341 01142 IF L001-VALID-DATE DTSBX341 01143 MOVE L001-SLASH-8-DATE TO QTR-PROCESS-DT DTSBX341 01144 END-IF DTSBX341 01145 END-IF. DTSBX341 01146 DTSBX341 01147 WRITE QTR-REC FROM W-QTR-REC DTSBX341 01148 IF NOT QTR-STATUS-OK-88 DTSBX341 01149 DISPLAY 'CANNOT WRITE TO QTR FILE ' DTSBX341 01150 ' ' QTR-STATUS ' ' QTR-EMP-NO DTSBX341 01151 ELSE DTSBX341 01152 ADD +1 TO W-QTR-CNT DTSBX341 01153 END-IF. DTSBX341 01154 DTSBX341 01155 P6100-EXIT. DTSBX341 01156 EXIT. DTSBX341 01157 DTSBX341 01158 P6110-BAL-DUE. DTSBX341 01159 PERFORM DTSBX341 01160 VARYING MQTR-ACCT-IDX FROM +1 BY +1 DTSBX341 01161 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT DTSBX341 01162 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) TO W-QTR-BAL DTSBX341 01163 END-PERFORM. DTSBX341 01164 DTSBX341 01165 P6110-EXIT. DTSBX341 01166 EXIT. DTSBX341 01167 DTSBX341 01168 P7000-NAMES. DTSBX341 01169 IF MPRF-PRIMARY-IS-ENTITY-88 DTSBX341 01170 SET X106-NAME-TYPE-ENTITY-88 TO TRUE DTSBX341 01171 MOVE MPRF-PRIMARY-NAME TO X106-EMP-NAME DTSBX341 01172 PERFORM P7200-WRITE-X106 THRU P7200-EXIT DTSBX341 01173 ELSE DTSBX341 01174 SET X106-NAME-TYPE-TRADE-88 TO TRUE DTSBX341 01175 MOVE MPRF-PRIMARY-NAME TO X106-EMP-NAME DTSBX341 01176 PERFORM P7200-WRITE-X106 THRU P7200-EXIT DTSBX341 01177 IF MPRF-ENTITY-NAME > SPACES DTSBX341 01178 SET X106-NAME-TYPE-ENTITY-88 TO TRUE DTSBX341 01179 MOVE MPRF-ENTITY-NAME TO X106-EMP-NAME DTSBX341 01180 PERFORM P7200-WRITE-X106 THRU P7200-EXIT DTSBX341 01181 END-IF DTSBX341 01182 END-IF. DTSBX341 01183 DTSBX341 01184 PERFORM P7100-ALT-NAMES THRU P7100-EXIT. DTSBX341 01185 DTSBX341 01186 P7000-EXIT. DTSBX341 01187 EXIT. DTSBX341 01188 DTSBX341 01189 P7100-ALT-NAMES. DTSBX341 01190 MOVE LOW-VALUES TO MTAA-REC. DTSBX341 01191 MOVE MPRF-EMP-NO TO MTAA-EMP-NO. DTSBX341 01192 SET MTAA-TAA-88 TO TRUE. DTSBX341 01193 MOVE MTAA-KEY-AREA TO MSKL-KEY-AREA. DTSBX341 01194 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBX341 01195 PERFORM DTSBX341 01196 UNTIL L910-NO-REC-88 DTSBX341 01197 MOVE MSKL-REC TO MTAA-REC DTSBX341 01198 IF MTAA-NAME > SPACES DTSBX341 01199 SET X106-NAME-TYPE-ALT-88 TO TRUE DTSBX341 01200 MOVE MTAA-NAME TO X106-EMP-NAME DTSBX341 01201 PERFORM P7200-WRITE-X106 THRU P7200-EXIT DTSBX341 01202 ADD +1 TO W-ALT-NAME-CNT DTSBX341 01203 END-IF DTSBX341 01204 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBX341 01205 END-PERFORM. DTSBX341 01206 DTSBX341 01207 P7100-EXIT. DTSBX341 01208 EXIT. DTSBX341 01209 DTSBX341 01210 P7200-WRITE-X106. DTSBX341 01211 MOVE MPRF-EMP-NO TO X106-EMP-NO. DTSBX341 01212 INSPECT X106-EMP-NAME REPLACING ALL ',' BY SPACE. DTSBX341 01213 INSPECT X106-EMP-NAME REPLACING ALL LOW-VALUES BY SPACE.DTSBX341 01214 DTSBX341 01215 WRITE NAME-REC FROM W-NAME-REC. DTSBX341 01216 IF NAME-STATUS-OK-88 DTSBX341 01217 ADD +1 TO W-NAME-CNT DTSBX341 01218 ELSE DTSBX341 01219 DISPLAY 'CANNOT WRITE TO NAME FILE ' DTSBX341 01220 ' ' NAME-STATUS ' ' MPRF-EMP-NO DTSBX341 01221 END-IF. DTSBX341 01222 DTSBX341 01223 P7200-EXIT. DTSBX341 01224 EXIT. DTSBX341 01225 DTSBX341 01226 P8000-OPO. DTSBX341 01227 MOVE LOW-VALUES TO MOPO-REC. DTSBX341 01228 MOVE MPRF-EMP-NO TO MOPO-EMP-NO. DTSBX341 01229 SET MOPO-OPO-88 TO TRUE. DTSBX341 01230 MOVE MOPO-KEY-AREA TO MSKL-KEY-AREA. DTSBX341 01231 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBX341 01232 PERFORM DTSBX341 01233 UNTIL L910-NO-REC-88 DTSBX341 01234 MOVE MSKL-REC TO MOPO-REC DTSBX341 01235 PERFORM P8100-PARSE-NAME THRU P8100-EXIT DTSBX341 01236 PERFORM P8200-WRITE-X120 THRU P8200-EXIT DTSBX341 01237 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBX341 01238 END-PERFORM. DTSBX341 01239 DTSBX341 01240 P8000-EXIT. DTSBX341 01241 EXIT. DTSBX341 01242 DTSBX341 01243 P8100-PARSE-NAME. DTSBX341 01244 MOVE +0 TO FSUB DTSBX341 01245 LSUB. DTSBX341 01246 MOVE SPACES TO FIRST-NAME DTSBX341 01247 MIDDLE-INIT DTSBX341 01248 LAST-NAME. DTSBX341 01249 SET FIRST-NAME-COMPLETE-NO-88 TO TRUE. DTSBX341 01250 SET LAST-NAME-COMPLETE-NO-88 TO TRUE. DTSBX341 01251 SET MID-INIT-COMPLETE-NO-88 TO TRUE. DTSBX341 01252 SET SLASH-FOUND-NO-88 TO TRUE. DTSBX341 01253 DTSBX341 01254 INSPECT MOPO-NAME REPLACING ALL ',' BY SPACE. DTSBX341 01255 DTSBX341 01256 MOVE MOPO-NAME TO SLASH-NAME. DTSBX341 01257 DTSBX341 01258 PERFORM DTSBX341 01259 VARYING NSUB FROM +1 BY +1 DTSBX341 01260 UNTIL NSUB > +40 DTSBX341 01261 IF SLASH-NAME-CHAR (NSUB) = '/' DTSBX341 01262 SET SLASH-FOUND-YES-88 TO TRUE DTSBX341 01263 END-IF DTSBX341 01264 END-PERFORM. DTSBX341 01265 DTSBX341 01266 IF SLASH-FOUND-NO-88 DTSBX341 01267 GO TO P8100-EXIT DTSBX341 01268 END-IF. DTSBX341 01269 DTSBX341 01270 PERFORM DTSBX341 01271 VARYING NSUB FROM +1 BY +1 DTSBX341 01272 UNTIL NSUB > +40 DTSBX341 01273 OR MID-INIT-COMPLETE-YES-88 DTSBX341 01274 IF FIRST-NAME-COMPLETE-YES-88 DTSBX341 01275 PERFORM P8130-MID-INIT THRU P8130-EXIT DTSBX341 01276 ELSE DTSBX341 01277 IF LAST-NAME-COMPLETE-YES-88 DTSBX341 01278 PERFORM P8110-FIRST-NAME THRU P8110-EXIT DTSBX341 01279 ELSE DTSBX341 01280 PERFORM P8120-LAST-NAME THRU P8120-EXIT DTSBX341 01281 END-IF DTSBX341 01282 END-IF DTSBX341 01283 END-PERFORM. DTSBX341 01284 DTSBX341 01285 P8100-EXIT. DTSBX341 01286 EXIT. DTSBX341 01287 DTSBX341 01288 P8110-FIRST-NAME. DTSBX341 01289 IF SLASH-NAME-CHAR (NSUB) = SPACE DTSBX341 01290 SET FIRST-NAME-COMPLETE-YES-88 TO TRUE DTSBX341 01291 GO TO P8110-EXIT DTSBX341 01292 ELSE DTSBX341 01293 IF FSUB < +20 DTSBX341 01294 ADD +1 TO FSUB DTSBX341 01295 MOVE SLASH-NAME-CHAR (NSUB) TO FIRST-NAME (FSUB:1) DTSBX341 01296 END-IF DTSBX341 01297 END-IF. DTSBX341 01298 DTSBX341 01299 P8110-EXIT. DTSBX341 01300 EXIT. DTSBX341 01301 DTSBX341 01302 P8120-LAST-NAME. DTSBX341 01303 IF SLASH-NAME-CHAR (NSUB) = '/' DTSBX341 01304 SET LAST-NAME-COMPLETE-YES-88 TO TRUE DTSBX341 01305 GO TO P8120-EXIT DTSBX341 01306 ELSE DTSBX341 01307 IF LSUB < +40 DTSBX341 01308 ADD +1 TO LSUB DTSBX341 01309 MOVE SLASH-NAME-CHAR (NSUB) TO LAST-NAME (LSUB:1) DTSBX341 01310 END-IF DTSBX341 01311 END-IF. DTSBX341 01312 DTSBX341 01313 P8120-EXIT. DTSBX341 01314 EXIT. DTSBX341 01315 DTSBX341 01316 P8130-MID-INIT. DTSBX341 01317 IF MID-INIT-COMPLETE-NO-88 DTSBX341 01318 MOVE SLASH-NAME-CHAR (NSUB) TO MIDDLE-INIT (1:1) DTSBX341 01319 SET MID-INIT-COMPLETE-YES-88 TO TRUE DTSBX341 01320 END-IF. DTSBX341 01321 DTSBX341 01322 P8130-EXIT. DTSBX341 01323 EXIT. DTSBX341 01324 DTSBX341 01325 P8200-WRITE-X120. DTSBX341 01326 DTSBX341 01327 MOVE MPRF-EMP-NO TO X120-EMP-NO. DTSBX341 01328 DTSBX341 01329 IF SLASH-FOUND-NO-88 DTSBX341 01330 MOVE MOPO-NAME TO X120-OPO-MEMBER-NAME DTSBX341 01331 MOVE SPACES TO X120-OPO-FIRST-NAME DTSBX341 01332 X120-OPO-MID-INIT DTSBX341 01333 X120-OPO-LAST-NAME DTSBX341 01334 ELSE DTSBX341 01335 IF LAST-NAME = SPACES DTSBX341 01336 GO TO P8200-EXIT DTSBX341 01337 ELSE DTSBX341 01338 MOVE FIRST-NAME (1:20) TO X120-OPO-FIRST-NAME DTSBX341 01339 MOVE MIDDLE-INIT TO X120-OPO-MID-INIT DTSBX341 01340 MOVE LAST-NAME (1:20) TO X120-OPO-LAST-NAME DTSBX341 01341 MOVE SPACES TO X120-OPO-MEMBER-NAME DTSBX341 01342 END-IF DTSBX341 01343 END-IF. DTSBX341 01344 DTSBX341 01345 ** IF FIRST-NAME = SPACES DTSBX341 01346 * MOVE MOPO-NAME TO X120-OPO-MEMBER-NAME DTSBX341 01347 * MOVE LAST-NAME (1:20) TO X120-OPO-FIRST-NAME DTSBX341 01348 * MOVE LAST-NAME (21:1) TO X120-OPO-MID-INIT DTSBX341 01349 * MOVE LAST-NAME (22:19) TO X120-OPO-LAST-NAME DTSBX341 01350 * ELSE DTSBX341 01351 * MOVE FIRST-NAME (1:20) TO X120-OPO-FIRST-NAME DTSBX341 01352 * MOVE MIDDLE-INIT TO X120-OPO-MID-INIT DTSBX341 01353 * MOVE LAST-NAME (1:20) TO X120-OPO-LAST-NAME DTSBX341 01354 * MOVE SPACES TO X120-OPO-MEMBER-NAME DTSBX341 01355 ** END-IF. DTSBX341 01356 DTSBX341 01357 ** MOVE SPACES TO X120-OPO-MEMBER-NAME. DTSBX341 01358 MOVE MOPO-SSN TO X120-OPO-SSN. DTSBX341 01359 MOVE MOPO-TITLE TO X120-OPO-TITLE. DTSBX341 01360 MOVE MOPO-TYPE-IND TO X120-TYPE-IND. DTSBX341 01361 IF MOPO-ATTN-LINE = LOW-VALUES DTSBX341 01362 MOVE SPACES TO X120-OPO-ATTENTION DTSBX341 01363 ELSE DTSBX341 01364 MOVE MOPO-ATTN-LINE TO X120-OPO-ATTENTION DTSBX341 01365 END-IF. DTSBX341 01366 MOVE MOPO-DELIV-LINE-1 TO X120-OPO-STREET-1. DTSBX341 01367 MOVE MOPO-DELIV-LINE-2 TO X120-OPO-STREET-2. DTSBX341 01368 MOVE MOPO-CITY TO X120-OPO-CITY. DTSBX341 01369 MOVE MOPO-ST TO X120-OPO-STATE. DTSBX341 01370 MOVE MOPO-ZIP TO X120-OPO-ZIP. DTSBX341 01371 MOVE MOPO-VOICE-1 TO X120-OPO-PHONE. DTSBX341 01372 MOVE MOPO-FAX TO X120-OPO-FAX. DTSBX341 01373 DTSBX341 01374 IF MOPO-EMAIL-ADDRESS = LOW-VALUES DTSBX341 01375 MOVE SPACES TO X120-OPO-EMAIL DTSBX341 01376 ELSE DTSBX341 01377 MOVE MOPO-EMAIL-ADDRESS TO X120-OPO-EMAIL DTSBX341 01378 END-IF. DTSBX341 01379 DTSBX341 01380 INSPECT X120-OPO-FIRST-NAME REPLACING ALL ',' BY SPACE. DTSBX341 01381 INSPECT X120-OPO-MID-INIT REPLACING ALL ',' BY SPACE. DTSBX341 01382 INSPECT X120-OPO-LAST-NAME REPLACING ALL ',' BY SPACE. DTSBX341 01383 INSPECT X120-OPO-TITLE REPLACING ALL ',' BY SPACE. DTSBX341 01384 INSPECT X120-OPO-ATTENTION REPLACING ALL ',' BY SPACE. DTSBX341 01385 INSPECT X120-OPO-STREET-1 REPLACING ALL ',' BY SPACE. DTSBX341 01386 INSPECT X120-OPO-STREET-2 REPLACING ALL ',' BY SPACE. DTSBX341 01387 INSPECT X120-OPO-CITY REPLACING ALL ',' BY SPACE. DTSBX341 01388 INSPECT X120-OPO-EMAIL REPLACING ALL ',' BY SPACE. DTSBX341 01389 DTSBX341 01390 WRITE OPO-REC FROM W-OPO-REC. DTSBX341 01391 IF OPO-STATUS-OK-88 DTSBX341 01392 ADD +1 TO W-OPO-CNT DTSBX341 01393 ELSE DTSBX341 01394 DISPLAY 'CANNOT WRITE X120 ' MPRF-EMP-NO DTSBX341 01395 END-IF. DTSBX341 01396 DTSBX341 01397 P8200-EXIT. DTSBX341 01398 EXIT. DTSBX341 01399 DTSBX341 01400 T0000-TERMINATE. DTSBX341 01401 PERFORM T1000-RELATIONSHIPS THRU T1000-EXIT. DTSBX341 01402 DTSBX341 01403 CLOSE PROFILE-FILE DTSBX341 01404 DETERM-FILE DTSBX341 01405 FSCHED-FILE DTSBX341 01406 ADDRESS-FILE DTSBX341 01407 RATE-FILE DTSBX341 01408 QTR-FILE DTSBX341 01409 REL-FILE DTSBX341 01410 NAME-FILE DTSBX341 01411 OPO-FILE. DTSBX341 01412 DTSBX341 01413 DTSBX341 01414 DISPLAY '*********************************************'. DTSBX341 01415 DISPLAY '** DTSBX341 TERMINATION STATISTICS **'. DTSBX341 01416 DISPLAY '** **'. DTSBX341 01417 DISPLAY '** ERRORS ' W-ERROR-CNT DTSBX341 01418 ' **'. DTSBX341 01419 DISPLAY '** PRF ' W-PRF-CNT DTSBX341 01420 ' **'. DTSBX341 01421 DISPLAY '** DET ' W-DET-CNT DTSBX341 01422 ' **'. DTSBX341 01423 DISPLAY '** FSC ' W-FSC-CNT DTSBX341 01424 ' **'. DTSBX341 01425 DISPLAY '** RATE ' W-RATE-CNT DTSBX341 01426 ' **'. DTSBX341 01427 DISPLAY '** ADDRESS ' W-X110-CNT DTSBX341 01428 ' **'. DTSBX341 01429 DISPLAY '** RELATIONSHIPS ' W-REL-CNT DTSBX341 01430 ' **'. DTSBX341 01431 DISPLAY '** NAMES ' W-NAME-CNT DTSBX341 01432 ' **'. DTSBX341 01433 DISPLAY '** ALTERNATE NAMES ' W-ALT-NAME-CNT DTSBX341 01434 ' **'. DTSBX341 01435 DISPLAY '** OPO ' W-OPO-CNT DTSBX341 01436 ' **'. DTSBX341 01437 DTSBX341 01438 DISPLAY '** **'. DTSBX341 01439 DISPLAY '** **'. DTSBX341 01440 DISPLAY '*********************************************'. DTSBX341 01441 DTSBX341 01442 DTSBX341 01443 T0000-EXIT. DTSBX341 01444 EXIT. DTSBX341 01445 DTSBX341 01446 T1000-RELATIONSHIPS. DTSBX341 01447 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSBX341 01448 MOVE +0 TO MPRF-EMP-NO. DTSBX341 01449 SET MPRF-PRF-88 TO TRUE. DTSBX341 01450 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSBX341 01451 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBX341 01452 PERFORM UNTIL L910-NO-REC-88 DTSBX341 01453 MOVE MSKL-REC TO MPRF-REC DTSBX341 01454 PERFORM T1100-SCAN-MREL THRU T1100-EXIT DTSBX341 01455 MOVE MPRF-REC TO MSKL-REC DTSBX341 01456 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBX341 01457 END-PERFORM. DTSBX341 01458 DTSBX341 01459 T1000-EXIT. DTSBX341 01460 EXIT. DTSBX341 01461 DTSBX341 01462 T1100-SCAN-MREL. DTSBX341 01463 MOVE LOW-VALUES TO MREL-KEY-AREA. DTSBX341 01464 MOVE MPRF-EMP-NO TO MREL-EMP-NO. DTSBX341 01465 SET MREL-REL-88 TO TRUE. DTSBX341 01466 MOVE MREL-KEY-AREA TO MSKL-KEY-AREA. DTSBX341 01467 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBX341 01468 PERFORM UNTIL L910-NO-REC-88 DTSBX341 01469 MOVE MSKL-REC TO MREL-REC DTSBX341 01470 PERFORM T1110-BUILD-REL THRU T1110-EXIT DTSBX341 01471 MOVE MREL-REC TO MSKL-REC DTSBX341 01472 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBX341 01473 END-PERFORM. DTSBX341 01474 DTSBX341 01475 T1100-EXIT. DTSBX341 01476 EXIT. DTSBX341 01477 DTSBX341 01478 T1110-BUILD-REL. DTSBX341 01479 * DISPLAY 'T1110 ' MREL-EMP-NO ' ' MREL-PRED-EMP-NO DTSBX341 01480 * ' ' MREL-EFF-DATE ' ' MREL-PORTION-EXP-TRNSF. DTSBX341 01481 MOVE MREL-EMP-NO TO REL-SUCC. DTSBX341 01482 MOVE MREL-PRED-EMP-NO TO REL-PRED DTSBX341 01483 MOVE MREL-PORTION-EXP-TRNSF TO W-PCT. DTSBX341 01484 MOVE W-PCT TO REL-PERCENT. DTSBX341 01485 MOVE MREL-RELATIONSHIP-CD TO REL-TYPE-CODE. DTSBX341 01486 MOVE MREL-EXP-TRNSF-CD TO REL-EXP-TRANS-IND. DTSBX341 01487 MOVE MREL-EFF-DATE TO L001-FED-8-DATE-9. DTSBX341 01488 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX341 01489 IF NOT L001-VALID-DATE DTSBX341 01490 DISPLAY 'T1110 BAD EFF DATE ' MREL-EMP-NO DTSBX341 01491 GO TO T1110-EXIT DTSBX341 01492 END-IF. DTSBX341 01493 MOVE L001-SLASH-8-DATE TO REL-EFF-DATE. DTSBX341 01494 MOVE MREL-ESTB-DATE TO L001-FED-8-DATE-9. DTSBX341 01495 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX341 01496 IF L001-VALID-DATE DTSBX341 01497 MOVE L001-SLASH-8-DATE TO REL-ESTB-DATE DTSBX341 01498 ELSE DTSBX341 01499 MOVE W-DEFAULT-DATE TO REL-ESTB-DATE DTSBX341 01500 END-IF. DTSBX341 01501 DTSBX341 01502 WRITE REL-REC FROM W-REL-REC DTSBX341 01503 IF NOT REL-STATUS-OK-88 DTSBX341 01504 DISPLAY 'CANNOT WRITE TO REL FILE ' DTSBX341 01505 ' ' REL-STATUS ' ' REL-SUCC DTSBX341 01506 ELSE DTSBX341 01507 ADD +1 TO W-REL-CNT DTSBX341 01508 END-IF. DTSBX341 01509 DTSBX341 01510 T1110-EXIT. DTSBX341 01511 EXIT. DTSBX341 01512 DTSBX341 01513 S001-FROM-FED-8. DTSBX341 01514 SET L001-FROM-FED-8 TO TRUE. DTSBX341 01515 GO TO S001-DATE. DTSBX341 01516 DTSBX341 01517 S001-FROM-ABS-DAY. DTSBX341 01518 SET L001-FROM-ABS-DAY TO TRUE. DTSBX341 01519 GO TO S001-DATE. DTSBX341 01520 DTSBX341 01521 S001-FROM-CAL-6. DTSBX341 01522 SET L001-FROM-CAL-6 TO TRUE. DTSBX341 01523 GO TO S001-DATE. DTSBX341 01524 DTSBX341 01525 S001-DATE. DTSBX341 01526 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBX341 01527 S001-EXIT. DTSBX341 01528 EXIT. DTSBX341 01529 SKIP3 DTSBX341 01530 S004-FROM-5. DTSBX341 01531 SET L004-FROM-5 TO TRUE. DTSBX341 01532 GO TO S004-QTR. DTSBX341 01533 DTSBX341 01534 S004-FROM-ABS. DTSBX341 01535 SET L004-FROM-ABS TO TRUE. DTSBX341 01536 GO TO S004-QTR. DTSBX341 01537 DTSBX341 01538 S004-FROM-3. DTSBX341 01539 SET L004-FROM-3 TO TRUE. DTSBX341 01540 GO TO S004-QTR. DTSBX341 01541 DTSBX341 01542 S004-FROM-DATE. DTSBX341 01543 SET L004-FROM-DATE TO TRUE. DTSBX341 01544 GO TO S004-QTR. DTSBX341 01545 DTSBX341 01546 S004-QTR. DTSBX341 01547 DTSBX341 01548 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBX341 01549 DTSBX341 01550 S004-EXIT. DTSBX341 01551 EXIT. DTSBX341 01552 SKIP3 DTSBX341 01553 S005-FROM-DATE-TIME. DTSBX341 01554 SET L005-FROM-DATE-TIME TO TRUE. DTSBX341 01555 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBX341 01556 S005-EXIT. DTSBX341 01557 EXIT. DTSBX341 01558 DTSBX341 01559 S910-OPEN-READ. DTSBX341 01560 SET L910-OPEN-READ-88 TO TRUE. DTSBX341 01561 GO TO S910-MSTR-IO. DTSBX341 01562 DTSBX341 01563 S910-READ. DTSBX341 01564 SET L910-READ-88 TO TRUE. DTSBX341 01565 GO TO S910-MSTR-IO. DTSBX341 01566 DTSBX341 01567 S910-START-BROWSE. DTSBX341 01568 SET L910-START-BROWSE-88 TO TRUE. DTSBX341 01569 GO TO S910-MSTR-IO. DTSBX341 01570 DTSBX341 01571 S910-READ-NEXT. DTSBX341 01572 SET L910-READ-NEXT-88 TO TRUE. DTSBX341 01573 GO TO S910-MSTR-IO. DTSBX341 01574 DTSBX341 01575 S910-COUNT. DTSBX341 01576 SET L910-COUNT-88 TO TRUE. DTSBX341 01577 GO TO S910-MSTR-IO. DTSBX341 01578 DTSBX341 01579 S910-REWRITE. DTSBX341 01580 SET L910-REWRITE-88 TO TRUE. DTSBX341 01581 GO TO S910-MSTR-IO. DTSBX341 01582 DTSBX341 01583 S910-CLOSE. DTSBX341 01584 SET L910-CLOSE-88 TO TRUE. DTSBX341 01585 GO TO S910-MSTR-IO. DTSBX341 01586 DTSBX341 01587 S910-MSTR-IO. DTSBX341 01588 CALL 'DTSBU910' USING L910-LINK-AREA DTSBX341 01589 MSKL-REC. DTSBX341 01590 S910-EXIT. DTSBX341 01591 EXIT. DTSBX341 01592 SKIP3 DTSBX341 01593 DTSBX341 01594 S921-OPEN-READ. DTSBX341 01595 SET L921-OPEN-READ-88 TO TRUE. DTSBX341 01596 GO TO S921-AIX-IO. DTSBX341 01597 DTSBX341 01598 S921-START-BROWSE. DTSBX341 01599 SET L921-START-BROWSE-88 TO TRUE. DTSBX341 01600 GO TO S921-AIX-IO. DTSBX341 01601 DTSBX341 01602 S921-READ-NEXT. DTSBX341 01603 SET L921-READ-NEXT-88 TO TRUE. DTSBX341 01604 GO TO S921-AIX-IO. DTSBX341 01605 DTSBX341 01606 S921-CLOSE. DTSBX341 01607 SET L921-CLOSE-88 TO TRUE. DTSBX341 01608 GO TO S921-AIX-IO. DTSBX341 01609 DTSBX341 01610 S921-AIX-IO. DTSBX341 01611 CALL 'DTSBU921' USING L921-LINK-AREA DTSBX341 01612 ISKL-REC. DTSBX341 01613 DTSBX341 01614 S921-EXIT. DTSBX341 01615 EXIT. DTSBX341 01616 DTSBX341 01617 S931-READ. DTSBX341 01618 SET L931-READ-88 TO TRUE. DTSBX341 01619 GO TO S931-REF-IO. DTSBX341 01620 DTSBX341 01621 S931-REF-IO. DTSBX341 01622 CALL 'DTSBU931' USING L931-LINK-AREA DTSBX341 01623 FSKL-REC. DTSBX341 01624 S931-EXIT. DTSBX341 01625 EXIT. DTSBX341 01626 DTSBX341 01627 S999-ABEND. DTSBX341 01628 DISPLAY '*** DTSBE335 ABENDING. ' DTSBX341 01629 ABEND-MSG. DTSBX341 01630 DTSBX341 01631 CALL 'DTSBU999' USING W-ABEND-CD. DTSBX341 01632 S999-EXIT. DTSBX341 01633 EXIT. DTSBX341