889 lines
70 KiB
COBOL
889 lines
70 KiB
COBOL
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
|