00001 IDENTIFICATION DIVISION. 08/26/04 00002 PROGRAM-ID. DTSBD707. DTSBD707 00003 AUTHOR. TRW. LV003 00004 DATE-WRITTEN. FEBRUARY 2002. DTSBD707 00005 DATE-COMPILED. DTSBD707 00006 DTSBD707 00007 ***** DTSBD707 00008 * 08/2004 LOGIC TO UPDATE DATABASE (FIELD ASSIGNMENT RECORD) DTSBD707 00009 * COMMENTED. LINES BEGINNING WITH *TMP* INDICATE DTSBD707 00010 * COMMENTED LINES. DTSBD707 00011 * DTSBD707 00012 * FUNCTION: 1. EACH QUARTER THE TAX STAFF WILL CREATE A DTSBD707 00013 * SPREADSHEET CONTAINING ACCOUNT NUMBER WITH 4 CHAR DTSBD707 00014 * NAME FOR ALL EMPLOYER'S RETURNED MAIL BECAUSE OF DTSBD707 00015 * A BAD ADDRESS. THIS FILE IS UPLOADED TO THE DTSBD707 00016 * MAINFRAME. DTSBD707 00017 * DTSBD707 00018 * 2. FOR EACH EMPLOYER ON THE BAD ADDRESS FILE, DTSBD707 00019 * READ THE MPRF RECORD TO GET THE FEIN. DTSBD707 00020 * DTSBD707 00021 * 3. SORT THE EMPLOYER FEINS (PROGRAM INTERNAL SORT DTSBD707 00022 * TO MATCH AGAINST THE FUTA FILE. CREATE A 2ND FILE DTSBD707 00023 * TO SORT (PROGRAM INTERNAL) DATA IN THE FOLLOWING DTSBD707 00024 * SEQUENCE: DTSBD707 00025 * A. RECORD TYPE DTSBD707 00026 * 1=DC ADDRESS IN DUTAS OR THE MATCHING FUTA DTSBD707 00027 * RECORD AND PURSUED REPORTS 3 OR MORE. DTSBD707 00028 * 2=NEITHER HAS DC ADDRESS OR PURSUED REPORTSDTSBD707 00029 * LESS THAN 3. DTSBD707 00030 * B. ZIP CODE (SPACE IF NOT DC ZIP) DTSBD707 00031 * C. ACCOUNT NUMBER DTSBD707 00032 * DTSBD707 00033 * 4. PRINT BAD ADDRESS REPORT WITH MAJOR BREAK DTSBD707 00034 * ON SORT RECORD TYPE AND SORT ZIP CODE. DTSBD707 00035 * DTSBD707 00036 * 5. CREATE A FIELD ASSIGNMENT (MFAS) FOR EACH DTSBD707 00037 * EMPLOYER WITH A SORT RECORD TYPE=1 (I.E.: DTSBD707 00038 * EMPLOYER HAS A DC ADDRESS AND 3 OR MORE DTSBD707 00039 * REPORTS ARE BEING PURSUED). DTSBD707 00040 * DTSBD707 00041 ***** DTSBD707 00042 DTSBD707 00043 ENVIRONMENT DIVISION. DTSBD707 00044 DTSBD707 00045 CONFIGURATION SECTION. DTSBD707 00046 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. DTSBD707 00047 DTSBD707 00048 INPUT-OUTPUT SECTION. DTSBD707 00049 DTSBD707 00050 FILE-CONTROL. DTSBD707 00051 SELECT PRT-FILE1 ASSIGN TO RPT707R1. DTSBD707 00052 SELECT REPORT-FILE ASSIGN TO REPORTF1. DTSBD707 00053 SELECT CERT-REQUEST-FILE ASSIGN TO DTSFRQST. DTSBD707 00054 SELECT SORT-FILE ASSIGN TO SORTWORK. DTSBD707 00055 SELECT SORT1-FILE ASSIGN TO SORTWORK. DTSBD707 00056 SELECT BAD-ADDRESSES ASSIGN TO DTSBADAD. DTSBD707 00057 DTSBD707 00058 DATA DIVISION. DTSBD707 00059 DTSBD707 00060 FILE SECTION. DTSBD707 00061 DTSBD707 00062 FD PRT-FILE1 DTSBD707 00063 RECORDING MODE IS F. DTSBD707 00064 01 PRT-RECORD PIC X(133). DTSBD707 00065 DTSBD707 00066 SD SORT-FILE. DTSBD707 00067 01 SORT-RECORD. DTSBD707 00068 05 SORT-FEIN PIC 9(09). DTSBD707 00069 05 SORT-EMPLOYER PIC X(06). DTSBD707 00070 DTSBD707 00071 SD SORT1-FILE. DTSBD707 00072 01 SORT1-RECORD. DTSBD707 00073 05 SORT1-KEY. DTSBD707 00074 10 SORT1-REC-TYPE PIC X(01). DTSBD707 00075 10 SORT1-ZIP PIC X(05). DTSBD707 00076 10 SORT1-EMPLOYER PIC X(06). DTSBD707 00077 05 SORT1-FILLER PIC X(258). DTSBD707 00078 DTSBD707 00079 FD REPORT-FILE DTSBD707 00080 RECORDING MODE IS F DTSBD707 00081 BLOCK CONTAINS 0 RECORDS DTSBD707 00082 LABEL RECORDS ARE STANDARD. DTSBD707 00083 01 REPORT-RECORD. DTSBD707 00084 05 RPT-KEY. DTSBD707 00085 10 RPT-REC-TYPE PIC X(01). DTSBD707 00086 10 RPT-ZIP PIC X(05). DTSBD707 00087 10 RPT-EMPLOYER-NBR PIC X(06). DTSBD707 00088 05 RPT-MSG-CD PIC X(01). DTSBD707 00089 05 RPT-DUTAS-NAME PIC X(40). DTSBD707 00090 05 RPT-DUTAS-PHONE PIC X(10). DTSBD707 00091 05 RPT-DUTAS-ADDR PIC X(40). DTSBD707 00092 05 RPT-DUTAS-CITY PIC X(25). DTSBD707 00093 05 RPT-DUTAS-STATE PIC X(02). DTSBD707 00094 05 RPT-DUTAS-ZIP PIC X(10). DTSBD707 00095 05 RPT-DUTAS-PURSUED PIC 9(02). DTSBD707 00096 05 RPT-DUTAS-SIC-CD PIC X(04). DTSBD707 00097 05 RPT-DUTAS-NAICS-CD PIC X(06). DTSBD707 00098 05 RPT-DUTAS-OWN-CD PIC X(02). DTSBD707 00099 05 RPT-FUTA-NAME PIC X(40). DTSBD707 00100 05 RPT-FUTA-ADDR PIC X(40). DTSBD707 00101 05 RPT-FUTA-CITY PIC X(25). DTSBD707 00102 05 RPT-FUTA-STATE PIC X(02). DTSBD707 00103 05 RPT-FUTA-ZIP PIC X(09). DTSBD707 00104 DTSBD707 00105 FD BAD-ADDRESSES DTSBD707 00106 RECORDING MODE IS F. DTSBD707 00107 01 BAD-ADDRESS-RECORD. DTSBD707 00108 05 BAR-EMPLOYER PIC X(07). DTSBD707 00109 05 FILLER PIC X(01). DTSBD707 00110 05 BAR-NAME-CHECK PIC X(04). DTSBD707 00111 05 FILLER PIC X(68). DTSBD707 00112 DTSBD707 00113 FD CERT-REQUEST-FILE DTSBD707 00114 RECORDING MODE IS F DTSBD707 00115 BLOCK CONTAINS 0 RECORDS DTSBD707 00116 LABEL RECORDS ARE STANDARD. DTSBD707 00117 DTSBD707 00118 01 REQUEST-REC. DTSBD707 00119 05 REQUEST-CHAR-CNT PIC S9(04) COMP. DTSBD707 00120 05 REQUEST-HEX-ZERO PIC S9(04) COMP. DTSBD707 00121 05 REQUEST-STATE-CD PIC X(02). DTSBD707 00122 05 REQUEST-FEIN PIC 9(09). DTSBD707 00123 05 REQUEST-FEIN-X REDEFINES REQUEST-FEIN DTSBD707 00124 PIC X(09). DTSBD707 00125 05 REQUEST-DOC-LOC-NUMBER PIC X(14). DTSBD707 00126 05 REQUEST-TAX-PERIOD PIC 9(06). DTSBD707 00127 05 REQUEST-TAX-PERIOD-X DTSBD707 00128 REDEFINES REQUEST-TAX-PERIOD. DTSBD707 00129 10 REQUEST-TAX-YEAR PIC 9(04). DTSBD707 00130 10 REQUEST-TAX-MONTH PIC 9(02). DTSBD707 00131 05 REQUEST-CHECK-DIGIT PIC X(02). DTSBD707 00132 05 REQUEST-TAXABLE-WAGES PIC 9(13)V9(02). DTSBD707 00133 05 REQUEST-ADDRESS-AREA. DTSBD707 00134 10 REQUEST-ZIP PIC X(12). DTSBD707 00135 10 REQUEST-STATE PIC X(02). DTSBD707 00136 10 REQUEST-CITY PIC X(25). DTSBD707 00137 10 REQUEST-STREET PIC X(35). DTSBD707 00138 10 REQUEST-NAME-1 PIC X(35). DTSBD707 00139 10 REQUEST-NAME-2 PIC X(35). DTSBD707 00140 10 REQUEST-NAME-3 PIC X(35). DTSBD707 00141 10 REQUEST-NAME-4 PIC X(35). DTSBD707 00142 05 REQUEST-NAME-CONTROL PIC X(04). DTSBD707 00143 05 REQUEST-XREF-FEIN PIC X(09). DTSBD707 00144 05 REQUEST-EMP-NO-AREA PIC X(15). DTSBD707 00145 05 REQUEST-FORM-INDICATOR PIC X(01). DTSBD707 00146 EJECT DTSBD707 00147 WORKING-STORAGE SECTION. DTSBD707 001475 77 PAN-VALET PICTURE X(24) VALUE '003DTSBD707 08/26/04'. DTSBD707 00148 01 WRK-AREA. DTSBD707 00149 05 WRK-PAGE-BREAK. DTSBD707 00150 10 WRK-PAGE-REC-TYPE PIC X(01) VALUE SPACES. DTSBD707 00151 10 WRK-PAGE-ZIP PIC X(05) VALUE SPACES. DTSBD707 00152 05 WRK-ADJUST-DATE PIC 9(08). DTSBD707 00153 05 WRK-ADJUST-DATE-RE REDEFINES WRK-ADJUST-DATE. DTSBD707 00154 10 WRK-ADJUST-CCYY PIC 9(04). DTSBD707 00155 10 WRK-ADJUST-MM PIC 9(02). DTSBD707 00156 10 FILLER PIC X(02). DTSBD707 00157 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +707.DTSBD707 00158 05 WRK-ABEND-MSG PIC X(60) VALUE SPACES. DTSBD707 00159 05 WRK-MSG-CD PIC X(01) VALUE SPACES. DTSBD707 00160 DTSBD707 00161 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBD707'.DTSBD707 00162 05 WRK-EMPLOYER PIC X(06). DTSBD707 00163 05 WRK-BAR-IN-CNT PIC S9(07) COMP-3 VALUE 0. DTSBD707 00164 05 WRK-FUTA-IN-CNT PIC S9(07) COMP-3 VALUE 0. DTSBD707 00165 05 WRK-BAR-WITH-MPRF-CNT PIC S9(07) COMP-3 VALUE 0. DTSBD707 00166 05 WRK-BAR-NO-MPRF-CNT PIC S9(07) COMP-3 VALUE 0. DTSBD707 00167 05 WRK-BAR-NO-FUTA-CNT PIC S9(07) COMP-3 VALUE 0. DTSBD707 00168 05 WRK-BAR-WITH-FUTA-CNT PIC S9(07) COMP-3 VALUE 0. DTSBD707 00169 05 WRK-ADDR-SAME-CNT PIC S9(07) COMP-3 VALUE 0. DTSBD707 00170 05 WRK-NO-MTAD-CNT PIC S9(07) COMP-3 VALUE 0. DTSBD707 00171 05 WRK-L910-RECORD-CNT PIC S9(03) COMP-3 VALUE 0. DTSBD707 00172 05 WRK-MTAD-UPDATED-CNT PIC S9(03) COMP-3 VALUE 0. DTSBD707 00173 DTSBD707 00174 05 WS-LINE-CNT PIC S9(02) COMP-3 VALUE 60. DTSBD707 00175 05 WS-PAGE-CNT PIC S9(05) COMP-3 VALUE +0. DTSBD707 00176 DTSBD707 00177 05 WRK-FUTA-ZIP-AREA. DTSBD707 00178 10 WRK-FUTA-ZIP-5 PIC X(05). DTSBD707 00179 10 WRK-FUTA-ZIP-PLUS4 PIC X(04). DTSBD707 00180 10 WRK-FUTA-ZIP-PLUS3 PIC X(03). DTSBD707 00181 DTSBD707 00182 05 WRK-MTAD-ZIP-AREA. DTSBD707 00183 10 WRK-TAD-ZIP-5 PIC X(05). DTSBD707 00184 10 WRK-TAD-DASH PIC X(01) VALUE '-'. DTSBD707 00185 10 WRK-TAD-ZIP-PLUS4 PIC X(04). DTSBD707 00186 DTSBD707 00187 05 WRK-LOG-MSG PIC X(39) VALUE DTSBD707 00188 'MAILING ADDRESS REPLACED BY IRS ADDRESS'. DTSBD707 00189 DTSBD707 00190 05 DISP-DATE PIC X(10). DTSBD707 00191 05 DISP-TIME PIC X(08). DTSBD707 00192 05 DISP-ABSTIME PIC X(16). DTSBD707 00193 DTSBD707 00194 05 WRK-EDIT-PHONE. DTSBD707 00195 10 FILLER PIC X(01) VALUE '('. DTSBD707 00196 10 WRK-EP-AREA-CODE PIC X(03). DTSBD707 00197 10 FILLER PIC X(02) VALUE ')'. DTSBD707 00198 10 WRK-EP-EXCHANGE PIC X(03). DTSBD707 00199 10 FILLER PIC X(01) VALUE '-'. DTSBD707 00200 10 WRK-EP-NUMBER PIC X(04). DTSBD707 00201 05 WRK-PURSUED-REPORTS. DTSBD707 00202 10 WRK-PR-EMP PIC X(06). DTSBD707 00203 10 FILLER PIC X(01) VALUE '/'. DTSBD707 00204 10 WRK-PR-NBR PIC X(02). DTSBD707 00205 01 HEADER-1. DTSBD707 00206 05 FILLER PIC X(06) DTSBD707 00207 VALUE ' 707R1'. DTSBD707 00208 05 FILLER PIC X(34). DTSBD707 00209 05 WS-AGY-NAME-LINE1 PIC X(50) VALUE DTSBD707 00210 ' DEPARTMENT OF EMPLOYMENT SERVICES '. DTSBD707 00211 05 FILLER PIC X(20). DTSBD707 00212 05 FILLER PIC X(05) DTSBD707 00213 VALUE 'DATE:'. DTSBD707 00214 05 FILLER PIC X(01). DTSBD707 00215 05 WS-SYS-DATE PIC X(08). DTSBD707 00216 01 HEADER-2. DTSBD707 00217 05 FILLER PIC X(01) VALUE SPACES. DTSBD707 00218 05 HDR2-FLD-REP-NAME PIC X(41) VALUE SPACES. DTSBD707 00219 05 FILLER PIC X(32) VALUE DTSBD707 00220 'DUTAS BAD ADDRESSES BY ZIP CODE'. DTSBD707 00221 05 HDR2-VARIABLE. DTSBD707 00222 10 FILLER PIC X(02) VALUE '('. DTSBD707 00223 10 HDR2-ZIP PIC X(05). DTSBD707 00224 10 FILLER PIC X(29) VALUE ' )'. DTSBD707 00225 05 FILLER PIC X(05) VALUE 'PAGE:'. DTSBD707 00226 05 HDR2-PAGE-CNT PIC ZZZ9. DTSBD707 00227 01 HEADER-3. DTSBD707 00228 10 FILLER PIC X(17) DTSBD707 00229 VALUE ' EMPLR/RPTS'. DTSBD707 00230 10 FILLER PIC X(42) DTSBD707 00231 VALUE 'DUTAS INFORMATION'. DTSBD707 00232 10 FILLER PIC X(40) DTSBD707 00233 VALUE 'FUTA INFORMATION'. DTSBD707 00234 DTSBD707 00235 01 HEADER-4. DTSBD707 00236 10 FILLER PIC X(01) VALUE SPACE. DTSBD707 00237 10 FILLER PIC X(14) VALUE ALL '-'. DTSBD707 00238 10 FILLER PIC X(02) VALUE SPACE. DTSBD707 00239 10 FILLER PIC X(40) VALUE ALL '-'. DTSBD707 00240 10 FILLER PIC X(02) VALUE SPACE. DTSBD707 00241 10 FILLER PIC X(40) VALUE ALL '-'. DTSBD707 00242 DTSBD707 00243 01 DETAIL-LINE-1 VALUE SPACES. DTSBD707 00244 05 FILLER PIC X(01). DTSBD707 00245 05 DTL1-FIELD1 PIC X(16). DTSBD707 00246 05 DTL1-FIELD2. DTSBD707 00247 10 DTL1-CITY2 PIC X(15). DTSBD707 00248 10 FILLER PIC X(01). DTSBD707 00249 10 DTL1-STATE2 PIC X(03). DTSBD707 00250 10 DTL1-ZIP2 PIC X(21). DTSBD707 00251 05 FILLER PIC X(02). DTSBD707 00252 05 DTL1-FIELD3. DTSBD707 00253 10 DTL1-CITY3 PIC X(15). DTSBD707 00254 10 FILLER PIC X(01). DTSBD707 00255 10 DTL1-STATE3 PIC X(03). DTSBD707 00256 10 DTL1-ZIP3 PIC X(21). DTSBD707 00257 01 DETAIL-LINE-3. DTSBD707 00258 05 FILLER PIC X(02) VALUE SPACE. DTSBD707 00259 05 WS-LITERAL-3 PIC X(50) VALUE SPACE. DTSBD707 00260 05 WS-COUNTS-3 PIC ZZZ,ZZ9. DTSBD707 00261 DTSBD707 00262 01 L001-LINK-AREA. DTSBD707 00263 ++INCLUDE DTSIL001 DTSBD707 00264 SKIP2 DTSBD707 00265 01 L005-LINK-AREA. DTSBD707 00266 ++INCLUDE DTSIL005 DTSBD707 00267 SKIP2 DTSBD707 00268 01 L061-LINK-AREA. DTSBD707 00269 ++INCLUDE DTSIL061 DTSBD707 00270 SKIP2 DTSBD707 00271 01 L062-LINK-AREA. DTSBD707 00272 ++INCLUDE DTSIL062 DTSBD707 00273 SKIP2 DTSBD707 00274 01 L910-LINK-AREA. DTSBD707 00275 ++INCLUDE DTSIL910 DTSBD707 00276 SKIP2 DTSBD707 00277 01 L921-LINK-AREA. DTSBD707 00278 ++INCLUDE DTSIL921 DTSBD707 00279 SKIP2 DTSBD707 00280 01 ISKL-REC. DTSBD707 00281 ++INCLUDE DTSIISKL DTSBD707 00282 SKIP2 DTSBD707 00283 01 IEIN-REC. DTSBD707 00284 ++INCLUDE DTSIIEIN DTSBD707 00285 SKIP2 DTSBD707 00286 01 L931-LINK-AREA. DTSBD707 00287 ++INCLUDE DTSIL931 DTSBD707 00288 SKIP2 DTSBD707 00289 01 FSKL-REC. DTSBD707 00290 ++INCLUDE DTSIFSKL DTSBD707 00291 SKIP2 DTSBD707 00292 01 MSKL-REC. DTSBD707 00293 ++INCLUDE DTSIMSKL DTSBD707 00294 SKIP2 DTSBD707 00295 01 MHDR-REC. DTSBD707 00296 ++INCLUDE DTSIMHDR DTSBD707 00297 SKIP2 DTSBD707 00298 01 MPRF-REC. DTSBD707 00299 ++INCLUDE DTSIMPRF DTSBD707 00300 SKIP2 DTSBD707 00301 01 MTAD-REC. DTSBD707 00302 ++INCLUDE DTSIMTAD DTSBD707 00303 SKIP2 DTSBD707 00304 01 MFAS-REC. DTSBD707 00305 ++INCLUDE DTSIMFAS DTSBD707 00306 EJECT DTSBD707 00307 PROCEDURE DIVISION. DTSBD707 00308 PERFORM I0000-INITIATE THRU I0000-EXIT. DTSBD707 00309 DTSBD707 00310 SORT SORT-FILE ASCENDING KEY SORT-FEIN DTSBD707 00311 INPUT PROCEDURE P1000-GET-FEIN THRU P1999-EXIT DTSBD707 00312 OUTPUT PROCEDURE P5000-WRITE-RPT-REC THRU DTSBD707 00313 P5999-EXIT. DTSBD707 00314 CLOSE REPORT-FILE. DTSBD707 00315 SORT SORT1-FILE ASCENDING KEY SORT1-KEY DTSBD707 00316 USING REPORT-FILE DTSBD707 00317 GIVING REPORT-FILE. DTSBD707 00318 DTSBD707 00319 OPEN INPUT REPORT-FILE. DTSBD707 00320 PERFORM P6000-PRINT THRU P6000-EXIT. DTSBD707 00321 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSBD707 00322 DTSBD707 00323 GOBACK. DTSBD707 00324 EJECT DTSBD707 00325 I0000-INITIATE. DTSBD707 00326 PERFORM I1000-SYS-DATE THRU I1000-EXIT. DTSBD707 00327 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. DTSBD707 00328 I0000-EXIT. DTSBD707 00329 EXIT. DTSBD707 00330 DTSBD707 00331 I1000-SYS-DATE. DTSBD707 00332 SET L005-FROM-SYS TO TRUE. DTSBD707 00333 PERFORM S005-SYS-DATE THRU S005-EXIT. DTSBD707 00334 MOVE L005-DATE TO L001-FED-8-DATE-9. DTSBD707 00335 SET L001-FROM-FED-8 TO TRUE. DTSBD707 00336 PERFORM S001-DATE THRU S001-EXIT. DTSBD707 00337 MOVE L001-SLASH-DATE TO DISP-DATE, WS-SYS-DATE. DTSBD707 00338 MOVE L005-TIME TO DISP-TIME. DTSBD707 00339 MOVE L005-ABSTIME TO DISP-ABSTIME. DTSBD707 00340 DTSBD707 00341 DISPLAY ' '. DTSBD707 00342 DISPLAY 'L005-DATE ' DISP-DATE ' L005-TIME ' DISP-TIME DTSBD707 00343 ' L005-ABSTIME ' DISP-ABSTIME. DTSBD707 00344 DTSBD707 00345 I1000-EXIT. DTSBD707 00346 EXIT. DTSBD707 00347 DTSBD707 00348 I2000-OPEN-FILES. DTSBD707 00349 MOVE 'N' TO L910-TRACE-IND. DTSBD707 00350 MOVE WRK-MOD-NAME TO L910-MOD-NAME. DTSBD707 00351 DTSBD707 00352 ** OPEN MSTR FOR UPDATE DTSBD707 00353 *TMP*PERFORM S910-OPEN-UPDATE THRU S910-EXIT. DTSBD707 00354 DTSBD707 00355 ** OPEN MSTR FOR RETRIEVAL DTSBD707 00356 PERFORM S910-OPEN-READ THRU S910-EXIT. DTSBD707 00357 DTSBD707 00358 ** OPEN AIX FOR UPDATE DTSBD707 00359 *TMP*PERFORM S921-OPEN-UPDATE THRU S921-EXIT. DTSBD707 00360 DTSBD707 00361 ** OPEN AIX FOR READ DTSBD707 00362 PERFORM S921-OPEN-READ THRU S921-EXIT. DTSBD707 00363 DTSBD707 00364 ** OPEN REF FOR UPDATE DTSBD707 00365 *TMP*PERFORM S931-OPEN-UPDATE THRU S931-EXIT. DTSBD707 00366 DTSBD707 00367 ** OPEN REF FOR READ DTSBD707 00368 PERFORM S931-OPEN-READ THRU S931-EXIT. DTSBD707 00369 DTSBD707 00370 OPEN INPUT CERT-REQUEST-FILE, DTSBD707 00371 BAD-ADDRESSES, DTSBD707 00372 OUTPUT PRT-FILE1, DTSBD707 00373 REPORT-FILE. DTSBD707 00374 I2000-EXIT. DTSBD707 00375 EXIT. DTSBD707 00376 DTSBD707 00377 P1000-GET-FEIN. DTSBD707 00378 READ BAD-ADDRESSES DTSBD707 00379 AT END DTSBD707 00380 CLOSE BAD-ADDRESSES DTSBD707 00381 GO TO P1999-EXIT. DTSBD707 00382 DTSBD707 00383 ADD +1 TO WRK-BAR-IN-CNT. DTSBD707 00384 MOVE BAR-EMPLOYER (1:3) TO WRK-EMPLOYER (1:3). DTSBD707 00385 MOVE BAR-EMPLOYER (5:3) TO WRK-EMPLOYER (4:3). DTSBD707 00386 DTSBD707 00387 PERFORM P9000-GET-MPRF THRU P9000-EXIT. DTSBD707 00388 IF L910-NO-REC-88 DTSBD707 00389 OR BAR-NAME-CHECK NOT EQUAL MPRF-PRIMARY-NAME (1:4) DTSBD707 00390 AND BAR-NAME-CHECK NOT EQUAL MPRF-ENTITY-NAME (1:4) DTSBD707 00391 ADD +1 TO WRK-BAR-NO-MPRF-CNT DTSBD707 00392 DISPLAY ' UNMATCHED MPRF RECORD-->' WRK-EMPLOYER DTSBD707 00393 '/' BAR-NAME-CHECK DTSBD707 00394 '/' MPRF-PRIMARY-NAME (1:15) DTSBD707 00395 '/' MPRF-ENTITY-NAME (1:15) DTSBD707 00396 GO TO P1000-GET-FEIN. DTSBD707 00397 DTSBD707 00398 ADD +1 TO WRK-BAR-WITH-MPRF-CNT. DTSBD707 00399 MOVE MPRF-FEIN TO SORT-FEIN. DTSBD707 00400 MOVE WRK-EMPLOYER TO SORT-EMPLOYER. DTSBD707 00401 RELEASE SORT-RECORD. DTSBD707 00402 GO TO P1000-GET-FEIN. DTSBD707 00403 P1999-EXIT. DTSBD707 00404 EXIT. DTSBD707 00405 DTSBD707 00406 P5000-WRITE-RPT-REC. DTSBD707 00407 P5010-READ-SORT-FILE. DTSBD707 00408 RETURN SORT-FILE AT END DTSBD707 00409 MOVE 999999999 TO SORT-FEIN. DTSBD707 00410 P5010-EXIT. DTSBD707 00411 EXIT. DTSBD707 00412 P5020-READ-FUTA-FILE. DTSBD707 00413 READ CERT-REQUEST-FILE AT END DTSBD707 00414 MOVE 999999999 TO REQUEST-FEIN DTSBD707 00415 GO TO P5020-EXIT. DTSBD707 00416 ADD 1 TO WRK-FUTA-IN-CNT. DTSBD707 00417 P5020-EXIT. DTSBD707 00418 EXIT. DTSBD707 00419 DTSBD707 00420 P5050-COMPARE-FILES. DTSBD707 00421 MOVE SPACE TO WRK-MSG-CD. DTSBD707 00422 IF SORT-FEIN EQUAL 999999999 DTSBD707 00423 AND REQUEST-FEIN EQUAL 999999999 DTSBD707 00424 GO TO P5999-EXIT. DTSBD707 00425 IF REQUEST-FEIN LESS THAN SORT-FEIN DTSBD707 00426 GO TO P5020-READ-FUTA-FILE. DTSBD707 00427 IF REQUEST-FEIN GREATER SORT-FEIN DTSBD707 00428 ADD 1 TO WRK-BAR-NO-FUTA-CNT DTSBD707 00429 MOVE '1' TO WRK-MSG-CD DTSBD707 00430 PERFORM P5060-MOVE-MPRF-DATA THRU P5060-EXIT DTSBD707 00431 PERFORM P5010-READ-SORT-FILE THRU P5010-EXIT DTSBD707 00432 GO TO P5050-COMPARE-FILES. DTSBD707 00433 DTSBD707 00434 ADD 1 TO WRK-BAR-WITH-FUTA-CNT. DTSBD707 00435 PERFORM P5060-MOVE-MPRF-DATA THRU P5060-EXIT. DTSBD707 00436 GO TO P5010-READ-SORT-FILE. DTSBD707 00437 P5999-EXIT. DTSBD707 00438 EXIT. DTSBD707 00439 DTSBD707 00440 P5060-MOVE-MPRF-DATA. DTSBD707 00441 INITIALIZE REPORT-RECORD. DTSBD707 00442 MOVE SORT-EMPLOYER TO WRK-EMPLOYER, RPT-EMPLOYER-NBR. DTSBD707 00443 PERFORM P9000-GET-MPRF THRU P9000-EXIT. DTSBD707 00444 IF L910-NO-REC-88 DTSBD707 00445 DISPLAY ' MPRF LOGIC SCREWUP<--' SORT-EMPLOYER DTSBD707 00446 PERFORM S999-ABEND THRU S999-EXIT. DTSBD707 00447 MOVE MPRF-PRIMARY-NAME TO RPT-DUTAS-NAME. DTSBD707 00448 MOVE MPRF-PURSUED-RPT-CNT TO RPT-DUTAS-PURSUED. DTSBD707 00449 MOVE MPRF-SIC-CD TO RPT-DUTAS-SIC-CD. DTSBD707 00450 MOVE MPRF-NAICS-CD TO RPT-DUTAS-NAICS-CD. DTSBD707 00451 MOVE MPRF-OWN-CD TO RPT-DUTAS-OWN-CD. DTSBD707 00452 DTSBD707 00453 PERFORM P5200-FIND-MTAD THRU P5200-EXIT. DTSBD707 00454 IF L910-NO-REC-88 DTSBD707 00455 ADD 1 TO WRK-NO-MTAD-CNT DTSBD707 00456 MOVE '2' TO WRK-MSG-CD DTSBD707 00457 INITIALIZE MTAD-REC DTSBD707 00458 ELSE DTSBD707 00459 MOVE MSKL-REC TO MTAD-REC DTSBD707 00460 IF MTAD-CHNG-DATE GREATER 20020315 DTSBD707 00461 ADD 1 TO WRK-MTAD-UPDATED-CNT DTSBD707 00462 MOVE '3' TO WRK-MSG-CD. DTSBD707 00463 DTSBD707 00464 MOVE MTAD-VOICE-1 TO RPT-DUTAS-PHONE. DTSBD707 00465 MOVE MTAD-DELIV-LINE-2 TO RPT-DUTAS-ADDR. DTSBD707 00466 MOVE MTAD-CITY TO RPT-DUTAS-CITY. DTSBD707 00467 MOVE MTAD-ST TO RPT-DUTAS-STATE. DTSBD707 00468 MOVE MTAD-ZIP TO RPT-DUTAS-ZIP. DTSBD707 00469 DTSBD707 00470 IF WRK-MSG-CD GREATER SPACES DTSBD707 00471 MOVE WRK-MSG-CD TO RPT-MSG-CD DTSBD707 00472 GO TO P5060-MMD-1. DTSBD707 00473 DTSBD707 00474 IF MTAD-DELIV-LINE-2 EQUAL REQUEST-STREET DTSBD707 00475 AND REQUEST-ZIP (1:5) EQUAL MTAD-ZIP (1:5) DTSBD707 00476 AND REQUEST-ZIP (6:4) EQUAL MTAD-ZIP (7:4) DTSBD707 00477 ADD 1 TO WRK-ADDR-SAME-CNT DTSBD707 00478 MOVE '4' TO RPT-MSG-CD DTSBD707 00479 GO TO P5060-MMD-1. DTSBD707 00480 DTSBD707 00481 MOVE REQUEST-NAME-1 TO RPT-FUTA-NAME. DTSBD707 00482 MOVE REQUEST-STREET TO RPT-FUTA-ADDR. DTSBD707 00483 MOVE REQUEST-CITY TO RPT-FUTA-CITY. DTSBD707 00484 MOVE REQUEST-STATE TO RPT-FUTA-STATE. DTSBD707 00485 MOVE REQUEST-ZIP TO RPT-FUTA-ZIP. DTSBD707 00486 P5060-MMD-1. DTSBD707 00487 MOVE '1' TO RPT-REC-TYPE. DTSBD707 00488 IF MPRF-PURSUED-RPT-CNT GREATER +2 DTSBD707 00489 IF 'DC' EQUAL RPT-DUTAS-STATE DTSBD707 00490 MOVE RPT-DUTAS-ZIP TO RPT-ZIP DTSBD707 00491 ELSE DTSBD707 00492 IF 'DC' EQUAL RPT-FUTA-STATE DTSBD707 00493 MOVE RPT-FUTA-ZIP TO RPT-ZIP DTSBD707 00494 ELSE DTSBD707 00495 MOVE '2' TO RPT-REC-TYPE DTSBD707 00496 ELSE DTSBD707 00497 MOVE '2' TO RPT-REC-TYPE. DTSBD707 00498 DTSBD707 00499 WRITE REPORT-RECORD. DTSBD707 00500 P5060-EXIT. DTSBD707 00501 EXIT. DTSBD707 00502 DTSBD707 00503 P5200-FIND-MTAD. DTSBD707 00504 MOVE LOW-VALUES TO MTAD-KEY-AREA. DTSBD707 00505 MOVE SORT-EMPLOYER TO MTAD-EMP-NO. DTSBD707 00506 SET MTAD-TAD-88 TO TRUE. DTSBD707 00507 SET MTAD-ID-TAX-MAILING-ADDR-88 TO TRUE. DTSBD707 00508 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. DTSBD707 00509 PERFORM S910-READ THRU S910-EXIT. DTSBD707 00510 P5200-EXIT. DTSBD707 00511 EXIT. DTSBD707 00512 DTSBD707 00513 P6000-PRINT. DTSBD707 00514 PERFORM P9010-GET-MHDR THRU P9010-EXIT. DTSBD707 00515 P6000-P-1. DTSBD707 00516 READ REPORT-FILE DTSBD707 00517 AT END DTSBD707 00518 GO TO P6000-EXIT. DTSBD707 00519 DTSBD707 00520 IF WRK-PAGE-BREAK EQUAL SPACES DTSBD707 00521 MOVE RPT-REC-TYPE TO WRK-PAGE-REC-TYPE DTSBD707 00522 MOVE RPT-ZIP TO WRK-PAGE-ZIP. DTSBD707 00523 DTSBD707 00524 IF RPT-REC-TYPE EQUAL '1' DTSBD707 00525 PERFORM P6010-WRITE-MFAS THRU P6010-EXIT. DTSBD707 00526 DTSBD707 00527 IF WRK-PAGE-REC-TYPE NOT EQUAL RPT-REC-TYPE DTSBD707 00528 OR WRK-PAGE-ZIP NOT EQUAL RPT-ZIP DTSBD707 00529 AND WRK-PAGE-REC-TYPE EQUAL '1' DTSBD707 00530 OR WS-LINE-CNT GREATER 51 DTSBD707 00531 MOVE RPT-REC-TYPE TO WRK-PAGE-REC-TYPE DTSBD707 00532 MOVE RPT-ZIP TO WRK-PAGE-ZIP DTSBD707 00533 MOVE ZEROS TO WS-LINE-CNT DTSBD707 00534 PERFORM P6020-PRINT-HEADER THRU P6020-EXIT. DTSBD707 00535 DTSBD707 00536 *** WRITE 1ST REPORT LINE *** DTSBD707 00537 MOVE RPT-EMPLOYER-NBR TO WRK-PR-EMP. DTSBD707 00538 MOVE RPT-DUTAS-PURSUED TO WRK-PR-NBR. DTSBD707 00539 MOVE WRK-PURSUED-REPORTS TO DTL1-FIELD1. DTSBD707 00540 MOVE RPT-DUTAS-NAME TO DTL1-FIELD2. DTSBD707 00541 DTSBD707 00542 IF RPT-MSG-CD EQUAL SPACES DTSBD707 00543 MOVE RPT-FUTA-NAME TO DTL1-FIELD3 DTSBD707 00544 ELSE DTSBD707 00545 IF RPT-MSG-CD EQUAL '1' DTSBD707 00546 MOVE ' !! NO MATCHING FUTA RECORD !!' TO DTL1-FIELD3 DTSBD707 00547 ELSE DTSBD707 00548 IF WRK-MSG-CD EQUAL '2' DTSBD707 00549 MOVE ' !! NO DUTAS MAILING ADDRESS !!' TO DTL1-FIELD3 DTSBD707 00550 ELSE DTSBD707 00551 IF WRK-MSG-CD EQUAL '3' DTSBD707 00552 MOVE ' !! DUTAS ADDRESS RECENTLY UPDATED !!' TO DTSBD707 00553 DTL1-FIELD3 DTSBD707 00554 ELSE DTSBD707 00555 MOVE ' !! DUTAS ADDRESS RECENTLY CHANGED !!' TO DTSBD707 00556 DTL1-FIELD3. DTSBD707 00557 WRITE PRT-RECORD FROM DETAIL-LINE-1 AFTER 2. DTSBD707 00558 DTSBD707 00559 *** WRITE 2ND REPORT LINE *** DTSBD707 00560 MOVE RPT-DUTAS-PHONE (1:3) TO WRK-EP-AREA-CODE. DTSBD707 00561 MOVE RPT-DUTAS-PHONE (4:3) TO WRK-EP-EXCHANGE. DTSBD707 00562 MOVE RPT-DUTAS-PHONE (7:4) TO WRK-EP-NUMBER. DTSBD707 00563 MOVE WRK-EDIT-PHONE TO DTL1-FIELD1. DTSBD707 00564 MOVE RPT-DUTAS-ADDR TO DTL1-FIELD2. DTSBD707 00565 IF RPT-MSG-CD EQUAL SPACES DTSBD707 00566 MOVE RPT-FUTA-ADDR TO DTL1-FIELD3 DTSBD707 00567 ELSE DTSBD707 00568 MOVE SPACES TO DTL1-FIELD3. DTSBD707 00569 WRITE PRT-RECORD FROM DETAIL-LINE-1 AFTER 1. DTSBD707 00570 DTSBD707 00571 *** WRITE 3ND REPORT LINE *** DTSBD707 00572 MOVE SPACES TO DTL1-FIELD1. DTSBD707 00573 MOVE RPT-DUTAS-CITY TO DTL1-FIELD2. DTSBD707 00574 MOVE RPT-DUTAS-STATE TO DTL1-STATE2. DTSBD707 00575 MOVE RPT-DUTAS-ZIP TO DTL1-ZIP2. DTSBD707 00576 IF RPT-MSG-CD EQUAL SPACES DTSBD707 00577 MOVE RPT-FUTA-CITY TO DTL1-FIELD3 DTSBD707 00578 MOVE RPT-FUTA-STATE TO DTL1-STATE3 DTSBD707 00579 MOVE RPT-FUTA-ZIP (1:5) TO DTL1-ZIP3 DTSBD707 00580 IF RPT-FUTA-ZIP (6:4) GREATER ZEROS DTSBD707 00581 MOVE '-' TO DTL1-ZIP3 (6:1) DTSBD707 00582 MOVE RPT-FUTA-ZIP (6:4) TO DTL1-ZIP3 (7:4) DTSBD707 00583 ELSE DTSBD707 00584 NEXT SENTENCE DTSBD707 00585 ELSE DTSBD707 00586 MOVE SPACES TO DTL1-FIELD3. DTSBD707 00587 WRITE PRT-RECORD FROM DETAIL-LINE-1 AFTER 1. DTSBD707 00588 DTSBD707 00589 *TMP*MOVE RPT-EMPLOYER-NBR TO WRK-EMPLOYER. DTSBD707 00590 * PERFORM P9000-GET-MPRF THRU P9000-EXIT. DTSBD707 00591 * IF L910-NO-REC-88 DTSBD707 00592 * DISPLAY ' MPRF LOGIC SCREWUP-2<--' RPT-EMPLOYER-NBR DTSBD707 00593 * PERFORM S999-ABEND THRU S999-EXIT. DTSBD707 00594 * SET MPRF-MFAS-EXISTS-88 TO TRUE. DTSBD707 00595 * MOVE MPRF-REC TO MSKL-REC. DTSBD707 00596 * PERFORM S910-REWRITE THRU S910-EXIT. DTSBD707 00597 * IF NOT L910-OK-88 DTSBD707 00598 * DISPLAY ' MPRF BAD REWRITE' DTSBD707 00599 *TMP* PERFORM S999-ABEND THRU S999-EXIT. DTSBD707 00600 DTSBD707 00601 ADD +4 TO WS-LINE-CNT. DTSBD707 00602 GO TO P6000-P-1. DTSBD707 00603 P6000-EXIT. DTSBD707 00604 EXIT. DTSBD707 00605 DTSBD707 00606 P6010-WRITE-MFAS. DTSBD707 00607 INITIALIZE MFAS-REC. DTSBD707 00608 MOVE RPT-EMPLOYER-NBR TO MFAS-EMP-NO. DTSBD707 00609 SET MFAS-STATUS-ACTIVE-88 TO TRUE. DTSBD707 00610 SET MFAS-NON-AUDIT-88 TO TRUE. DTSBD707 00611 ADD 1 TO MHDR-LAST-USED-ASSIGN-NO. DTSBD707 00612 MOVE MHDR-LAST-USED-ASSIGN-NO TO MFAS-ASSIGN-NO. DTSBD707 00613 DTSBD707 00614 PERFORM P9030-GET-FIELD-REP THRU P9030-EXIT. DTSBD707 00615 MOVE L061-FLD-REP-ID TO MFAS-FLD-REP-ID. DTSBD707 00616 DISPLAY MFAS-EMP-NO ' ASSGN=' MHDR-LAST-USED-ASSIGN-NO DTSBD707 00617 ' ' L061-FLD-REP-ID. DTSBD707 00618 MOVE '13' TO MFAS-ASSIGN-TYPE. DTSBD707 00619 MOVE L005-DATE TO MFAS-START-DATE, DTSBD707 00620 WRK-ADJUST-DATE. DTSBD707 00621 IF WRK-ADJUST-MM EQUAL 12 DTSBD707 00622 ADD 1 TO WRK-ADJUST-CCYY DTSBD707 00623 MOVE 1 TO WRK-ADJUST-MM DTSBD707 00624 ELSE DTSBD707 00625 ADD 1 TO WRK-ADJUST-MM. DTSBD707 00626 MOVE WRK-ADJUST-DATE TO MFAS-DUE-DATE. DTSBD707 00627 MOVE 'SYSTEM' TO MFAS-SOURCE-OP-ID. DTSBD707 00628 MOVE RPT-DUTAS-SIC-CD TO MFAS-SIC-CD. DTSBD707 00629 MOVE RPT-DUTAS-NAICS-CD TO MFAS-NAICS-CD DTSBD707 00630 MOVE RPT-DUTAS-OWN-CD TO MFAS-OWN-CD. DTSBD707 00631 SET MFAS-NOT-CONVERTED-88 TO TRUE. DTSBD707 00632 MOVE L005-DATE TO MFAS-ESTB-DATE, DTSBD707 00633 MFAS-CHNG-DATE. DTSBD707 00634 SET MFAS-FAS-88 TO TRUE. DTSBD707 00635 MOVE MFAS-REC TO MSKL-REC. DTSBD707 00636 DTSBD707 00637 *TMP*PERFORM S910-WRITE THRU S910-EXIT. DTSBD707 00638 * IF L910-OK-88 DTSBD707 00639 * NEXT SENTENCE DTSBD707 00640 * ELSE DTSBD707 00641 * MOVE 'WRITE MFAS-REC ERROR' TO WRK-ABEND-MSG DTSBD707 00642 *TMP* PERFORM S999-ABEND THRU S999-EXIT. DTSBD707 00643 DTSBD707 00644 P6010-EXIT. DTSBD707 00645 EXIT. DTSBD707 00646 DTSBD707 00647 P6020-PRINT-HEADER. DTSBD707 00648 IF WRK-PAGE-REC-TYPE EQUAL '1' DTSBD707 00649 MOVE L061-FLD-REP-ID TO L062-FLD-REP-ID DTSBD707 00650 PERFORM S062-FLD-REP-NAME THRU S062-EXIT DTSBD707 00651 MOVE L062-NAME TO HDR2-FLD-REP-NAME DTSBD707 00652 MOVE RPT-ZIP TO HDR2-ZIP DTSBD707 00653 ELSE DTSBD707 00654 MOVE SPACES TO HDR2-FLD-REP-NAME DTSBD707 00655 MOVE ' N/A' TO HDR2-ZIP. DTSBD707 00656 ADD 1 TO WS-PAGE-CNT. DTSBD707 00657 MOVE WS-PAGE-CNT TO HDR2-PAGE-CNT DTSBD707 00658 WRITE PRT-RECORD FROM HEADER-1 AFTER TOP-OF-PAGE DTSBD707 00659 WRITE PRT-RECORD FROM HEADER-2 AFTER 1 DTSBD707 00660 WRITE PRT-RECORD FROM HEADER-3 AFTER 2 DTSBD707 00661 WRITE PRT-RECORD FROM HEADER-4 AFTER 1. DTSBD707 00662 P6020-EXIT. DTSBD707 00663 EXIT. DTSBD707 00664 DTSBD707 00665 P9000-GET-MPRF. DTSBD707 00666 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSBD707 00667 MOVE WRK-EMPLOYER TO MSKL-EMP-NO. DTSBD707 00668 SET MSKL-PRF-88 TO TRUE. DTSBD707 00669 DTSBD707 00670 PERFORM S910-READ THRU S910-EXIT. DTSBD707 00671 DTSBD707 00672 IF L910-NO-REC-88 DTSBD707 00673 NEXT SENTENCE DTSBD707 00674 ELSE DTSBD707 00675 MOVE MSKL-REC TO MPRF-REC. DTSBD707 00676 P9000-EXIT. DTSBD707 00677 EXIT. DTSBD707 00678 DTSBD707 00679 P9010-GET-MHDR. DTSBD707 00680 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSBD707 00681 MOVE ZEROS TO MSKL-EMP-NO. DTSBD707 00682 SET MSKL-HDR-88 TO TRUE. DTSBD707 00683 DTSBD707 00684 PERFORM S910-READ THRU S910-EXIT. DTSBD707 00685 DTSBD707 00686 IF L910-NO-REC-88 DTSBD707 00687 DISPLAY ' MHDR NOT FOUND' DTSBD707 00688 PERFORM S999-ABEND THRU S999-EXIT DTSBD707 00689 ELSE DTSBD707 00690 MOVE MSKL-REC TO MHDR-REC. DTSBD707 00691 P9010-EXIT. DTSBD707 00692 EXIT. DTSBD707 00693 DTSBD707 00694 P9020-REWRITE-MHDR. DTSBD707 00695 MOVE MHDR-REC TO MSKL-REC. DTSBD707 00696 PERFORM S910-REWRITE THRU S910-EXIT. DTSBD707 00697 IF NOT L910-OK-88 DTSBD707 00698 DISPLAY ' MHDR BAD REWRITE' DTSBD707 00699 PERFORM S999-ABEND THRU S999-EXIT. DTSBD707 00700 P9020-EXIT. DTSBD707 00701 EXIT. DTSBD707 00702 DTSBD707 00703 P9030-GET-FIELD-REP. DTSBD707 00704 IF RPT-DUTAS-STATE EQUAL 'DC' DTSBD707 00705 MOVE RPT-DUTAS-ZIP TO L061-FLD-ZIP DTSBD707 00706 ELSE DTSBD707 00707 MOVE RPT-FUTA-ZIP (1:5) TO L061-FLD-ZIP. DTSBD707 00708 MOVE 'DC' TO L061-FLD-ST. DTSBD707 00709 DTSBD707 00710 MOVE RPT-EMPLOYER-NBR TO L061-EMP-NO. DTSBD707 00711 DTSBD707 00712 PERFORM S061-LOOKUP-FLD-REP-ID THRU S061-EXIT. DTSBD707 00713 P9030-EXIT. DTSBD707 00714 EXIT. DTSBD707 00715 DTSBD707 00716 T0000-TERMINATE. DTSBD707 00717 ADD +1 TO WS-PAGE-CNT DTSBD707 00718 MOVE WS-PAGE-CNT TO HDR2-PAGE-CNT DTSBD707 00719 WRITE PRT-RECORD FROM HEADER-1 AFTER TOP-OF-PAGE DTSBD707 00720 WRITE PRT-RECORD FROM HEADER-2 AFTER 1. DTSBD707 00721 MOVE ' *** PROCESSING STATISTICS FOR DTSBD707 ***' TO DTSBD707 00722 PRT-RECORD. DTSBD707 00723 WRITE PRT-RECORD AFTER 2. DTSBD707 00724 DTSBD707 00725 MOVE ' NBR INPUT EMPLOYER RECORDS ' TO WS-LITERAL-3. DTSBD707 00726 MOVE WRK-BAR-IN-CNT TO WS-COUNTS-3. DTSBD707 00727 WRITE PRT-RECORD FROM DETAIL-LINE-3 AFTER 2. DTSBD707 00728 DTSBD707 00729 MOVE ' NBR INPUT FUTA RECORDS ' TO WS-LITERAL-3. DTSBD707 00730 MOVE WRK-FUTA-IN-CNT TO WS-COUNTS-3. DTSBD707 00731 WRITE PRT-RECORD FROM DETAIL-LINE-3 AFTER 1. DTSBD707 00732 DTSBD707 00733 MOVE ' NBR EMPLOYERS WITH MATCHING MPRF ' TO WS-LITERAL-3. DTSBD707 00734 MOVE WRK-BAR-WITH-MPRF-CNT TO WS-COUNTS-3. DTSBD707 00735 WRITE PRT-RECORD FROM DETAIL-LINE-3 AFTER 2. DTSBD707 00736 DTSBD707 00737 MOVE ' NBR EMPLOYERS NO MATCHING MPRF ' TO WS-LITERAL-3. DTSBD707 00738 MOVE WRK-BAR-NO-MPRF-CNT TO WS-COUNTS-3. DTSBD707 00739 WRITE PRT-RECORD FROM DETAIL-LINE-3 AFTER 1. DTSBD707 00740 DTSBD707 00741 MOVE ' NBR ADDRESSES RECENTLY UPDATED ' TO WS-LITERAL-3. DTSBD707 00742 MOVE WRK-MTAD-UPDATED-CNT TO WS-COUNTS-3. DTSBD707 00743 WRITE PRT-RECORD FROM DETAIL-LINE-3 AFTER 1. DTSBD707 00744 DTSBD707 00745 MOVE ' NBR EMPLOYERS WITH NO MTAD ' TO WS-LITERAL-3. DTSBD707 00746 MOVE WRK-NO-MTAD-CNT TO WS-COUNTS-3. DTSBD707 00747 WRITE PRT-RECORD FROM DETAIL-LINE-3 AFTER 1. DTSBD707 00748 DTSBD707 00749 MOVE ' NBR EMPLOYERS WITH MATCHING FUTA ' TO WS-LITERAL-3. DTSBD707 00750 MOVE WRK-BAR-WITH-FUTA-CNT TO WS-COUNTS-3. DTSBD707 00751 WRITE PRT-RECORD FROM DETAIL-LINE-3 AFTER 2. DTSBD707 00752 DTSBD707 00753 MOVE ' NBR EMPLOYERS NO MATCHING FUTA ' TO WS-LITERAL-3. DTSBD707 00754 MOVE WRK-BAR-NO-FUTA-CNT TO WS-COUNTS-3. DTSBD707 00755 WRITE PRT-RECORD FROM DETAIL-LINE-3 AFTER 1. DTSBD707 00756 DTSBD707 00757 MOVE ' NBR DUTAS ADDRESSES SAME AS FUTA ' TO WS-LITERAL-3. DTSBD707 00758 MOVE WRK-ADDR-SAME-CNT TO WS-COUNTS-3. DTSBD707 00759 WRITE PRT-RECORD FROM DETAIL-LINE-3 AFTER 1. DTSBD707 00760 DTSBD707 00761 CLOSE CERT-REQUEST-FILE, REPORT-FILE DTSBD707 00762 PRT-FILE1. DTSBD707 00763 *TMP*PERFORM P9020-REWRITE-MHDR THRU P9020-EXIT. DTSBD707 00764 PERFORM S910-CLOSE THRU S910-EXIT. DTSBD707 00765 PERFORM S921-CLOSE THRU S921-EXIT. DTSBD707 00766 PERFORM S931-CLOSE THRU S931-EXIT. DTSBD707 00767 DTSBD707 00768 T0000-EXIT. DTSBD707 00769 EXIT. DTSBD707 00770 DTSBD707 00771 S001-DATE. DTSBD707 00772 SKIP1 DTSBD707 00773 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBD707 00774 SKIP2 DTSBD707 00775 S001-EXIT. DTSBD707 00776 EXIT. DTSBD707 00777 DTSBD707 00778 S005-SYS-DATE. DTSBD707 00779 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBD707 00780 S005-EXIT. DTSBD707 00781 EXIT. DTSBD707 00782 DTSBD707 00783 S061-LOOKUP-FLD-REP-ID. DTSBD707 00784 CALL 'DTSBU061' USING L061-LINK-AREA. DTSBD707 00785 S061-EXIT. DTSBD707 00786 EXIT. DTSBD707 00787 DTSBD707 00788 S062-FLD-REP-NAME. DTSBD707 00789 CALL 'DTSBU062' USING L062-LINK-AREA. DTSBD707 00790 S062-EXIT. DTSBD707 00791 EXIT. DTSBD707 00792 DTSBD707 00793 S910-OPEN-READ. DTSBD707 00794 SET L910-OPEN-READ-88 TO TRUE. DTSBD707 00795 GO TO S910-MSTR-IO. DTSBD707 00796 DTSBD707 00797 S910-OPEN-UPDATE. DTSBD707 00798 SET L910-OPEN-UPDATE-88 TO TRUE. DTSBD707 00799 GO TO S910-MSTR-IO. DTSBD707 00800 DTSBD707 00801 S910-READ. DTSBD707 00802 SET L910-READ-88 TO TRUE. DTSBD707 00803 GO TO S910-MSTR-IO. DTSBD707 00804 DTSBD707 00805 S910-START-BROWSE. DTSBD707 00806 SET L910-START-BROWSE-88 TO TRUE. DTSBD707 00807 GO TO S910-MSTR-IO. DTSBD707 00808 DTSBD707 00809 S910-READ-NEXT. DTSBD707 00810 SET L910-READ-NEXT-88 TO TRUE. DTSBD707 00811 GO TO S910-MSTR-IO. DTSBD707 00812 DTSBD707 00813 S910-COUNT. DTSBD707 00814 SET L910-COUNT-88 TO TRUE. DTSBD707 00815 GO TO S910-MSTR-IO. DTSBD707 00816 DTSBD707 00817 S910-WRITE. DTSBD707 00818 SET L910-WRITE-88 TO TRUE. DTSBD707 00819 GO TO S910-MSTR-IO. DTSBD707 00820 DTSBD707 00821 S910-REWRITE. DTSBD707 00822 SET L910-REWRITE-88 TO TRUE. DTSBD707 00823 GO TO S910-MSTR-IO. DTSBD707 00824 DTSBD707 00825 S910-CLOSE. DTSBD707 00826 SET L910-CLOSE-88 TO TRUE. DTSBD707 00827 GO TO S910-MSTR-IO. DTSBD707 00828 DTSBD707 00829 S910-MSTR-IO. DTSBD707 00830 CALL 'DTSBU910' USING L910-LINK-AREA DTSBD707 00831 MSKL-REC. DTSBD707 00832 S910-EXIT. DTSBD707 00833 EXIT. DTSBD707 00834 DTSBD707 00835 S921-OPEN-READ. DTSBD707 00836 SET L921-OPEN-READ-88 TO TRUE. DTSBD707 00837 GO TO S921-AIX-IO. DTSBD707 00838 DTSBD707 00839 S921-OPEN-UPDATE. DTSBD707 00840 SET L921-OPEN-UPDATE-88 TO TRUE. DTSBD707 00841 GO TO S921-AIX-IO. DTSBD707 00842 DTSBD707 00843 S921-READ. DTSBD707 00844 SET L921-READ-88 TO TRUE. DTSBD707 00845 GO TO S921-AIX-IO. DTSBD707 00846 DTSBD707 00847 S921-START-BROWSE. DTSBD707 00848 SET L921-START-BROWSE-88 TO TRUE. DTSBD707 00849 GO TO S921-AIX-IO. DTSBD707 00850 DTSBD707 00851 S921-READ-NEXT. DTSBD707 00852 SET L921-READ-NEXT-88 TO TRUE. DTSBD707 00853 GO TO S921-AIX-IO. DTSBD707 00854 DTSBD707 00855 S921-CLOSE. DTSBD707 00856 SET L921-CLOSE-88 TO TRUE. DTSBD707 00857 GO TO S921-AIX-IO. DTSBD707 00858 DTSBD707 00859 S921-AIX-IO. DTSBD707 00860 CALL 'DTSBU921' USING L921-LINK-AREA DTSBD707 00861 ISKL-REC. DTSBD707 00862 S921-EXIT. DTSBD707 00863 EXIT. DTSBD707 00864 DTSBD707 00865 S931-OPEN-READ. DTSBD707 00866 SET L931-OPEN-READ-88 TO TRUE. DTSBD707 00867 GO TO S931-REF-IO. DTSBD707 00868 DTSBD707 00869 S931-CLOSE. DTSBD707 00870 SET L931-CLOSE-88 TO TRUE. DTSBD707 00871 GO TO S931-REF-IO. DTSBD707 00872 DTSBD707 00873 S931-REF-IO. DTSBD707 00874 CALL 'DTSBU931' USING L931-LINK-AREA DTSBD707 00875 FSKL-REC. DTSBD707 00876 S931-EXIT. DTSBD707 00877 EXIT. DTSBD707 00878 DTSBD707 00879 S999-ABEND. DTSBD707 00880 DTSBD707 00881 DISPLAY '**** DTSBD707 ABENDING ' DTSBD707 00882 WRK-ABEND-MSG. DTSBD707 00883 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBD707 00884 DTSBD707 00885 S999-EXIT. DTSBD707 00886 EXIT. DTSBD707 00887 DTSBD707