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