00001 IDENTIFICATION DIVISION. 10/18/05 00002 PROGRAM-ID. DTSBX470. DTSBX470 00003 AUTHOR. TRW. LV001 00004 DATE-WRITTEN. JULY 2003. DTSBX470 00005 DATE-COMPILED. DTSBX470 00006 SKIP3 DTSBX470 00007 ***** DTSBX470 00008 * DTSBX470 00009 * FUNCTION: EXTRACT MAILING & LOCAL ADDRESSES OF EMPLOYERS DTSBX470 00010 * FOR OFFICE OF WORKERS COMPENSATION. DTSBX470 00011 * DTSBX470 00012 * DTSBX470 00013 * DTSBX470 00014 * DTSBX470 00015 * DTSBX470 00016 * DTSBX470 00017 * DTSBX470 00018 * DTSBX470 00019 ***** DTSBX470 00020 SKIP3 DTSBX470 00021 ENVIRONMENT DIVISION. DTSBX470 00022 SKIP2 DTSBX470 00023 INPUT-OUTPUT SECTION. DTSBX470 00024 DTSBX470 00025 FILE-CONTROL. DTSBX470 00026 SELECT OWC-FILE ASSIGN TO DTSBX470 DTSBX470 00027 FILE STATUS IS BX470-STATUS. DTSBX470 00028 DTSBX470 00029 SKIP2 DTSBX470 00030 DATA DIVISION. DTSBX470 00031 SKIP3 DTSBX470 00032 FILE SECTION. DTSBX470 00033 FD OWC-FILE DTSBX470 00034 RECORDING MODE IS F DTSBX470 00035 LABEL RECORDS ARE STANDARD. DTSBX470 00036 DTSBX470 00037 01 OWC-REC1 PIC X(441). DTSBX470 00038 DTSBX470 00039 EJECT DTSBX470 00040 WORKING-STORAGE SECTION. DTSBX470 000405 77 PAN-VALET PICTURE X(24) VALUE '001DTSBX470 10/18/05'. DTSBX470 00041 SKIP3 DTSBX470 00042 01 WRK-OWC-REC. DTSBX470 00043 05 OWC-EMP-NO PIC 9(06). DTSBX470 00044 05 FILLER PIC X(01) VALUE ','. DTSBX470 00045 05 OWC-FEIN PIC 9(09). DTSBX470 00046 05 FILLER PIC X(01) VALUE ','. DTSBX470 00047 05 OWC-TRADE-NAME PIC X(40). DTSBX470 00048 05 FILLER PIC X(01) VALUE ','. DTSBX470 00049 05 OWC-ENTITY-NAME PIC X(40). DTSBX470 00050 05 FILLER PIC X(01) VALUE ','. DTSBX470 00051 05 OWC-M-ATTN PIC X(40). DTSBX470 00052 05 FILLER PIC X(01) VALUE ','. DTSBX470 00053 05 OWC-M-DELV1 PIC X(40). DTSBX470 00054 05 FILLER PIC X(01) VALUE ','. DTSBX470 00055 05 OWC-M-DELV2 PIC X(40). DTSBX470 00056 05 FILLER PIC X(01) VALUE ','. DTSBX470 00057 05 OWC-M-CITY PIC X(25). DTSBX470 00058 05 FILLER PIC X(01) VALUE ','. DTSBX470 00059 05 OWC-M-STATE PIC X(02). DTSBX470 00060 05 FILLER PIC X(01) VALUE ','. DTSBX470 00061 05 OWC-M-ZIP PIC X(05). DTSBX470 00062 05 FILLER PIC X(01) VALUE ','. DTSBX470 00063 05 OWC-W-ATTN PIC X(40). DTSBX470 00064 05 FILLER PIC X(01) VALUE ','. DTSBX470 00065 05 OWC-W-DELV1 PIC X(40). DTSBX470 00066 05 FILLER PIC X(01) VALUE ','. DTSBX470 00067 05 OWC-W-DELV2 PIC X(40). DTSBX470 00068 05 FILLER PIC X(01) VALUE ','. DTSBX470 00069 05 OWC-W-CITY PIC X(25). DTSBX470 00070 05 FILLER PIC X(01) VALUE ','. DTSBX470 00071 05 OWC-W-STATE PIC X(02). DTSBX470 00072 05 FILLER PIC X(01) VALUE ','. DTSBX470 00073 05 OWC-W-ZIP PIC X(05). DTSBX470 00074 05 FILLER PIC X(01) VALUE ','. DTSBX470 00075 05 OWC-VOICE-1. DTSBX470 00076 10 OWC-VOICE-1-AREA-CD PIC X(03). DTSBX470 00077 10 OWC-VOICE-1-PREFIX PIC X(03). DTSBX470 00078 10 OWC-VOICE-1-SUFFIX PIC X(04). DTSBX470 00079 10 OWC-VOICE-1-EXT PIC X(05). DTSBX470 00080 05 FILLER PIC X(01) VALUE ','. DTSBX470 00081 05 OWC-INACT-DATE PIC X(10). DTSBX470 00082 DTSBX470 00083 01 WRK-M-ADDR. DTSBX470 00084 05 WRK-M-ATTN PIC X(40). DTSBX470 00085 05 WRK-M-DELV1 PIC X(40). DTSBX470 00086 05 WRK-M-DELV2 PIC X(40). DTSBX470 00087 05 WRK-M-CITY PIC X(25). DTSBX470 00088 05 WRK-M-STATE PIC X(02). DTSBX470 00089 05 WRK-M-ZIP PIC X(05). DTSBX470 00090 DTSBX470 00091 01 WRK-W-ADDR. DTSBX470 00092 05 WRK-W-ATTN PIC X(40). DTSBX470 00093 05 WRK-W-DELV1 PIC X(40). DTSBX470 00094 05 WRK-W-DELV2 PIC X(40). DTSBX470 00095 05 WRK-W-CITY PIC X(25). DTSBX470 00096 05 WRK-W-STATE PIC X(02). DTSBX470 00097 05 WRK-W-ZIP PIC X(05). DTSBX470 00098 DTSBX470 00099 01 WRK-AREA. DTSBX470 00100 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +470.DTSBX470 00101 DTSBX470 00102 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBX470'.DTSBX470 00103 DTSBX470 00104 05 WRK-RUN-TYPE PIC X(06). DTSBX470 00105 88 WRK-RUN-TYPE-CONV-88 VALUE ' CONV'. DTSBX470 00106 88 WRK-RUN-TYPE-UPDATE-88 VALUE 'UPDATE'. DTSBX470 00107 DTSBX470 00108 05 WRK-INTERVAL PIC X(01). DTSBX470 00109 88 WRK-INTERVAL-WEEK-88 VALUE 'W'. DTSBX470 00110 88 WRK-INTERVAL-MONTH-88 VALUE 'M'. DTSBX470 00111 88 WRK-INTERVAL-QTR-88 VALUE 'Q'. DTSBX470 00112 DTSBX470 00113 05 BX470-STATUS PIC X(02). DTSBX470 00114 88 BX470-STATUS-OK-88 VALUE '00'. DTSBX470 00115 DTSBX470 00116 05 WRK-CUTOFF-DATE PIC S9(09) COMP-3 DTSBX470 00117 VALUE +0. DTSBX470 00118 05 WRK-LIAB-ENTER-DATE PIC S9(09) COMP-3 DTSBX470 00119 VALUE +0. DTSBX470 00120 05 WRK-INACT-ENTER-DATE PIC S9(09) COMP-3 DTSBX470 00121 VALUE +0. DTSBX470 00122 05 WRK-INACT-DATE PIC S9(09) COMP-3 DTSBX470 00123 VALUE +0. DTSBX470 00124 05 WRK-MPRF-READ-CNT PIC S9(07) COMP-3 DTSBX470 00125 VALUE +0. DTSBX470 00126 05 WRK-WRITTEN-CNT PIC S9(07) COMP-3 DTSBX470 00127 VALUE +0. DTSBX470 00128 05 WRK-NO-W-ADDRESS-CNT PIC S9(07) COMP-3 DTSBX470 00129 VALUE +0. DTSBX470 00130 DTSBX470 00131 05 WRK-STATUS-IND PIC X(01). DTSBX470 00132 88 WRK-STATUS-ACT-88 VALUE '0'. DTSBX470 00133 88 WRK-STATUS-INACT-88 VALUE '1'. DTSBX470 00134 DTSBX470 00135 05 WRK-ERROR-IND PIC X(01) VALUE 'N'. DTSBX470 00136 88 WRK-ERROR-YES-88 VALUE 'Y'. DTSBX470 00137 88 WRK-ERROR-NO-88 VALUE 'N'. DTSBX470 00138 DTSBX470 00139 05 WRK-SELECT-IND PIC X(01). DTSBX470 00140 88 WRK-SELECT-YES-88 VALUE 'Y'. DTSBX470 00141 88 WRK-SELECT-NO-88 VALUE 'N'. DTSBX470 00142 DTSBX470 00143 05 WRK-FINAL-SELECT-IND PIC X(01). DTSBX470 00144 88 WRK-FINAL-SELECT-YES-88 VALUE 'Y'. DTSBX470 00145 88 WRK-FINAL-SELECT-NO-88 VALUE 'N'. DTSBX470 00146 DTSBX470 00147 05 WRK-NAME-UPD-IND PIC X(01). DTSBX470 00148 88 WRK-NAME-UPD-YES-88 VALUE 'Y'. DTSBX470 00149 88 WRK-NAME-UPD-NO-88 VALUE 'N'. DTSBX470 00150 DTSBX470 00151 05 WRK-ADDR-UPD-IND PIC X(01). DTSBX470 00152 88 WRK-ADDR-UPD-YES-88 VALUE 'Y'. DTSBX470 00153 88 WRK-ADDR-UPD-NO-88 VALUE 'N'. DTSBX470 00154 DTSBX470 00155 05 WRK-STATUS-UPD-IND PIC X(01). DTSBX470 00156 88 WRK-STATUS-UPD-YES-88 VALUE 'Y'. DTSBX470 00157 88 WRK-STATUS-UPD-NO-88 VALUE 'N'. DTSBX470 00158 DTSBX470 00159 05 WRK-EMP-CNT PIC 9(07). DTSBX470 00160 05 WRK-EMP-NO PIC 9(06) VALUE ZEROS. DTSBX470 00161 DTSBX470 00162 05 REC-TYPE PIC X(01). DTSBX470 00163 05 WRK-TRACE-IND PIC X(01). DTSBX470 00164 DTSBX470 00165 DTSBX470 00166 01 L001-LINK-AREA. DTSBX470 00167 ++INCLUDE DTSIL001 DTSBX470 00168 EJECT DTSBX470 00169 01 L004-COMM-AREA. DTSBX470 00170 ++INCLUDE DTSIL004 DTSBX470 00171 EJECT DTSBX470 00172 01 L056-COMM-AREA. DTSBX470 00173 ++INCLUDE DTSIL056 DTSBX470 00174 EJECT DTSBX470 00175 01 L910-LINK-AREA. DTSBX470 00176 ++INCLUDE DTSIL910 DTSBX470 00177 EJECT DTSBX470 00178 01 MSKL-REC. DTSBX470 00179 ++INCLUDE DTSIMSKL DTSBX470 00180 EJECT DTSBX470 00181 01 MHDR-REC. DTSBX470 00182 ++INCLUDE DTSIMHDR DTSBX470 00183 EJECT DTSBX470 00184 01 MPRF-REC. DTSBX470 00185 ++INCLUDE DTSIMPRF DTSBX470 00186 EJECT DTSBX470 00187 01 MTAD-REC. DTSBX470 00188 ++INCLUDE DTSIMTAD DTSBX470 00189 EJECT DTSBX470 00190 01 MSOL-REC. DTSBX470 00191 ++INCLUDE DTSIMSOL DTSBX470 00192 EJECT DTSBX470 00193 01 MQTR-REC. DTSBX470 00194 ++INCLUDE DTSIMQTR DTSBX470 00195 EJECT DTSBX470 00196 01 MLOG-REC. DTSBX470 00197 ++INCLUDE DTSIMLOG DTSBX470 00198 EJECT DTSBX470 00199 LINKAGE SECTION. DTSBX470 00200 SKIP3 DTSBX470 00201 01 PARM-AREA. DTSBX470 00202 05 PARM-LENGTH PIC S9(04) COMP. DTSBX470 00203 DTSBX470 00204 05 PARM-DATA. DTSBX470 00205 10 PARM-RUN-TYPE PIC X(06). DTSBX470 00206 88 PARM-RUN-TYPE-CONV-88 VALUE ' CONV'. DTSBX470 00207 88 PARM-RUN-TYPE-UPDATE-88 VALUE 'UPDATE'. DTSBX470 00208 88 PARM-RUN-TYPE-VALID-88 VALUE ' CONV', DTSBX470 00209 'UPDATE'. DTSBX470 00210 10 FILLER PIC X(01). DTSBX470 00211 10 PARM-INTERVAL PIC X(01). DTSBX470 00212 88 PARM-INTERVAL-WEEK-88 VALUE 'W'. DTSBX470 00213 88 PARM-INTERVAL-MONTH-88 VALUE 'M'. DTSBX470 00214 88 PARM-INTERVAL-QTR-88 VALUE 'Q'. DTSBX470 00215 88 PARM-INTERVAL-VALID-88 VALUE 'W' 'M' 'Q'. DTSBX470 00216 DTSBX470 00217 PROCEDURE DIVISION USING PARM-AREA. DTSBX470 00218 SKIP2 DTSBX470 00219 PERFORM I0000-INITIATE THRU I0000-EXIT. DTSBX470 00220 IF WRK-ERROR-NO-88 DTSBX470 00221 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBX470 00222 PERFORM T0000-TERMINATE THRU T0000-EXIT DTSBX470 00223 END-IF. DTSBX470 00224 DTSBX470 00225 GOBACK. DTSBX470 00226 EJECT DTSBX470 00227 I0000-INITIATE. DTSBX470 00228 DISPLAY 'EMPLOYER ADDRESS EXTRACT (OWC) '. DTSBX470 00229 DISPLAY SPACE. DTSBX470 00230 DTSBX470 00231 MOVE 'N' TO WRK-TRACE-IND. DTSBX470 00232 DTSBX470 00233 PERFORM I1000-EDIT-PARM THRU I1000-EXIT. DTSBX470 00234 DTSBX470 00235 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. DTSBX470 00236 DTSBX470 00237 PERFORM I3000-SET-DATES THRU I3000-EXIT. DTSBX470 00238 DTSBX470 00239 I0000-EXIT. DTSBX470 00240 EXIT. DTSBX470 00241 DTSBX470 00242 I1000-EDIT-PARM. DTSBX470 00243 IF NOT PARM-RUN-TYPE-VALID-88 DTSBX470 00244 SET WRK-ERROR-YES-88 TO TRUE DTSBX470 00245 DISPLAY 'DTSBX470: INVALID RUN TYPE PARM ' DTSBX470 00246 PARM-RUN-TYPE DTSBX470 00247 GO TO I1000-EXIT DTSBX470 00248 ELSE DTSBX470 00249 MOVE PARM-RUN-TYPE TO WRK-RUN-TYPE DTSBX470 00250 END-IF. DTSBX470 00251 DTSBX470 00252 IF WRK-RUN-TYPE-UPDATE-88 DTSBX470 00253 IF NOT PARM-INTERVAL-VALID-88 DTSBX470 00254 SET WRK-ERROR-YES-88 TO TRUE DTSBX470 00255 DISPLAY 'DTSBX470: INVALID INTERVAL PARM ' DTSBX470 00256 PARM-INTERVAL DTSBX470 00257 GO TO I1000-EXIT DTSBX470 00258 ELSE DTSBX470 00259 MOVE PARM-INTERVAL TO WRK-INTERVAL DTSBX470 00260 END-IF DTSBX470 00261 END-IF. DTSBX470 00262 DTSBX470 00263 IF WRK-RUN-TYPE-UPDATE-88 DTSBX470 00264 DISPLAY 'BX470 RUN TYPE: UPDATE' DTSBX470 00265 ELSE DTSBX470 00266 DISPLAY 'BX470 RUN TYPE: CONVERSION' DTSBX470 00267 END-IF. DTSBX470 00268 DTSBX470 00269 IF WRK-RUN-TYPE-UPDATE-88 DTSBX470 00270 IF WRK-INTERVAL-WEEK-88 DTSBX470 00271 DISPLAY ' INTERVAL: WEEKLY' DTSBX470 00272 ELSE DTSBX470 00273 IF WRK-INTERVAL-MONTH-88 DTSBX470 00274 DISPLAY ' INTERVAL: MONTHLY' DTSBX470 00275 ELSE DTSBX470 00276 IF WRK-INTERVAL-QTR-88 DTSBX470 00277 DISPLAY ' INTERVAL: QUARTERLY' DTSBX470 00278 END-IF DTSBX470 00279 END-IF DTSBX470 00280 END-IF DTSBX470 00281 END-IF. DTSBX470 00282 DTSBX470 00283 I1000-EXIT. DTSBX470 00284 EXIT. DTSBX470 00285 DTSBX470 00286 I2000-OPEN-FILES. DTSBX470 00287 MOVE WRK-TRACE-IND TO L910-TRACE-IND. DTSBX470 00288 DTSBX470 00289 MOVE WRK-MOD-NAME TO L910-MOD-NAME. DTSBX470 00290 DTSBX470 00291 PERFORM S910-OPEN-READ THRU S910-EXIT. DTSBX470 00292 DTSBX470 00293 OPEN OUTPUT OWC-FILE. DTSBX470 00294 IF NOT BX470-STATUS-OK-88 DTSBX470 00295 DISPLAY 'CANNOT OPEN OUTPUT FILE ' BX470-STATUS DTSBX470 00296 SET WRK-ERROR-YES-88 TO TRUE DTSBX470 00297 END-IF. DTSBX470 00298 DTSBX470 00299 I2000-EXIT. DTSBX470 00300 EXIT. DTSBX470 00301 DTSBX470 00302 I3000-SET-DATES. DTSBX470 00303 MOVE LOW-VALUES TO MSKL-REC. DTSBX470 00304 MOVE +0 TO MSKL-EMP-NO. DTSBX470 00305 SET MSKL-HDR-88 TO TRUE. DTSBX470 00306 DTSBX470 00307 PERFORM S910-READ THRU S910-EXIT. DTSBX470 00308 IF L910-NO-REC-88 DTSBX470 00309 DISPLAY 'DTSBX470: MHDR RECORD IS MISSING' DTSBX470 00310 SET WRK-ERROR-YES-88 TO TRUE DTSBX470 00311 GO TO I3000-EXIT DTSBX470 00312 ELSE DTSBX470 00313 MOVE MSKL-REC TO MHDR-REC DTSBX470 00314 END-IF. DTSBX470 00315 DTSBX470 00316 EVALUATE TRUE DTSBX470 00317 WHEN WRK-INTERVAL-WEEK-88 DTSBX470 00318 MOVE MHDR-CMPL-WEEK-END-DATE TO WRK-CUTOFF-DATE DTSBX470 00319 DTSBX470 00320 WHEN WRK-INTERVAL-MONTH-88 DTSBX470 00321 MOVE MHDR-CMPL-MONTH-END-DATE TO WRK-CUTOFF-DATE DTSBX470 00322 DTSBX470 00323 WHEN WRK-INTERVAL-QTR-88 DTSBX470 00324 MOVE MHDR-CMPL-QTR-END-DATE TO WRK-CUTOFF-DATE DTSBX470 00325 DTSBX470 00326 END-EVALUATE. DTSBX470 00327 DTSBX470 00328 MOVE 20051001 TO WRK-CUTOFF-DATE. DTSBX470 00329 DISPLAY 'WRK-CUTOFF DATE ' WRK-CUTOFF-DATE. DTSBX470 00330 I3000-EXIT. DTSBX470 00331 EXIT. DTSBX470 00332 DTSBX470 00333 P0000-PROCESS. DTSBX470 00334 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBX470 00335 DTSBX470 00336 MOVE +0 TO MSKL-EMP-NO. DTSBX470 00337 DTSBX470 00338 SET MSKL-PRF-88 TO TRUE. DTSBX470 00339 DTSBX470 00340 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBX470 00341 IF NOT L910-OK-88 DTSBX470 00342 DISPLAY 'BAD FIRST READ ' L910-RESULT-IND DTSBX470 00343 GO TO P0000-EXIT DTSBX470 00344 ELSE DTSBX470 00345 PERFORM P1000-SCAN-MPRF THRU P1000-EXIT DTSBX470 00346 UNTIL L910-NO-REC-88 DTSBX470 00347 END-IF. DTSBX470 00348 DTSBX470 00349 DTSBX470 00350 P0000-EXIT. DTSBX470 00351 EXIT. DTSBX470 00352 EJECT DTSBX470 00353 P1000-SCAN-MPRF. DTSBX470 00354 MOVE MSKL-REC TO MPRF-REC. DTSBX470 00355 DTSBX470 00356 IF MPRF-CLASS-SUB-88 DTSBX470 00357 IF WRK-RUN-TYPE-CONV-88 DTSBX470 00358 PERFORM P1100-CONVERSION THRU P1100-EXIT DTSBX470 00359 ELSE DTSBX470 00360 PERFORM P1200-UPDATE THRU P1200-EXIT DTSBX470 00361 END-IF DTSBX470 00362 END-IF. DTSBX470 00363 DTSBX470 00364 MOVE MPRF-REC TO MSKL-REC. DTSBX470 00365 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBX470 00366 DTSBX470 00367 P1000-EXIT. DTSBX470 00368 EXIT. DTSBX470 00369 DTSBX470 00370 P1100-CONVERSION. DTSBX470 00371 IF MPRF-STATUS-ACT-88 DTSBX470 00372 ADD +1 TO WRK-MPRF-READ-CNT DTSBX470 00373 PERFORM P2200-FIND-ADDRESS THRU P2200-EXIT DTSBX470 00374 PERFORM P3100-WRITE-OUTPUT THRU P3100-EXIT DTSBX470 00375 END-IF. DTSBX470 00376 DTSBX470 00377 P1100-EXIT. DTSBX470 00378 EXIT. DTSBX470 00379 DTSBX470 00380 P1200-UPDATE. DTSBX470 00381 ADD +1 TO WRK-MPRF-READ-CNT DTSBX470 00382 SET WRK-SELECT-NO-88 TO TRUE. DTSBX470 00383 SET WRK-NAME-UPD-NO-88 TO TRUE. DTSBX470 00384 SET WRK-ADDR-UPD-NO-88 TO TRUE. DTSBX470 00385 SET WRK-STATUS-UPD-NO-88 TO TRUE. DTSBX470 00386 DTSBX470 00387 PERFORM P2000-CHK-UPDATES THRU P2000-EXIT. DTSBX470 00388 IF WRK-SELECT-YES-88 DTSBX470 00389 PERFORM P2100-LIABILITY THRU P2100-EXIT DTSBX470 00390 PERFORM P2200-FIND-ADDRESS THRU P2200-EXIT DTSBX470 00391 PERFORM P3000-FINAL-SELECT THRU P3000-EXIT DTSBX470 00392 IF WRK-FINAL-SELECT-YES-88 DTSBX470 00393 PERFORM P3100-WRITE-OUTPUT THRU P3100-EXIT DTSBX470 00394 END-IF DTSBX470 00395 END-IF. DTSBX470 00396 DTSBX470 00397 P1200-EXIT. DTSBX470 00398 EXIT. DTSBX470 00399 DTSBX470 00400 P2000-CHK-UPDATES. DTSBX470 00401 MOVE LOW-VALUES TO MLOG-KEY-AREA. DTSBX470 00402 MOVE MPRF-EMP-NO TO MLOG-EMP-NO. DTSBX470 00403 SET MLOG-LOG-88 TO TRUE. DTSBX470 00404 MOVE MLOG-KEY-AREA TO MSKL-KEY-AREA. DTSBX470 00405 DTSBX470 00406 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBX470 00407 IF L910-OK-88 DTSBX470 00408 MOVE MSKL-REC TO MLOG-REC DTSBX470 00409 PERFORM DTSBX470 00410 UNTIL L910-NO-REC-88 DTSBX470 00411 PERFORM P2010-EVALUATE THRU P2010-EXIT DTSBX470 00412 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBX470 00413 MOVE MSKL-REC TO MLOG-REC DTSBX470 00414 END-PERFORM DTSBX470 00415 END-IF. DTSBX470 00416 DTSBX470 00417 P2000-EXIT. DTSBX470 00418 EXIT. DTSBX470 00419 DTSBX470 00420 P2010-EVALUATE. DTSBX470 00421 IF ((MLOG-DATA-ELEMENT-NAME = DTSBX470 00422 'MPRF-PRIMARY-NAME' OR 'MPRF-ENTITY-NAME') DTSBX470 00423 AND MLOG-ESTB-DATE > WRK-CUTOFF-DATE) DTSBX470 00424 SET WRK-SELECT-YES-88 TO TRUE DTSBX470 00425 SET WRK-NAME-UPD-YES-88 TO TRUE DTSBX470 00426 ELSE DTSBX470 00427 IF ((MLOG-DE-REC-TYPE = 'MTAD') DTSBX470 00428 AND MLOG-ESTB-DATE > WRK-CUTOFF-DATE) DTSBX470 00429 SET WRK-SELECT-YES-88 TO TRUE DTSBX470 00430 SET WRK-ADDR-UPD-YES-88 TO TRUE DTSBX470 00431 ELSE DTSBX470 00432 IF ((MLOG-DE-REC-TYPE = 'MSOL') DTSBX470 00433 AND MLOG-ESTB-DATE > WRK-CUTOFF-DATE) DTSBX470 00434 SET WRK-SELECT-YES-88 TO TRUE DTSBX470 00435 END-IF DTSBX470 00436 END-IF DTSBX470 00437 END-IF. DTSBX470 00438 DTSBX470 00439 P2010-EXIT. DTSBX470 00440 EXIT. DTSBX470 00441 DTSBX470 00442 P2100-LIABILITY. DTSBX470 00443 MOVE ZERO TO WRK-LIAB-ENTER-DATE DTSBX470 00444 WRK-INACT-ENTER-DATE DTSBX470 00445 WRK-INACT-DATE. DTSBX470 00446 DTSBX470 00447 MOVE LOW-VALUES TO MSOL-KEY-AREA. DTSBX470 00448 MOVE MPRF-EMP-NO TO MSOL-EMP-NO. DTSBX470 00449 SET MSOL-SOL-88 TO TRUE. DTSBX470 00450 MOVE MSOL-KEY-AREA TO MSKL-KEY-AREA. DTSBX470 00451 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBX470 00452 PERFORM DTSBX470 00453 UNTIL L910-NO-REC-88 DTSBX470 00454 MOVE MSKL-REC TO MSOL-REC DTSBX470 00455 PERFORM P2110-CHECK-DATES THRU P2110-EXIT DTSBX470 00456 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBX470 00457 END-PERFORM. DTSBX470 00458 DTSBX470 00459 IF MPRF-STATUS-ACT-88 DTSBX470 00460 IF ((WRK-LIAB-ENTER-DATE > WRK-INACT-ENTER-DATE) DTSBX470 00461 AND (WRK-LIAB-ENTER-DATE > WRK-CUTOFF-DATE)) DTSBX470 00462 SET WRK-STATUS-UPD-YES-88 TO TRUE DTSBX470 00463 END-IF DTSBX470 00464 ELSE DTSBX470 00465 IF MPRF-STATUS-INACT-88 DTSBX470 00466 IF ((WRK-INACT-ENTER-DATE > WRK-LIAB-ENTER-DATE) DTSBX470 00467 AND (WRK-INACT-ENTER-DATE > WRK-CUTOFF-DATE)) DTSBX470 00468 SET WRK-STATUS-UPD-YES-88 TO TRUE DTSBX470 00469 END-IF DTSBX470 00470 END-IF DTSBX470 00471 END-IF. DTSBX470 00472 DTSBX470 00473 P2100-EXIT. DTSBX470 00474 EXIT. DTSBX470 00475 DTSBX470 00476 P2110-CHECK-DATES. DTSBX470 00477 IF MSOL-INACT-WITHDRAWN-88 DTSBX470 00478 NEXT SENTENCE DTSBX470 00479 ELSE DTSBX470 00480 IF MSOL-INACT-INACTIVE-88 DTSBX470 00481 MOVE MSOL-INACT-DATE TO WRK-INACT-DATE DTSBX470 00482 MOVE MSOL-INACT-ENTER-DATE TO WRK-INACT-ENTER-DATE DTSBX470 00483 ELSE DTSBX470 00484 MOVE MSOL-ESTB-DATE TO WRK-LIAB-ENTER-DATE DTSBX470 00485 END-IF DTSBX470 00486 END-IF. DTSBX470 00487 DTSBX470 00488 P2110-EXIT. DTSBX470 00489 EXIT. DTSBX470 00490 DTSBX470 00491 P2200-FIND-ADDRESS. DTSBX470 00492 MOVE SPACES TO WRK-M-ADDR DTSBX470 00493 WRK-W-ADDR. DTSBX470 00494 DTSBX470 00495 PERFORM P2210-MAILING-ADDR THRU P2210-EXIT. DTSBX470 00496 PERFORM P2220-LOCAL-ADDR THRU P2220-EXIT. DTSBX470 00497 DTSBX470 00498 P2200-EXIT. DTSBX470 00499 EXIT. DTSBX470 00500 DTSBX470 00501 P2210-MAILING-ADDR. DTSBX470 00502 MOVE LOW-VALUES TO MTAD-KEY-AREA. DTSBX470 00503 MOVE MPRF-EMP-NO TO MTAD-EMP-NO. DTSBX470 00504 SET MTAD-TAD-88 TO TRUE. DTSBX470 00505 SET MTAD-ID-TAX-MAILING-ADDR-88 TO TRUE. DTSBX470 00506 DTSBX470 00507 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. DTSBX470 00508 DTSBX470 00509 PERFORM S910-READ THRU S910-EXIT. DTSBX470 00510 IF L910-NO-REC-88 DTSBX470 00511 GO TO P2210-EXIT DTSBX470 00512 ELSE DTSBX470 00513 MOVE MSKL-REC TO MTAD-REC DTSBX470 00514 END-IF. DTSBX470 00515 DTSBX470 00516 INSPECT MTAD-ATTN-LINE REPLACING ALL ',' BY SPACE. DTSBX470 00517 MOVE MTAD-ATTN-LINE TO WRK-M-ATTN. DTSBX470 00518 INSPECT MTAD-DELIV-LINE-1 REPLACING ALL ',' BY SPACE. DTSBX470 00519 MOVE MTAD-DELIV-LINE-1 TO WRK-M-DELV1. DTSBX470 00520 INSPECT MTAD-DELIV-LINE-2 REPLACING ALL ',' BY SPACE. DTSBX470 00521 MOVE MTAD-DELIV-LINE-2 TO WRK-M-DELV2. DTSBX470 00522 MOVE MTAD-CITY TO WRK-M-CITY. DTSBX470 00523 MOVE MTAD-ST TO WRK-M-STATE. DTSBX470 00524 MOVE MTAD-ZIP TO WRK-M-ZIP. DTSBX470 00525 DTSBX470 00526 P2210-EXIT. DTSBX470 00527 EXIT. DTSBX470 00528 DTSBX470 00529 P2220-LOCAL-ADDR. DTSBX470 00530 MOVE LOW-VALUES TO MTAD-KEY-AREA. DTSBX470 00531 MOVE MPRF-EMP-NO TO MTAD-EMP-NO. DTSBX470 00532 SET MTAD-TAD-88 TO TRUE. DTSBX470 00533 SET MTAD-ID-TAX-RECORDS-ADDR-88 TO TRUE. DTSBX470 00534 DTSBX470 00535 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. DTSBX470 00536 DTSBX470 00537 PERFORM S910-READ THRU S910-EXIT. DTSBX470 00538 IF L910-NO-REC-88 DTSBX470 00539 ADD +1 TO WRK-NO-W-ADDRESS-CNT DTSBX470 00540 MOVE SPACES TO WRK-W-ADDR DTSBX470 00541 GO TO P2220-EXIT DTSBX470 00542 ELSE DTSBX470 00543 MOVE MSKL-REC TO MTAD-REC DTSBX470 00544 END-IF. DTSBX470 00545 DTSBX470 00546 INSPECT MTAD-ATTN-LINE REPLACING ALL ',' BY SPACE. DTSBX470 00547 MOVE MTAD-ATTN-LINE TO WRK-W-ATTN. DTSBX470 00548 INSPECT MTAD-DELIV-LINE-1 REPLACING ALL ',' BY SPACE. DTSBX470 00549 MOVE MTAD-DELIV-LINE-1 TO WRK-W-DELV1. DTSBX470 00550 INSPECT MTAD-DELIV-LINE-2 REPLACING ALL ',' BY SPACE. DTSBX470 00551 MOVE MTAD-DELIV-LINE-2 TO WRK-W-DELV2. DTSBX470 00552 MOVE MTAD-CITY TO WRK-W-CITY. DTSBX470 00553 MOVE MTAD-ST TO WRK-W-STATE. DTSBX470 00554 MOVE MTAD-ZIP TO WRK-W-ZIP. DTSBX470 00555 DTSBX470 00556 P2220-EXIT. DTSBX470 00557 EXIT. DTSBX470 00558 DTSBX470 00559 P3000-FINAL-SELECT. DTSBX470 00560 SET WRK-FINAL-SELECT-NO-88 TO TRUE. DTSBX470 00561 DTSBX470 00562 IF WRK-RUN-TYPE-UPDATE-88 DTSBX470 00563 IF (WRK-NAME-UPD-YES-88 DTSBX470 00564 OR WRK-ADDR-UPD-YES-88 DTSBX470 00565 OR WRK-STATUS-UPD-YES-88) DTSBX470 00566 SET WRK-FINAL-SELECT-YES-88 TO TRUE DTSBX470 00567 ELSE DTSBX470 00568 GO TO P3000-EXIT DTSBX470 00569 END-IF DTSBX470 00570 END-IF. DTSBX470 00571 DTSBX470 00572 IF MPRF-STATUS-INACT-88 DTSBX470 00573 IF NOT WRK-STATUS-UPD-YES-88 DTSBX470 00574 SET WRK-FINAL-SELECT-NO-88 TO TRUE DTSBX470 00575 GO TO P3000-EXIT DTSBX470 00576 END-IF DTSBX470 00577 END-IF. DTSBX470 00578 DTSBX470 00579 P3000-EXIT. DTSBX470 00580 EXIT. DTSBX470 00581 DTSBX470 00582 P3100-WRITE-OUTPUT. DTSBX470 00583 DISPLAY SPACE. DTSBX470 00584 DISPLAY MPRF-EMP-NO ' ' MPRF-PRIMARY-NAME. DTSBX470 00585 DISPLAY ' ' WRK-NAME-UPD-IND ' ' WRK-ADDR-UPD-IND DTSBX470 00586 ' ' WRK-STATUS-UPD-IND. DTSBX470 00587 DTSBX470 00588 MOVE MPRF-EMP-NO TO OWC-EMP-NO. DTSBX470 00589 MOVE MPRF-FEIN TO OWC-FEIN. DTSBX470 00590 IF MPRF-PRIMARY-IS-ENTITY-88 DTSBX470 00591 MOVE MPRF-PRIMARY-NAME TO OWC-ENTITY-NAME DTSBX470 00592 MOVE SPACES TO OWC-TRADE-NAME DTSBX470 00593 ELSE DTSBX470 00594 MOVE MPRF-PRIMARY-NAME TO OWC-TRADE-NAME DTSBX470 00595 MOVE MPRF-ENTITY-NAME TO OWC-ENTITY-NAME DTSBX470 00596 END-IF. DTSBX470 00597 INSPECT OWC-ENTITY-NAME REPLACING ALL ',' BY SPACE. DTSBX470 00598 INSPECT OWC-TRADE-NAME REPLACING ALL ',' BY SPACE. DTSBX470 00599 DTSBX470 00600 MOVE WRK-M-ATTN TO OWC-M-ATTN. DTSBX470 00601 MOVE WRK-M-DELV1 TO OWC-M-DELV1. DTSBX470 00602 MOVE WRK-M-DELV2 TO OWC-M-DELV2. DTSBX470 00603 MOVE WRK-M-CITY TO OWC-M-CITY. DTSBX470 00604 MOVE WRK-M-STATE TO OWC-M-STATE. DTSBX470 00605 MOVE WRK-M-ZIP TO OWC-M-ZIP. DTSBX470 00606 DTSBX470 00607 MOVE WRK-W-ATTN TO OWC-W-ATTN. DTSBX470 00608 MOVE WRK-W-DELV1 TO OWC-W-DELV1. DTSBX470 00609 MOVE WRK-W-DELV2 TO OWC-W-DELV2. DTSBX470 00610 MOVE WRK-W-CITY TO OWC-W-CITY. DTSBX470 00611 MOVE WRK-W-STATE TO OWC-W-STATE. DTSBX470 00612 MOVE WRK-W-ZIP TO OWC-W-ZIP. DTSBX470 00613 DTSBX470 00614 MOVE MTAD-VOICE-1 TO OWC-VOICE-1. DTSBX470 00615 DTSBX470 00616 MOVE SPACES TO OWC-INACT-DATE. DTSBX470 00617 IF MPRF-STATUS-INACT-88 DTSBX470 00618 MOVE WRK-INACT-DATE TO L001-FED-8-DATE-9 DTSBX470 00619 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBX470 00620 IF L001-VALID-DATE DTSBX470 00621 MOVE L001-SLASH-8-DATE TO OWC-INACT-DATE DTSBX470 00622 END-IF DTSBX470 00623 END-IF. DTSBX470 00624 DTSBX470 00625 ADD +1 TO WRK-WRITTEN-CNT. DTSBX470 00626 WRITE OWC-REC1 FROM WRK-OWC-REC. DTSBX470 00627 IF NOT BX470-STATUS-OK-88 DTSBX470 00628 DISPLAY 'CANNOT WRITE OUTPUT FILE ' BX470-STATUS DTSBX470 00629 END-IF. DTSBX470 00630 DTSBX470 00631 P3100-EXIT. DTSBX470 00632 EXIT. DTSBX470 00633 DTSBX470 00634 T0000-TERMINATE. DTSBX470 00635 DISPLAY ' '. DTSBX470 00636 DTSBX470 00637 DISPLAY '*** DTSBX470 TERMINATION STATISTICS ***'. DTSBX470 00638 DTSBX470 00639 DISPLAY ' '. DTSBX470 00640 DTSBX470 00641 DISPLAY 'NUMBER OF MASTER FILE PROFILE RECORDS ENCOUNTERED: 'DTSBX470 00642 WRK-MPRF-READ-CNT. DTSBX470 00643 DTSBX470 00644 DISPLAY 'NUMBER OF RECORDS WRITTEN : 'DTSBX470 00645 WRK-WRITTEN-CNT. DTSBX470 00646 DTSBX470 00647 PERFORM S910-CLOSE THRU S910-EXIT. DTSBX470 00648 DTSBX470 00649 CLOSE OWC-FILE. DTSBX470 00650 DTSBX470 00651 T0000-EXIT. DTSBX470 00652 EXIT. DTSBX470 00653 EJECT DTSBX470 00654 S001-FROM-FED-8. DTSBX470 00655 SET L001-FROM-FED-8 TO TRUE. DTSBX470 00656 GO TO S001-DATE. DTSBX470 00657 DTSBX470 00658 S001-DATE. DTSBX470 00659 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBX470 00660 S001-EXIT. DTSBX470 00661 EXIT. DTSBX470 00662 DTSBX470 00663 S004-EDIT-QTR. DTSBX470 00664 CALL 'DTSBU004' USING L004-COMM-AREA. DTSBX470 00665 DTSBX470 00666 S004-EXIT. DTSBX470 00667 EXIT. DTSBX470 00668 SKIP3 DTSBX470 00669 S056-DISP-RATE. DTSBX470 00670 CALL 'DTSBU056' USING L056-COMM-AREA. DTSBX470 00671 DTSBX470 00672 S056-EXIT. DTSBX470 00673 EXIT. DTSBX470 00674 SKIP3 DTSBX470 00675 S910-OPEN-READ. DTSBX470 00676 SET L910-OPEN-READ-88 TO TRUE. DTSBX470 00677 GO TO S910-MSTR-IO. DTSBX470 00678 DTSBX470 00679 S910-OPEN-UPDATE-NO-AIX. DTSBX470 00680 SET L910-OPEN-UPDATE-NO-AIX-88 TO TRUE. DTSBX470 00681 GO TO S910-MSTR-IO. DTSBX470 00682 DTSBX470 00683 S910-READ. DTSBX470 00684 SET L910-READ-88 TO TRUE. DTSBX470 00685 GO TO S910-MSTR-IO. DTSBX470 00686 DTSBX470 00687 S910-START-BROWSE. DTSBX470 00688 SET L910-START-BROWSE-88 TO TRUE. DTSBX470 00689 GO TO S910-MSTR-IO. DTSBX470 00690 DTSBX470 00691 S910-READ-NEXT. DTSBX470 00692 SET L910-READ-NEXT-88 TO TRUE. DTSBX470 00693 GO TO S910-MSTR-IO. DTSBX470 00694 DTSBX470 00695 S910-COUNT. DTSBX470 00696 SET L910-COUNT-88 TO TRUE. DTSBX470 00697 GO TO S910-MSTR-IO. DTSBX470 00698 DTSBX470 00699 S910-REWRITE. DTSBX470 00700 SET L910-REWRITE-88 TO TRUE. DTSBX470 00701 GO TO S910-MSTR-IO. DTSBX470 00702 DTSBX470 00703 S910-CLOSE. DTSBX470 00704 SET L910-CLOSE-88 TO TRUE. DTSBX470 00705 GO TO S910-MSTR-IO. DTSBX470 00706 DTSBX470 00707 S910-MSTR-IO. DTSBX470 00708 CALL 'DTSBU910' USING L910-LINK-AREA DTSBX470 00709 MSKL-REC. DTSBX470 00710 S910-EXIT. DTSBX470 00711 EXIT. DTSBX470 00712 SKIP3 DTSBX470 00713 S999-ABEND. DTSBX470 00714 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBX470 00715 S999-EXIT. DTSBX470 00716 EXIT. DTSBX470