00001 IDENTIFICATION DIVISION. 04/19/04 00002 PROGRAM-ID. DTSBX475. DTSBX475 00003 AUTHOR. TRW. LV003 00004 DATE-WRITTEN. FEBRUARY 2003. DTSBX475 00005 DATE-COMPILED. DTSBX475 00006 SKIP3 DTSBX475 00007 ***** DTSBX475 00008 * DTSBX475 00009 * FUNCTION: EXTRACT FOR BENEFITS WEB PAGE DTSBX475 00010 * DTSBX475 00011 * DTSBX475 00012 ***** DTSBX475 00013 ***************************************************************** DTSBX475 00014 * * DTSBX475 00015 * MODIFICATION HISTORY: * DTSBX475 00016 * * DTSBX475 00017 * * DTSBX475 00018 * 10-10-2003 INITIAL DEVELOPMENT * DTSBX475 00019 * REFERENCE: AUTHOR OF CHANGE - GD * DTSBX475 00020 * * DTSBX475 00021 * 04-19-2004 MODIFIED TO INCLUDE SELF-INSURED EMPLOYERS. * DTSBX475 00022 * REFERENCE: REQUEST FROM BENEFITS - GD * DTSBX475 00023 * * DTSBX475 00024 * MM-DD-YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX * DTSBX475 00025 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX * DTSBX475 00026 * REFERENCE RFP #**** AUTHOR OF CHANGE - *** * DTSBX475 00027 ***************************************************************** DTSBX475 00028 SKIP3 DTSBX475 00029 ENVIRONMENT DIVISION. DTSBX475 00030 SKIP2 DTSBX475 00031 INPUT-OUTPUT SECTION. DTSBX475 00032 DTSBX475 00033 FILE-CONTROL. DTSBX475 00034 DTSBX475 00035 SELECT ADR-FILE ASSIGN TO ADRFILE DTSBX475 00036 FILE STATUS IS ADR-STATUS. DTSBX475 00037 DTSBX475 00038 DATA DIVISION. DTSBX475 00039 DTSBX475 00040 FILE SECTION. DTSBX475 00041 DTSBX475 00042 FD ADR-FILE DTSBX475 00043 RECORDING MODE IS F DTSBX475 00044 BLOCK CONTAINS 0 RECORDS DTSBX475 00045 LABEL RECORDS ARE OMITTED. DTSBX475 00046 DTSBX475 00047 01 ADR-REC PIC X(432). DTSBX475 00048 DTSBX475 00049 WORKING-STORAGE SECTION. DTSBX475 000495 77 PAN-VALET PICTURE X(24) VALUE '003DTSBX475 04/19/04'. DTSBX475 00050 SKIP3 DTSBX475 00051 01 WRK-AREA. DTSBX475 00052 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +300.DTSBX475 00053 DTSBX475 00054 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBX475'.DTSBX475 00055 DTSBX475 00056 05 WRK-MPRF-CNT PIC S9(07) COMP-3. DTSBX475 00057 DTSBX475 00058 05 WRK-ADR-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX475 00059 DTSBX475 00060 05 ADR-STATUS PIC X(02). DTSBX475 00061 88 ADR-STATUS-OK-88 VALUE '00'. DTSBX475 00062 DTSBX475 00063 05 WRK-ERROR-IND PIC X(01). DTSBX475 00064 88 WRK-ERROR-YES-88 VALUE 'Y'. DTSBX475 00065 88 WRK-ERROR-NO-88 VALUE 'N'. DTSBX475 00066 DTSBX475 00067 05 WRK-MPRF-IND PIC X(01). DTSBX475 00068 88 WRK-MPRF-OK-88 VALUE 'Y'. DTSBX475 00069 88 WRK-MPRF-NO-REC-88 VALUE 'N'. DTSBX475 00070 DTSBX475 00071 05 WRK-MTAD-IND PIC X(01). DTSBX475 00072 88 WRK-MTAD-OK-88 VALUE 'Y'. DTSBX475 00073 88 WRK-MTAD-NO-REC-88 VALUE 'N'. DTSBX475 00074 DTSBX475 00075 05 WRK-MBAA-IND PIC X(01). DTSBX475 00076 88 WRK-MBAA-OK-88 VALUE 'Y'. DTSBX475 00077 88 WRK-MBAA-NO-REC-88 VALUE 'N'. DTSBX475 00078 DTSBX475 00079 05 WRK-MRTE-IND PIC X(01). DTSBX475 00080 88 WRK-MRTE-OK-88 VALUE 'Y'. DTSBX475 00081 88 WRK-MRTE-NO-REC-88 VALUE 'N'. DTSBX475 00082 DTSBX475 00083 05 WRK-ADR-REC. DTSBX475 00084 10 WRK-ADR-PRIMARY-NAME PIC X(40). DTSBX475 00085 10 FILLER PIC X(01) VALUE ','. DTSBX475 00086 10 WRK-ADR-ENTITY-NAME PIC X(40). DTSBX475 00087 10 FILLER PIC X(01) VALUE ','. DTSBX475 00088 10 WRK-ADR-BEN-ADDRESS. DTSBX475 00089 15 WRK-ADR-BEN-ATTN PIC X(40). DTSBX475 00090 15 FILLER PIC X(01) VALUE ','. DTSBX475 00091 15 WRK-ADR-BEN-DELV1 PIC X(40). DTSBX475 00092 15 FILLER PIC X(01) VALUE ','. DTSBX475 00093 15 WRK-ADR-BEN-DELV2 PIC X(40). DTSBX475 00094 15 FILLER PIC X(01) VALUE ','. DTSBX475 00095 15 WRK-ADR-BEN-CITY PIC X(25). DTSBX475 00096 15 FILLER PIC X(01) VALUE ','. DTSBX475 00097 15 WRK-ADR-BEN-STATE PIC X(02). DTSBX475 00098 15 FILLER PIC X(01) VALUE ','. DTSBX475 00099 15 WRK-ADR-BEN-ZIP PIC X(10). DTSBX475 00100 15 FILLER PIC X(01) VALUE ','. DTSBX475 00101 10 WRK-ADR-MAIL-ADDRESS. DTSBX475 00102 15 WRK-ADR-MAIL-ATTN PIC X(40). DTSBX475 00103 15 FILLER PIC X(01) VALUE ','. DTSBX475 00104 15 WRK-ADR-MAIL-DELV1 PIC X(40). DTSBX475 00105 15 FILLER PIC X(01) VALUE ','. DTSBX475 00106 15 WRK-ADR-MAIL-DELV2 PIC X(40). DTSBX475 00107 15 FILLER PIC X(01) VALUE ','. DTSBX475 00108 15 WRK-ADR-MAIL-CITY PIC X(25). DTSBX475 00109 15 FILLER PIC X(01) VALUE ','. DTSBX475 00110 15 WRK-ADR-MAIL-STATE PIC X(02). DTSBX475 00111 15 FILLER PIC X(01) VALUE ','. DTSBX475 00112 15 WRK-ADR-MAIL-ZIP PIC X(10). DTSBX475 00113 15 FILLER PIC X(01) VALUE ','. DTSBX475 00114 10 WRK-ADR-EMP-NO PIC 9(06). DTSBX475 00115 10 FILLER PIC X(01) VALUE ','. DTSBX475 00116 10 WRK-ADR-FEIN PIC 9(09). DTSBX475 00117 10 FILLER PIC X(01) VALUE ','. DTSBX475 00118 10 WRK-ADR-EMP-CLASS PIC X(01). DTSBX475 00119 88 WRK-ADR-CLASS-RATED-88 VALUE 'R'. DTSBX475 00120 88 WRK-ADR-CLASS-SELF-INS-88 VALUE 'S'. DTSBX475 00121 10 FILLER PIC X(01) VALUE ','. DTSBX475 00122 10 WRK-ADR-EMP-STATUS PIC X(01). DTSBX475 00123 88 WRK-ADR-STATUS-ACT-88 VALUE 'A'. DTSBX475 00124 88 WRK-ADR-STATUS-INACT-88 VALUE 'I'. DTSBX475 00125 88 WRK-ADR-STATUS-NEVERSUB-88 VALUE 'N'. DTSBX475 00126 88 WRK-ADR-STATUS-UNK-88 VALUE 'U'. DTSBX475 00127 10 FILLER PIC X(01) VALUE ','. DTSBX475 00128 10 WRK-ADR-UI-RATE PIC 9.9. DTSBX475 00129 DTSBX475 00130 05 WRK-CURR-RATE-YRQ PIC S9(05) COMP-3. DTSBX475 00131 DTSBX475 00132 05 WRK-AMT-DISP PIC Z(10)9.99-. DTSBX475 00133 DTSBX475 00134 05 WRK-TRACE-IND PIC X(01). DTSBX475 00135 DTSBX475 00136 01 L001-LINK-AREA. DTSBX475 00137 ++INCLUDE DTSIL001 DTSBX475 00138 DTSBX475 00139 01 L004-LINK-AREA. DTSBX475 00140 ++INCLUDE DTSIL004 DTSBX475 00141 DTSBX475 00142 01 L005-LINK-AREA. DTSBX475 00143 ++INCLUDE DTSIL005 DTSBX475 00144 DTSBX475 00145 DTSBX475 00146 01 L910-LINK-AREA. DTSBX475 00147 ++INCLUDE DTSIL910 DTSBX475 00148 EJECT DTSBX475 00149 01 MSKL-REC. DTSBX475 00150 ++INCLUDE DTSIMSKL DTSBX475 00151 EJECT DTSBX475 00152 01 MHDR-REC. DTSBX475 00153 ++INCLUDE DTSIMHDR DTSBX475 00154 EJECT DTSBX475 00155 01 MPRF-REC. DTSBX475 00156 ++INCLUDE DTSIMPRF DTSBX475 00157 EJECT DTSBX475 00158 01 MBAA-REC. DTSBX475 00159 ++INCLUDE DTSIMBAA DTSBX475 00160 EJECT DTSBX475 00161 01 MTAD-REC. DTSBX475 00162 ++INCLUDE DTSIMTAD DTSBX475 00163 EJECT DTSBX475 00164 01 MRTE-REC. DTSBX475 00165 ++INCLUDE DTSIMRTE DTSBX475 00166 EJECT DTSBX475 00167 PROCEDURE DIVISION. DTSBX475 00168 DTSBX475 00169 DTSBX475-MAIN. DTSBX475 00170 PERFORM I0000-INITIATE THRU I0000-EXIT. DTSBX475 00171 IF WRK-ERROR-YES-88 DTSBX475 00172 GO TO DTSBX475-MAIN-EXIT. DTSBX475 00173 DTSBX475 00174 PERFORM P0000-PROCESS THRU P0000-EXIT. DTSBX475 00175 DTSBX475 00176 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSBX475 00177 DTSBX475 00178 DTSBX475-MAIN-EXIT. DTSBX475 00179 GOBACK. DTSBX475 00180 EJECT DTSBX475 00181 I0000-INITIATE. DTSBX475 00182 MOVE +0 TO WRK-MPRF-CNT. DTSBX475 00183 DTSBX475 00184 SET WRK-ERROR-NO-88 TO TRUE. DTSBX475 00185 DTSBX475 00186 PERFORM I1000-OPEN-FILES THRU I1000-EXIT. DTSBX475 00187 IF WRK-ERROR-YES-88 DTSBX475 00188 GO TO I0000-EXIT. DTSBX475 00189 DTSBX475 00190 PERFORM I2000-READ-HEADER THRU I2000-EXIT. DTSBX475 00191 DTSBX475 00192 I0000-EXIT. DTSBX475 00193 EXIT. DTSBX475 00194 I1000-OPEN-FILES. DTSBX475 00195 DTSBX475 00196 OPEN OUTPUT ADR-FILE. DTSBX475 00197 IF ADR-STATUS-OK-88 DTSBX475 00198 NEXT SENTENCE DTSBX475 00199 ELSE DTSBX475 00200 DISPLAY 'DTSBX475: CANNOT OPEN OUTPUT FILE ' DTSBX475 00201 ADR-STATUS DTSBX475 00202 SET WRK-ERROR-YES-88 TO TRUE DTSBX475 00203 GO TO I1000-EXIT. DTSBX475 00204 DTSBX475 00205 MOVE WRK-TRACE-IND TO L910-TRACE-IND. DTSBX475 00206 DTSBX475 00207 MOVE WRK-MOD-NAME TO L910-MOD-NAME. DTSBX475 00208 DTSBX475 00209 PERFORM S910-OPEN-READ THRU S910-EXIT. DTSBX475 00210 DTSBX475 00211 I1000-EXIT. DTSBX475 00212 EXIT. DTSBX475 00213 DTSBX475 00214 I2000-READ-HEADER. DTSBX475 00215 MOVE LOW-VALUES TO MSKL-REC. DTSBX475 00216 DTSBX475 00217 MOVE +0 TO MSKL-EMP-NO. DTSBX475 00218 DTSBX475 00219 SET MSKL-HDR-88 TO TRUE. DTSBX475 00220 DTSBX475 00221 PERFORM S910-READ THRU S910-EXIT. DTSBX475 00222 DTSBX475 00223 IF L910-NO-REC-88 DTSBX475 00224 DISPLAY 'DTSBX475: MHDR RECORD IS MISSING' DTSBX475 00225 SET WRK-ERROR-YES-88 TO TRUE DTSBX475 00226 ELSE DTSBX475 00227 MOVE MSKL-REC TO MHDR-REC DTSBX475 00228 MOVE MHDR-LAST-RATE-END-YRQ TO L004-QTR-5-9 DTSBX475 00229 MOVE 1 TO L004-QTR-5-Q DTSBX475 00230 MOVE L004-QTR-5-9 TO WRK-CURR-RATE-YRQ. DTSBX475 00231 DTSBX475 00232 I2000-EXIT. DTSBX475 00233 EXIT. DTSBX475 00234 DTSBX475 00235 EJECT DTSBX475 00236 P0000-PROCESS. DTSBX475 00237 DISPLAY 'BENEFITS ADDRESS EXTRACT '. DTSBX475 00238 DISPLAY SPACE. DTSBX475 00239 DTSBX475 00240 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBX475 00241 MOVE +0 TO MSKL-EMP-NO. DTSBX475 00242 SET MSKL-PRF-88 TO TRUE. DTSBX475 00243 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBX475 00244 IF NOT L910-OK-88 DTSBX475 00245 DISPLAY 'BAD FIRST READ' DTSBX475 00246 GO TO P0000-EXIT DTSBX475 00247 ELSE DTSBX475 00248 MOVE MSKL-REC TO MPRF-REC DTSBX475 00249 SET WRK-MPRF-OK-88 TO TRUE. DTSBX475 00250 DTSBX475 00251 PERFORM P1000-SCAN-MPRF THRU P1000-EXIT DTSBX475 00252 UNTIL WRK-MPRF-NO-REC-88. DTSBX475 00253 DTSBX475 00254 P0000-EXIT. DTSBX475 00255 EXIT. DTSBX475 00256 EJECT DTSBX475 00257 P1000-SCAN-MPRF. DTSBX475 00258 IF MPRF-CLASS-SUB-88 DTSBX475 00259 IF MPRF-STATUS-ACT-88 DTSBX475 00260 ADD +1 TO WRK-MPRF-CNT DTSBX475 00261 PERFORM P1100-FIND-MBAA THRU P1100-EXIT DTSBX475 00262 PERFORM P1200-FIND-MTAD THRU P1200-EXIT DTSBX475 00263 PERFORM P1300-FIND-MRTE THRU P1300-EXIT DTSBX475 00264 PERFORM P2000-BUILD-OUTPUT THRU P2000-EXIT. DTSBX475 00265 DTSBX475 00266 MOVE MPRF-REC TO MSKL-REC. DTSBX475 00267 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBX475 00268 IF NOT L910-OK-88 DTSBX475 00269 SET WRK-MPRF-NO-REC-88 TO TRUE DTSBX475 00270 ELSE DTSBX475 00271 MOVE MSKL-REC TO MPRF-REC. DTSBX475 00272 DTSBX475 00273 P1000-EXIT. DTSBX475 00274 EXIT. DTSBX475 00275 DTSBX475 00276 P1100-FIND-MBAA. DTSBX475 00277 MOVE LOW-VALUES TO MBAA-KEY-AREA. DTSBX475 00278 MOVE MPRF-EMP-NO TO MBAA-EMP-NO. DTSBX475 00279 SET MBAA-PRIMARY-BEN-MAIL-ADDR-88 TO TRUE. DTSBX475 00280 SET MBAA-BAA-88 TO TRUE. DTSBX475 00281 MOVE MBAA-KEY-AREA TO MSKL-KEY-AREA. DTSBX475 00282 DTSBX475 00283 PERFORM S910-READ THRU S910-EXIT. DTSBX475 00284 IF L910-OK-88 DTSBX475 00285 MOVE MSKL-REC TO MBAA-REC DTSBX475 00286 SET WRK-MBAA-OK-88 TO TRUE DTSBX475 00287 ELSE DTSBX475 00288 SET WRK-MBAA-NO-REC-88 TO TRUE. DTSBX475 00289 DTSBX475 00290 P1100-EXIT. DTSBX475 00291 EXIT. DTSBX475 00292 DTSBX475 00293 P1200-FIND-MTAD. DTSBX475 00294 MOVE LOW-VALUES TO MTAD-KEY-AREA. DTSBX475 00295 MOVE MPRF-EMP-NO TO MTAD-EMP-NO. DTSBX475 00296 SET MTAD-ID-TAX-MAILING-ADDR-88 TO TRUE. DTSBX475 00297 SET MTAD-TAD-88 TO TRUE. DTSBX475 00298 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. DTSBX475 00299 DTSBX475 00300 PERFORM S910-READ THRU S910-EXIT. DTSBX475 00301 IF L910-OK-88 DTSBX475 00302 MOVE MSKL-REC TO MTAD-REC DTSBX475 00303 SET WRK-MTAD-OK-88 TO TRUE DTSBX475 00304 ELSE DTSBX475 00305 SET WRK-MTAD-NO-REC-88 TO TRUE. DTSBX475 00306 DTSBX475 00307 P1200-EXIT. DTSBX475 00308 EXIT. DTSBX475 00309 DTSBX475 00310 P1300-FIND-MRTE. DTSBX475 00311 IF MPRF-CLASS-RATED-88 DTSBX475 00312 NEXT SENTENCE DTSBX475 00313 ELSE DTSBX475 00314 GO TO P1300-EXIT. DTSBX475 00315 DTSBX475 00316 MOVE LOW-VALUES TO MRTE-KEY-AREA. DTSBX475 00317 MOVE MPRF-EMP-NO TO MRTE-EMP-NO. DTSBX475 00318 MOVE WRK-CURR-RATE-YRQ TO MRTE-EFF-YRQ. DTSBX475 00319 SET MRTE-RTE-88 TO TRUE. DTSBX475 00320 MOVE MRTE-KEY-AREA TO MSKL-KEY-AREA. DTSBX475 00321 DTSBX475 00322 PERFORM S910-READ THRU S910-EXIT. DTSBX475 00323 IF L910-OK-88 DTSBX475 00324 MOVE MSKL-REC TO MRTE-REC DTSBX475 00325 SET WRK-MRTE-OK-88 TO TRUE DTSBX475 00326 ELSE DTSBX475 00327 SET WRK-MRTE-NO-REC-88 TO TRUE. DTSBX475 00328 DTSBX475 00329 P1300-EXIT. DTSBX475 00330 EXIT. DTSBX475 00331 DTSBX475 00332 P2000-BUILD-OUTPUT. DTSBX475 00333 PERFORM P2100-INITIALIZE THRU P2100-EXIT. DTSBX475 00334 PERFORM P2200-BUILD THRU P2200-EXIT. DTSBX475 00335 DTSBX475 00336 DTSBX475 00337 P2000-EXIT. DTSBX475 00338 EXIT. DTSBX475 00339 DTSBX475 00340 P2100-INITIALIZE. DTSBX475 00341 MOVE SPACES TO WRK-ADR-PRIMARY-NAME DTSBX475 00342 WRK-ADR-ENTITY-NAME DTSBX475 00343 WRK-ADR-BEN-ATTN DTSBX475 00344 WRK-ADR-BEN-DELV1 DTSBX475 00345 WRK-ADR-BEN-DELV2 DTSBX475 00346 WRK-ADR-BEN-CITY DTSBX475 00347 WRK-ADR-BEN-STATE DTSBX475 00348 WRK-ADR-BEN-ZIP DTSBX475 00349 WRK-ADR-MAIL-ATTN DTSBX475 00350 WRK-ADR-MAIL-DELV1 DTSBX475 00351 WRK-ADR-MAIL-DELV2 DTSBX475 00352 WRK-ADR-MAIL-CITY DTSBX475 00353 WRK-ADR-MAIL-STATE DTSBX475 00354 WRK-ADR-MAIL-ZIP DTSBX475 00355 WRK-ADR-EMP-CLASS DTSBX475 00356 WRK-ADR-EMP-STATUS. DTSBX475 00357 DTSBX475 00358 MOVE ZERO TO WRK-ADR-EMP-NO DTSBX475 00359 WRK-ADR-FEIN DTSBX475 00360 WRK-ADR-UI-RATE. DTSBX475 00361 DTSBX475 00362 P2100-EXIT. DTSBX475 00363 EXIT. DTSBX475 00364 DTSBX475 00365 P2200-BUILD. DTSBX475 00366 MOVE MPRF-PRIMARY-NAME TO WRK-ADR-PRIMARY-NAME. DTSBX475 00367 IF MPRF-PRIMARY-IS-NOT-ENTITY-88 DTSBX475 00368 MOVE MPRF-ENTITY-NAME TO WRK-ADR-ENTITY-NAME. DTSBX475 00369 DTSBX475 00370 INSPECT WRK-ADR-PRIMARY-NAME REPLACING ALL ',' BY SPACE. DTSBX475 00371 INSPECT WRK-ADR-ENTITY-NAME REPLACING ALL ',' BY SPACE. DTSBX475 00372 DTSBX475 00373 IF WRK-MBAA-OK-88 DTSBX475 00374 MOVE MBAA-ATTN-LINE TO WRK-ADR-BEN-ATTN DTSBX475 00375 MOVE MBAA-DELIV-LINE-1 TO WRK-ADR-BEN-DELV1 DTSBX475 00376 MOVE MBAA-DELIV-LINE-2 TO WRK-ADR-BEN-DELV2 DTSBX475 00377 MOVE MBAA-CITY TO WRK-ADR-BEN-CITY DTSBX475 00378 MOVE MBAA-ST TO WRK-ADR-BEN-STATE DTSBX475 00379 MOVE MBAA-ZIP TO WRK-ADR-BEN-ZIP. DTSBX475 00380 DTSBX475 00381 INSPECT WRK-ADR-BEN-ATTN REPLACING ALL ',' BY SPACE. DTSBX475 00382 INSPECT WRK-ADR-BEN-DELV1 REPLACING ALL ',' BY SPACE. DTSBX475 00383 INSPECT WRK-ADR-BEN-DELV2 REPLACING ALL ',' BY SPACE. DTSBX475 00384 DTSBX475 00385 IF WRK-MTAD-OK-88 DTSBX475 00386 MOVE MTAD-ATTN-LINE TO WRK-ADR-MAIL-ATTN DTSBX475 00387 MOVE MTAD-DELIV-LINE-1 TO WRK-ADR-MAIL-DELV1 DTSBX475 00388 MOVE MTAD-DELIV-LINE-2 TO WRK-ADR-MAIL-DELV2 DTSBX475 00389 MOVE MTAD-CITY TO WRK-ADR-MAIL-CITY DTSBX475 00390 MOVE MTAD-ST TO WRK-ADR-MAIL-STATE DTSBX475 00391 MOVE MTAD-ZIP TO WRK-ADR-MAIL-ZIP. DTSBX475 00392 DTSBX475 00393 INSPECT WRK-ADR-MAIL-ATTN REPLACING ALL ',' BY SPACE. DTSBX475 00394 INSPECT WRK-ADR-MAIL-DELV1 REPLACING ALL ',' BY SPACE. DTSBX475 00395 INSPECT WRK-ADR-MAIL-DELV2 REPLACING ALL ',' BY SPACE. DTSBX475 00396 DTSBX475 00397 MOVE MPRF-EMP-NO TO WRK-ADR-EMP-NO. DTSBX475 00398 MOVE MPRF-FEIN TO WRK-ADR-FEIN. DTSBX475 00399 MOVE MPRF-EMP-CLASS TO WRK-ADR-EMP-CLASS. DTSBX475 00400 MOVE MPRF-EMP-STATUS TO WRK-ADR-EMP-STATUS. DTSBX475 00401 DTSBX475 00402 IF WRK-MRTE-OK-88 DTSBX475 00403 COMPUTE WRK-ADR-UI-RATE = MRTE-UI-RATE * 100. DTSBX475 00404 DTSBX475 00405 ADD +1 TO WRK-ADR-CNT. DTSBX475 00406 DTSBX475 00407 WRITE ADR-REC FROM WRK-ADR-REC. DTSBX475 00408 DTSBX475 00409 P2200-EXIT. DTSBX475 00410 EXIT. DTSBX475 00411 DTSBX475 00412 T0000-TERMINATE. DTSBX475 00413 DTSBX475 00414 DISPLAY ' '. DTSBX475 00415 DTSBX475 00416 DISPLAY '*** DTSBX475 TERMINATION STATISTICS ***'. DTSBX475 00417 DTSBX475 00418 DISPLAY ' '. DTSBX475 00419 DTSBX475 00420 DISPLAY 'NUMBER OF OUTPUT RECORDS WRITTEN: ' DTSBX475 00421 WRK-ADR-CNT. DTSBX475 00422 DTSBX475 00423 DISPLAY 'NUMBER OF EMPLOYERS ENCOUNTERED: ' DTSBX475 00424 WRK-MPRF-CNT. DTSBX475 00425 DTSBX475 00426 DISPLAY 'CURRENT RATE YEAR : ' DTSBX475 00427 WRK-CURR-RATE-YRQ. DTSBX475 00428 DTSBX475 00429 CLOSE ADR-FILE. DTSBX475 00430 DTSBX475 00431 PERFORM S910-CLOSE THRU S910-EXIT. DTSBX475 00432 DTSBX475 00433 T0000-EXIT. DTSBX475 00434 EXIT. DTSBX475 00435 EJECT DTSBX475 00436 S910-OPEN-READ. DTSBX475 00437 SET L910-OPEN-READ-88 TO TRUE. DTSBX475 00438 GO TO S910-MSTR-IO. DTSBX475 00439 DTSBX475 00440 S910-OPEN-UPDATE-NO-AIX. DTSBX475 00441 SET L910-OPEN-UPDATE-NO-AIX-88 TO TRUE. DTSBX475 00442 GO TO S910-MSTR-IO. DTSBX475 00443 DTSBX475 00444 S910-READ. DTSBX475 00445 SET L910-READ-88 TO TRUE. DTSBX475 00446 GO TO S910-MSTR-IO. DTSBX475 00447 DTSBX475 00448 S910-START-BROWSE. DTSBX475 00449 SET L910-START-BROWSE-88 TO TRUE. DTSBX475 00450 GO TO S910-MSTR-IO. DTSBX475 00451 DTSBX475 00452 S910-READ-NEXT. DTSBX475 00453 SET L910-READ-NEXT-88 TO TRUE. DTSBX475 00454 GO TO S910-MSTR-IO. DTSBX475 00455 DTSBX475 00456 S910-COUNT. DTSBX475 00457 SET L910-COUNT-88 TO TRUE. DTSBX475 00458 GO TO S910-MSTR-IO. DTSBX475 00459 DTSBX475 00460 S910-REWRITE. DTSBX475 00461 SET L910-REWRITE-88 TO TRUE. DTSBX475 00462 GO TO S910-MSTR-IO. DTSBX475 00463 DTSBX475 00464 S910-CLOSE. DTSBX475 00465 SET L910-CLOSE-88 TO TRUE. DTSBX475 00466 GO TO S910-MSTR-IO. DTSBX475 00467 DTSBX475 00468 S910-MSTR-IO. DTSBX475 00469 CALL 'DTSBU910' USING L910-LINK-AREA DTSBX475 00470 MSKL-REC. DTSBX475 00471 S910-EXIT. DTSBX475 00472 EXIT. DTSBX475 00473 DTSBX475 00474 S001-FROM-FED-8. DTSBX475 00475 SET L001-FROM-FED-8 TO TRUE. DTSBX475 00476 GO TO S001-DATE. DTSBX475 00477 DTSBX475 00478 S001-DATE. DTSBX475 00479 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBX475 00480 S001-EXIT. DTSBX475 00481 EXIT. DTSBX475 00482 DTSBX475 00483 S004-FROM-5. DTSBX475 00484 SET L004-FROM-5 TO TRUE. DTSBX475 00485 GO TO S004-YRQ. DTSBX475 00486 DTSBX475 00487 S004-YRQ. DTSBX475 00488 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBX475 00489 DTSBX475 00490 S004-EXIT. DTSBX475 00491 EXIT. DTSBX475 00492 DTSBX475 00493 S005-FROM-DATE-TIME. DTSBX475 00494 SET L005-FROM-DATE-TIME TO TRUE. DTSBX475 00495 GO TO S005-ABSTIME. DTSBX475 00496 DTSBX475 00497 S005-ABSTIME. DTSBX475 00498 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBX475 00499 S005-EXIT. DTSBX475 00500 EXIT. DTSBX475