00001 IDENTIFICATION DIVISION. 05/15/02 00002 PROGRAM-ID. DTSBR611. DTSBR611 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV032 00004 DATE-WRITTEN. JANUARY 1995. DTSBR611 00005 DATE-COMPILED. DTSBR611 00006 DTSBR611 00007 ***** DTSBR611 00008 * DTSBR611 00009 * CALLING SEQUENCE: DTSBD400 CALLS DTSBR611 00010 * DTSBE611 WHICH UPDATES DTSIR611 DTSBR611 00011 * DTSBR611 READS DTSIR611 RECORDS. DTSBR611 00012 * DTSBR611 00013 * FUNCTION: ACTIVE EMPLOYERS BY ZIP CODE COUNTS. DTSBR611 00014 * DTSBR611 00015 * DTSBR611 00016 * MODIFICATION HISTORY: DTSBR611 00017 * DTSBR611 00018 * 01-18-95 INITIAL DEVELOPMENT DTSBR611 00019 * REFERENCE RFP #RAP AUTHOR OF CHANGE - EHH DTSBR611 00020 * DTSBR611 00021 * 08-20-97 RECOMPILED FOR NEW RELEASE (R680) OF FINALIST. DTSBR611 00022 * REFERENCE RFP #NONE AUTHOR OF CHANGE - EHH DTSBR611 00023 * DTSBR611 00024 * 09-20-00 RECOMPILED FOR NEW RELEASE (R720) OF FINALIST. DTSBR611 00025 * REFERENCE RFP #NONE AUTHOR OF CHANGE - ZL1 DTSBR611 00026 * DTSBR611 00027 * MM-DD-YY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBR611 00028 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBR611 00029 * REFERENCE RFP #**** AUTHOR OF CHANGE - XXX DTSBR611 00030 * DTSBR611 00031 * DTSBR611 00032 * DESCRIPTION: DTSBR611 00033 * DTSBR611 00034 * THIS MODULE PRODUCES THE ACTIVE EMPLOYERS BY ZIP CODE DTSBR611 00035 * COUNTS REPORT. DTSBR611 00036 * DTSBR611 00037 * DTSBR611 CALLS THE "FINALIST" ACCESS METHOD UTILITY DTSBR611 00038 * MODULE ('LPAM') TO EXTRACT CITY NAMES AND COUNTY CODES DTSBR611 00039 * FROM THE FINALIST DATABASE. THUS, FOR EXECUTION OF DTSBR611 00040 * DTSBR611 ONE FINALIST DD STATEMENTS IS REQUIRED: DTSBR611 00041 * DTSBR611 00042 * //CBDATA DD DSN=SYPPDOES.FINALIST.V340.DATAFILE,DISP=SHR DTSBR611 00043 * DTSBR611 00044 * 'LPAM' IS DESCRIBED IN CHAPTER 10 OF THE FINALIST DTSBR611 00045 * MANUAL. DTSBR611 00046 * DTSBR611 00047 * DTSBR611 00048 * RECORDS READ: DTSBR611 00049 * DTSBR611 00050 * NONE. DTSBR611 00051 * DTSBR611 00052 * DTSBR611 00053 * PRINTED OUTPUTS: DTSBR611 00054 * DTSBR611 00055 * 611R1 ACTIVE EMPLOYERS BY ZIP CODE COUNTS. DTSBR611 00056 * DTSBR611 00057 * DTSBR611 00058 * RECORDS WRITTEN: DTSBR611 00059 * DTSBR611 00060 * NONE. DTSBR611 00061 * DTSBR611 00062 * DTSBR611 00063 * MODULES CALLED: DTSBR611 00064 * DTSBR611 00065 * DTSBU062 FIELD REP ID EDIT/DESCRIPTION. DTSBR611 00066 * LPAM FINALIST ACCESS METHOD INTERFACE. DTSBR611 00067 * DTSBR611 00068 * DTSBR611 00069 ***** DTSBR611 00070 EJECT DTSBR611 00071 ENVIRONMENT DIVISION. DTSBR611 00072 DTSBR611 00073 CONFIGURATION SECTION. DTSBR611 00074 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. DTSBR611 00075 DTSBR611 00076 INPUT-OUTPUT SECTION. DTSBR611 00077 DTSBR611 00078 FILE-CONTROL. DTSBR611 00079 SELECT PRT-FILE ASSIGN TO RPT611R1. DTSBR611 00080 DTSBR611 00081 DATA DIVISION. DTSBR611 00082 DTSBR611 00083 FILE SECTION. DTSBR611 00084 DTSBR611 00085 FD PRT-FILE DTSBR611 00086 RECORDING MODE IS F. DTSBR611 00087 01 REPORT-LISTING1 PIC X(133). DTSBR611 00088 DTSBR611 00089 WORKING-STORAGE SECTION. DTSBR611 000895 77 PAN-VALET PICTURE X(24) VALUE '032DTSBR611 05/15/02'. DTSBR611 00090 DTSBR611 00091 01 WRK-AREA. DTSBR611 00092 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +611.DTSBR611 00093 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBR611 00094 05 ABEND-MSG PIC X(60). DTSBR611 00095 DTSBR611 00096 05 WS-NUMBER-ONE PIC S9(05) COMP-3 VALUE +0. DTSBR611 00097 05 WS-NUMBER-TWO PIC S9(03) COMP-3 VALUE +0. DTSBR611 00098 05 WS-LINE-CNT PIC S9(02) COMP-3 VALUE 60. DTSBR611 00099 05 WS-LINE-CNT2 PIC S9(02) COMP-3 VALUE +0. DTSBR611 00100 05 WS-PAGE-CNT PIC S9(03) COMP-3 VALUE +0. DTSBR611 00101 05 WS-BLANK-LINE PIC X(133) VALUE SPACES. DTSBR611 00102 DTSBR611 00103 05 WRK-ZIP-CNT PIC S9(05) COMP-3 VALUE +0. DTSBR611 00104 05 WRK-NAME-ZIP-CNT PIC S9(05) COMP-3 VALUE +0. DTSBR611 00105 05 WRK-TOTAL-CNT PIC S9(05) COMP-3 VALUE +0. DTSBR611 00106 DTSBR611 00107 05 WRK-FLD-REP-AREA. DTSBR611 00108 10 WS-FLD-REP-ID PIC X(02). DTSBR611 00109 10 WRK-FLD-REP-ID PIC X(02). DTSBR611 00110 10 WRK-FLD-REP-NAME PIC X(32). DTSBR611 00111 DTSBR611 00112 05 WRK-ZIP-AREA. DTSBR611 00113 10 WRK-ZIP PIC X(05). DTSBR611 00114 10 WRK-CITY PIC X(25). DTSBR611 00115 10 WRK-COUNTY-CODE PIC X(05). DTSBR611 00116 DTSBR611 00117 05 WRK-PREV-AREA. DTSBR611 00118 10 PREV-FLD-REP-ID PIC X(02). DTSBR611 00119 10 PREV-FLD-REP-NAME PIC X(32). DTSBR611 00120 10 PREV-COUNTY-CODE PIC X(05). DTSBR611 00121 10 PREV-ZIP PIC X(05). DTSBR611 00122 10 PREV-CITY PIC X(25). DTSBR611 00123 DTSBR611 00124 01 LPAM-LITERAL-AREA. DTSBR611 00125 05 LPAM-MODULE-NAME PIC X(08) VALUE 'LPAM '. DTSBR611 00126 DTSBR611 00127 05 LPAM-PROFILE-NAME PIC X(08) VALUE ' '. DTSBR611 00128 DTSBR611 00129 05 LPAM-PRODUCT-NAME PIC X(08) VALUE 'BACCMETH'. DTSBR611 00130 DTSBR611 00131 05 LPAM-STREET-FILE-NAME PIC X(08) VALUE 'CBDATA '. DTSBR611 00132 DTSBR611 00133 05 LPAM-CITY-FILE-NAME PIC X(08) VALUE 'CBCTYST '. DTSBR611 00134 DTSBR611 00135 05 LPAM-OPEN-FUNCTION PIC X(08) VALUE 'OPEN '. DTSBR611 00136 DTSBR611 00137 05 LPAM-INIT-FUNCTION PIC X(08) VALUE 'INIT '. DTSBR611 00138 DTSBR611 00139 05 LPAM-TERM-FUNCTION PIC X(08) VALUE 'TERM '. DTSBR611 00140 DTSBR611 00141 05 LPAM-CLOSE-FUNCTION PIC X(08) VALUE 'CLOSE '. DTSBR611 00142 DTSBR611 00143 05 LPAM-GETZIP-FUNCTION PIC X(08) VALUE 'GETZIP '. DTSBR611 00144 DTSBR611 00145 01 LPAM-ANCHOR-AREA PIC X(04). DTSBR611 00146 DTSBR611 00147 01 LPAM-STREET-FILE-RCB PIC X(08). DTSBR611 00148 DTSBR611 00149 01 LPAM-RETURN-CODE PIC X(02). DTSBR611 00150 DTSBR611 00151 01 LPAM-ERROR-AREA. DTSBR611 00152 05 LPAM-ERROR-MODULE PIC X(08). DTSBR611 00153 05 FILLER PIC X(01). DTSBR611 00154 05 LPAM-ERROR-FUNCTION PIC X(08). DTSBR611 00155 05 FILLER PIC X(01). DTSBR611 00156 05 ERROR-RETURN-CODES PIC X(17). DTSBR611 00157 05 FILLER REDEFINES ERROR-RETURN-CODES. DTSBR611 00158 10 ERROR-RETURN-CODE OCCURS 17 TIMES DTSBR611 00159 INDEXED BY ERROR-RETURN-IDX DTSBR611 00160 PIC X(01). DTSBR611 00161 05 FILLER PIC X(01). DTSBR611 00162 05 ERROR-MESSAGE PIC X(44). DTSBR611 00163 DTSBR611 00164 ++INCLUDE LPAM007C DTSBR611 00165 SKIP3 DTSBR611 00166 ++INCLUDE LPAM008C DTSBR611 00167 EJECT DTSBR611 00168 01 L062-LINK-AREA. DTSBR611 00169 ++INCLUDE DTSIL062 DTSBR611 00170 EJECT DTSBR611 00171 DTSBR611 00172 01 PAGE-HEADING. DTSBR611 00173 05 HDR-LINE-1. DTSBR611 00174 10 FILLER PIC X(01) VALUE SPACE. DTSBR611 00175 10 FILLER PIC X(05) DTSBR611 00176 VALUE '611R1'. DTSBR611 00177 10 FILLER PIC X(23) VALUE SPACES.DTSBR611 00178 10 HDR-AGY-NAME-LINE1 PIC X(50). DTSBR611 00179 10 FILLER PIC X(10) VALUE SPACES.DTSBR611 00180 10 FILLER PIC X(05) DTSBR611 00181 VALUE 'DATE:'. DTSBR611 00182 10 FILLER PIC X(01) VALUE SPACE. DTSBR611 00183 10 HDR-SYS-DATE PIC X(08). DTSBR611 00184 DTSBR611 00185 05 HDR-LINE-2. DTSBR611 00186 10 FILLER PIC X(01) VALUE SPACE. DTSBR611 00187 10 FILLER PIC X(27) DTSBR611 00188 VALUE 'ROUTE TO: ENFORCEMENT UNIT'. DTSBR611 00189 10 HDR-AGY-NAME-LINE2 PIC X(50). DTSBR611 00190 10 FILLER PIC X(11) VALUE SPACES.DTSBR611 00191 10 FILLER PIC X(05) DTSBR611 00192 VALUE 'TIME:'. DTSBR611 00193 10 FILLER PIC X(01) VALUE SPACE. DTSBR611 00194 10 HDR-SYS-TIME PIC X(08). DTSBR611 00195 DTSBR611 00196 05 HDR-LINE-3. DTSBR611 00197 10 FILLER PIC X(11) VALUE SPACES.DTSBR611 00198 10 FILLER PIC X(20) DTSBR611 00199 VALUE ' '. DTSBR611 00200 10 FILLER PIC X(58) VALUE SPACES.DTSBR611 00201 10 FILLER PIC X(05) DTSBR611 00202 VALUE 'PAGE:'. DTSBR611 00203 10 FILLER PIC X(03) VALUE SPACES.DTSBR611 00204 10 HDR-PAGE-CNT PIC ZZ,ZZ9. DTSBR611 00205 DTSBR611 00206 05 HDR-LINE-4 PIC X(133) VALUE SPACES.DTSBR611 00207 05 HDR-LINE-5. DTSBR611 00208 10 FILLER PIC X(34) VALUE SPACES.DTSBR611 00209 10 FILLER PIC X(38) DTSBR611 00210 VALUE 'ACTIVE EMPLOYERS BY ZIP CODE COUNTS'. DTSBR611 00211 DTSBR611 00212 05 HDR-LINE-6 PIC X(133) VALUE SPACES.DTSBR611 00213 05 HDR-LINE-7 PIC X(133) VALUE SPACES.DTSBR611 00214 05 HDR-LINE-8. DTSBR611 00215 10 FILLER PIC X(58) VALUE SPACES.DTSBR611 00216 10 FILLER PIC X(06) DTSBR611 00217 VALUE 'ACTIVE'. DTSBR611 00218 DTSBR611 00219 05 HDR-LINE-9. DTSBR611 00220 10 FILLER PIC X(01) VALUE SPACE. DTSBR611 00221 10 FILLER PIC X(05) DTSBR611 00222 VALUE 'FIELD'. DTSBR611 00223 10 FILLER PIC X(43) VALUE SPACES.DTSBR611 00224 10 FILLER PIC X(03) DTSBR611 00225 VALUE 'ZIP'. DTSBR611 00226 10 FILLER PIC X(04) VALUE SPACES.DTSBR611 00227 10 FILLER PIC X(08) DTSBR611 00228 VALUE 'EMPLOYER'. DTSBR611 00229 10 FILLER PIC X(22) VALUE SPACES.DTSBR611 00230 10 FILLER PIC X(06) DTSBR611 00231 VALUE ' '. DTSBR611 00232 DTSBR611 00233 05 HDR-LINE-10. DTSBR611 00234 10 FILLER PIC X(02) VALUE SPACES.DTSBR611 00235 10 FILLER PIC X(04) DTSBR611 00236 VALUE 'CODE'. DTSBR611 00237 10 FILLER PIC X(06) VALUE SPACES.DTSBR611 00238 10 FILLER PIC X(04) DTSBR611 00239 VALUE 'NAME'. DTSBR611 00240 10 FILLER PIC X(32) VALUE SPACES.DTSBR611 00241 10 FILLER PIC X(04) DTSBR611 00242 VALUE 'CODE'. DTSBR611 00243 10 FILLER PIC X(07) VALUE SPACES.DTSBR611 00244 10 FILLER PIC X(05) DTSBR611 00245 VALUE 'COUNT'. DTSBR611 00246 10 FILLER PIC X(07) VALUE SPACES.DTSBR611 00247 10 FILLER PIC X(15) DTSBR611 00248 VALUE 'CITY/STATE NAME'. DTSBR611 00249 10 FILLER PIC X(11) VALUE SPACES.DTSBR611 00250 10 FILLER PIC X(04) DTSBR611 00251 VALUE ' '. DTSBR611 00252 DTSBR611 00253 05 HDR-LINE-11 PIC X(133) VALUE SPACES.DTSBR611 00254 DTSBR611 00255 01 CONTROL-FOOTING-ZIP. DTSBR611 00256 05 CFZ-LINE-1. DTSBR611 00257 10 FILLER PIC X(03) VALUE SPACES.DTSBR611 00258 10 CFZ-FLD-REP-ID PIC X(02). DTSBR611 00259 10 FILLER PIC X(05) VALUE SPACES.DTSBR611 00260 10 CFZ-FLD-REP-NAME PIC X(32). DTSBR611 00261 10 FILLER PIC X(05) VALUE SPACES.DTSBR611 00262 10 CFZ-ZIP PIC X(05). DTSBR611 00263 10 FILLER PIC X(06) VALUE SPACES.DTSBR611 00264 10 CFZ-ZIP-CNT PIC ZZ,ZZ9. DTSBR611 00265 10 FILLER PIC X(05) VALUE SPACES.DTSBR611 00266 10 CFZ-CITY PIC X(25). DTSBR611 00267 DTSBR611 00268 01 CONTROL-FOOTING-NAME. DTSBR611 00269 05 CFN-LINE-2. DTSBR611 00270 10 FILLER PIC X(47) VALUE SPACES.DTSBR611 00271 10 FILLER PIC X(05) DTSBR611 00272 VALUE 'TOTAL'. DTSBR611 00273 10 FILLER PIC X(06) VALUE SPACES.DTSBR611 00274 10 CFN-NAME-ZIP-CNT PIC ZZ,ZZ9. DTSBR611 00275 DTSBR611 00276 01 CONTROL-FOOTING-FINAL. DTSBR611 00277 05 CFF-LINE-1. DTSBR611 00278 10 FILLER PIC X(42) VALUE SPACES.DTSBR611 00279 10 FILLER PIC X(05) DTSBR611 00280 VALUE 'TOTAL'. DTSBR611 00281 10 FILLER PIC X(11) VALUE SPACES.DTSBR611 00282 10 CFF-TOTAL-CNT PIC ZZ,ZZ9. DTSBR611 00283 DTSBR611 00284 EJECT DTSBR611 00285 LINKAGE SECTION. DTSBR611 00286 DTSBR611 00287 01 LRCM-LINK-AREA. DTSBR611 00288 ++INCLUDE DTSILRCM DTSBR611 00289 EJECT DTSBR611 00290 01 R611-REC. DTSBR611 00291 ++INCLUDE DTSIR611 DTSBR611 00292 EJECT DTSBR611 00293 PROCEDURE DIVISION USING LRCM-LINK-AREA DTSBR611 00294 R611-REC. DTSBR611 00295 DTSBR611 00296 IF FIRST-TIME-IND = 'Y' DTSBR611 00297 PERFORM I1000-INITIATE THRU I1000-EXIT DTSBR611 00298 MOVE 'N' TO FIRST-TIME-IND. DTSBR611 00299 DTSBR611 00300 IF LRCM-EOR-88 DTSBR611 00301 PERFORM T1000-TERMINATE THRU T1000-EXIT DTSBR611 00302 ELSE DTSBR611 00303 PERFORM P1000-PROCESS THRU P1000-EXIT. DTSBR611 00304 DTSBR611 00305 GOBACK. DTSBR611 00306 DTSBR611 00307 I1000-INITIATE. DTSBR611 00308 DTSBR611 00309 OPEN OUTPUT PRT-FILE. DTSBR611 00310 MOVE LRCM-SYS-DATE TO HDR-SYS-DATE. DTSBR611 00311 MOVE LRCM-SYS-TIME TO HDR-SYS-TIME. DTSBR611 00312 MOVE LRCM-AGY-NAME-LINE1 TO HDR-AGY-NAME-LINE1. DTSBR611 00313 MOVE LRCM-AGY-NAME-LINE2 TO HDR-AGY-NAME-LINE2. DTSBR611 00314 MOVE SPACES TO REPORT-LISTING1. DTSBR611 00315 DTSBR611 00316 CALL LPAM-MODULE-NAME DTSBR611 00317 USING LPAM-INIT-FUNCTION DTSBR611 00318 LPAM-ANCHOR-AREA DTSBR611 00319 LPAM-RETURN-CODE DTSBR611 00320 LPAM-ERROR-AREA DTSBR611 00321 LPAM-PROFILE-NAME. DTSBR611 00322 DTSBR611 00323 IF LPAM-RETURN-CODE = '00' OR '04' DTSBR611 00324 NEXT SENTENCE DTSBR611 00325 ELSE DTSBR611 00326 MOVE 'UNEXPECTED RETURN CODE FROM LPAM INIT CALL' DTSBR611 00327 TO ABEND-MSG DTSBR611 00328 PERFORM S999-ABEND THRU S999-EXIT. DTSBR611 00329 DTSBR611 00330 DTSBR611 00331 CALL LPAM-MODULE-NAME DTSBR611 00332 USING LPAM-OPEN-FUNCTION DTSBR611 00333 LPAM-ANCHOR-AREA DTSBR611 00334 LPAM-RETURN-CODE DTSBR611 00335 LPAM-ERROR-AREA DTSBR611 00336 LPAM-STREET-FILE-RCB DTSBR611 00337 LPAM-PRODUCT-NAME DTSBR611 00338 LPAM-STREET-FILE-NAME. DTSBR611 00339 DTSBR611 00340 IF LPAM-RETURN-CODE = '00' OR '04' DTSBR611 00341 NEXT SENTENCE DTSBR611 00342 ELSE DTSBR611 00343 MOVE 'UNEXPECTED RETURN CODE FROM LPAM OPEN STREET CALL' DTSBR611 00344 TO ABEND-MSG DTSBR611 00345 PERFORM S999-ABEND THRU S999-EXIT. DTSBR611 00346 DTSBR611 00347 MOVE LOW-VALUES TO WRK-FLD-REP-AREA DTSBR611 00348 WRK-ZIP-AREA. DTSBR611 00349 DTSBR611 00350 I1000-EXIT. DTSBR611 00351 EXIT. DTSBR611 00352 DTSBR611 00353 P1000-PROCESS. DTSBR611 00354 DTSBR611 00355 IF R611-FIELD-ASSIGN-ZIP-1-5 NOT = WRK-ZIP DTSBR611 00356 MOVE R611-FIELD-ASSIGN-ZIP-1-5 TO WRK-ZIP DTSBR611 00357 DTSBR611 00358 IF WS-NUMBER-ONE = +0 DTSBR611 00359 MOVE +99 TO WS-NUMBER-ONE DTSBR611 00360 ELSE DTSBR611 00361 PERFORM P3000-PRINT-CFZ-LINE THRU P3000-EXIT DTSBR611 00362 END-IF. DTSBR611 00363 DTSBR611 00364 IF R611-FIELD-REP-ID NOT = WRK-FLD-REP-ID DTSBR611 00365 MOVE R611-FIELD-REP-ID TO WRK-FLD-REP-ID PREV-FLD-REP-ID DTSBR611 00366 PERFORM S1100-FLD-REP-ID-BREAK THRU S1100-EXIT DTSBR611 00367 DTSBR611 00368 IF WS-NUMBER-TWO = +0 DTSBR611 00369 MOVE +99 TO WS-NUMBER-TWO DTSBR611 00370 ELSE DTSBR611 00371 PERFORM P4000-PRINT-CFN-LINE THRU P4000-EXIT DTSBR611 00372 END-IF. DTSBR611 00373 DTSBR611 00374 PERFORM P2000-PRINT-HEADER THRU P2000-EXIT. DTSBR611 00375 PERFORM S1200-ZIP-BREAK THRU S1200-EXIT DTSBR611 00376 DTSBR611 00377 ADD +1 TO WRK-ZIP-CNT. DTSBR611 00378 ADD +1 TO WRK-NAME-ZIP-CNT. DTSBR611 00379 ADD +1 TO WRK-TOTAL-CNT. DTSBR611 00380 DTSBR611 00381 P1000-EXIT. DTSBR611 00382 EXIT. DTSBR611 00383 DTSBR611 00384 P2000-PRINT-HEADER. DTSBR611 00385 DTSBR611 00386 IF WS-LINE-CNT GREATER 54 OR DTSBR611 00387 WS-LINE-CNT2 GREATER 54 DTSBR611 00388 MOVE +0 TO WS-LINE-CNT DTSBR611 00389 MOVE +0 TO WS-LINE-CNT2 DTSBR611 00390 ADD +1 TO WS-PAGE-CNT DTSBR611 00391 MOVE WS-PAGE-CNT TO HDR-PAGE-CNT DTSBR611 00392 WRITE REPORT-LISTING1 FROM HDR-LINE-1 DTSBR611 00393 AFTER TOP-OF-PAGE DTSBR611 00394 WRITE REPORT-LISTING1 FROM HDR-LINE-2 AFTER 1 DTSBR611 00395 WRITE REPORT-LISTING1 FROM HDR-LINE-3 AFTER 1 DTSBR611 00396 WRITE REPORT-LISTING1 FROM HDR-LINE-4 AFTER 1 DTSBR611 00397 WRITE REPORT-LISTING1 FROM HDR-LINE-5 AFTER 1 DTSBR611 00398 WRITE REPORT-LISTING1 FROM HDR-LINE-6 AFTER 1 DTSBR611 00399 WRITE REPORT-LISTING1 FROM HDR-LINE-7 AFTER 1 DTSBR611 00400 WRITE REPORT-LISTING1 FROM HDR-LINE-8 AFTER 1 DTSBR611 00401 WRITE REPORT-LISTING1 FROM HDR-LINE-9 AFTER 1 DTSBR611 00402 WRITE REPORT-LISTING1 FROM HDR-LINE-10 AFTER 1 DTSBR611 00403 WRITE REPORT-LISTING1 FROM HDR-LINE-11 AFTER 1 DTSBR611 00404 ADD +11 TO WS-LINE-CNT2. DTSBR611 00405 DTSBR611 00406 P2000-EXIT. DTSBR611 00407 EXIT. DTSBR611 00408 DTSBR611 00409 P3000-PRINT-CFZ-LINE. DTSBR611 00410 DTSBR611 00411 * IF R611-FIELD-REP-ID NOT = CFZ-FLD-REP-ID DTSBR611 00412 IF PREV-FLD-REP-ID NOT = CFZ-FLD-REP-ID DTSBR611 00413 MOVE PREV-FLD-REP-ID TO CFZ-FLD-REP-ID DTSBR611 00414 MOVE PREV-FLD-REP-NAME TO CFZ-FLD-REP-NAME DTSBR611 00415 ELSE DTSBR611 00416 MOVE SPACES TO CFZ-FLD-REP-ID CFZ-FLD-REP-NAME. DTSBR611 00417 DTSBR611 00418 IF WS-LINE-CNT2 = +11 DTSBR611 00419 MOVE R611-FIELD-REP-ID TO CFZ-FLD-REP-ID DTSBR611 00420 MOVE PREV-FLD-REP-NAME TO CFZ-FLD-REP-NAME. DTSBR611 00421 DTSBR611 00422 MOVE PREV-ZIP TO CFZ-ZIP. DTSBR611 00423 MOVE WRK-ZIP-CNT TO CFZ-ZIP-CNT. DTSBR611 00424 MOVE PREV-CITY TO CFZ-CITY. DTSBR611 00425 DTSBR611 00426 WRITE REPORT-LISTING1 FROM CFZ-LINE-1 AFTER 1. DTSBR611 00427 MOVE PREV-FLD-REP-ID TO CFZ-FLD-REP-ID DTSBR611 00428 MOVE +0 TO WRK-ZIP-CNT. DTSBR611 00429 ADD +1 TO WS-LINE-CNT2. DTSBR611 00430 DTSBR611 00431 P3000-EXIT. DTSBR611 00432 EXIT. DTSBR611 00433 DTSBR611 00434 P4000-PRINT-CFN-LINE. DTSBR611 00435 IF WS-LINE-CNT2 > 52 DTSBR611 00436 PERFORM P2000-PRINT-HEADER THRU P2000-EXIT DTSBR611 00437 END-IF. DTSBR611 00438 DTSBR611 00439 MOVE WRK-NAME-ZIP-CNT TO CFN-NAME-ZIP-CNT. DTSBR611 00440 DTSBR611 00441 WRITE REPORT-LISTING1 FROM CFN-LINE-2 AFTER 2. DTSBR611 00442 MOVE +0 TO WRK-NAME-ZIP-CNT. DTSBR611 00443 ADD +2 TO WS-LINE-CNT2. DTSBR611 00444 WRITE REPORT-LISTING1 FROM WS-BLANK-LINE AFTER 3. DTSBR611 00445 ADD +3 TO WS-LINE-CNT2. DTSBR611 00446 DTSBR611 00447 P4000-EXIT. DTSBR611 00448 EXIT. DTSBR611 00449 DTSBR611 00450 T1000-TERMINATE. DTSBR611 00451 DTSBR611 00452 PERFORM P3000-PRINT-CFZ-LINE THRU P3000-EXIT. DTSBR611 00453 PERFORM P4000-PRINT-CFN-LINE THRU P4000-EXIT. DTSBR611 00454 MOVE WRK-TOTAL-CNT TO CFF-TOTAL-CNT. DTSBR611 00455 WRITE REPORT-LISTING1 FROM CFF-LINE-1 AFTER 1. DTSBR611 00456 DTSBR611 00457 CLOSE PRT-FILE. DTSBR611 00458 DTSBR611 00459 CALL LPAM-MODULE-NAME DTSBR611 00460 USING LPAM-CLOSE-FUNCTION DTSBR611 00461 LPAM-ANCHOR-AREA DTSBR611 00462 LPAM-RETURN-CODE DTSBR611 00463 LPAM-ERROR-AREA DTSBR611 00464 LPAM-STREET-FILE-RCB. DTSBR611 00465 DTSBR611 00466 CALL LPAM-MODULE-NAME DTSBR611 00467 USING LPAM-TERM-FUNCTION DTSBR611 00468 LPAM-ANCHOR-AREA DTSBR611 00469 LPAM-RETURN-CODE DTSBR611 00470 LPAM-ERROR-AREA. DTSBR611 00471 T1000-EXIT. DTSBR611 00472 EXIT. DTSBR611 00473 DTSBR611 00474 DTSBR611 00475 S1100-FLD-REP-ID-BREAK. DTSBR611 00476 DTSBR611 00477 MOVE R611-FIELD-REP-ID TO L062-FLD-REP-ID DTSBR611 00478 DTSBR611 00479 PERFORM S062-FLD-REP-DSCR THRU S062-EXIT. DTSBR611 00480 DTSBR611 00481 MOVE L062-NAME TO WRK-FLD-REP-NAME. DTSBR611 00482 MOVE L062-NAME TO PREV-FLD-REP-NAME. DTSBR611 00483 DTSBR611 00484 S1100-EXIT. DTSBR611 00485 EXIT. DTSBR611 00486 DTSBR611 00487 S1200-ZIP-BREAK. DTSBR611 00488 MOVE SPACES TO WRK-CITY DTSBR611 00489 WRK-COUNTY-CODE. DTSBR611 00490 DTSBR611 00491 MOVE R611-FIELD-ASSIGN-ZIP-1-5 TO WRK-ZIP. DTSBR611 00492 MOVE R611-FIELD-ASSIGN-ZIP-1-5 TO PREV-ZIP. DTSBR611 00493 DTSBR611 00494 MOVE LOW-VALUES TO LPAM-GETZIP-INPUT. DTSBR611 00495 MOVE WRK-ZIP TO LPAM-GETZIP-TARGET-ZIP. DTSBR611 00496 MOVE 'FIRST' TO LPAM-GETZIP-TARGET-IND. DTSBR611 00497 MOVE 1 TO LPAM-GETZIP-REPLICATION. DTSBR611 00498 DTSBR611 00499 CALL LPAM-MODULE-NAME DTSBR611 00500 USING LPAM-GETZIP-FUNCTION DTSBR611 00501 LPAM-ANCHOR-AREA DTSBR611 00502 LPAM-RETURN-CODE DTSBR611 00503 LPAM-ERROR-AREA DTSBR611 00504 LPAM-STREET-FILE-RCB DTSBR611 00505 LPAM-GETZIP-INPUT DTSBR611 00506 LPAM-GETZIP-OUTPUT. DTSBR611 00507 DTSBR611 00508 IF LPAM-RETURN-CODE = '00' DTSBR611 00509 STRING LPAM-GETZIP-RCITY DELIMITED BY ' ' DTSBR611 00510 ', ' DELIMITED BY SIZE DTSBR611 00511 R611-FIELD-ASSIGN-ST DELIMITED BY SIZE DTSBR611 00512 INTO WRK-CITY DTSBR611 00513 MOVE WRK-CITY TO PREV-CITY DTSBR611 00514 MOVE LPAM-GETZIP-RCITY TO WRK-CITY DTSBR611 00515 MOVE LPAM-GETZIP-RCNTY TO WRK-COUNTY-CODE DTSBR611 00516 ELSE DTSBR611 00517 IF LPAM-RETURN-CODE = '04' DTSBR611 00518 NEXT SENTENCE DTSBR611 00519 ELSE DTSBR611 00520 MOVE 'UNEXPECTED RETURN CODE FROM LPAM GETZIP CALL' DTSBR611 00521 TO ABEND-MSG DTSBR611 00522 PERFORM S999-ABEND THRU S999-EXIT. DTSBR611 00523 DTSBR611 00524 S1200-EXIT. DTSBR611 00525 EXIT. DTSBR611 00526 DTSBR611 00527 S062-FLD-REP-DSCR. DTSBR611 00528 DTSBR611 00529 CALL 'DTSBU062' USING L062-LINK-AREA. DTSBR611 00530 DTSBR611 00531 S062-EXIT. DTSBR611 00532 EXIT. DTSBR611 00533 DTSBR611 00534 S999-ABEND. DTSBR611 00535 DTSBR611 00536 DISPLAY '***'. DTSBR611 00537 DISPLAY '*** ' DTSBR611 00538 ABEND-MSG. DTSBR611 00539 DISPLAY '***'. DTSBR611 00540 DISPLAY '*** ' DTSBR611 00541 LPAM-ERROR-AREA. DTSBR611 00542 DTSBR611 00543 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBR611 00544 DTSBR611 00545 S999-EXIT. DTSBR611 00546 EXIT. DTSBR611 00547 DTSBR611