DUTAS re-platformed to Raincode - Initial Source Code
This commit is contained in:
Neeraj Kumar
888
Batch/DTSBD707.cob
Normal file
888
Batch/DTSBD707.cob
Normal file
@ -0,0 +1,888 @@
|
||||
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
|
||||
Reference in New Issue
Block a user