502 lines
40 KiB
COBOL
502 lines
40 KiB
COBOL
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
|