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
