1635 lines
129 KiB
COBOL
1635 lines
129 KiB
COBOL
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
|