Files
DUTAS/Batch/DTSBR551.cob
2025-07-21 11:20:11 -04:00

523 lines
41 KiB
COBOL

00001 IDENTIFICATION DIVISION. 02/10/05
00002 PROGRAM-ID. DTSBR551. DTSBR551
00003 AUTHOR. NORTHROP GRUMMAN. LV001
00004 DATE-WRITTEN. AUGUST 2004. DTSBR551
00005 DATE-COMPILED. DTSBR551
00006 SKIP3 DTSBR551
00007 ***** DTSBR551
00008 * DTSBR551
00009 * FUNCTION: ICESA CONTRIBUTION AND WAGE REPORT EDIT-ERROR DTSBR551
00010 * RECORDS LISTING. DTSBR551
00011 * DTSBR551
00012 * CALLING SEQUENCE: DTSBD551 WHICH CREATES DTSIR551 RECORDS, DTSBR551
00013 * DTSBD800 CALLS DTSBR551 PRODUCES THE DTSBR551
00014 * THE REPORTS. DTSBR551
00015 * DTSBR551
00016 * MODIFICATION HISTORY: DTSBR551
00017 * DTSBR551
00018 * 04-19-04 INITIAL DEVELOPMENT DTSBR551
00019 * REFERENCE RFP #RAP AUTHOR OF CHANGE - RW1 DTSBR551
00020 * DTSBR551
00021 * MM-DD-YY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBR551
00022 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBR551
00023 * REFERENCE RFP #**** PROGRAMMER: XXX DTSBR551
00024 * DTSBR551
00025 * DTSBR551
00026 * DESCRIPTION: DTSBR551
00027 * DTSBR551
00028 * THIS MODULE PRODUCES TWO REPORT FROM EDITING THE FISCAL DTSBR551
00029 * AGENT INPUT DATA OF CONTRIBUTIONS AND WAGES. IT PRODUCES DTSBR551
00030 * A FATAL AND NON-FATAL ERROR LISTINGS. DTSBR551
00031 * DTSBR551
00032 * DTSBR551
00033 * RECORDS READ: DTSBR551
00034 * DTSBR551
00035 * NONE. DTSBR551
00036 * DTSBR551
00037 * DTSBR551
00038 * PRINTED OUTPUTS: DTSBR551
00039 * DTSBR551
00040 * 551R1 FATAL ERRORS REPORT. DTSBR551
00041 * 552R2 NON FATAL ERRORS REPORT. DTSBR551
00042 * DTSBR551
00043 * DTSBR551
00044 * RECORDS WRITTEN: DTSBR551
00045 * DTSBR551
00046 * NONE. DTSBR551
00047 * DTSBR551
00048 * DTSBR551
00049 * MODULES CALLED: DTSBR551
00050 * DTSBR551
00051 * DTSBU001 DATE EDIT/CONVERSION MODULE DTSBR551
00052 * DTSBU002 DATE ALPHA CONVERSION MODULE DTSBR551
00053 * DTSBU004 YEAR/QUARTER CONVERSION. DTSBR551
00054 * DTSBR551
00055 ***** DTSBR551
00056 DTSBR551
00057 ENVIRONMENT DIVISION. DTSBR551
00058 DTSBR551
00059 CONFIGURATION SECTION. DTSBR551
00060 DTSBR551
00061 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. DTSBR551
00062 DTSBR551
00063 INPUT-OUTPUT SECTION. DTSBR551
00064 DTSBR551
00065 FILE-CONTROL. DTSBR551
00066 SELECT PRT-FILE1 ASSIGN TO RPT551R1. DTSBR551
00067 SELECT PRT-FILE2 ASSIGN TO RPT551R2. DTSBR551
00068 DTSBR551
00069 DATA DIVISION. DTSBR551
00070 DTSBR551
00071 FILE SECTION. DTSBR551
00072 DTSBR551
00073 FD PRT-FILE1 DTSBR551
00074 RECORDING MODE IS F DTSBR551
00075 BLOCK CONTAINS 0 RECORDS DTSBR551
00076 LABEL RECORDS ARE OMITTED. DTSBR551
00077 DTSBR551
00078 01 PRT-RECORD1. DTSBR551
00079 05 FILLER PIC X(1). DTSBR551
00080 05 PRT-RPT1 PIC X(79). DTSBR551
00081 DTSBR551
00082 FD PRT-FILE2 DTSBR551
00083 RECORDING MODE IS F DTSBR551
00084 BLOCK CONTAINS 0 RECORDS DTSBR551
00085 LABEL RECORDS ARE OMITTED. DTSBR551
00086 DTSBR551
00087 01 PRT-RECORD2. DTSBR551
00088 05 FILLER PIC X(1). DTSBR551
00089 05 PRT-RPT2 PIC X(79). DTSBR551
00090 DTSBR551
00091 WORKING-STORAGE SECTION. DTSBR551
000915 77 PAN-VALET PICTURE X(24) VALUE '001DTSBR551 02/10/05'. DTSBR551
00092 DTSBR551
00093 01 WRK-AREA. DTSBR551
00094 DTSBR551
00095 05 WS-LINE-CNT PIC S9(03) COMP-3 VALUE 60. DTSBR551
00096 05 WS-LINE-CNT2 PIC S9(03) COMP-3 VALUE +0. DTSBR551
00097 05 WS-PAGE-CNT PIC S9(05) COMP-3 VALUE +0. DTSBR551
00098 05 WS-LINE-CNT3 PIC S9(03) COMP-3 VALUE 60. DTSBR551
00099 05 WS-LINE-CNT4 PIC S9(03) COMP-3 VALUE +0. DTSBR551
00100 05 WS-PAGE-CNT2 PIC S9(05) COMP-3 VALUE +0. DTSBR551
00101 05 WS-SUM-FOOT-CNT1 PIC S9(07) COMP-3 VALUE +0. DTSBR551
00102 05 WS-SUM-FOOT-CNT2 PIC S9(07) COMP-3 VALUE +0. DTSBR551
00103 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +551.DTSBR551
00104 05 WRK-ABEND-MSG PIC X(60) VALUE SPACES. DTSBR551
00105 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBR551
00106 DTSBR551
00107 01 HEADER-1. DTSBR551
00108 05 FILLER PIC X(01) VALUE SPACE. DTSBR551
00109 05 HDR1-RPT-NO PIC X(05). DTSBR551
00110 05 FILLER PIC X(24) VALUE SPACES. DTSBR551
00111 05 FILLER PIC X(20) VALUE DTSBR551
00112 'DISTRICT OF COLUMBIA'. DTSBR551
00113 05 FILLER PIC X(16) VALUE SPACES. DTSBR551
00114 05 FILLER PIC X(05) VALUE 'DATE:'. DTSBR551
00115 05 FILLER PIC X(01) VALUE SPACE. DTSBR551
00116 05 WS-SYS-DATE PIC X(08) VALUE SPACE. DTSBR551
00117 DTSBR551
00118 01 HEADER-2. DTSBR551
00119 05 FILLER PIC X(34) VALUE SPACES. DTSBR551
00120 05 FILLER PIC X(12) VALUE DTSBR551
00121 'TAX DIVISION'. DTSBR551
00122 05 FILLER PIC X(20) VALUE SPACES. DTSBR551
00123 05 FILLER PIC X(05) VALUE 'TIME:'. DTSBR551
00124 05 FILLER PIC X(01) VALUE SPACE. DTSBR551
00125 05 WS-SYS-TIME PIC X(08) VALUE SPACE. DTSBR551
00126 DTSBR551
00127 01 HEADER-3. DTSBR551
00128 05 FILLER PIC X(01) VALUE SPACE. DTSBR551
00129 05 FILLER PIC X(25) DTSBR551
00130 VALUE 'ROUTE TO: TAX ACCOUNTING '. DTSBR551
00131 05 FILLER PIC X(40) VALUE SPACES. DTSBR551
00132 05 FILLER PIC X(05) VALUE 'PAGE:'. DTSBR551
00133 05 FILLER PIC X(03) VALUE SPACES. DTSBR551
00134 05 HDR3-PAGE-CNT PIC ZZ,ZZ9. DTSBR551
00135 DTSBR551
00136 01 HEADER-3B. DTSBR551
00137 05 FILLER PIC X(01) VALUE SPACE. DTSBR551
00138 05 FILLER PIC X(25) DTSBR551
00139 VALUE 'ROUTE TO: TAX ACCOUNTING '. DTSBR551
00140 05 FILLER PIC X(40) VALUE SPACES. DTSBR551
00141 05 FILLER PIC X(05) DTSBR551
00142 VALUE 'PAGE:'. DTSBR551
00143 05 FILLER PIC X(03) VALUE SPACES. DTSBR551
00144 05 HDR3-PAGE-CNT2 PIC ZZ,ZZ9. DTSBR551
00145 DTSBR551
00146 01 HEADER-4. DTSBR551
00147 05 FILLER PIC X(01) VALUE SPACE. DTSBR551
00148 05 FILLER PIC X(14) VALUE SPACE. DTSBR551
00149 05 FILLER PIC X(50) VALUE DTSBR551
00150 'ICESA CONTRIBUTION AND WAGE REPORT - FATAL ERRORS '. DTSBR551
00151 05 FILLER PIC X(15) VALUE SPACE. DTSBR551
00152 DTSBR551
00153 01 HEADER-4B. DTSBR551
00154 05 FILLER PIC X(01) VALUE SPACE. DTSBR551
00155 05 FILLER PIC X(12) VALUE SPACE. DTSBR551
00156 05 FILLER PIC X(53) VALUE DTSBR551
00157 'ICESA CONTRIBUTION AND WAGE REPORT - NON FATAL ERRORS'. DTSBR551
00158 05 FILLER PIC X(14) VALUE SPACE. DTSBR551
00159 DTSBR551
00160 01 HEADER-5 PIC X(80) VALUE SPACES. DTSBR551
00161 DTSBR551
00162 01 HEADER-6. DTSBR551
00163 05 FILLER PIC X(01) VALUE SPACE. DTSBR551
00164 05 FILLER PIC X(16) VALUE DTSBR551
00165 'SUBMITTER NAME: '. DTSBR551
00166 05 HDR6-SUBMIT-NAME PIC X(35). DTSBR551
00167 05 FILLER PIC X(02) VALUE SPACE. DTSBR551
00168 05 FILLER PIC X(06) VALUE DTSBR551
00169 'FEIN: '. DTSBR551
00170 05 FILLER PIC X(01) VALUE SPACE. DTSBR551
00171 05 HDR6-SUBMIT-FEIN PIC 99B9999999 BLANK WHEN DTSBR551
00172 ZEROS. DTSBR551
00173 05 FILLER PIC X(02) VALUE SPACES. DTSBR551
00174 DTSBR551
00175 01 HEADER-7. DTSBR551
00176 05 FILLER PIC X(01) VALUE SPACE. DTSBR551
00177 05 FILLER PIC X(16) VALUE DTSBR551
00178 ' CONTACT NAME: '. DTSBR551
00179 05 HDR7-CONTACT-NAME PIC X(35). DTSBR551
00180 05 FILLER PIC X(01) VALUE SPACE. DTSBR551
00181 05 FILLER PIC X(07) VALUE DTSBR551
00182 'PHONE: '. DTSBR551
00183 05 FILLER PIC X(01) VALUE SPACE. DTSBR551
00184 05 HDR7-AREA-CODE PIC X(03). DTSBR551
00185 05 FILLER PIC X(01) VALUE SPACE. DTSBR551
00186 05 HDR7-PREFIX PIC X(03). DTSBR551
00187 05 FILLER PIC X(01) VALUE '-'. DTSBR551
00188 05 HDR7-SUFFIX PIC X(04). DTSBR551
00189 DTSBR551
00190 01 HEADER-8 PIC X(80) VALUE SPACES. DTSBR551
00191 DTSBR551
00192 01 HEADER-9. DTSBR551
00193 05 FILLER PIC X(01) VALUE SPACE. DTSBR551
00194 05 FILLER PIC X(06) VALUE 'REC-NO'. DTSBR551
00195 05 FILLER PIC X(02) VALUE SPACES. DTSBR551
00196 05 FILLER PIC X(04) VALUE 'TYPE'. DTSBR551
00197 05 FILLER PIC X(01) VALUE SPACE. DTSBR551
00198 05 FILLER PIC X(04) VALUE 'FEIN'. DTSBR551
00199 05 FILLER PIC X(07) VALUE SPACES. DTSBR551
00200 05 FILLER PIC X(05) VALUE 'ERROR'. DTSBR551
00201 05 FILLER PIC X(50) VALUE SPACES. DTSBR551
00202 DTSBR551
00203 01 HEADER-9B. DTSBR551
00204 05 FILLER PIC X(01) VALUE SPACE. DTSBR551
00205 05 FILLER PIC X(06) VALUE 'REC-NO'. DTSBR551
00206 05 FILLER PIC X(02) VALUE SPACE. DTSBR551
00207 05 FILLER PIC X(04) VALUE 'FEIN'. DTSBR551
00208 05 FILLER PIC X(07) VALUE SPACES. DTSBR551
00209 05 FILLER PIC X(05) VALUE 'ERROR'. DTSBR551
00210 05 FILLER PIC X(55) VALUE SPACE. DTSBR551
00211 DTSBR551
00212 01 DETAIL-SPACES PIC X(80) VALUE SPACES. DTSBR551
00213 DTSBR551
00214 01 DETAIL-LINE. DTSBR551
00215 05 FILLER PIC X(01) VALUE SPACE. DTSBR551
00216 05 WS-REC-NO PIC X(07). DTSBR551
00217 05 FILLER PIC X(02) VALUE SPACES. DTSBR551
00218 05 WS-REC-TYPE PIC X(01). DTSBR551
00219 05 FILLER PIC X(03) VALUE SPACES. DTSBR551
00220 05 WS-EMP-FEIN PIC X(09). DTSBR551
00221 05 FILLER PIC X(02) VALUE SPACES. DTSBR551
00222 05 WS-ERROR PIC X(55). DTSBR551
00223 DTSBR551
00224 01 DETAIL-LINE2. DTSBR551
00225 05 FILLER PIC X(01) VALUE SPACE. DTSBR551
00226 05 WS-REC-NO2 PIC X(07). DTSBR551
00227 05 FILLER PIC X(01) VALUE SPACES. DTSBR551
00228 05 WS-EMP-FEIN2 PIC X(09). DTSBR551
00229 05 FILLER PIC X(02) VALUE SPACES. DTSBR551
00230 05 WS-ERROR2 PIC X(55). DTSBR551
00231 05 FILLER PIC X(05) VALUE SPACES. DTSBR551
00232 DTSBR551
00233 01 DETAIL-LINE3. DTSBR551
00234 05 FILLER PIC X(14) VALUE SPACES. DTSBR551
00235 05 FILLER PIC X(05) VALUE 'NAME:'. DTSBR551
00236 05 FILLER PIC X(01) VALUE SPACE. DTSBR551
00237 05 WS-EMP-NAME PIC X(50). DTSBR551
00238 05 FILLER PIC X(10) VALUE SPACES. DTSBR551
00239 DTSBR551
00240 01 DETAIL-LINE4. DTSBR551
00241 05 FILLER PIC X(11). DTSBR551
00242 05 FILLER PIC X(08) VALUE 'ADDRESS:'.DTSBR551
00243 05 FILLER PIC X(01) VALUE SPACE. DTSBR551
00244 05 WS-EMP-STREET PIC X(40). DTSBR551
00245 05 FILLER PIC X(20) VALUE SPACES. DTSBR551
00246 DTSBR551
00247 01 DETAIL-LINE5. DTSBR551
00248 05 FILLER PIC X(20) VALUE SPACES. DTSBR551
00249 05 WS-EMP-CITY PIC X(25). DTSBR551
00250 05 FILLER PIC X(01) VALUE SPACE. DTSBR551
00251 05 WS-EMP-STATE PIC X(02). DTSBR551
00252 05 FILLER PIC X(01) VALUE SPACE. DTSBR551
00253 05 WS-EMP-ZIP-5 PIC X(05). DTSBR551
00254 05 WS-EMP-ZIP-EXT PIC X(05). DTSBR551
00255 05 FILLER PIC X(21) VALUE SPACES. DTSBR551
00256 DTSBR551
00257 01 CONTROL-SUM-FOOTING. DTSBR551
00258 DTSBR551
00259 05 SUM-LINE-5 PIC X(80) VALUE SPACES. DTSBR551
00260 05 SUM-LINE-6. DTSBR551
00261 10 FILLER PIC X(20) VALUE SPACES. DTSBR551
00262 10 FILLER PIC X(30) DTSBR551
00263 VALUE 'NUMBER OF FATAL ERRORS COUNT: '. DTSBR551
00264 10 WS-SUM-FOOT-NUMBER PIC ZZ,ZZ9. DTSBR551
00265 10 FILLER PIC X(24) VALUE SPACES. DTSBR551
00266 05 SUM-LINE-6B. DTSBR551
00267 10 FILLER PIC X(18) VALUE SPACES. DTSBR551
00268 10 FILLER PIC X(34) DTSBR551
00269 VALUE 'NUMBER OF NON-FATAL ERRORS COUNT: '. DTSBR551
00270 10 WS-SUM-FOOT-NUMBER-2 PIC ZZ,ZZ9. DTSBR551
00271 10 FILLER PIC X(22) VALUE SPACES. DTSBR551
00272 DTSBR551
00273 05 SUM-ASTR-7. DTSBR551
00274 10 FILLER PIC X(24) VALUE SPACES. DTSBR551
00275 10 FILLER PIC X(26) DTSBR551
00276 VALUE ' *** END OF REPORT '. DTSBR551
00277 10 FILLER PIC X(30) VALUE SPACES. DTSBR551
00278 DTSBR551
00279 01 L001-LINK-AREA. DTSBR551
00280 ++INCLUDE DTSIL001 DTSBR551
00281 EJECT DTSBR551
00282 01 L002-LINK-AREA. DTSBR551
00283 ++INCLUDE DTSIL002 DTSBR551
00284 EJECT DTSBR551
00285 01 L004-LINK-AREA. DTSBR551
00286 ++INCLUDE DTSIL004 DTSBR551
00287 EJECT DTSBR551
00288 DTSBR551
00289 LINKAGE SECTION. DTSBR551
00290 DTSBR551
00291 01 LRCM-LINK-AREA. DTSBR551
00292 ++INCLUDE DTSILRCM DTSBR551
00293 DTSBR551
00294 01 R551-REC. DTSBR551
00295 ++INCLUDE DTSIR551 DTSBR551
00296 EJECT DTSBR551
00297 PROCEDURE DIVISION USING LRCM-LINK-AREA DTSBR551
00298 R551-REC. DTSBR551
00299 DTSBR551
00300 IF FIRST-TIME-IND = 'Y' DTSBR551
00301 PERFORM I1000-INITIATE THRU I1000-EXIT DTSBR551
00302 MOVE 'N' TO FIRST-TIME-IND. DTSBR551
00303 DTSBR551
00304 IF LRCM-EOR-88 DTSBR551
00305 PERFORM T1000-TERMINATE THRU T1000-EXIT DTSBR551
00306 ELSE DTSBR551
00307 PERFORM P1000-PROCESS THRU P1000-EXIT. DTSBR551
00308 DTSBR551
00309 GOBACK. DTSBR551
00310 DTSBR551
00311 I1000-INITIATE. DTSBR551
00312 OPEN OUTPUT PRT-FILE1 PRT-FILE2. DTSBR551
00313 MOVE LRCM-SYS-DATE TO WS-SYS-DATE. DTSBR551
00314 MOVE LRCM-SYS-TIME TO WS-SYS-TIME. DTSBR551
00315 DTSBR551
00316 MOVE SPACES TO PRT-RECORD1. DTSBR551
00317 MOVE SPACES TO PRT-RECORD2. DTSBR551
00318 DTSBR551
00319 I1000-EXIT. DTSBR551
00320 EXIT. DTSBR551
00321 DTSBR551
00322 P1000-PROCESS. DTSBR551
00323 DTSBR551
00324 IF R551-RPT-TYPE-FATAL-88 DTSBR551
00325 PERFORM P3000-PRINT-HEADER THRU P3000-EXIT DTSBR551
00326 MOVE R551-REC-NO TO WS-REC-NO DTSBR551
00327 MOVE R551-ICESA-REC-TYPE TO WS-REC-TYPE DTSBR551
00328 MOVE R551-EMP-FEIN TO WS-EMP-FEIN DTSBR551
00329 MOVE R551-MSG-TEXT TO WS-ERROR DTSBR551
00330 WRITE PRT-RECORD1 FROM DETAIL-LINE AFTER 1 DTSBR551
00331 ADD +2 TO WS-LINE-CNT2 DTSBR551
00332 ADD +1 TO WS-SUM-FOOT-CNT1 DTSBR551
00333 ELSE DTSBR551
00334 IF R551-RPT-TYPE-NON-FATAL-88 DTSBR551
00335 PERFORM P4000-PRINT-HEADER THRU P4000-EXIT DTSBR551
00336 MOVE R551-REC-NO TO WS-REC-NO2 DTSBR551
00337 MOVE R551-EMP-FEIN TO WS-EMP-FEIN2 DTSBR551
00338 MOVE R551-MSG-TEXT TO WS-ERROR2 DTSBR551
00339 WRITE PRT-RECORD2 FROM DETAIL-LINE2 AFTER 1 DTSBR551
00340 DTSBR551
00341 MOVE R551-EMP-NAME TO WS-EMP-NAME DTSBR551
00342 WRITE PRT-RECORD2 FROM DETAIL-LINE3 AFTER 1 DTSBR551
00343 DTSBR551
00344 MOVE R551-EMP-STREET TO WS-EMP-STREET DTSBR551
00345 WRITE PRT-RECORD2 FROM DETAIL-LINE4 AFTER 1 DTSBR551
00346 DTSBR551
00347 MOVE R551-EMP-CITY TO WS-EMP-CITY DTSBR551
00348 MOVE R551-EMP-STATE TO WS-EMP-STATE DTSBR551
00349 MOVE R551-EMP-ZIP-5 TO WS-EMP-ZIP-5 DTSBR551
00350 IF R551-EMP-ZIP-EXT > SPACES DTSBR551
00351 MOVE R551-EMP-ZIP-EXT TO WS-EMP-ZIP-EXT DTSBR551
00352 ELSE DTSBR551
00353 MOVE SPACES TO WS-EMP-ZIP-EXT DTSBR551
00354 END-IF DTSBR551
00355 WRITE PRT-RECORD2 FROM DETAIL-LINE5 AFTER 1 DTSBR551
00356 WRITE PRT-RECORD2 FROM DETAIL-SPACES AFTER 1 DTSBR551
00357 DTSBR551
00358 ADD +5 TO WS-LINE-CNT4 DTSBR551
00359 ADD +1 TO WS-SUM-FOOT-CNT2 DTSBR551
00360 END-IF DTSBR551
00361 END-IF. DTSBR551
00362 DTSBR551
00363 P1000-EXIT. DTSBR551
00364 EXIT. DTSBR551
00365 DTSBR551
00366 P3000-PRINT-HEADER. DTSBR551
00367 IF WS-LINE-CNT GREATER 56 DTSBR551
00368 MOVE R551-SUBMITTER-NAME TO HDR6-SUBMIT-NAME DTSBR551
00369 MOVE R551-SUBMITTER-FEIN TO HDR6-SUBMIT-FEIN DTSBR551
00370 MOVE R551-CONTACT-NAME TO HDR7-CONTACT-NAME DTSBR551
00371 MOVE R551-CONTACT-PHONE (1:3) TO HDR7-AREA-CODE DTSBR551
00372 MOVE R551-CONTACT-PHONE (4:3) TO HDR7-PREFIX DTSBR551
00373 MOVE R551-CONTACT-PHONE (7:4) TO HDR7-SUFFIX. DTSBR551
00374 DTSBR551
00375 IF WS-LINE-CNT GREATER 56 OR DTSBR551
00376 WS-LINE-CNT2 GREATER 56 DTSBR551
00377 MOVE +0 TO WS-LINE-CNT DTSBR551
00378 MOVE +0 TO WS-LINE-CNT2 DTSBR551
00379 ADD +1 TO WS-PAGE-CNT DTSBR551
00380 MOVE WS-PAGE-CNT TO HDR3-PAGE-CNT DTSBR551
00381 WRITE PRT-RECORD1 FROM HEADER-1 AFTER TOP-OF-PAGE DTSBR551
00382 WRITE PRT-RECORD1 FROM HEADER-2 AFTER 1 DTSBR551
00383 WRITE PRT-RECORD1 FROM HEADER-3 AFTER 1 DTSBR551
00384 WRITE PRT-RECORD1 FROM HEADER-4 AFTER 1 DTSBR551
00385 WRITE PRT-RECORD1 FROM HEADER-5 AFTER 1 DTSBR551
00386 WRITE PRT-RECORD1 FROM HEADER-6 AFTER 1 DTSBR551
00387 WRITE PRT-RECORD1 FROM HEADER-7 AFTER 1 DTSBR551
00388 WRITE PRT-RECORD1 FROM HEADER-8 AFTER 1 DTSBR551
00389 WRITE PRT-RECORD1 FROM HEADER-9 AFTER 1 DTSBR551
00390 WRITE PRT-RECORD1 FROM HEADER-8 AFTER 1 DTSBR551
00391 ADD +10 TO WS-LINE-CNT2. DTSBR551
00392 DTSBR551
00393 P3000-EXIT. DTSBR551
00394 EXIT. DTSBR551
00395 DTSBR551
00396 P4000-PRINT-HEADER. DTSBR551
00397 IF WS-LINE-CNT3 GREATER 56 DTSBR551
00398 MOVE R551-SUBMITTER-NAME TO HDR6-SUBMIT-NAME DTSBR551
00399 MOVE R551-SUBMITTER-FEIN TO HDR6-SUBMIT-FEIN DTSBR551
00400 MOVE R551-CONTACT-NAME TO HDR7-CONTACT-NAME DTSBR551
00401 MOVE R551-CONTACT-PHONE (1:3) TO HDR7-AREA-CODE DTSBR551
00402 MOVE R551-CONTACT-PHONE (4:3) TO HDR7-PREFIX DTSBR551
00403 MOVE R551-CONTACT-PHONE (7:4) TO HDR7-SUFFIX. DTSBR551
00404 DTSBR551
00405 IF WS-LINE-CNT3 GREATER 56 OR DTSBR551
00406 WS-LINE-CNT4 GREATER 56 DTSBR551
00407 MOVE +0 TO WS-LINE-CNT3 DTSBR551
00408 MOVE +0 TO WS-LINE-CNT4 DTSBR551
00409 ADD +1 TO WS-PAGE-CNT2 DTSBR551
00410 MOVE WS-PAGE-CNT2 TO HDR3-PAGE-CNT2 DTSBR551
00411 WRITE PRT-RECORD2 FROM HEADER-1 AFTER TOP-OF-PAGE DTSBR551
00412 WRITE PRT-RECORD2 FROM HEADER-2 AFTER 1 DTSBR551
00413 WRITE PRT-RECORD2 FROM HEADER-3B AFTER 1 DTSBR551
00414 WRITE PRT-RECORD2 FROM HEADER-4B AFTER 1 DTSBR551
00415 WRITE PRT-RECORD2 FROM HEADER-5 AFTER 1 DTSBR551
00416 WRITE PRT-RECORD2 FROM HEADER-6 AFTER 1 DTSBR551
00417 WRITE PRT-RECORD2 FROM HEADER-7 AFTER 1 DTSBR551
00418 WRITE PRT-RECORD2 FROM HEADER-8 AFTER 1 DTSBR551
00419 WRITE PRT-RECORD2 FROM HEADER-9B AFTER 1 DTSBR551
00420 WRITE PRT-RECORD2 FROM HEADER-8 AFTER 1 DTSBR551
00421 ADD +10 TO WS-LINE-CNT4. DTSBR551
00422 DTSBR551
00423 P4000-EXIT. DTSBR551
00424 EXIT. DTSBR551
00425 DTSBR551
00426 P5000-EXIT. DTSBR551
00427 EXIT. DTSBR551
00428 DTSBR551
00429 T1000-TERMINATE. DTSBR551
00430 DTSBR551
00431 IF WS-LINE-CNT > 56 DTSBR551
00432 NEXT SENTENCE DTSBR551
00433 ELSE DTSBR551
00434 IF WS-LINE-CNT2 > 56 DTSBR551
00435 PERFORM P3000-PRINT-HEADER THRU P3000-EXIT DTSBR551
00436 MOVE WS-SUM-FOOT-CNT1 TO WS-SUM-FOOT-NUMBER DTSBR551
00437 WRITE PRT-RECORD1 FROM SUM-LINE-5 AFTER 1 DTSBR551
00438 WRITE PRT-RECORD1 FROM SUM-LINE-6 AFTER 2 DTSBR551
00439 WRITE PRT-RECORD1 FROM SUM-ASTR-7 AFTER 2 DTSBR551
00440 ELSE DTSBR551
00441 MOVE WS-SUM-FOOT-CNT1 TO WS-SUM-FOOT-NUMBER DTSBR551
00442 WRITE PRT-RECORD1 FROM SUM-LINE-5 AFTER 1 DTSBR551
00443 WRITE PRT-RECORD1 FROM SUM-LINE-6 AFTER 2 DTSBR551
00444 WRITE PRT-RECORD1 FROM SUM-ASTR-7 AFTER 2 DTSBR551
00445 END-IF DTSBR551
00446 END-IF. DTSBR551
00447 DTSBR551
00448 IF WS-LINE-CNT3 > 56 DTSBR551
00449 NEXT SENTENCE DTSBR551
00450 ELSE DTSBR551
00451 IF WS-LINE-CNT4 > 56 DTSBR551
00452 PERFORM P4000-PRINT-HEADER THRU P4000-EXIT DTSBR551
00453 MOVE WS-SUM-FOOT-CNT2 TO WS-SUM-FOOT-NUMBER-2 DTSBR551
00454 WRITE PRT-RECORD2 FROM SUM-LINE-5 AFTER 1 DTSBR551
00455 WRITE PRT-RECORD2 FROM SUM-LINE-6B AFTER 2 DTSBR551
00456 WRITE PRT-RECORD2 FROM SUM-ASTR-7 AFTER 2 DTSBR551
00457 ELSE DTSBR551
00458 MOVE WS-SUM-FOOT-CNT2 TO WS-SUM-FOOT-NUMBER-2 DTSBR551
00459 WRITE PRT-RECORD2 FROM SUM-LINE-5 AFTER 1 DTSBR551
00460 WRITE PRT-RECORD2 FROM SUM-LINE-6B AFTER 2 DTSBR551
00461 WRITE PRT-RECORD2 FROM SUM-ASTR-7 AFTER 2 DTSBR551
00462 END-IF DTSBR551
00463 END-IF. DTSBR551
00464 DTSBR551
00465 * IF WS-LINE-CNT4 > 56 OR WS-LINE-CNT3 > 56 DTSBR551
00466 * PERFORM P4000-PRINT-HEADER THRU P4000-EXIT DTSBR551
00467 * END-IF. DTSBR551
00468 * DTSBR551
00469 * MOVE WS-SUM-FOOT-CNT2 TO WS-SUM-FOOT-NUMBER-2. DTSBR551
00470 * WRITE PRT-RECORD2 FROM SUM-LINE-5 AFTER 1. DTSBR551
00471 * WRITE PRT-RECORD2 FROM SUM-LINE-6B AFTER 2. DTSBR551
00472 * WRITE PRT-RECORD2 FROM SUM-ASTR-7 AFTER 2. DTSBR551
00473 DTSBR551
00474 CLOSE PRT-FILE1 PRT-FILE2. DTSBR551
00475 DTSBR551
00476 T1000-EXIT. DTSBR551
00477 EXIT. DTSBR551
00478 DTSBR551
00479 S001-DATE. DTSBR551
00480 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBR551
00481 DTSBR551
00482 S001-EXIT. DTSBR551
00483 EXIT. DTSBR551
00484 DTSBR551
00485 S002-DATE-ALPHA. DTSBR551
00486 CALL 'DTSBU002' USING L002-LINK-AREA. DTSBR551
00487 DTSBR551
00488 S002-EXIT. DTSBR551
00489 EXIT. DTSBR551
00490 DTSBR551
00491 S004-FROM-DATE. DTSBR551
00492 SET L004-FROM-DATE TO TRUE. DTSBR551
00493 GO TO S004-YRQ. DTSBR551
00494 DTSBR551
00495 S004-FROM-3. DTSBR551
00496 SET L004-FROM-3 TO TRUE. DTSBR551
00497 GO TO S004-YRQ. DTSBR551
00498 DTSBR551
00499 S004-FROM-5. DTSBR551
00500 SET L004-FROM-5 TO TRUE. DTSBR551
00501 GO TO S004-YRQ. DTSBR551
00502 DTSBR551
00503 S004-FROM-ABS. DTSBR551
00504 SET L004-FROM-ABS TO TRUE. DTSBR551
00505 GO TO S004-YRQ. DTSBR551
00506 DTSBR551
00507 S004-YRQ. DTSBR551
00508 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBR551
00509 DTSBR551
00510 S004-EXIT. DTSBR551
00511 EXIT. DTSBR551
00512 DTSBR551
00513 S999-ABEND. DTSBR551
00514 DISPLAY '*** DTSBR551 ABENDING. ' DTSBR551
00515 WRK-ABEND-MSG. DTSBR551
00516 DTSBR551
00517 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBR551
00518 DTSBR551
00519 S999-EXIT. DTSBR551
00520 EXIT. DTSBR551
00521 DTSBR551