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

468 lines
37 KiB
COBOL

00001 IDENTIFICATION DIVISION. 04/27/06
00002 PROGRAM-ID. DTSBR511. DTSBR511
00003 AUTHOR. NGI. LV003
00004 DATE-WRITTEN. MAR 2006. DTSBR511
00005 DATE-COMPILED. DTSBR511
00006 SKIP3 DTSBR511
00007 ***** DTSBR511
00008 * DTSBR511
00009 * CALLING SEQUENCE: DTSBD400 CALLS DTSBR511
00010 * DTSBd511 WHICH CREATES DTSIR511 RECORDS DTSBR511
00011 * DTSBD800 CALLS DTSBR511
00012 * DTSBR511 WHICH READS DTSIR511 RECORDS DTSBR511
00013 * DTSBR511
00014 * FUNCTION: print notice of non paymt assessment charges. DTSBR511
00015 * DTSBR511
00016 * MODIFICATION HISTORY: DTSBR511
00017 * DTSBR511
00018 * 04-26-06 produce self mailer for non payemtn of assessment DTSBR511
00019 * sharges DTSBR511
00020 * REFERENCE RFP # dc sur charge PROGRAMMER: ZL1 DTSBR511
00021 * DTSBR511
00022 * MM-DD-YY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBR511
00023 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBR511
00024 * REFERENCE RFP #**** PROGRAMMER: XXX DTSBR511
00025 * DTSBR511
00026 * DTSBR511
00027 * DESCRIPTION: DTSBR511
00028 * DTSBR511
00029 * THIS MODULE PRINTS ASSESSMENT notice of non payment. DTSBR511
00030 * DTSBR511
00031 * DTSBR511
00032 * PROCESSING: DTSBR511
00033 * DTSBR511
00034 * DETAIL: DTSBR511
00035 * DTSBR511
00036 * DTSBR511
00037 * RECORDS READ: DTSBR511
00038 * DTSBR511
00039 * FOPR. DTSBR511
00040 * DTSBR511
00041 * DTSBR511
00042 * PRINTED OUTPUTS: DTSBR511
00043 * DTSBR511
00044 * 511R1 notice of non payment of admin. assessment DTSBR511
00045 * DTSBR511
00046 * DTSBR511
00047 * RECORDS WRITTEN: DTSBR511
00048 * DTSBR511
00049 * NONE. DTSBR511
00050 * DTSBR511
00051 * DTSBR511
00052 * MODULES CALLED: DTSBR511
00053 * DTSBR511
00054 * DTSBU001 DATE EDIT/CONVERSION. DTSBR511
00055 * DTSBR511
00056 ***** DTSBR511
00057 EJECT DTSBR511
00058 ENVIRONMENT DIVISION. DTSBR511
00059 CONFIGURATION SECTION. DTSBR511
00060 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. DTSBR511
00061 DTSBR511
00062 INPUT-OUTPUT SECTION. DTSBR511
00063 DTSBR511
00064 FILE-CONTROL. DTSBR511
00065 SELECT PRT-FILE1 ASSIGN TO RPT511R1. DTSBR511
00066 SELECT PRT-FILE2 ASSIGN TO RPT511R2. DTSBR511
00067 SKIP3 DTSBR511
00068 DATA DIVISION. DTSBR511
00069 SKIP3 DTSBR511
00070 FILE SECTION. DTSBR511
00071 SKIP3 DTSBR511
00072 FD PRT-FILE1 DTSBR511
00073 LABEL RECORDS ARE STANDARD. DTSBR511
00074 01 PRT-REC1. DTSBR511
00075 05 FILLER PIC X(132). DTSBR511
00076 SKIP3 DTSBR511
00077 FD PRT-FILE2 DTSBR511
00078 LABEL RECORDS ARE STANDARD. DTSBR511
00079 01 PRT-REC2. DTSBR511
00080 05 FILLER PIC X(132). DTSBR511
00081 SKIP3 DTSBR511
00082 WORKING-STORAGE SECTION. DTSBR511
000825 77 PAN-VALET PICTURE X(24) VALUE '003DTSBR511 04/27/06'. DTSBR511
00083 SKIP3 DTSBR511
00084 01 WRK-AREA-CONSTANTS. DTSBR511
00085 05 WRK-ABEND-CD PIC S9(04) COMP DTSBR511
00086 VALUE +511. DTSBR511
00087 DTSBR511
00088 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBR511
00089 DTSBR511
00090 05 TOT-LINE-CNT PIC S9(04) COMP VALUE +47. DTSBR511
00091 05 MAX-QTR-PRINT PIC S9(04) COMP VALUE +21. DTSBR511
00092 05 LINE-CNT PIC S9(04) COMP VALUE +0. DTSBR511
00093 DTSBR511
00094 05 ABEND-MSG PIC X(60) VALUE SPACE. DTSBR511
00095 DTSBR511
00096 05 WS-WRK-QTR PIC 9(05) VALUE ZEROS. DTSBR511
00097 05 WS-WRK-QTR-X REDEFINES WS-WRK-QTR. DTSBR511
00098 10 WRK-QTR-YR PIC 9(04). DTSBR511
00099 10 WRK-QTR-Q PIC 9(01). DTSBR511
00100 DTSBR511
00101 05 WS-PRT-QTR. DTSBR511
00102 10 WRK-PRT-YR PIC X(04) VALUE SPACES. DTSBR511
00103 10 WRK-PRT-SLASH PIC X(01) VALUE SPACES. DTSBR511
00104 10 WRK-PRT-Q PIC X(01) VALUE SPACES. DTSBR511
00105 DTSBR511
00106 05 WS-EMP-NAME. DTSBR511
00107 10 WRK-FIRST-4 PIC X(04) VALUE SPACES. DTSBR511
00108 10 WRK-LAST-36 PIC X(36) VALUE SPACES. DTSBR511
00109 DTSBR511
00110 SKIP3 DTSBR511
00111 05 WS-REC PIC X(132) VALUE SPACES. DTSBR511
00112 05 WS-XREC PIC X(132) VALUE SPACES. DTSBR511
00113 DTSBR511
00114 05 WS-QTR-PLUS20 PIC 9(3) VALUE ZERO. DTSBR511
00115 05 WS-QTR-CNT PIC 9(3) VALUE ZERO. DTSBR511
00116 05 TOT-RPT-CNT PIC 9(5) VALUE ZERO. DTSBR511
00117 05 WS-QTR-IDX PIC 9(3) VALUE ZERO. DTSBR511
00118 05 WRK-CTR PIC 9(3) VALUE ZERO. DTSBR511
00119 05 WS-PAGE-CNT PIC 9(3) VALUE ZERO. DTSBR511
00120 05 WS-LINE-CNT PIC 9(3) VALUE 60. DTSBR511
00121 DTSBR511
00122 ++INCLUDE DTSXL511 DTSBR511
00123 05 STUB-LINE1. DTSBR511
00124 10 FILLER PIC X(36) VALUE SPACES. DTSBR511
00125 10 STUB-STMT-DATE PIC X(20). DTSBR511
00126 SKIP3 DTSBR511
00127 05 STUB-LINE2. DTSBR511
00128 10 FILLER PIC X(22) VALUE SPACES. DTSBR511
00129 10 STUB-EMP-NO PIC 999B999. DTSBR511
00130 * 10 FILLER PIC X(03) VALUE SPACES. DTSBR511
00131 * 10 STUB-NAME-CHEK PIC X(04). DTSBR511
00132 * 10 FILLER PIC X(04) VALUE SPACES. DTSBR511
00133 * 10 STUB-EMP-FEIN PIC 99B9999999. DTSBR511
00134 * 10 FILLER PIC X(03) VALUE SPACES. DTSBR511
00135 * 10 STUB-QTR PIC X(10). DTSBR511
00136 * 10 FILLER PIC X(06) VALUE SPACES. DTSBR511
00137 * 10 STUB-STMT-DATE PIC X(10). DTSBR511
00138 * 10 FILLER PIC X(04) VALUE SPACES. DTSBR511
00139 * 10 STUB-AMT PIC $,$$$,$$$.$$. DTSBR511
00140 DTSBR511
00141 05 rept-LINE1. DTSBR511
00142 10 FILLER PIC X(05) VALUE SPACES. DTSBR511
00143 10 rept-EMP-NO PIC 999B999. DTSBR511
00144 10 FILLER PIC X(03) VALUE SPACES. DTSBR511
00145 10 rept-EMP-FEIN PIC 99B9999999. DTSBR511
00146 10 FILLER PIC X(04) VALUE SPACES. DTSBR511
00147 10 rept-emp-name PIC X(30). DTSBR511
00148 10 FILLER PIC X(03) VALUE SPACES. DTSBR511
00149 10 rept-AMT PIC $,$$$,$$$.$$. DTSBR511
00150 10 FILLER PIC X(06) VALUE SPACES. DTSBR511
00151 * 10 STUB-STMT-DATE PIC X(10). DTSBR511
00152 * 10 FILLER PIC X(04) VALUE SPACES. DTSBR511
00153 10 rept-QTR PIC X(10). DTSBR511
00154 DTSBR511
00155 05 ADDR01. DTSBR511
00156 10 FILLER PIC X(05) VALUE SPACE. DTSBR511
00157 10 STUB-ADDR-LINE1 PIC X(40). DTSBR511
00158 10 FILLER PIC X(23) value spaces. DTSBR511
00159 DTSBR511
00160 05 ADDR02. DTSBR511
00161 10 FILLER PIC X(05) VALUE SPACE. DTSBR511
00162 10 STUB-ADDR-LINE2 PIC X(40). DTSBR511
00163 10 FILLER PIC X(23) value spaces. DTSBR511
00164 DTSBR511
00165 05 ADDR03. DTSBR511
00166 10 FILLER PIC X(05) VALUE SPACE. DTSBR511
00167 10 STUB-ADDR-LINE3 PIC X(40). DTSBR511
00168 10 FILLER PIC X(23) value spaces. DTSBR511
00169 DTSBR511
00170 05 ADDR04. DTSBR511
00171 10 FILLER PIC X(05) VALUE SPACE. DTSBR511
00172 10 STUB-ADDR-LINE4 PIC X(40). DTSBR511
00173 10 FILLER PIC X(32) VALUE SPACES. DTSBR511
00174 DTSBR511
00175 05 ADDR05. DTSBR511
00176 10 FILLER PIC X(05) VALUE SPACE. DTSBR511
00177 10 STUB-ADDR-LINE5 PIC X(40). DTSBR511
00178 10 FILLER PIC X(32) VALUE SPACES. DTSBR511
00179 DTSBR511
00180 * 05 STMT-LINE1. DTSBR511
00181 * 10 FILLER PIC X(05) VALUE SPACES. DTSBR511
00182 * 10 STMT-EMP-NO PIC 999B999. DTSBR511
00183 * 10 FILLER PIC X(07) VALUE SPACES. DTSBR511
00184 * 10 STMT-EMP-FEIN PIC 99B9999999. DTSBR511
00185 * 10 FILLER PIC X(07) VALUE SPACES. DTSBR511
00186 * 10 STMT-QTR PIC X(10). DTSBR511
00187 * 10 FILLER PIC X(03) VALUE SPACES. DTSBR511
00188 * 10 STMT-STMT-DATE PIC X(10). DTSBR511
00189 * 10 FILLER PIC X(04) VALUE SPACES. DTSBR511
00190 DTSBR511
00191 05 STMT-QTR-DETAIL. DTSBR511
00192 * 10 FILLER PIC X(03) VALUE SPACE. DTSBR511
00193 * 10 QTR-DET-YR. DTSBR511
00194 * 15 QTR-DET-YR1 PIC X(06). DTSBR511
00195 * 15 QTR-DET-YR2 PIC X(03). DTSBR511
00196 * 10 FILLER PIC X(09). DTSBR511
00197 * 10 QTR-DET-TOTAL-WAGE PIC $$$,$$$,$$$.99. DTSBR511
00198 * 10 FILLER PIC X(04). DTSBR511
00199 * 10 QTR-DET-ASSESSMENT-WAGE PIC $$$,$$$,$$$.99. DTSBR511
00200 * 10 FILLER PIC X(06). DTSBR511
00201 * 10 QTR-DET-ASSESSMENT-RATE PIC Z,ZZZ,Z9.999. DTSBR511
00202 10 FILLER PIC X(41). DTSBR511
00203 10 QTR-DET-ASSESSMENT-DUE PIC $,$$$,$$$.99. DTSBR511
00204 10 FILLER PIC X(02). DTSBR511
00205 01 HEADER1. DTSBR511
00206 05 FILLER PIC X(01) VALUE SPACES. DTSBR511
00207 05 HDR1-RPT PIC X(05). DTSBR511
00208 05 FILLER PIC X(44) VALUE SPACES. DTSBR511
00209 05 FILLER PIC X(60) VALUE DTSBR511
00210 'DISTRICT OF COLUMBIA'. DTSBR511
00211 05 FILLER PIC X(06) VALUE 'DATE:'. DTSBR511
00212 05 HDR1-DATE PIC X(08). DTSBR511
00213 01 HEADER2. DTSBR511
00214 05 FILLER PIC X(54) VALUE SPACES. DTSBR511
00215 05 FILLER PIC X(56) VALUE DTSBR511
00216 'TAX DIVISION'. DTSBR511
00217 05 FILLER PIC X(06) VALUE 'TIME:'. DTSBR511
00218 05 HDR2-TIME PIC X(08). DTSBR511
00219 DTSBR511
00220 01 HEADER3. DTSBR511
00221 05 FILLER PIC X(40) VALUE SPACES. DTSBR511
00222 05 FILLER PIC X(52) VALUE DTSBR511
00223 ' NON PAYMENT OF ADMINISTRATIVE ASSESSMENT OVER $25'. DTSBR511
00224 05 FILLER PIC X(24) VALUE SPACES. DTSBR511
00225 05 FILLER PIC X(06) VALUE 'PAGE:'. DTSBR511
00226 05 HDR3-PAGE PIC ZZ,ZZ9. DTSBR511
00227 DTSBR511
00228 DTSBR511
00229 01 HEADER5. DTSBR511
00230 05 FILLER PIC X(01) VALUE SPACES. DTSBR511
00231 05 FILLER PIC X(05) VALUE SPACES. DTSBR511
00232 05 FILLER PIC X(06) VALUE DTSBR511
00233 'EMP NO'. DTSBR511
00234 05 FILLER PIC X(05) VALUE SPACES. DTSBR511
00235 05 FILLER PIC X(12) VALUE DTSBR511
00236 ' FEIN '. DTSBR511
00237 05 FILLER PIC X(15) VALUE SPACES. DTSBR511
00238 05 FILLER PIC X(12) VALUE DTSBR511
00239 'PRIMARY NAME'. DTSBR511
00240 05 FILLER PIC X(04) VALUE SPACES. DTSBR511
00241 05 FILLER PIC X(15) VALUE DTSBR511
00242 ' ASSESSED AMT'. DTSBR511
00243 05 FILLER PIC X(08) VALUE SPACES. DTSBR511
00244 05 FILLER PIC X(04) VALUE DTSBR511
00245 'QTR'. DTSBR511
00246 05 FILLER PIC X(03) VALUE SPACES. DTSBR511
00247 DTSBR511
00248 DTSBR511
00249 DTSBR511
00250 EJECT DTSBR511
00251 01 L001-LINK-AREA. DTSBR511
00252 ++INCLUDE DTSIL001 DTSBR511
00253 EJECT DTSBR511
00254 01 L002-LINK-AREA. DTSBR511
00255 ++INCLUDE DTSIL002 DTSBR511
00256 EJECT DTSBR511
00257 01 L005-LINK-AREA. DTSBR511
00258 ++INCLUDE DTSIL005 DTSBR511
00259 EJECT DTSBR511
00260 01 L004-LINK-AREA. DTSBR511
00261 ++INCLUDE DTSIL004 DTSBR511
00262 EJECT DTSBR511
00263 LINKAGE SECTION. DTSBR511
00264 SKIP3 DTSBR511
00265 01 LRCM-LINK-AREA. DTSBR511
00266 ++INCLUDE DTSILRCM DTSBR511
00267 EJECT DTSBR511
00268 01 R511-REC. DTSBR511
00269 ++INCLUDE DTSIR511 DTSBR511
00270 EJECT DTSBR511
00271 PROCEDURE DIVISION USING LRCM-LINK-AREA DTSBR511
00272 R511-REC. DTSBR511
00273 SKIP2 DTSBR511
00274 IF FIRST-TIME-IND = 'Y' DTSBR511
00275 PERFORM I1000-INITIATE THRU I1000-EXIT DTSBR511
00276 MOVE 'N' TO FIRST-TIME-IND. DTSBR511
00277 DTSBR511
00278 IF LRCM-EOR-88 DTSBR511
00279 PERFORM T1000-TERMINATE THRU T1000-EXIT DTSBR511
00280 ELSE DTSBR511
00281 PERFORM P1000-PROCESS THRU P1000-EXIT. DTSBR511
00282 SKIP2 DTSBR511
00283 GOBACK. DTSBR511
00284 EJECT DTSBR511
00285 I1000-INITIATE. DTSBR511
00286 OPEN OUTPUT PRT-FILE1 DTSBR511
00287 prt-file2. DTSBR511
00288 MOVE +0 TO WS-PAGE-CNT. DTSBR511
00289 DTSBR511
00290 PERFORM S005-SYS-DATE THRU S005-EXIT. DTSBR511
00291 MOVE L005-SLASH-DATE TO HDR1-DATE. DTSBR511
00292 MOVE L005-DISPLAY-TIME TO HDR2-TIME. DTSBR511
00293 DTSBR511
00294 MOVE XEROX-8X11-LINE TO WS-REC. DTSBR511
00295 WRITE PRT-REC1 FROM WS-REC DTSBR511
00296 AFTER ADVANCING PAGE. DTSBR511
00297 DTSBR511
00298 MOVE XEROX-CNTL-LINE2 TO WS-REC. DTSBR511
00299 WRITE PRT-REC1 FROM WS-REC DTSBR511
00300 AFTER ADVANCING 1. DTSBR511
00301 DTSBR511
00302 I1000-EXIT. DTSBR511
00303 EXIT. DTSBR511
00304 SKIP3 DTSBR511
00305 P1000-PROCESS. DTSBR511
00306 DTSBR511
00307 MOVE SPACES TO WS-REC. DTSBR511
00308 DTSBR511
00309 add 1 to tot-rpt-cnt. DTSBR511
00310 MOVE r511-EMP-NO TO STUB-EMP-NO DTSBR511
00311 rept-emp-no DTSBR511
00312 MOVE r511-EMP-FEIN TO rept-EMP-FEIN DTSBR511
00313 * STMT-EMP-FEIN. DTSBR511
00314 DTSBR511
00315 * MOVE r511-STMT-DATE TO L001-FED-8-DATE-9. DTSBR511
00316 * PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBR511
00317 * MOVE L001-SLASH-8-DATE TO STUB-STMT-DATE DTSBR511
00318 * STMT-STMT-DATE. DTSBR511
00319 DTSBR511
00320 MOVE R511-stmt-DATE TO L002-DATE. DTSBR511
00321 PERFORM S002-MIXED-CASE THRU S002-EXIT. DTSBR511
00322 MOVE L002-LONG-TEXT-AREA TO stub-stmt-date. DTSBR511
00323 DTSBR511
00324 DTSBR511
00325 MOVE r511-QTR TO WS-WRK-QTR. DTSBR511
00326 MOVE WRK-QTR-Q TO WRK-PRT-Q DTSBR511
00327 MOVE WRK-QTR-YR TO WRK-PRT-YR DTSBR511
00328 MOVE '/' TO WRK-PRT-SLASH DTSBR511
00329 MOVE WS-PRT-QTR TO rept-QTR DTSBR511
00330 * STMT-QTR. DTSBR511
00331 DTSBR511
00332 MOVE r511-FMT-LINE (1) TO STUB-ADDR-LINE1 DTSBR511
00333 MAIL-ADDR-LINE1 DTSBR511
00334 rept-emp-name. DTSBR511
00335 DTSBR511
00336 MOVE r511-FMT-LINE (2) TO STUB-ADDR-LINE2 DTSBR511
00337 MAIL-ADDR-LINE2. DTSBR511
00338 DTSBR511
00339 MOVE r511-FMT-LINE (3) TO STUB-ADDR-LINE3 DTSBR511
00340 MAIL-ADDR-LINE3. DTSBR511
00341 DTSBR511
00342 MOVE r511-FMT-LINE (4) TO STUB-ADDR-LINE4 DTSBR511
00343 MAIL-ADDR-LINE4. DTSBR511
00344 DTSBR511
00345 MOVE r511-FMT-LINE (5) TO STUB-ADDR-LINE5 DTSBR511
00346 MAIL-ADDR-LINE5. DTSBR511
00347 DTSBR511
00348 * MOVE WRK-FIRST-4 TO STUB-NAME-CHEK. DTSBR511
00349 DTSBR511
00350 MOVE r511-ASSESSMENT-DUE TO QTR-DET-ASSESSMENT-DUE DTSBR511
00351 rept-AMT. DTSBR511
00352 PERFORM P1200-PRINT-STUB-MAILR THRU P1200-EXIT. DTSBR511
00353 DTSBR511
00354 PERFORM P1500-PRINT-MAILR-ADDR THRU P1500-EXIT. DTSBR511
00355 PERFORM P1600-PRINT-report THRU P1600-EXIT. DTSBR511
00356 DTSBR511
00357 P1000-EXIT. DTSBR511
00358 EXIT. DTSBR511
00359 SKIP3 DTSBR511
00360 DTSBR511
00361 P1200-PRINT-STUB-MAILR. DTSBR511
00362 DTSBR511
00363 WRITE PRT-REC1 FROM WS-REC AFTER ADVANCING PAGE DTSBR511
00364 WRITE PRT-REC1 FROM WS-REC AFTER ADVANCING 6 LINES DTSBR511
00365 MOVE STUB-LINE1 TO WS-REC DTSBR511
00366 WRITE PRT-REC1 FROM WS-REC AFTER ADVANCING 1 LINES DTSBR511
00367 MOVE STUB-LINE2 TO WS-REC DTSBR511
00368 WRITE PRT-REC1 FROM WS-REC AFTER ADVANCING 3 LINES DTSBR511
00369 MOVE ADDR01 TO WS-REC DTSBR511
00370 WRITE PRT-REC1 FROM WS-REC AFTER ADVANCING 3 LINES DTSBR511
00371 MOVE ADDR02 TO WS-REC DTSBR511
00372 WRITE PRT-REC1 FROM WS-REC AFTER ADVANCING 1 LINES DTSBR511
00373 MOVE ADDR03 TO WS-REC DTSBR511
00374 WRITE PRT-REC1 FROM WS-REC AFTER ADVANCING 1 LINES DTSBR511
00375 MOVE ADDR04 TO WS-REC DTSBR511
00376 WRITE PRT-REC1 FROM WS-REC AFTER ADVANCING 1 LINES DTSBR511
00377 MOVE ADDR05 TO WS-REC DTSBR511
00378 WRITE PRT-REC1 FROM WS-REC AFTER ADVANCING 1 LINES DTSBR511
00379 MOVE SPACES TO WS-REC. DTSBR511
00380 WRITE PRT-REC1 FROM STMT-QTR-DETAIL DTSBR511
00381 AFTER ADVANCING 20 lines. DTSBR511
00382 P1200-EXIT. DTSBR511
00383 EXIT. DTSBR511
00384 SKIP3 DTSBR511
00385 DTSBR511
00386 P1500-PRINT-MAILR-ADDR. DTSBR511
00387 DTSBR511
00388 WRITE PRT-REC1 FROM WS-XREC AFTER ADVANCING PAGE DTSBR511
00389 MOVE LINE-ADDR-17 TO WS-XREC DTSBR511
00390 WRITE PRT-REC1 FROM WS-XREC DTSBR511
00391 AFTER ADVANCING 17 LINES DTSBR511
00392 MOVE LINE-ADDR-18 TO WS-XREC DTSBR511
00393 WRITE PRT-REC1 FROM WS-XREC AFTER 1 DTSBR511
00394 MOVE LINE-ADDR-19 TO WS-XREC DTSBR511
00395 WRITE PRT-REC1 FROM WS-XREC AFTER 1 DTSBR511
00396 MOVE LINE-ADDR-20 TO WS-XREC DTSBR511
00397 WRITE PRT-REC1 FROM WS-XREC AFTER 1 DTSBR511
00398 MOVE LINE-ADDR-21 TO WS-XREC DTSBR511
00399 WRITE PRT-REC1 FROM WS-XREC AFTER 1. DTSBR511
00400 P1500-EXIT. DTSBR511
00401 EXIT. DTSBR511
00402 SKIP3 DTSBR511
00403 P1600-PRINT-REPORT. DTSBR511
00404 ADD 1 TO WS-LINE-CNT. DTSBR511
00405 IF WS-LINE-CNT > 50 DTSBR511
00406 ADD 1 TO WS-PAGE-CNT DTSBR511
00407 MOVE WS-PAGE-CNT TO HDR3-PAGE DTSBR511
00408 MOVE '511R2' TO HDR1-RPT DTSBR511
00409 WRITE PRT-REC2 FROM HEADER1 AFTER ADVANCING TOP-OF-PAGE DTSBR511
00410 WRITE PRT-REC2 FROM HEADER2 AFTER ADVANCING 1 DTSBR511
00411 WRITE PRT-REC2 FROM HEADER3 AFTER ADVANCING 1 DTSBR511
00412 WRITE PRT-REC2 FROM HEADER5 AFTER ADVANCING 1 DTSBR511
00413 MOVE 1 TO WS-LINE-CNT DTSBR511
00414 END-IF. DTSBR511
00415 DTSBR511
00416 WRITE PRT-REC2 FROM REPT-LINE1 AFTER ADVANCING 1. DTSBR511
00417 P1600-EXIT. DTSBR511
00418 EXIT. DTSBR511
00419 SKIP3 DTSBR511
00420 T1000-TERMINATE. DTSBR511
00421 CLOSE PRT-FILE1 PRT-FILE2. DTSBR511
00422 DTSBR511
00423 DISPLAY '***'. DTSBR511
00424 DTSBR511
00425 DISPLAY '*** DTSBr511 (notice of non payment ) ' DTSBR511
00426 'TERMINATION STATISTICS'. DTSBR511
00427 DISPLAY ' '. DTSBR511
00428 display 'total notices generated ' tot-rpt-cnt. DTSBR511
00429 DTSBR511
00430 DISPLAY '***END JOB****'. DTSBR511
00431 T1000-EXIT. DTSBR511
00432 EXIT. DTSBR511
00433 EJECT DTSBR511
00434 S001-FROM-FED-8. DTSBR511
00435 SET L001-FROM-FED-8 TO TRUE. DTSBR511
00436 GO TO S001-DATE. DTSBR511
00437 DTSBR511
00438 S001-DATE. DTSBR511
00439 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBR511
00440 S001-EXIT. DTSBR511
00441 EXIT. DTSBR511
00442 DTSBR511
00443 S002-MIXED-CASE. DTSBR511
00444 SET L002-MIXED-CASE TO TRUE. DTSBR511
00445 CALL 'DTSBU002' USING L002-LINK-AREA. DTSBR511
00446 S002-EXIT. DTSBR511
00447 EXIT. DTSBR511
00448 SKIP3 DTSBR511
00449 S004-FROM-QTR-5. DTSBR511
00450 SET L004-FROM-5 TO TRUE. DTSBR511
00451 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBR511
00452 S004-EXIT. DTSBR511
00453 EXIT. DTSBR511
00454 SKIP3 DTSBR511
00455 S005-SYS-DATE. DTSBR511
00456 SET L005-FROM-SYS TO TRUE DTSBR511
00457 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBR511
00458 S005-EXIT. DTSBR511
00459 EXIT. DTSBR511
00460 SKIP3 DTSBR511
00461 S999-ABEND. DTSBR511
00462 DISPLAY ABEND-MSG. DTSBR511
00463 DTSBR511
00464 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBR511
00465 S999-EXIT. DTSBR511
00466 EXIT. DTSBR511