00001  IDENTIFICATION DIVISION.                                         11/22/04
00002  PROGRAM-ID.             DTSBD991.                                DTSBD991
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV004
00004  DATE-WRITTEN.           OCTOBER 1992.                            DTSBD991
00005  DATE-COMPILED.                                                   DTSBD991
00006      SKIP3                                                        DTSBD991
00007 *****                                                             DTSBD991
00008 *                                                                 DTSBD991
00009 *    FUNCTION:  EXTRACT PARAMETER SPECIFIED RANGES OF EMPLOYER    DTSBD991
00010 *               FROM THE MASTER FILE.                             DTSBD991
00011 *                                                                 DTSBD991
00012 *    *********  THIS VERSION IS USED FOR THE DIVISION  *******    DTSBD991
00013 *    *********  OF THE MSTB FILE. IT CALLS DTSBU911    *******    DTSBD991
00014 *    *********  (THE ORIGINAL VERSION OF THE I-O       *******    DTSBD991
00015 *    *********  MODULE) INSTEAD OF DTSBU910            *******    DTSBD991
00016 *                                                                 DTSBD991
00017 *    MODIFICATION LOG:                                            DTSBD991
00018 *                                                                 DTSBD991
00019 *    10/08/92  INITIAL DEVELOPMENT.      COPIED FROM MACBD991     DTSBD991
00020 *              WORK ORDER:                      PROGRAMMER: ZL1   DTSBD991
00021 *                                                                 DTSBD991
00022 *    XX/XX/XX  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBD991
00023 *              XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBD991
00024 *              REFERENCE RFP: #XXX              PROGRAMMER: XXX   DTSBD991
00025 *                                                                 DTSBD991
00026 *                                                                 DTSBD991
00027 *  DESCRIPTION:                                                   DTSBD991
00028 *                                                                 DTSBD991
00029 *****                                                             DTSBD991
00030      SKIP3                                                        DTSBD991
00031  ENVIRONMENT DIVISION.                                            DTSBD991
00032      SKIP2                                                        DTSBD991
00033  INPUT-OUTPUT SECTION.                                            DTSBD991
00034      SKIP1                                                        DTSBD991
00035  FILE-CONTROL.                                                    DTSBD991
00036      SELECT PARM-FILE ASSIGN TO SYSIN.                            DTSBD991
00037      EJECT                                                        DTSBD991
00038  DATA DIVISION.                                                   DTSBD991
00039      SKIP3                                                        DTSBD991
00040  FILE SECTION.                                                    DTSBD991
00041      SKIP2                                                        DTSBD991
00042  FD  PARM-FILE                                                    DTSBD991
00043      RECORDING MODE IS F                                          DTSBD991
00044      BLOCK CONTAINS 0 RECORDS                                     DTSBD991
00045      LABEL RECORDS ARE STANDARD.                                  DTSBD991
00046      SKIP1                                                        DTSBD991
00047  01  PARM-REC.                                                    DTSBD991
00048      05  PREC-ID-NO                      PIC  X(03).              DTSBD991
00049      05  FILLER                          PIC  X(01).              DTSBD991
00050      05  PREC-START-EMP-NO-X             PIC  X(06).              DTSBD991
00051      05  PREC-START-EMP-NO REDEFINES PREC-START-EMP-NO-X          DTSBD991
00052                                          PIC  9(06).              DTSBD991
00053      05  FILLER                          PIC  X(01).              DTSBD991
00054      05  PREC-END-EMP-NO-X               PIC  X(06).              DTSBD991
00055      05  PREC-END-EMP-NO REDEFINES PREC-END-EMP-NO-X              DTSBD991
00056                                          PIC  9(06).              DTSBD991
00057      05  FILLER                          PIC  X(63).              DTSBD991
00058      EJECT                                                        DTSBD991
00059  WORKING-STORAGE SECTION.                                         DTSBD991
000595 77  PAN-VALET PICTURE X(24) VALUE '004DTSBD991  11/22/04'.       DTSBD991
00060      SKIP3                                                        DTSBD991
00061  01  WRK-AREA.                                                    DTSBD991
00062      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +991.DTSBD991
00063                                                                   DTSBD991
00064      05  PARM-REC-CNT                PIC S9(07)  COMP-3.          DTSBD991
00065                                                                   DTSBD991
00066      05  PARM-EMP-EXT-CNT            PIC S9(07)  COMP-3.          DTSBD991
00067                                                                   DTSBD991
00068      05  TOT-EMP-EXT-CNT             PIC S9(07)  COMP-3.          DTSBD991
00069                                                                   DTSBD991
00070      05  PARM-EOF-IND                    PIC  X(01).              DTSBD991
00071                                                                   DTSBD991
00072      05  WRK-START-EMP-NO                PIC S9(07)  COMP-3.      DTSBD991
00073                                                                   DTSBD991
00074      05  WRK-END-EMP-NO                  PIC S9(07)  COMP-3.      DTSBD991
00075                                                                   DTSBD991
00076      05  WRK-REC-TYPE                    PIC S9(04)  COMP.        DTSBD991
00077      EJECT                                                        DTSBD991
00078  01  L910-LINK-AREA.                                              DTSBD991
00079  ++INCLUDE DTSIL910                                               DTSBD991
00080      EJECT                                                        DTSBD991
00081  01  MSKL-REC.                                                    DTSBD991
00082  ++INCLUDE DTSIMSKL                                               DTSBD991
00083      EJECT                                                        DTSBD991
00084  01  MHDR-REC.                                                    DTSBD991
00085  ++INCLUDE DTSIMHDR                                               DTSBD991
00086      EJECT                                                        DTSBD991
00087  01  MPRF-REC.                                                    DTSBD991
00088  ++INCLUDE DTSIMPRF                                               DTSBD991
00089      EJECT                                                        DTSBD991
00090  01  L921-LINK-AREA.                                              DTSBD991
00091  ++INCLUDE DTSIL921                                               DTSBD991
00092      EJECT                                                        DTSBD991
00093  01  ISKL-REC.                                                    DTSBD991
00094  ++INCLUDE DTSIISKL                                               DTSBD991
00095      EJECT                                                        DTSBD991
00096  01  L962-LINK-AREA.                                              DTSBD991
00097  ++INCLUDE DTSIL962                                               DTSBD991
00098      EJECT                                                        DTSBD991
00099  01  MLEN-AREA.                                                   DTSBD991
00100  ++INCLUDE DTSIMLEN                                               DTSBD991
00101      EJECT                                                        DTSBD991
00102  PROCEDURE DIVISION.                                              DTSBD991
00103      SKIP2                                                        DTSBD991
00104      PERFORM I0000-INITIATE THRU I0000-EXIT.                      DTSBD991
00105                                                                   DTSBD991
00106      PERFORM P0000-PROCESS THRU P0000-EXIT.                       DTSBD991
00107                                                                   DTSBD991
00108      PERFORM T0000-TERMINATE THRU T0000-EXIT.                     DTSBD991
00109      SKIP2                                                        DTSBD991
00110      GOBACK.                                                      DTSBD991
00111      EJECT                                                        DTSBD991
00112  I0000-INITIATE.                                                  DTSBD991
00113      PERFORM I1000-OPEN-FILES          THRU I1000-EXIT.           DTSBD991
00114                                                                   DTSBD991
00115      PERFORM I2000-INITIALIZE-WRK      THRU I2000-EXIT.           DTSBD991
00116  I0000-EXIT.                                                      DTSBD991
00117      EXIT.                                                        DTSBD991
00118      EJECT                                                        DTSBD991
00119  I1000-OPEN-FILES.                                                DTSBD991
00120      OPEN INPUT PARM-FILE.                                        DTSBD991
00121                                                                   DTSBD991
00122      MOVE 'N' TO L910-TRACE-IND                                   DTSBD991
00123                  L921-TRACE-IND                                   DTSBD991
00124                  L962-TRACE-IND.                                  DTSBD991
00125                                                                   DTSBD991
00126      MOVE 'DTSBD991' TO L910-MOD-NAME                             DTSBD991
00127                         L921-MOD-NAME                             DTSBD991
00128                         L962-MOD-NAME.                            DTSBD991
00129                                                                   DTSBD991
00130      PERFORM S910-OPEN-READ THRU S910-EXIT.                       DTSBD991
00131                                                                   DTSBD991
00132      PERFORM S921-OPEN-READ THRU S921-EXIT.                       DTSBD991
00133                                                                   DTSBD991
00134      PERFORM S962-OPEN-UPDATE THRU S962-EXIT.                     DTSBD991
00135  I1000-EXIT.                                                      DTSBD991
00136      EXIT.                                                        DTSBD991
00137      EJECT                                                        DTSBD991
00138  I2000-INITIALIZE-WRK.                                            DTSBD991
00139      MOVE +0 TO PARM-REC-CNT                                      DTSBD991
00140                 TOT-EMP-EXT-CNT.                                  DTSBD991
00141  I2000-EXIT.                                                      DTSBD991
00142      EXIT.                                                        DTSBD991
00143      EJECT                                                        DTSBD991
00144  P0000-PROCESS.                                                   DTSBD991
00145      DISPLAY '*** DTSBD991 (EMPLOYER EXTRACT) STATISTICS ***'.    DTSBD991
00146                                                                   DTSBD991
00147      MOVE 'N' TO PARM-EOF-IND.                                    DTSBD991
00148                                                                   DTSBD991
00149      PERFORM P1000-READ-PROCESS-PARM THRU P1000-EXIT              DTSBD991
00150          UNTIL PARM-EOF-IND = 'Y'.                                DTSBD991
00151  P0000-EXIT.                                                      DTSBD991
00152      EXIT.                                                        DTSBD991
00153      EJECT                                                        DTSBD991
00154  P1000-READ-PROCESS-PARM.                                         DTSBD991
00155      READ PARM-FILE                                               DTSBD991
00156          AT END                                                   DTSBD991
00157              MOVE 'Y' TO PARM-EOF-IND                             DTSBD991
00158              GO TO P1000-EXIT.                                    DTSBD991
00159                                                                   DTSBD991
00160      IF PREC-ID-NO = '***'                                        DTSBD991
00161          GO TO P1000-EXIT.                                        DTSBD991
00162                                                                   DTSBD991
00163      ADD +1 TO PARM-REC-CNT.                                      DTSBD991
00164                                                                   DTSBD991
00165      DISPLAY ' '.                                                 DTSBD991
00166      DISPLAY ' '.                                                 DTSBD991
00167      DISPLAY PARM-REC.                                            DTSBD991
00168                                                                   DTSBD991
00169      IF PREC-START-EMP-NO NOT NUMERIC                             DTSBD991
00170          DISPLAY '  INVALID START EMP NO.  PARM BYPASSED.'        DTSBD991
00171          GO TO P1000-EXIT.                                        DTSBD991
00172                                                                   DTSBD991
00173      MOVE PREC-START-EMP-NO TO WRK-START-EMP-NO.                  DTSBD991
00174                                                                   DTSBD991
00175      IF PREC-END-EMP-NO-X = SPACES                                DTSBD991
00176          MOVE WRK-START-EMP-NO TO WRK-END-EMP-NO                  DTSBD991
00177      ELSE                                                         DTSBD991
00178      IF (PREC-END-EMP-NO NOT NUMERIC)                             DTSBD991
00179             OR                                                    DTSBD991
00180         (PREC-END-EMP-NO < WRK-START-EMP-NO)                      DTSBD991
00181          DISPLAY '  INVALID END EMP NO.  PARM BYPASSED.'          DTSBD991
00182          GO TO P1000-EXIT                                         DTSBD991
00183      ELSE                                                         DTSBD991
00184          MOVE PREC-END-EMP-NO TO WRK-END-EMP-NO.                  DTSBD991
00185                                                                   DTSBD991
00186      MOVE +0 TO PARM-EMP-EXT-CNT.                                 DTSBD991
00187                                                                   DTSBD991
00188 ******************************************************            DTSBD991
00189 *  WRITE HEADER RECORD                                            DTSBD991
00190 ******************************************************            DTSBD991
00191      MOVE LOW-VALUES TO MSKL-KEY-AREA.                            DTSBD991
00192      MOVE WRK-START-EMP-NO TO MSKL-EMP-NO.                        DTSBD991
00193      SET MSKL-HDR-88 TO TRUE.                                     DTSBD991
00194      PERFORM S910-READ         THRU S910-EXIT.                    DTSBD991
00195      MOVE MSKL-REC TO MHDR-REC.                                   DTSBD991
00196      ADD +1 TO PARM-EMP-EXT-CNT.                                  DTSBD991
00197                                                                   DTSBD991
00198      PERFORM S962-WRITE THRU S962-EXIT.                           DTSBD991
00199                                                                   DTSBD991
00200 ******************************************************            DTSBD991
00201 *  WRITE EMPLOYER DATA RECORDS                                    DTSBD991
00202 ******************************************************            DTSBD991
00203      MOVE LOW-VALUES TO MPRF-KEY-AREA.                            DTSBD991
00204      MOVE WRK-START-EMP-NO TO MPRF-EMP-NO.                        DTSBD991
00205      SET MPRF-PRF-88 TO TRUE.                                     DTSBD991
00206      MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA.                         DTSBD991
00207      PERFORM S910-START-BROWSE THRU S910-EXIT.                    DTSBD991
00208      MOVE MSKL-REC TO MPRF-REC.                                   DTSBD991
00209      PERFORM P1100-BROWSE-MPRF THRU P1100-EXIT                    DTSBD991
00210          UNTIL (L910-NO-REC-88)                                   DTSBD991
00211                    OR                                             DTSBD991
00212                (MPRF-EMP-NO > WRK-END-EMP-NO).                    DTSBD991
00213                                                                   DTSBD991
00214      ADD PARM-EMP-EXT-CNT TO TOT-EMP-EXT-CNT.                     DTSBD991
00215                                                                   DTSBD991
00216      DISPLAY '  '                                                 DTSBD991
00217              PARM-EMP-EXT-CNT                                     DTSBD991
00218              ' EMPLOYERS EXTRACTED.'.                             DTSBD991
00219  P1000-EXIT.                                                      DTSBD991
00220      EXIT.                                                        DTSBD991
00221      SKIP3                                                        DTSBD991
00222  P1100-BROWSE-MPRF.                                               DTSBD991
00223      ADD +1 TO PARM-EMP-EXT-CNT.                                  DTSBD991
00224                                                                   DTSBD991
00225      PERFORM S962-WRITE THRU S962-EXIT.                           DTSBD991
00226                                                                   DTSBD991
00227      PERFORM P1110-REC-TYPE-LOOP THRU P1110-EXIT                  DTSBD991
00228          VARYING MLEN-IDX FROM 3 BY 1                             DTSBD991
00229          UNTIL MLEN-IDX > MLEN-MAX-REC-TYPE.                      DTSBD991
00230                                                                   DTSBD991
00231      MOVE MPRF-REC TO MSKL-REC.                                   DTSBD991
00232                                                                   DTSBD991
00233      PERFORM S910-READ-NEXT THRU S910-EXIT.                       DTSBD991
00234                                                                   DTSBD991
00235      MOVE MSKL-REC TO MPRF-REC.                                   DTSBD991
00236  P1100-EXIT.                                                      DTSBD991
00237      EXIT.                                                        DTSBD991
00238      SKIP3                                                        DTSBD991
00239  P1110-REC-TYPE-LOOP.                                             DTSBD991
00240 ***  IF MLEN-FILE-ID (MLEN-IDX) = +0                              DTSBD991
00241 ***      GO TO P1110-EXIT.                                        DTSBD991
00242      IF MLEN-FILE-ID (MLEN-IDX) = +2 OR +5 OR +6                  DTSBD991
00243          NEXT SENTENCE                                            DTSBD991
00244      ELSE                                                         DTSBD991
00245          GO TO P1110-EXIT.                                        DTSBD991
00246                                                                   DTSBD991
00247      MOVE LOW-VALUES TO MSKL-KEY-AREA.                            DTSBD991
00248      MOVE MPRF-EMP-NO TO MSKL-EMP-NO.                             DTSBD991
00249      SET MSKL-REC-TYPE TO MLEN-IDX.                               DTSBD991
00250                                                                   DTSBD991
00251      PERFORM S910-START-BROWSE THRU S910-EXIT.                    DTSBD991
00252                                                                   DTSBD991
00253      PERFORM P1111-EXTRACT-LOOP THRU P1111-EXIT                   DTSBD991
00254          UNTIL L910-NO-REC-88.                                    DTSBD991
00255  P1110-EXIT.                                                      DTSBD991
00256      EXIT.                                                        DTSBD991
00257      SKIP3                                                        DTSBD991
00258  P1111-EXTRACT-LOOP.                                              DTSBD991
00259      PERFORM S962-WRITE THRU S962-EXIT.                           DTSBD991
00260                                                                   DTSBD991
00261      PERFORM S910-READ-NEXT THRU S910-EXIT.                       DTSBD991
00262  P1111-EXIT.                                                      DTSBD991
00263      EXIT.                                                        DTSBD991
00264      EJECT                                                        DTSBD991
00265  T0000-TERMINATE.                                                 DTSBD991
00266      DISPLAY ' '.                                                 DTSBD991
00267      DISPLAY '*** DTSBD991 TERMINATION STATISTICS ***'.           DTSBD991
00268      DISPLAY ' '.                                                 DTSBD991
00269      DISPLAY 'NUMBER OF PARAMETER RECORDS ENCOUNTERED: '          DTSBD991
00270              PARM-REC-CNT.                                        DTSBD991
00271      DISPLAY ' '.                                                 DTSBD991
00272      DISPLAY 'NUMBER OF EMPLOYERS EXTRACTED          : '          DTSBD991
00273              TOT-EMP-EXT-CNT.                                     DTSBD991
00274                                                                   DTSBD991
00275      CLOSE PARM-FILE.                                             DTSBD991
00276                                                                   DTSBD991
00277      PERFORM S910-CLOSE        THRU S910-EXIT.                    DTSBD991
00278                                                                   DTSBD991
00279      PERFORM S921-CLOSE        THRU S921-EXIT.                    DTSBD991
00280                                                                   DTSBD991
00281      PERFORM S962-CLOSE        THRU S962-EXIT.                    DTSBD991
00282  T0000-EXIT.                                                      DTSBD991
00283      EXIT.                                                        DTSBD991
00284      EJECT                                                        DTSBD991
00285  S910-OPEN-READ.                                                  DTSBD991
00286      SET L910-OPEN-READ-88 TO TRUE.                               DTSBD991
00287      GO TO S910-MSTR-IO.                                          DTSBD991
00288                                                                   DTSBD991
00289  S910-READ.                                                       DTSBD991
00290      SET L910-READ-88 TO TRUE.                                    DTSBD991
00291      GO TO S910-MSTR-IO.                                          DTSBD991
00292                                                                   DTSBD991
00293  S910-START-BROWSE.                                               DTSBD991
00294      SET L910-START-BROWSE-88 TO TRUE.                            DTSBD991
00295      GO TO S910-MSTR-IO.                                          DTSBD991
00296                                                                   DTSBD991
00297  S910-READ-NEXT.                                                  DTSBD991
00298      SET L910-READ-NEXT-88 TO TRUE.                               DTSBD991
00299      GO TO S910-MSTR-IO.                                          DTSBD991
00300                                                                   DTSBD991
00301  S910-CLOSE.                                                      DTSBD991
00302      SET L910-CLOSE-88 TO TRUE.                                   DTSBD991
00303      GO TO S910-MSTR-IO.                                          DTSBD991
00304                                                                   DTSBD991
00305  S910-MSTR-IO.                                                    DTSBD991
00306      CALL 'DTSBU911' USING L910-LINK-AREA                         DTSBD991
00307                            MSKL-REC.                              DTSBD991
00308  S910-EXIT.                                                       DTSBD991
00309      EXIT.                                                        DTSBD991
00310      SKIP3                                                        DTSBD991
00311  S921-OPEN-READ.                                                  DTSBD991
00312      SET L921-OPEN-READ-88 TO TRUE.                               DTSBD991
00313      GO TO S921-ALT-INDEX-IO.                                     DTSBD991
00314                                                                   DTSBD991
00315  S921-CLOSE.                                                      DTSBD991
00316      SET L921-CLOSE-88 TO TRUE.                                   DTSBD991
00317      GO TO S921-ALT-INDEX-IO.                                     DTSBD991
00318                                                                   DTSBD991
00319  S921-ALT-INDEX-IO.                                               DTSBD991
00320      CALL 'DTSBU921' USING L921-LINK-AREA                         DTSBD991
00321                            ISKL-REC.                              DTSBD991
00322  S921-EXIT.                                                       DTSBD991
00323      EXIT.                                                        DTSBD991
00324      SKIP3                                                        DTSBD991
00325  S962-OPEN-UPDATE.                                                DTSBD991
00326      SET L962-OPEN-UPDATE-88 TO TRUE.                             DTSBD991
00327      GO TO S962-SEQ-MSTR-O.                                       DTSBD991
00328                                                                   DTSBD991
00329  S962-WRITE.                                                      DTSBD991
00330      SET L962-WRITE-88 TO TRUE.                                   DTSBD991
00331      GO TO S962-SEQ-MSTR-O.                                       DTSBD991
00332                                                                   DTSBD991
00333  S962-CLOSE.                                                      DTSBD991
00334      SET L962-CLOSE-88 TO TRUE.                                   DTSBD991
00335      GO TO S962-SEQ-MSTR-O.                                       DTSBD991
00336                                                                   DTSBD991
00337  S962-SEQ-MSTR-O.                                                 DTSBD991
00338      CALL 'DTSBU962' USING L962-LINK-AREA                         DTSBD991
00339                            MSKL-REC.                              DTSBD991
00340  S962-EXIT.                                                       DTSBD991
00341      EXIT.                                                        DTSBD991
00342      SKIP3                                                        DTSBD991
00343  S999-ABEND.                                                      DTSBD991
00344      CALL 'DTSBU999' USING WRK-ABEND-CD.                          DTSBD991
00345  S999-EXIT.                                                       DTSBD991
00346      EXIT.                                                        DTSBD991
