687 lines
54 KiB
COBOL
687 lines
54 KiB
COBOL
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
|