00001 IDENTIFICATION DIVISION. 12/03/09 00002 PROGRAM-ID. DTSBR590. DTSBR590 00003 AUTHOR. TRW. LV015 00004 DATE-WRITTEN. FEBRUARY 2000. DTSBR590 00005 DATE-COMPILED. DTSBR590 00006 SKIP3 DTSBR590 00007 ***** DTSBR590 00008 * FUNCTION: CREATE FISCAL AGENT RATE REPORT DTSBR590 00009 ***** DTSBR590 00010 SKIP3 DTSBR590 00011 ENVIRONMENT DIVISION. DTSBR590 00012 INPUT-OUTPUT SECTION. DTSBR590 00013 FILE-CONTROL. DTSBR590 00014 DTSBR590 00015 SELECT DTS-RATE-OUT ASSIGN TO RPT590R1 DTSBR590 00016 FILE STATUS IS WRK-COL-STATUS. DTSBR590 00017 DTSBR590 00018 SELECT DTS-TAPE-OUT ASSIGN TO RPT590R2 DTSBR590 00019 FILE STATUS IS WRK-COL-STATUS. DTSBR590 00020 DTSBR590 00021 SELECT DTS-EROR-OUT ASSIGN TO RPT590R3 DTSBR590 00022 FILE STATUS IS WRK-COL-STATUS. DTSBR590 00023 DTSBR590 00024 SELECT DTS-FEIN-OUT ASSIGN TO RPT590R4 DTSBR590 00025 FILE STATUS IS WRK-COL-STATUS. DTSBR590 00026 DTSBR590 00027 DTSBR590 00028 SKIP2 DTSBR590 00029 DATA DIVISION. DTSBR590 00030 FILE SECTION. DTSBR590 00031 DTSBR590 00032 FD DTS-TAPE-OUT DTSBR590 00033 LABEL RECORDS ARE STANDARD. DTSBR590 00034 01 DTS-TAPE-OUTREC PIC X(100). DTSBR590 00035 DTSBR590 00036 FD DTS-RATE-OUT DTSBR590 00037 LABEL RECORDS ARE STANDARD. DTSBR590 00038 DTSBR590 00039 01 PRT-REC1 PIC X(133). DTSBR590 00040 DTSBR590 00041 FD DTS-EROR-OUT DTSBR590 00042 LABEL RECORDS ARE STANDARD. DTSBR590 00043 DTSBR590 00044 01 PRT-REC2 PIC X(133). DTSBR590 00045 DTSBR590 00046 FD DTS-FEIN-OUT DTSBR590 00047 LABEL RECORDS ARE STANDARD. DTSBR590 00048 DTSBR590 00049 01 PRT-REC3 PIC X(133). DTSBR590 00050 DTSBR590 00051 WORKING-STORAGE SECTION. DTSBR590 000515 77 PAN-VALET PICTURE X(24) VALUE '015DTSBR590 12/03/09'. DTSBR590 00052 SKIP3 DTSBR590 00053 01 WRK-AREA. DTSBR590 00054 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +590.DTSBR590 00055 DTSBR590 00056 05 WRK-FISCAL-AGENT-CD PIC X(03) VALUE SPACES. DTSBR590 00057 DTSBR590 00058 05 WRK-EMP-PHA PIC X(10) VALUE SPACES. DTSBR590 00059 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBR590'.DTSBR590 00060 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBR590 00061 DTSBR590 00062 05 WRK-RATE-CNT PIC S9(07) COMP-3 VALUE 0. DTSBR590 00063 05 WRK-TAPE-CNT PIC S9(07) COMP-3 VALUE 0. DTSBR590 00064 05 WRK-EROR-CNT PIC S9(07) COMP-3 VALUE 0. DTSBR590 00065 05 WRK-FEIN-CNT PIC S9(07) COMP-3 VALUE 0. DTSBR590 00066 DTSBR590 00067 05 WS-NUMBER-ONE PIC S9(07) COMP-3 VALUE +0. DTSBR590 00068 05 WS-NUMBER-TWO PIC S9(07) COMP-3 VALUE +0. DTSBR590 00069 05 WS-NUMBER-THREE PIC S9(07) COMP-3 VALUE +0. DTSBR590 00070 DTSBR590 00071 05 WRK-COL-CNT PIC S9(07) COMP-3. DTSBR590 00072 DTSBR590 00073 05 WRK-COL-STATUS PIC X(02). DTSBR590 00074 88 WRK-COL-STAT-OK VALUE '00'. DTSBR590 00075 05 WRK-MPRF-IND PIC X(01). DTSBR590 00076 88 WRK-MPRF-OK VALUE 'Y'. DTSBR590 00077 88 WRK-MPRF-NO-REC VALUE 'N'. DTSBR590 00078 DTSBR590 00079 05 WRK-ERROR-IND PIC X(01) VALUE SPACES. DTSBR590 00080 88 WRK-ERROR-YES VALUE 'Y'. DTSBR590 00081 88 WRK-ERROR-NO VALUE 'N'. DTSBR590 00082 DTSBR590 00083 05 WRK-FISC-AGNT-CODE PIC X(01). DTSBR590 00084 88 WRK-FISC-AGNT-VALID-88 VALUE 'Y'. DTSBR590 00085 88 WRK-FISC-AGNT-INVALID-88 VALUE 'N'. DTSBR590 00086 DTSBR590 00087 05 RPT01-LINE-CNT PIC S9(05) VALUE +65. DTSBR590 00088 05 RPT01-PAGE-CNT PIC 9(05) VALUE ZEROS. DTSBR590 00089 DTSBR590 00090 05 RPT02-LINE-CNT PIC S9(05) VALUE +65. DTSBR590 00091 05 RPT02-PAGE-CNT PIC 9(05) VALUE ZEROS. DTSBR590 00092 DTSBR590 00093 05 RPT03-LINE-CNT PIC S9(05) VALUE +65. DTSBR590 00094 05 RPT03-PAGE-CNT PIC 9(05) VALUE ZEROS. DTSBR590 00095 DTSBR590 00096 05 WRK-DATE PIC 9(06) VALUE ZEROS. DTSBR590 00097 05 WRK-DATE-9 REDEFINES WRK-DATE. DTSBR590 00098 10 WRK-DATE-YY PIC 9(02). DTSBR590 00099 10 WRK-DATE-MM PIC 9(02). DTSBR590 00100 10 WRK-DATE-DD PIC 9(02). DTSBR590 00101 05 WRK-TRACE-IND PIC X(01). DTSBR590 00102 DTSBR590 00103 05 WS-REC PIC X(133) VALUE SPACES.DTSBR590 00104 EJECT DTSBR590 00105 01 RPT01DET. DTSBR590 00106 05 FILLER PIC X(2) VALUE SPACES. DTSBR590 00107 05 EMP-NO-OUT PIC X(6) VALUE SPACES. DTSBR590 00108 05 FILLER PIC X(4) VALUE SPACES. DTSBR590 00109 05 EMP-FEIN-OUT PIC X(9) VALUE SPACES. DTSBR590 00110 05 EMP-FEIN-SEA-OUT PIC X(1) VALUE SPACES. DTSBR590 00111 05 FILLER PIC X(4) VALUE SPACES. DTSBR590 00112 05 EMP-RATE-OUT PIC ZZ9.9 VALUE ZEROS. DTSBR590 00113 05 FILLER PIC X(6) VALUE SPACES. DTSBR590 00114 05 EMP-SICC-OUT PIC X(4) VALUE SPACES. DTSBR590 00115 05 FILLER PIC X(4) VALUE SPACES. DTSBR590 00116 05 EMP-NAME-OUT PIC X(40) VALUE SPACES. DTSBR590 00117 05 FILLER PIC X(3) VALUE SPACES. DTSBR590 00118 05 EMP-NAMEA-OUT PIC X(40) VALUE SPACES. DTSBR590 00119 05 FILLER PIC X(06) VALUE SPACES. DTSBR590 00120 EJECT DTSBR590 00121 DTSBR590 00122 01 RPT02DET. DTSBR590 00123 05 FILLER PIC X(2) VALUE SPACES. DTSBR590 00124 05 ERR-NO-OUT PIC X(6) VALUE SPACES. DTSBR590 00125 05 FILLER PIC X(4) VALUE SPACES. DTSBR590 00126 05 ERR-FEIN-OUT PIC X(9) VALUE SPACES. DTSBR590 00127 05 FILLER PIC X(6) VALUE SPACES. DTSBR590 00128 05 ERR-STATUS-OUT PIC X VALUE SPACES. DTSBR590 00129 05 FILLER PIC X(6) VALUE SPACES. DTSBR590 00130 05 ERR-NAME-OUT PIC X(40) VALUE SPACES. DTSBR590 00131 05 FILLER PIC X(6) VALUE SPACES. DTSBR590 00132 05 ERR-MSG-OUT PIC X(40) VALUE SPACES. DTSBR590 00133 05 FILLER PIC X(06) VALUE SPACES. DTSBR590 00134 EJECT DTSBR590 00135 01 RPT03DET. DTSBR590 00136 05 FILLER PIC X(2) VALUE SPACES. DTSBR590 00137 05 FEIN-NO-OUT PIC X(6) VALUE SPACES. DTSBR590 00138 05 FILLER PIC X(4) VALUE SPACES. DTSBR590 00139 05 FEIN-FEIN-OUT PIC X(9) VALUE SPACES. DTSBR590 00140 05 FILLER PIC X(6) VALUE SPACES. DTSBR590 00141 05 FEIN-STATUS-OUT PIC X VALUE SPACES. DTSBR590 00142 05 FILLER PIC X(6) VALUE SPACES. DTSBR590 00143 05 FEIN-NAME-OUT PIC X(40) VALUE SPACES. DTSBR590 00144 05 FILLER PIC X(6) VALUE SPACES. DTSBR590 00145 05 FEIN-MSG-OUT PIC X(40) VALUE SPACES. DTSBR590 00146 05 FILLER PIC X(06) VALUE SPACES. DTSBR590 00147 EJECT DTSBR590 00148 01 REPORT-LINE-AREA. DTSBR590 00149 05 HEAD01. DTSBR590 00150 10 FILLER PIC X(05) VALUE SPACE. DTSBR590 00151 10 HEAD01-RPT-NAME PIC X(05) VALUE '590R1'. DTSBR590 00152 10 FILLER PIC X(47) VALUE SPACES. DTSBR590 00153 10 HEAD01-PROGRAM-NAME PIC X(52). DTSBR590 00154 10 FILLER PIC X(04) VALUE SPACES. DTSBR590 00155 10 FILLER PIC X(06) VALUE 'DATE: '. DTSBR590 00156 10 HEAD01-SYS-DATE. DTSBR590 00157 15 HEAD01-SYS-MM PIC 99. DTSBR590 00158 15 FILLER PIC X(01) VALUE '/'. DTSBR590 00159 15 HEAD01-SYS-DD PIC 99. DTSBR590 00160 15 FILLER PIC X(01) VALUE '/'. DTSBR590 00161 15 HEAD01-SYS-CEN PIC 99 VALUE 20. DTSBR590 00162 15 HEAD01-SYS-YY PIC 99. DTSBR590 00163 DTSBR590 00164 05 HEAD02. DTSBR590 00165 10 FILLER PIC X(01) VALUE SPACE. DTSBR590 00166 10 FILLER PIC X(50) VALUE SPACES. DTSBR590 00167 10 HEAD02-AGY-NAME PIC X(60). DTSBR590 00168 10 HEAD02-SYS-TIME PIC X(10) VALUE SPACES. DTSBR590 00169 DTSBR590 00170 05 HEAD03. DTSBR590 00171 10 FILLER PIC X(01) VALUE SPACE. DTSBR590 00172 10 FILLER PIC X(20) DTSBR590 00173 VALUE 'FISCAL AGENT NAME:'. DTSBR590 00174 10 HEAD03-FA-NAME PIC X(30) VALUE SPACES. DTSBR590 00175 10 FILLER PIC X(10) VALUE SPACES. DTSBR590 00176 10 HEAD03-AGY-MAIL1 PIC X(52). DTSBR590 00177 10 FILLER PIC X(06) VALUE 'PAGE: '. DTSBR590 00178 10 HEAD03-PAGE-CNT PIC ZZZ9. DTSBR590 00179 DTSBR590 00180 05 HEAD04. DTSBR590 00181 10 FILLER PIC X(01) VALUE SPACE. DTSBR590 00182 10 FILLER PIC X(50) VALUE SPACES. DTSBR590 00183 10 HEAD04-TITLE PIC X(36) DTSBR590 00184 VALUE 'FISCAL AGENT RATE TAPE REPORT '. DTSBR590 00185 10 FILLER PIC X(50) VALUE SPACES. DTSBR590 00186 DTSBR590 00187 05 HEAD05. DTSBR590 00188 10 FILLER PIC X(02) VALUE SPACE. DTSBR590 00189 10 FILLER PIC X(43) VALUE DTSBR590 00190 'ACCOUNT FEDERAL CONTRIB SIC '. DTSBR590 00191 10 FILLER PIC X(49) VALUE DTSBR590 00192 'TRADE ENTITY'. DTSBR590 00193 10 FILLER PIC X(41) VALUE SPACE. DTSBR590 00194 05 HEAD06. DTSBR590 00195 10 FILLER PIC X(02) VALUE SPACE. DTSBR590 00196 10 FILLER PIC X(43) VALUE DTSBR590 00197 'NUMBER ACCOUNT RATE CODE '. DTSBR590 00198 10 FILLER PIC X(49) VALUE DTSBR590 00199 'NAME NAME '. DTSBR590 00200 10 FILLER PIC X(41) VALUE SPACES. DTSBR590 00201 DTSBR590 00202 05 HEAD07. DTSBR590 00203 10 FILLER PIC X(02) VALUE SPACE. DTSBR590 00204 10 FILLER PIC X(40) VALUE DTSBR590 00205 'ACCOUNT FEDERAL STATUS '. DTSBR590 00206 10 FILLER PIC X(90) VALUE SPACE. DTSBR590 00207 05 HEAD08. DTSBR590 00208 10 FILLER PIC X(02) VALUE SPACE. DTSBR590 00209 10 FILLER PIC X(45) VALUE DTSBR590 00210 'NUMBER ACCOUNT CODE EMPLOYER NAME'. DTSBR590 00211 10 FILLER PIC X(18) VALUE SPACES. DTSBR590 00212 10 FILLER PIC X(26) VALUE DTSBR590 00213 ' MESSAGE '. DTSBR590 00214 10 FILLER PIC X(39) VALUE SPACES. DTSBR590 00215 EJECT DTSBR590 00216 DTSBR590 00217 01 FOOTING-LINE-1 PIC X(133) VALUE SPACES. DTSBR590 00218 01 FOOTING-LINE-2 PIC X(133) VALUE SPACES. DTSBR590 00219 01 FOOTING-LINE-3. DTSBR590 00220 05 FILLER PIC X(25) VALUE SPACES. DTSBR590 00221 05 WS-FOOTING-CNT PIC ZZ,ZZ9. DTSBR590 00222 05 FILLER PIC X(02) VALUE SPACES. DTSBR590 00223 05 WS-REPORT PIC X(57) VALUE SPACES. DTSBR590 00224 05 FILLER PIC X(34) VALUE SPACES. DTSBR590 00225 01 FOOTING-LINE-3-DUP. DTSBR590 00226 05 FILLER PIC X(33) VALUE SPACES. DTSBR590 00227 05 FILLER PIC X(57) VALUE DTSBR590 00228 '(DUPLICATE RECORDS FROM A SINGLE FISCAL AGENT ARE ELIMINA'.DTSBR590 00229 05 FILLER PIC X(43) VALUE DTSBR590 00230 'TED BEFORE PROCESSING) '. DTSBR590 00231 01 FOOTING-LINE-4 PIC X(133) VALUE SPACES. DTSBR590 00232 01 FOOTING-LINE-5 PIC X(133) VALUE SPACES. DTSBR590 00233 01 FOOTING-LINE-6. DTSBR590 00234 05 FILLER PIC X(25) VALUE SPACES. DTSBR590 00235 05 FILLER PIC X(17) VALUE DTSBR590 00236 '*** END OF REPORT'. DTSBR590 00237 DTSBR590 00238 01 DTS-RATE-REC. DTSBR590 00239 ++INCLUDE DTSIXFAR DTSBR590 00240 EJECT DTSBR590 00241 DTSBR590 00242 01 DTS-TAPE-REC. DTSBR590 00243 ++INCLUDE DTSIXFAT DTSBR590 00244 EJECT DTSBR590 00245 DTSBR590 00246 01 L119-LINK-AREA. DTSBR590 00247 ++INCLUDE DTSIL119 DTSBR590 00248 EJECT DTSBR590 00249 01 FISCAL-AGENT-TABLE-AREA. DTSBR590 00250 ++INCLUDE CHGIC001 DTSBR590 00251 EJECT DTSBR590 00252 LINKAGE SECTION. DTSBR590 00253 SKIP3 DTSBR590 00254 01 LRCM-LINK-AREA. DTSBR590 00255 ++INCLUDE DTSILRCM DTSBR590 00256 DTSBR590 00257 01 R590-REC. DTSBR590 00258 ++INCLUDE DTSIR590 DTSBR590 00259 EJECT DTSBR590 00260 PROCEDURE DIVISION USING LRCM-LINK-AREA DTSBR590 00261 R590-REC. DTSBR590 00262 DTSBR590 00263 IF FIRST-TIME-IND = 'Y' DTSBR590 00264 PERFORM I1000-INITIATE THRU I1000-EXIT DTSBR590 00265 MOVE 'N' TO FIRST-TIME-IND. DTSBR590 00266 DTSBR590 00267 IF WRK-ERROR-YES DTSBR590 00268 PERFORM S999-ABEND THRU S999-EXIT DTSBR590 00269 ELSE DTSBR590 00270 IF LRCM-EOR-88 DTSBR590 00271 PERFORM T0000-TERMINATE THRU T0000-EXIT DTSBR590 00272 ELSE DTSBR590 00273 PERFORM P0000-PROCESS THRU P0000-EXIT. DTSBR590 00274 SKIP2 DTSBR590 00275 GOBACK. DTSBR590 00276 EJECT DTSBR590 00277 I1000-INITIATE. DTSBR590 00278 SKIP2 DTSBR590 00279 MOVE 'N' TO WRK-TRACE-IND. DTSBR590 00280 SET WRK-ERROR-NO TO TRUE. DTSBR590 00281 DTSBR590 00282 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. DTSBR590 00283 DTSBR590 00284 SKIP2 DTSBR590 00285 I1000-EXIT. DTSBR590 00286 EXIT. DTSBR590 00287 I2000-OPEN-FILES. DTSBR590 00288 DTSBR590 00289 OPEN OUTPUT DTS-TAPE-OUT. DTSBR590 00290 IF NOT WRK-COL-STAT-OK DTSBR590 00291 DISPLAY 'CANNOT OP TAPE OUTP FILE ' WRK-COL-STATUS DTSBR590 00292 SET WRK-ERROR-YES TO TRUE. DTSBR590 00293 DTSBR590 00294 OPEN OUTPUT DTS-RATE-OUT. DTSBR590 00295 IF NOT WRK-COL-STAT-OK DTSBR590 00296 DISPLAY 'CANNOT OP RATE OUTP FILE ' WRK-COL-STATUS DTSBR590 00297 SET WRK-ERROR-YES TO TRUE. DTSBR590 00298 DTSBR590 00299 OPEN OUTPUT DTS-EROR-OUT. DTSBR590 00300 IF NOT WRK-COL-STAT-OK DTSBR590 00301 DISPLAY 'CANNOT OP EROR OUTP FILE ' WRK-COL-STATUS DTSBR590 00302 SET WRK-ERROR-YES TO TRUE. DTSBR590 00303 DTSBR590 00304 OPEN OUTPUT DTS-FEIN-OUT. DTSBR590 00305 IF NOT WRK-COL-STAT-OK DTSBR590 00306 DISPLAY 'CANNOT OP EROR FEIN FILE ' WRK-COL-STATUS DTSBR590 00307 SET WRK-ERROR-YES TO TRUE. DTSBR590 00308 DTSBR590 00309 ACCEPT WRK-DATE FROM DATE. DTSBR590 00310 MOVE WRK-DATE-DD TO HEAD01-SYS-DD. DTSBR590 00311 MOVE WRK-DATE-MM TO HEAD01-SYS-MM. DTSBR590 00312 MOVE WRK-DATE-YY TO HEAD01-SYS-YY. DTSBR590 00313 PERFORM S119-AGENCY-FACTS THRU S119-EXIT. DTSBR590 00314 DTSBR590 00315 MOVE L119-AGY-NAMEB1 TO HEAD01-PROGRAM-NAME. DTSBR590 00316 DTSBR590 00317 MOVE SPACES TO HEAD02-AGY-NAME. DTSBR590 00318 STRING L119-AGY-NAMEB2 DELIMITED BY ' ' DTSBR590 00319 INTO HEAD02-AGY-NAME. DTSBR590 00320 DTSBR590 00321 MOVE SPACES TO HEAD03-AGY-MAIL1. DTSBR590 00322 STRING L119-TAX-DIV-NAME DELIMITED BY ' ' DTSBR590 00323 INTO HEAD03-AGY-MAIL1. DTSBR590 00324 DTSBR590 00325 I2000-EXIT. DTSBR590 00326 EXIT. DTSBR590 00327 EJECT DTSBR590 00328 P0000-PROCESS. DTSBR590 00329 DTSBR590 00330 DTSBR590 00331 IF R590-UPDATE-88 DTSBR590 00332 PERFORM P1000-WRITE-RATE-RPT THRU P1000-EXIT DTSBR590 00333 PERFORM P2000-WRITE-RATE-TAPE THRU P2000-EXIT DTSBR590 00334 ELSE DTSBR590 00335 IF R590-ERROR-88 DTSBR590 00336 PERFORM P3000-WRITE-ERROR-RPT THRU P3000-EXIT DTSBR590 00337 ELSE DTSBR590 00338 PERFORM P6000-WRITE-FEIN-RPT THRU P6000-EXIT DTSBR590 00339 END-IF DTSBR590 00340 END-IF. DTSBR590 00341 DTSBR590 00342 P0000-EXIT. DTSBR590 00343 EXIT. DTSBR590 00344 EJECT DTSBR590 00345 P1000-WRITE-RATE-RPT. DTSBR590 00346 DTSBR590 00347 ADD +1 TO WRK-RATE-CNT. DTSBR590 00348 MOVE R590-EMP-NO TO EMP-NO-OUT. DTSBR590 00349 MOVE R590-EMP-FEIN TO EMP-FEIN-OUT. DTSBR590 00350 MOVE R590-EMP-CONTR-RATE TO EMP-RATE-OUT. DTSBR590 00351 MOVE R590-SIC-CODE TO EMP-SICC-OUT. DTSBR590 00352 MOVE R590-EMP-NAME TO EMP-NAME-OUT. DTSBR590 00353 MOVE R590-EMP-NAME-A TO EMP-NAMEA-OUT. DTSBR590 00354 DTSBR590 00355 PERFORM P1100-WRITE-RATE-REPORT THRU P1100-EXIT. DTSBR590 00356 P1000-EXIT. DTSBR590 00357 EXIT. DTSBR590 00358 P1100-WRITE-RATE-REPORT. DTSBR590 00359 DTSBR590 00360 MOVE SPACES TO WS-REC. DTSBR590 00361 IF RPT01-LINE-CNT > 56 DTSBR590 00362 PERFORM P4000-RATE-HEADINGS THRU P4000-EXIT. DTSBR590 00363 DTSBR590 00364 MOVE RPT01DET TO WS-REC. DTSBR590 00365 WRITE PRT-REC1 FROM WS-REC AFTER ADVANCING 1 LINE. DTSBR590 00366 ADD 1 TO RPT01-LINE-CNT. DTSBR590 00367 ADD 1 TO WS-NUMBER-ONE. DTSBR590 00368 DTSBR590 00369 P1100-EXIT. DTSBR590 00370 EXIT. DTSBR590 00371 DTSBR590 00372 P2000-WRITE-RATE-TAPE. DTSBR590 00373 ADD +1 TO WRK-TAPE-CNT. DTSBR590 00374 MOVE R590-EMP-NO TO XFAT-EMP-NO. DTSBR590 00375 MOVE R590-EMP-FEIN TO XFAT-EMP-FEIN. DTSBR590 00376 MOVE R590-EMP-CONTR-RATE TO XFAT-EMP-CONTR-RATE. DTSBR590 00377 MOVE R590-SIC-CODE TO XFAT-SIC-CODE. DTSBR590 00378 MOVE R590-EMP-NAME TO XFAT-EMP-NAME. DTSBR590 00379 MOVE R590-EMP-NAME-A TO XFAT-EMP-NAME-A. DTSBR590 00380 MOVE R590-EMP-STATUS-CODE TO XFAT-EMP-STATUS-CODE. DTSBR590 00381 DTSBR590 00382 WRITE DTS-TAPE-OUTREC FROM DTS-TAPE-REC. DTSBR590 00383 P2000-EXIT. DTSBR590 00384 EXIT. DTSBR590 00385 DTSBR590 00386 P3000-WRITE-ERROR-RPT. DTSBR590 00387 DTSBR590 00388 ADD +1 TO WRK-EROR-CNT. DTSBR590 00389 MOVE R590-EMP-NO TO ERR-NO-OUT. DTSBR590 00390 MOVE R590-EMP-FEIN TO ERR-FEIN-OUT. DTSBR590 00391 MOVE R590-EMP-STATUS-CODE TO ERR-STATUS-OUT. DTSBR590 00392 MOVE R590-EMP-NAME TO ERR-NAME-OUT. DTSBR590 00393 MOVE R590-MESSAGE TO ERR-MSG-OUT. DTSBR590 00394 PERFORM P3100-WRITE-EROR-REPORT THRU P3100-EXIT. DTSBR590 00395 DTSBR590 00396 P3000-EXIT. DTSBR590 00397 EXIT. DTSBR590 00398 EJECT DTSBR590 00399 P3100-WRITE-EROR-REPORT. DTSBR590 00400 DTSBR590 00401 MOVE SPACES TO WS-REC. DTSBR590 00402 IF RPT02-LINE-CNT > 56 DTSBR590 00403 PERFORM P4500-EROR-HEADINGS THRU P4500-EXIT. DTSBR590 00404 DTSBR590 00405 MOVE RPT02DET TO WS-REC. DTSBR590 00406 WRITE PRT-REC2 FROM WS-REC AFTER ADVANCING 1 LINE. DTSBR590 00407 ADD 1 TO RPT02-LINE-CNT. DTSBR590 00408 ADD 1 TO WS-NUMBER-TWO. DTSBR590 00409 P3100-EXIT. DTSBR590 00410 EXIT. DTSBR590 00411 P4000-RATE-HEADINGS. DTSBR590 00412 PERFORM P5000-FISCAL-AGENT THRU P5000-EXIT. DTSBR590 00413 ADD 1 TO RPT01-PAGE-CNT. DTSBR590 00414 MOVE RPT01-PAGE-CNT TO HEAD03-PAGE-CNT. DTSBR590 00415 MOVE HEAD01 TO WS-REC DTSBR590 00416 WRITE PRT-REC1 FROM WS-REC AFTER ADVANCING PAGE DTSBR590 00417 MOVE HEAD02 TO WS-REC DTSBR590 00418 WRITE PRT-REC1 FROM WS-REC AFTER ADVANCING 1 LINE DTSBR590 00419 MOVE HEAD03 TO WS-REC DTSBR590 00420 WRITE PRT-REC1 FROM WS-REC AFTER ADVANCING 1 LINE DTSBR590 00421 MOVE SPACES TO WS-REC DTSBR590 00422 WRITE PRT-REC1 FROM WS-REC AFTER ADVANCING 1 LINE DTSBR590 00423 MOVE HEAD04 TO WS-REC DTSBR590 00424 WRITE PRT-REC1 FROM WS-REC AFTER ADVANCING 1 LINE DTSBR590 00425 MOVE SPACES TO WS-REC DTSBR590 00426 WRITE PRT-REC1 FROM WS-REC AFTER ADVANCING 1 LINE DTSBR590 00427 MOVE HEAD05 TO WS-REC DTSBR590 00428 WRITE PRT-REC1 FROM WS-REC AFTER ADVANCING 1 LINE DTSBR590 00429 MOVE HEAD06 TO WS-REC DTSBR590 00430 WRITE PRT-REC1 FROM WS-REC AFTER ADVANCING 1 LINE DTSBR590 00431 MOVE SPACES TO WS-REC DTSBR590 00432 WRITE PRT-REC1 FROM WS-REC AFTER ADVANCING 1 LINE. DTSBR590 00433 MOVE 10 TO RPT01-LINE-CNT. DTSBR590 00434 P4000-EXIT. DTSBR590 00435 EXIT. DTSBR590 00436 EJECT DTSBR590 00437 P4500-EROR-HEADINGS. DTSBR590 00438 DTSBR590 00439 *? MOVE +62 TO RPT02-LINE-CNT. DTSBR590 00440 MOVE '590R3' TO HEAD01-RPT-NAME. DTSBR590 00441 MOVE 'FISCAL AGENT RATE TAPE ERROR REPORT' TO HEAD04-TITLEDTSBR590 00442 DTSBR590 00443 PERFORM P5000-FISCAL-AGENT THRU P5000-EXIT. DTSBR590 00444 DTSBR590 00445 ADD 1 TO RPT02-PAGE-CNT. DTSBR590 00446 MOVE RPT02-PAGE-CNT TO HEAD03-PAGE-CNT. DTSBR590 00447 MOVE HEAD01 TO WS-REC DTSBR590 00448 WRITE PRT-REC2 FROM WS-REC AFTER ADVANCING PAGE DTSBR590 00449 MOVE HEAD02 TO WS-REC DTSBR590 00450 WRITE PRT-REC2 FROM WS-REC AFTER ADVANCING 1 LINE DTSBR590 00451 MOVE HEAD03 TO WS-REC DTSBR590 00452 WRITE PRT-REC2 FROM WS-REC AFTER ADVANCING 1 LINE DTSBR590 00453 MOVE SPACES TO WS-REC DTSBR590 00454 WRITE PRT-REC2 FROM WS-REC AFTER ADVANCING 1 LINE DTSBR590 00455 MOVE HEAD04 TO WS-REC DTSBR590 00456 WRITE PRT-REC2 FROM WS-REC AFTER ADVANCING 1 LINE DTSBR590 00457 MOVE SPACES TO WS-REC DTSBR590 00458 WRITE PRT-REC2 FROM WS-REC AFTER ADVANCING 1 LINE DTSBR590 00459 MOVE HEAD07 TO WS-REC DTSBR590 00460 WRITE PRT-REC2 FROM WS-REC AFTER ADVANCING 1 LINE DTSBR590 00461 MOVE HEAD08 TO WS-REC DTSBR590 00462 WRITE PRT-REC2 FROM WS-REC AFTER ADVANCING 1 LINE DTSBR590 00463 MOVE SPACES TO WS-REC DTSBR590 00464 WRITE PRT-REC2 FROM WS-REC AFTER ADVANCING 1 LINE. DTSBR590 00465 MOVE 10 TO RPT02-LINE-CNT. DTSBR590 00466 P4500-EXIT. DTSBR590 00467 EXIT. DTSBR590 00468 P4700-FEIN-HEADINGS. DTSBR590 00469 DTSBR590 00470 *? MOVE +62 TO RPT03-LINE-CNT. DTSBR590 00471 MOVE '590R4' TO HEAD01-RPT-NAME. DTSBR590 00472 MOVE 'ACCOUNT NUMBERS/FEIN NUMBERS FOUND ' TO HEAD04-TITLEDTSBR590 00473 DTSBR590 00474 PERFORM P5000-FISCAL-AGENT THRU P5000-EXIT. DTSBR590 00475 DTSBR590 00476 ADD 1 TO RPT03-PAGE-CNT. DTSBR590 00477 MOVE RPT03-PAGE-CNT TO HEAD03-PAGE-CNT. DTSBR590 00478 MOVE HEAD01 TO WS-REC DTSBR590 00479 WRITE PRT-REC3 FROM WS-REC AFTER ADVANCING PAGE DTSBR590 00480 MOVE HEAD02 TO WS-REC DTSBR590 00481 WRITE PRT-REC3 FROM WS-REC AFTER ADVANCING 1 LINE DTSBR590 00482 MOVE HEAD03 TO WS-REC DTSBR590 00483 WRITE PRT-REC3 FROM WS-REC AFTER ADVANCING 1 LINE DTSBR590 00484 MOVE SPACES TO WS-REC DTSBR590 00485 WRITE PRT-REC3 FROM WS-REC AFTER ADVANCING 1 LINE DTSBR590 00486 MOVE HEAD04 TO WS-REC DTSBR590 00487 WRITE PRT-REC3 FROM WS-REC AFTER ADVANCING 1 LINE DTSBR590 00488 MOVE SPACES TO WS-REC DTSBR590 00489 WRITE PRT-REC3 FROM WS-REC AFTER ADVANCING 1 LINE DTSBR590 00490 MOVE HEAD07 TO WS-REC DTSBR590 00491 WRITE PRT-REC3 FROM WS-REC AFTER ADVANCING 1 LINE DTSBR590 00492 MOVE HEAD08 TO WS-REC DTSBR590 00493 WRITE PRT-REC3 FROM WS-REC AFTER ADVANCING 1 LINE DTSBR590 00494 MOVE SPACES TO WS-REC DTSBR590 00495 WRITE PRT-REC3 FROM WS-REC AFTER ADVANCING 1 LINE. DTSBR590 00496 MOVE 10 TO RPT03-LINE-CNT. DTSBR590 00497 P4700-EXIT. DTSBR590 00498 EXIT. DTSBR590 00499 EJECT DTSBR590 00500 P5000-FISCAL-AGENT. DTSBR590 00501 IF R590-FISCAL-AGENT-CD = WRK-FISCAL-AGENT-CD DTSBR590 00502 GO TO P5000-EXIT. DTSBR590 00503 SET WRK-FISC-AGNT-INVALID-88 TO TRUE DTSBR590 00504 DTSBR590 00505 PERFORM VARYING FISCAL-AGENT-IDX FROM 1 BY 1 DTSBR590 00506 UNTIL WRK-FISC-AGNT-VALID-88 DTSBR590 00507 OR FISCAL-AGENT-IDX > FISCAL-AGENT-CNT DTSBR590 00508 OR FISCAL-AGENT-CODE (FISCAL-AGENT-IDX) DTSBR590 00509 = SPACE DTSBR590 00510 IF R590-FISCAL-AGENT-CD = DTSBR590 00511 FISCAL-AGENT-CODE (FISCAL-AGENT-IDX) DTSBR590 00512 SET WRK-FISC-AGNT-VALID-88 TO TRUE DTSBR590 00513 MOVE FISCAL-AGENT-CODE (FISCAL-AGENT-IDX) DTSBR590 00514 TO WRK-FISCAL-AGENT-CD DTSBR590 00515 MOVE FISCAL-AGENT-NAME (FISCAL-AGENT-IDX) DTSBR590 00516 TO HEAD03-FA-NAME DTSBR590 00517 END-IF DTSBR590 00518 END-PERFORM. DTSBR590 00519 DTSBR590 00520 IF WRK-FISC-AGNT-INVALID-88 DTSBR590 00521 MOVE 'INVALID FISCAL AGENT' TO HEAD03-FA-NAME DTSBR590 00522 GO TO P5000-EXIT. DTSBR590 00523 P5000-EXIT. DTSBR590 00524 EXIT. DTSBR590 00525 P6000-WRITE-FEIN-RPT. DTSBR590 00526 DTSBR590 00527 ADD +1 TO WRK-FEIN-CNT. DTSBR590 00528 MOVE R590-EMP-NO TO FEIN-NO-OUT. DTSBR590 00529 MOVE R590-EMP-FEIN TO FEIN-FEIN-OUT. DTSBR590 00530 MOVE R590-EMP-STATUS-CODE TO FEIN-STATUS-OUT. DTSBR590 00531 MOVE R590-EMP-NAME TO FEIN-NAME-OUT. DTSBR590 00532 MOVE R590-MESSAGE TO FEIN-MSG-OUT. DTSBR590 00533 PERFORM P6100-WRITE-FEIN-REPORT THRU P6100-EXIT. DTSBR590 00534 DTSBR590 00535 P6000-EXIT. DTSBR590 00536 EXIT. DTSBR590 00537 EJECT DTSBR590 00538 P6100-WRITE-FEIN-REPORT. DTSBR590 00539 DTSBR590 00540 MOVE SPACES TO WS-REC. DTSBR590 00541 IF RPT03-LINE-CNT > 56 DTSBR590 00542 PERFORM P4700-FEIN-HEADINGS THRU P4700-EXIT. DTSBR590 00543 DTSBR590 00544 MOVE RPT03DET TO WS-REC. DTSBR590 00545 WRITE PRT-REC3 FROM WS-REC AFTER ADVANCING 1 LINE. DTSBR590 00546 ADD 1 TO RPT03-LINE-CNT. DTSBR590 00547 ADD 1 TO WS-NUMBER-THREE. DTSBR590 00548 P6100-EXIT. DTSBR590 00549 EXIT. DTSBR590 00550 T0000-TERMINATE. DTSBR590 00551 DTSBR590 00552 DISPLAY ' '. DTSBR590 00553 DTSBR590 00554 DISPLAY '*** DTSBR590 TERMINATION STATISTICS ***'. DTSBR590 00555 DTSBR590 00556 DISPLAY ' '. DTSBR590 00557 DTSBR590 00558 DISPLAY 'NUMBER OF INPUT RATE RECORDS READ : 'DTSBR590 00559 WRK-RATE-CNT. DTSBR590 00560 DISPLAY 'NUMBER OF INPUT ERROR RECORDS READ : 'DTSBR590 00561 WRK-EROR-CNT. DTSBR590 00562 DISPLAY 'NUMBER OF INPUT FEIN OR EMPLOYER ACCOUNT READ : 'DTSBR590 00563 WRK-FEIN-CNT. DTSBR590 00564 *RW1 DTSBR590 00565 IF RPT01-LINE-CNT > 52 OR WS-NUMBER-ONE = ZERO DTSBR590 00566 MOVE '590R1' TO HEAD01-RPT-NAME DTSBR590 00567 MOVE 'FISCAL AGENT RATE TAPE REPORT' TO HEAD04-TITLE DTSBR590 00568 ADD 1 TO RPT01-PAGE-CNT DTSBR590 00569 MOVE RPT01-PAGE-CNT TO HEAD03-PAGE-CNT DTSBR590 00570 MOVE HEAD01 TO WS-REC DTSBR590 00571 WRITE PRT-REC1 FROM WS-REC AFTER ADVANCING PAGE DTSBR590 00572 MOVE HEAD02 TO WS-REC DTSBR590 00573 WRITE PRT-REC1 FROM WS-REC AFTER ADVANCING 1 LINE DTSBR590 00574 MOVE HEAD03 TO WS-REC DTSBR590 00575 WRITE PRT-REC1 FROM WS-REC AFTER ADVANCING 1 LINE DTSBR590 00576 MOVE SPACES TO WS-REC DTSBR590 00577 WRITE PRT-REC1 FROM WS-REC AFTER ADVANCING 1 LINE DTSBR590 00578 MOVE HEAD04 TO WS-REC DTSBR590 00579 WRITE PRT-REC1 FROM WS-REC AFTER ADVANCING 1 LINE DTSBR590 00580 MOVE SPACES TO WS-REC DTSBR590 00581 WRITE PRT-REC1 FROM WS-REC AFTER ADVANCING 1 LINE DTSBR590 00582 MOVE HEAD05 TO WS-REC DTSBR590 00583 WRITE PRT-REC1 FROM WS-REC AFTER ADVANCING 1 LINE DTSBR590 00584 MOVE HEAD06 TO WS-REC DTSBR590 00585 WRITE PRT-REC1 FROM WS-REC AFTER ADVANCING 1 LINE DTSBR590 00586 MOVE SPACES TO WS-REC. DTSBR590 00587 DTSBR590 00588 MOVE WS-NUMBER-ONE TO WS-FOOTING-CNT. DTSBR590 00589 MOVE 'FISCAL AGENT RATE REPORT RECORDS WRITTEN' TO WS-REPORT.DTSBR590 00590 WRITE PRT-REC1 FROM FOOTING-LINE-1 AFTER 1. DTSBR590 00591 WRITE PRT-REC1 FROM FOOTING-LINE-2 AFTER 1. DTSBR590 00592 WRITE PRT-REC1 FROM FOOTING-LINE-3 AFTER 1. DTSBR590 00593 WRITE PRT-REC1 FROM FOOTING-LINE-4 AFTER 1. DTSBR590 00594 WRITE PRT-REC1 FROM FOOTING-LINE-5 AFTER 1. DTSBR590 00595 WRITE PRT-REC1 FROM FOOTING-LINE-6 AFTER 1. DTSBR590 00596 DTSBR590 00597 IF RPT02-LINE-CNT > 52 OR WS-NUMBER-TWO = ZERO DTSBR590 00598 MOVE '590R3' TO HEAD01-RPT-NAME DTSBR590 00599 MOVE 'FISCAL AGENT RATE TAPE ERROR REPORT' TO HEAD04-TITLEDTSBR590 00600 ADD 1 TO RPT02-PAGE-CNT DTSBR590 00601 MOVE RPT02-PAGE-CNT TO HEAD03-PAGE-CNT DTSBR590 00602 MOVE HEAD01 TO WS-REC DTSBR590 00603 WRITE PRT-REC2 FROM WS-REC AFTER ADVANCING PAGE DTSBR590 00604 MOVE HEAD02 TO WS-REC DTSBR590 00605 WRITE PRT-REC2 FROM WS-REC AFTER ADVANCING 1 LINE DTSBR590 00606 MOVE HEAD03 TO WS-REC DTSBR590 00607 WRITE PRT-REC2 FROM WS-REC AFTER ADVANCING 1 LINE DTSBR590 00608 MOVE SPACES TO WS-REC DTSBR590 00609 WRITE PRT-REC2 FROM WS-REC AFTER ADVANCING 1 LINE DTSBR590 00610 MOVE HEAD04 TO WS-REC DTSBR590 00611 WRITE PRT-REC2 FROM WS-REC AFTER ADVANCING 1 LINE DTSBR590 00612 MOVE SPACES TO WS-REC DTSBR590 00613 WRITE PRT-REC2 FROM WS-REC AFTER ADVANCING 1 LINE DTSBR590 00614 MOVE HEAD07 TO WS-REC DTSBR590 00615 WRITE PRT-REC2 FROM WS-REC AFTER ADVANCING 1 LINE DTSBR590 00616 MOVE HEAD08 TO WS-REC DTSBR590 00617 WRITE PRT-REC2 FROM WS-REC AFTER ADVANCING 1 LINE DTSBR590 00618 MOVE SPACES TO WS-REC DTSBR590 00619 WRITE PRT-REC2 FROM WS-REC AFTER ADVANCING 1 LINE. DTSBR590 00620 DTSBR590 00621 MOVE WS-NUMBER-TWO TO WS-FOOTING-CNT. DTSBR590 00622 MOVE 'FISCAL AGENT ERRORS RECORDS WRITTEN' TO WS-REPORT. DTSBR590 00623 WRITE PRT-REC2 FROM FOOTING-LINE-1 AFTER 1. DTSBR590 00624 WRITE PRT-REC2 FROM FOOTING-LINE-2 AFTER 1. DTSBR590 00625 WRITE PRT-REC2 FROM FOOTING-LINE-3 AFTER 1. DTSBR590 00626 WRITE PRT-REC2 FROM FOOTING-LINE-3-DUP AFTER 1. DTSBR590 00627 WRITE PRT-REC2 FROM FOOTING-LINE-4 AFTER 1. DTSBR590 00628 WRITE PRT-REC2 FROM FOOTING-LINE-5 AFTER 1. DTSBR590 00629 WRITE PRT-REC2 FROM FOOTING-LINE-6 AFTER 1. DTSBR590 00630 DTSBR590 00631 IF RPT03-LINE-CNT > 52 OR WS-NUMBER-THREE = ZERO DTSBR590 00632 MOVE '590R4' TO HEAD01-RPT-NAME DTSBR590 00633 MOVE 'ACCOUNT NUMBERS/FEIN NUMBERS FOUND ' TO HEAD04-TITLEDTSBR590 00634 ADD 1 TO RPT03-PAGE-CNT DTSBR590 00635 MOVE RPT03-PAGE-CNT TO HEAD03-PAGE-CNT DTSBR590 00636 MOVE HEAD01 TO WS-REC DTSBR590 00637 WRITE PRT-REC3 FROM WS-REC AFTER ADVANCING PAGE DTSBR590 00638 MOVE HEAD02 TO WS-REC DTSBR590 00639 WRITE PRT-REC3 FROM WS-REC AFTER ADVANCING 1 LINE DTSBR590 00640 MOVE HEAD03 TO WS-REC DTSBR590 00641 WRITE PRT-REC3 FROM WS-REC AFTER ADVANCING 1 LINE DTSBR590 00642 MOVE SPACES TO WS-REC DTSBR590 00643 WRITE PRT-REC3 FROM WS-REC AFTER ADVANCING 1 LINE DTSBR590 00644 MOVE HEAD04 TO WS-REC DTSBR590 00645 WRITE PRT-REC3 FROM WS-REC AFTER ADVANCING 1 LINE DTSBR590 00646 MOVE SPACES TO WS-REC DTSBR590 00647 WRITE PRT-REC3 FROM WS-REC AFTER ADVANCING 1 LINE DTSBR590 00648 MOVE HEAD07 TO WS-REC DTSBR590 00649 WRITE PRT-REC3 FROM WS-REC AFTER ADVANCING 1 LINE DTSBR590 00650 MOVE HEAD08 TO WS-REC DTSBR590 00651 WRITE PRT-REC3 FROM WS-REC AFTER ADVANCING 1 LINE DTSBR590 00652 MOVE SPACES TO WS-REC DTSBR590 00653 WRITE PRT-REC3 FROM WS-REC AFTER ADVANCING 1 LINE. DTSBR590 00654 DTSBR590 00655 MOVE WS-NUMBER-THREE TO WS-FOOTING-CNT. DTSBR590 00656 MOVE 'FEIN/EMP-ACCT RECORDS FOUND WRITTEN' TO WS-REPORT. DTSBR590 00657 WRITE PRT-REC3 FROM FOOTING-LINE-1 AFTER 1. DTSBR590 00658 WRITE PRT-REC3 FROM FOOTING-LINE-2 AFTER 1. DTSBR590 00659 WRITE PRT-REC3 FROM FOOTING-LINE-3 AFTER 1. DTSBR590 00660 WRITE PRT-REC3 FROM FOOTING-LINE-4 AFTER 1. DTSBR590 00661 WRITE PRT-REC3 FROM FOOTING-LINE-5 AFTER 1. DTSBR590 00662 WRITE PRT-REC3 FROM FOOTING-LINE-6 AFTER 1. DTSBR590 00663 DTSBR590 00664 *RW2 DTSBR590 00665 CLOSE DTS-RATE-OUT DTSBR590 00666 DTS-TAPE-OUT DTSBR590 00667 DTS-FEIN-OUT DTSBR590 00668 DTS-EROR-OUT. DTSBR590 00669 DTSBR590 00670 T0000-EXIT. DTSBR590 00671 EXIT. DTSBR590 00672 EJECT DTSBR590 00673 SKIP3 DTSBR590 00674 S119-AGENCY-FACTS. DTSBR590 00675 SET L119-REQ-CAPS-88 TO TRUE. DTSBR590 00676 SET L119-REQ-COLLECTIONS-88 TO TRUE. DTSBR590 00677 DTSBR590 00678 CALL 'DTSBU119' USING L119-LINK-AREA. DTSBR590 00679 S119-EXIT. DTSBR590 00680 EXIT. DTSBR590 00681 SKIP3 DTSBR590 00682 S999-ABEND. DTSBR590 00683 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBR590 00684 S999-EXIT. DTSBR590 00685 EXIT. DTSBR590