00001  IDENTIFICATION DIVISION.                                         08/02/02
00002  PROGRAM-ID.             DTSBE611.                                DTSBE611
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV029
00004  DATE-WRITTEN.           AUGUST 1994.                             DTSBE611
00005  DATE-COMPILED.                                                   DTSBE611
00006                                                                   DTSBE611
00007 *****                                                             DTSBE611
00008 *                                                                 DTSBE611
00009 *    FUNCTION:  ACTIVE EMPLOYERS BY ZIP CODE COUNTS.              DTSBE611
00010 *                                                                 DTSBE611
00011 *                                                                 DTSBE611
00012 *    MODIFICATION LOG:                                            DTSBE611
00013 *                                                                 DTSBE611
00014 *    12/15/98  MODIFIED TO MEET DUTAS PROGRAMMING SPECIFICATIONS. DTSBE611
00015 *              WORK ORDER:                      PROGRAMMER: DVS   DTSBE611
00016 *                                                                 DTSBE611
00017 *    XX/XX/XX  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBE611
00018 *              XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBE611
00019 *              WORK ORDER:                      PROGRAMMER: XXX   DTSBE611
00020 *                                                                 DTSBE611
00021 *                                                                 DTSBE611
00022 *  DESCRIPTION:                                                   DTSBE611
00023 *                                                                 DTSBE611
00024 *                                                                 DTSBE611
00025 *    INITIATION:                                                  DTSBE611
00026 *                                                                 DTSBE611
00027 *      SET LECM-MST-OPEN-READ-88 TO TRUE.                         DTSBE611
00028 *      SET LECM-REF-OPEN-READ-88 TO TRUE.                         DTSBE611
00029 *                                                                 DTSBE611
00030 *      EDIT PARAMETERS.  START ZIP CODE AND END ZIP CODE          DTSBE611
00031 *      DEFAULT VALUES ARE 20000 AND 29999.                        DTSBE611
00032 *                                                                 DTSBE611
00033 *                                                                 DTSBE611
00034 *    PROCESSING:                                                  DTSBE611
00035 *                                                                 DTSBE611
00036 *      SEE PRINTED OUTPUTS DESCRIPTION AND LAYOUTS (611R1).       DTSBE611
00037 *                                                                 DTSBE611
00038 *                                                                 DTSBE611
00039 *    TERMINATION:                                                 DTSBE611
00040 *                                                                 DTSBE611
00041 *      NONE.                                                      DTSBE611
00042 *                                                                 DTSBE611
00043 *                                                                 DTSBE611
00044 *    RECORDS READ:                                                DTSBE611
00045 *                                                                 DTSBE611
00046 *      MASTER:                                                    DTSBE611
00047 *                                                                 DTSBE611
00048 *        MTAD                                                     DTSBE611
00049 *                                                                 DTSBE611
00050 *                                                                 DTSBE611
00051 *      ALTERNATE INDEX:                                           DTSBE611
00052 *                                                                 DTSBE611
00053 *        NONE.                                                    DTSBE611
00054 *                                                                 DTSBE611
00055 *                                                                 DTSBE611
00056 *      REFERENCE:                                                 DTSBE611
00057 *                                                                 DTSBE611
00058 *        NONE.                                                    DTSBE611
00059 *                                                                 DTSBE611
00060 *                                                                 DTSBE611
00061 *    RECORDS UPDATED:                                             DTSBE611
00062 *                                                                 DTSBE611
00063 *        NONE.                                                    DTSBE611
00064 *                                                                 DTSBE611
00065 *                                                                 DTSBE611
00066 *    REPORT RECORDS WRITTEN:                                      DTSBE611
00067 *                                                                 DTSBE611
00068 *        R611  ACTIVE EMPLOYERS BY ZIP CODE COUNTS.               DTSBE611
00069 *                                                                 DTSBE611
00070 *                                                                 DTSBE611
00071 *    BATCH TRANSACTION COLLECTION RECORDS WRITTEN:                DTSBE611
00072 *                                                                 DTSBE611
00073 *        NONE.                                                    DTSBE611
00074 *                                                                 DTSBE611
00075 *                                                                 DTSBE611
00076 *    MODULES CALLED:                                              DTSBE611
00077 *                                                                 DTSBE611
00078 *        DTSBU001  DATE CONVERSION/EDIT.                          DTSBE611
00079 *        DTSBU004  QUARTER EDIT/CONVERSION.                       DTSBE611
00080 *        DTSBU910  MASTER FILE I/O.                               DTSBE611
00081 *        DTSBU946  VARIABLE LENGTH RECORDS SEQUENTIAL OUTPUT 1.   DTSBE611
00082 *                                                                 DTSBE611
00083 *                                                                 DTSBE611
00084 *    VERMONT REFERENCE:                                           DTSBE611
00085 *                                                                 DTSBE611
00086 *        TXBE364                                                  DTSBE611
00087 *                                                                 DTSBE611
00088 *****                                                             DTSBE611
00089                                                                   DTSBE611
00090  ENVIRONMENT DIVISION.                                            DTSBE611
00091                                                                   DTSBE611
00092  DATA DIVISION.                                                   DTSBE611
00093                                                                   DTSBE611
00094  WORKING-STORAGE SECTION.                                         DTSBE611
000945 77  PAN-VALET PICTURE X(24) VALUE '029DTSBE611  08/02/02'.       DTSBE611
00095                                                                   DTSBE611
00096  01  WRK-AREA.                                                    DTSBE611
00097      05  WS-RECORD-CNT               PIC  9(04)        VALUE  0.  DTSBE611
00098                                                                   DTSBE611
00099      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +611.DTSBE611
00100                                                                   DTSBE611
00101      05  WRK-MOD-NAME                PIC  X(08)  VALUE 'DTSBE611'.DTSBE611
00102                                                                   DTSBE611
00103                                                                   DTSBE611
00104                                                                   DTSBE611
00105      EJECT                                                        DTSBE611
00106  01  MSG-AREA.                                                    DTSBE611
00107      05  MSG1-TEXT.                                               DTSBE611
00108          10  FILLER                      PIC  X(40)               DTSBE611
00109                VALUE '                                        '.  DTSBE611
00110          10  FILLER                      PIC  X(40)               DTSBE611
00111                VALUE '                                        '.  DTSBE611
00112      EJECT                                                        DTSBE611
00113 *01  L001-LINK-AREA.                                              DTSBE611
00114 *****COPY DTSIL001.                                               DTSBE611
00115 *****EJECT                                                        DTSBE611
00116 *01  L004-LINK-AREA.                                              DTSBE611
00117 *****COPY DTSIL004.                                               DTSBE611
00118      EJECT                                                        DTSBE611
00119  01  L061-LINK-AREA.                                              DTSBE611
00120  ++INCLUDE DTSIL061                                               DTSBE611
00121      EJECT                                                        DTSBE611
00122  01  L910-LINK-AREA.                                              DTSBE611
00123  ++INCLUDE DTSIL910                                               DTSBE611
00124                                                                   DTSBE611
00125  01  MSKL-REC.                                                    DTSBE611
00126  ++INCLUDE DTSIMSKL                                               DTSBE611
00127                                                                   DTSBE611
00128 *01  MTAD-REC.                                                    DTSBE611
00129 *++INCLUDE DTSIMTAD                                               DTSBE611
00130 *    EJECT                                                        DTSBE611
00131  01  R611-REC.                                                    DTSBE611
00132  ++INCLUDE DTSIR611                                               DTSBE611
00133      EJECT                                                        DTSBE611
00134  ++INCLUDE OJRWE611                                               DTSBE611
00135      EJECT                                                        DTSBE611
00136  LINKAGE SECTION.                                                 DTSBE611
00137                                                                   DTSBE611
00138  01  LECM-LINK-AREA.                                              DTSBE611
00139  ++INCLUDE DTSILECM                                               DTSBE611
00140                                                                   DTSBE611
00141          10  FILLER REDEFINES LECM-EXTRACT-PARMS.                 DTSBE611
00142              15  LECM-PARM-START-ZIP-CODE        PIC  X(05).      DTSBE611
00143              15  FILLER                          PIC  X(01).      DTSBE611
00144              15  LECM-PARM-END-ZIP-CODE          PIC  X(05).      DTSBE611
00145              15  FILLER                          PIC  X(01).      DTSBE611
00146              15  LECM-PARM-STATE-CODE            PIC  X(02).      DTSBE611
00147              15  FILLER                          PIC X(54).       DTSBE611
00148      EJECT                                                        DTSBE611
00149  01  MPRF-LINK-REC.                                               DTSBE611
00150  ++INCLUDE DTSIMPRF                                               DTSBE611
00151      EJECT                                                        DTSBE611
00152  PROCEDURE DIVISION USING LECM-LINK-AREA                          DTSBE611
00153                           MPRF-LINK-REC.                          DTSBE611
00154      EVALUATE TRUE                                                DTSBE611
00155      WHEN LECM-PROCESS-88                                         DTSBE611
00156          PERFORM P0000-PROCESS                                    DTSBE611
00157             THRU P0000-EXIT                                       DTSBE611
00158                                                                   DTSBE611
00159          WHEN LECM-INITIALIZE-88                                  DTSBE611
00160              SET WRK-EDIT-PASSED-88 TO TRUE                       DTSBE611
00161              PERFORM I0000-INITIALIZE                             DTSBE611
00162                 THRU I0000-EXIT                                   DTSBE611
00163                 IF WRK-EDIT-FAILED-88                             DTSBE611
00164                    PERFORM S999-ABEND                             DTSBE611
00165                     THRU S999-EXIT                                DTSBE611
00166          END-IF                                                   DTSBE611
00167                                                                   DTSBE611
00168              WHEN LECM-TERMINATE-88                               DTSBE611
00169                  PERFORM T0000-TERMINATE                          DTSBE611
00170                     THRU T0000-EXIT                               DTSBE611
00171              WHEN OTHER                                           DTSBE611
00172                  MOVE 'INVALID LECM-CALL-TYPE-IND ENCOUNTERED'    DTSBE611
00173                    TO ABEND-MSG                                   DTSBE611
00174                  PERFORM S999-ABEND                               DTSBE611
00175                     THRU S999-EXIT.                               DTSBE611
00176                                                                   DTSBE611
00177 *    DISPLAY ' RECORD CNT ' WS-RECORD-CNT.                        DTSBE611
00178                                                                   DTSBE611
00179      GOBACK.                                                      DTSBE611
00180      EJECT                                                        DTSBE611
00181  I0000-INITIALIZE.                                                DTSBE611
00182                                                                   DTSBE611
00183      MOVE LENGTH OF R611-REC TO R611-LENGTH.                      DTSBE611
00184      MOVE '611'              TO R611-REC-TYPE.                    DTSBE611
00185                                                                   DTSBE611
00186      MOVE LECM-PARM-START-ZIP-CODE TO                             DTSBE611
00187                  OJR-PARM-START-ZIP-CODE.                         DTSBE611
00188      MOVE LECM-PARM-END-ZIP-CODE TO                               DTSBE611
00189                  OJR-PARM-END-ZIP-CODE.                           DTSBE611
00190      MOVE LECM-PARM-STATE-CODE TO                                 DTSBE611
00191                  OJR-PARM-STATE-CODE.                             DTSBE611
00192                                                                   DTSBE611
00193      MOVE LECM-TRACE-IND TO L910-TRACE-IND.                       DTSBE611
00194      MOVE WRK-MOD-NAME TO L910-MOD-NAME.                          DTSBE611
00195                                                                   DTSBE611
00196      PERFORM I1000-EDIT-AND-DEFAULT-PARMS                         DTSBE611
00197         THRU I1000-EXIT.                                          DTSBE611
00198                                                                   DTSBE611
00199      SET LECM-MST-OPEN-READ-88 TO TRUE.                           DTSBE611
00200      SET LECM-REF-OPEN-READ-88 TO TRUE.                           DTSBE611
00201                                                                   DTSBE611
00202  I0000-EXIT.                                                      DTSBE611
00203      EXIT.                                                        DTSBE611
00204                                                                   DTSBE611
00205  ++INCLUDE OJRPE611                                               DTSBE611
00206                                                                   DTSBE611
00207  P0000-PROCESS.                                                   DTSBE611
00208      IF  MPRF-STATUS-ACT-88                                       DTSBE611
00209      AND MPRF-CLASS-SUB-88                                        DTSBE611
00210          NEXT SENTENCE                                            DTSBE611
00211      ELSE                                                         DTSBE611
00212          GO TO P0000-EXIT.                                        DTSBE611
00213                                                                   DTSBE611
00214      IF WRK-PARM-ST-IND-88                                        DTSBE611
00215 *        DISPLAY 'WRK-IND ' WRK-PARM-SELECTION-IND                DTSBE611
00216          IF MPRF-FLD-ST NOT = WRK-PARM-STATE-CODE                 DTSBE611
00217              GO TO P0000-EXIT                                     DTSBE611
00218          END-IF                                                   DTSBE611
00219      ELSE                                                         DTSBE611
00220 *        DISPLAY 'WRK-IND-A ' WRK-PARM-SELECTION-IND              DTSBE611
00221          IF MPRF-FLD-ZIP (1:5) < WRK-PARM-START-ZIP-CODE          DTSBE611
00222          OR MPRF-FLD-ZIP (1:5) > WRK-PARM-END-ZIP-CODE            DTSBE611
00223              GO TO P0000-EXIT.                                    DTSBE611
00224                                                                   DTSBE611
00225      ADD 1 TO WS-RECORD-CNT.                                      DTSBE611
00226                                                                   DTSBE611
00227      PERFORM S061-DETERMINE-FLD-REP                               DTSBE611
00228         THRU S061-EXIT.                                           DTSBE611
00229                                                                   DTSBE611
00230      MOVE L061-FLD-REP-ID TO R611-FIELD-REP-ID.                   DTSBE611
00231                                                                   DTSBE611
00232      MOVE MPRF-FLD-ZIP    TO R611-FIELD-ASSIGN-ZIP-1-5.           DTSBE611
00233                                                                   DTSBE611
00234      MOVE MPRF-FLD-ST     TO R611-FIELD-ASSIGN-ST                 DTSBE611
00235                                                                   DTSBE611
00236      IF L061-TERRITORY-IND = 'S'                                  DTSBE611
00237          SET R611-ST  TO TRUE                                     DTSBE611
00238      ELSE                                                         DTSBE611
00239          SET R611-ZIP TO TRUE.                                    DTSBE611
00240                                                                   DTSBE611
00241 *    MOVE SPACES TO R611-CITY.                                    DTSBE611
00242 *                                                                 DTSBE611
00243 *    MOVE LOW-VALUES TO MTAD-KEY-AREA.                            DTSBE611
00244 *    MOVE MPRF-EMP-NO TO MTAD-EMP-NO.                             DTSBE611
00245 *    SET MTAD-TAD-88 TO TRUE.                                     DTSBE611
00246 *    MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA.                         DTSBE611
00247 *    PERFORM S910-START-BROWSE THRU S910-EXIT.                    DTSBE611
00248 *    PERFORM P1000-SCAN-MTAD THRU P1000-EXIT                      DTSBE611
00249 *        UNTIL L910-NO-REC-88.                                    DTSBE611
00250                                                                   DTSBE611
00251      PERFORM S946-WRITE-R611                                      DTSBE611
00252         THRU S946-EXIT.                                           DTSBE611
00253  P0000-EXIT.                                                      DTSBE611
00254      EXIT.                                                        DTSBE611
00255                                                                   DTSBE611
00256 *P1000-SCAN-MTAD.                                                 DTSBE611
00257 *    MOVE MSKL-REC TO MTAD-REC.                                   DTSBE611
00258 *                                                                 DTSBE611
00259 *    IF R611-FIELD-ASSIGN-ZIP-1-5 = MTAD-ZIP (1:5)                DTSBE611
00260 *        MOVE MTAD-CITY TO R611-CITY                              DTSBE611
00261 *        SET L910-NO-REC-88 TO TRUE                               DTSBE611
00262 *        GO TO P1000-EXIT.                                        DTSBE611
00263 *                                                                 DTSBE611
00264 *    PERFORM S910-READ-NEXT THRU S910-EXIT.                       DTSBE611
00265 *P1000-EXIT.                                                      DTSBE611
00266 *    EXIT.                                                        DTSBE611
00267      EJECT                                                        DTSBE611
00268  T0000-TERMINATE.                                                 DTSBE611
00269                                                                   DTSBE611
00270      DISPLAY ' DTSBE611 TERMINATION '.                            DTSBE611
00271                                                                   DTSBE611
00272  T0000-EXIT.                                                      DTSBE611
00273      EXIT.                                                        DTSBE611
00274      EJECT                                                        DTSBE611
00275 *S001-FROM-FED-8.                                                 DTSBE611
00276 *****SET L001-FROM-FED-8 TO TRUE.                                 DTSBE611
00277 *****GO TO S001-DATE.                                             DTSBE611
00278 *****                                                             DTSBE611
00279 *S001-FROM-CAL-6.                                                 DTSBE611
00280 *****SET L001-FROM-CAL-6 TO TRUE.                                 DTSBE611
00281 *****GO TO S001-DATE.                                             DTSBE611
00282 *****                                                             DTSBE611
00283 *S001-FROM-ABS-DAY.                                               DTSBE611
00284 *****SET L001-FROM-ABS-DAY TO TRUE.                               DTSBE611
00285 *****GO TO S001-DATE.                                             DTSBE611
00286 *****                                                             DTSBE611
00287 *S001-DATE.                                                       DTSBE611
00288 *****CALL 'DTSBU001' USING L001-LINK-AREA.                        DTSBE611
00289 *S001-EXIT.                                                       DTSBE611
00290 *****EXIT.                                                        DTSBE611
00291                                                                   DTSBE611
00292 *S004-FROM-5.                                                     DTSBE611
00293 *****SET L004-FROM-5 TO TRUE.                                     DTSBE611
00294 *****GO TO S004-QTR.                                              DTSBE611
00295 *****                                                             DTSBE611
00296 *S004-FROM-ABS.                                                   DTSBE611
00297 *****SET L004-FROM-ABS TO TRUE.                                   DTSBE611
00298 *****GO TO S004-QTR.                                              DTSBE611
00299 *****                                                             DTSBE611
00300 *S004-FROM-3.                                                     DTSBE611
00301 *****SET L004-FROM-3 TO TRUE.                                     DTSBE611
00302 *****GO TO S004-QTR.                                              DTSBE611
00303 *****                                                             DTSBE611
00304 *S004-QTR.                                                        DTSBE611
00305 *****                                                             DTSBE611
00306 *****CALL 'DTSBU004' USING L004-LINK-AREA.                        DTSBE611
00307 *****                                                             DTSBE611
00308 *S004-EXIT.                                                       DTSBE611
00309 *****EXIT.                                                        DTSBE611
00310                                                                   DTSBE611
00311  S061-DETERMINE-FLD-REP.                                          DTSBE611
00312      MOVE MPRF-FLD-ZIP TO L061-FLD-ZIP.                           DTSBE611
00313      MOVE MPRF-FLD-ST  TO L061-FLD-ST.                            DTSBE611
00314      MOVE MPRF-EMP-NO  TO L061-EMP-NO.                            DTSBE611
00315                                                                   DTSBE611
00316      CALL 'DTSBU061' USING L061-LINK-AREA.                        DTSBE611
00317  S061-EXIT.                                                       DTSBE611
00318      EXIT.                                                        DTSBE611
00319                                                                   DTSBE611
00320 *S910-READ.                                                       DTSBE611
00321 **   SET L910-READ-88 TO TRUE.                                    DTSBE611
00322 **   GO TO S910-MSTR-IO.                                          DTSBE611
00323                                                                   DTSBE611
00324 *S910-START-BROWSE.                                               DTSBE611
00325 **   SET L910-START-BROWSE-88 TO TRUE.                            DTSBE611
00326 **   GO TO S910-MSTR-IO.                                          DTSBE611
00327                                                                   DTSBE611
00328 *S910-READ-NEXT.                                                  DTSBE611
00329 **   SET L910-READ-NEXT-88 TO TRUE.                               DTSBE611
00330 **   GO TO S910-MSTR-IO.                                          DTSBE611
00331                                                                   DTSBE611
00332 *S910-COUNT.                                                      DTSBE611
00333 **   SET L910-COUNT-88 TO TRUE.                                   DTSBE611
00334 **   GO TO S910-MSTR-IO.                                          DTSBE611
00335                                                                   DTSBE611
00336 *S910-MSTR-IO.                                                    DTSBE611
00337 **   CALL 'DTSBU910' USING L910-LINK-AREA                         DTSBE611
00338 **                         MSKL-REC.                              DTSBE611
00339 *S910-EXIT.                                                       DTSBE611
00340 **   EXIT.                                                        DTSBE611
00341                                                                   DTSBE611
00342  S946-WRITE-R611.                                                 DTSBE611
00343      CALL 'DTSBU946' USING R611-REC.                              DTSBE611
00344      GO TO S946-EXIT.                                             DTSBE611
00345                                                                   DTSBE611
00346  S946-EXIT.                                                       DTSBE611
00347      EXIT.                                                        DTSBE611
00348                                                                   DTSBE611
00349  S999-ABEND.                                                      DTSBE611
00350      DISPLAY '*** DTSBE611 ABENDING.  '                           DTSBE611
00351              ABEND-MSG.                                           DTSBE611
00352                                                                   DTSBE611
00353      CALL 'DTSBU999' USING WRK-ABEND-CD.                          DTSBE611
00354  S999-EXIT.                                                       DTSBE611
00355      EXIT.                                                        DTSBE611
