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