00001  IDENTIFICATION DIVISION.                                         11/19/98
00002  PROGRAM-ID.             DTSBER31.                                DTSBER31
00003  AUTHOR.                 MT DEPT OF LABOR/UI PROGRAMMING SECTION.    LV003
00004  DATE-WRITTEN.           MAY 1996.                                DTSBER31
00005  DATE-COMPILED.                                                   DTSBER31
00006      SKIP3                                                        DTSBER31
00007 *****                                                             DTSBER31
00008 *                                                                 DTSBER31
00009 *    FUNCTION:  CONTROL RECORD BUILD FOR RQC FIELD AUDIT          DTSBER31
00010 *               (CS031) SAMPLING.                                 DTSBER31
00011 *                                                                 DTSBER31
00012 *                                                                 DTSBER31
00013 *    MODIFICATION HISTORY:                                        DTSBER31
00014 *                                                                 DTSBER31
00015 * 05-06-96 INITIAL DEVELOPMENT                                    DTSBER31
00016 *          REFERENCE RFP #RAP             AUTHOR OF CHANGE - SFW  DTSBER31
00017 *                                                                 DTSBER31
00018 * MM-DD-YY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX  DTSBER31
00019 *          XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX  DTSBER31
00020 *          REFERENCE RFP #****            AUTHOR OF CHANGE - XXX  DTSBER31
00021 *                                                                 DTSBER31
00022 *                                                                 DTSBER31
00023 *    DESCRIPTION:                                                 DTSBER31
00024 *                                                                 DTSBER31
00025 *        THIS MODULE READS AN INPUT PARM AND COUNTS THE NUMBER    DTSBER31
00026 *        OF RECORDS IN THE RQC UNIVERSE IN ORDER TO PRODUCE A     DTSBER31
00027 *        CONTROL RECORD.                                          DTSBER31
00028 *                                                                 DTSBER31
00029 *                                                                 DTSBER31
00030 *    RECORDS READ:                                                DTSBER31
00031 *                                                                 DTSBER31
00032 *        RQC CS031 UNIVERSE FILE.                                 DTSBER31
00033 *        PARM FILE.                                               DTSBER31
00034 *                                                                 DTSBER31
00035 *                                                                 DTSBER31
00036 *    PRINTED OUTPUTS:                                             DTSBER31
00037 *                                                                 DTSBER31
00038 *        NONE.                                                    DTSBER31
00039 *                                                                 DTSBER31
00040 *                                                                 DTSBER31
00041 *    RECORDS WRITTEN:                                             DTSBER31
00042 *                                                                 DTSBER31
00043 *        RQC CS031 CONTROL RECORD.                                DTSBER31
00044 *                                                                 DTSBER31
00045 *                                                                 DTSBER31
00046 *    MODULES CALLED:                                              DTSBER31
00047 *                                                                 DTSBER31
00048 *        NONE.                                                    DTSBER31
00049 *                                                                 DTSBER31
00050 *                                                                 DTSBER31
00051 *****                                                             DTSBER31
00052      EJECT                                                        DTSBER31
00053  ENVIRONMENT DIVISION.                                            DTSBER31
00054      SKIP2                                                        DTSBER31
00055  INPUT-OUTPUT SECTION.                                            DTSBER31
00056      SKIP1                                                        DTSBER31
00057  FILE-CONTROL.                                                    DTSBER31
00058      SELECT PARM-FILE     ASSIGN TO PARMIN.                       DTSBER31
00059      SELECT UNIVERSE-FILE ASSIGN TO FILEIN.                       DTSBER31
00060      SELECT CONTROL-FILE  ASSIGN TO CNTRFILE.                     DTSBER31
00061      SKIP3                                                        DTSBER31
00062  DATA DIVISION.                                                   DTSBER31
00063      SKIP3                                                        DTSBER31
00064  FILE SECTION.                                                    DTSBER31
00065      SKIP2                                                        DTSBER31
00066  FD  PARM-FILE                                                    DTSBER31
00067      RECORDING MODE IS F                                          DTSBER31
00068      BLOCK CONTAINS 0 RECORDS.                                    DTSBER31
00069  01  PARM-REC.                                                    DTSBER31
00070      05  PARM-RANDOM-NUMBER          PIC  9(03).                  DTSBER31
00071      05  FILLER                      PIC  X(01).                  DTSBER31
00072      05  PARM-NUMBER-SAMPLED         PIC  9(04).                  DTSBER31
00073      05  FILLER                      PIC  X(01).                  DTSBER31
00074      05  PARM-SAMPLE-TYPE            PIC  X(02).                  DTSBER31
00075      05  FILLER                      PIC  X(01).                  DTSBER31
00076      05  PARM-YYYY                   PIC  9(04).                  DTSBER31
00077      05  FILLER                      PIC  X(64).                  DTSBER31
00078      SKIP2                                                        DTSBER31
00079  FD  UNIVERSE-FILE                                                DTSBER31
00080      RECORDING MODE IS F                                          DTSBER31
00081      BLOCK CONTAINS 0 RECORDS.                                    DTSBER31
00082  01  UNIVERSE-REC                    PIC  X(60).                  DTSBER31
00083      SKIP2                                                        DTSBER31
00084  FD  CONTROL-FILE                                                 DTSBER31
00085      RECORDING MODE IS F                                          DTSBER31
00086      BLOCK CONTAINS 0 RECORDS.                                    DTSBER31
00087  01  CONTROL-REC                     PIC  X(33).                  DTSBER31
00088      EJECT                                                        DTSBER31
00089  WORKING-STORAGE SECTION.                                         DTSBER31
000895 77  PAN-VALET PICTURE X(24) VALUE '003DTSBER31  11/19/98'.       DTSBER31
00090      SKIP3                                                        DTSBER31
00091  01  WRK-AREA.                                                    DTSBER31
00092      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +31. DTSBER31
00093      05  FILE-DONE-IND               PIC  X(01)  VALUE 'N'.       DTSBER31
00094          88  FILE-DONE                           VALUE 'Y'.       DTSBER31
00095      SKIP1                                                        DTSBER31
00096  01  WS-CONTROL-REC.                                              DTSBER31
00097      05  CNTR-RECORD-TYPE            PIC  X(05)  VALUE 'CS031'.   DTSBER31
00098      05  CNTR-TRANS-TYPE             PIC  X(01)  VALUE '1'.       DTSBER31
00099      05  CNTR-SESA-ID                PIC  X(02)  VALUE 'DC'.         CL**3
00100      05  CNTR-RANDOM-NUMBER          PIC  9(03).                  DTSBER31
00101      05  CNTR-NUMBER-SAMPLED         PIC  9(04).                  DTSBER31
00102      05  CNTR-RECORD-COUNT           PIC  9(08)  VALUE 0.         DTSBER31
00103      05  CNTR-SAMPLE-TYPE            PIC  X(02).                  DTSBER31
00104      05  CNTR-YYYY                   PIC  9(04).                  DTSBER31
00105      05  FILLER                      PIC  X(04)  VALUE '0000'.    DTSBER31
00106      EJECT                                                        DTSBER31
00107  PROCEDURE DIVISION.                                              DTSBER31
00108      SKIP2                                                        DTSBER31
00109      PERFORM I1000-INITIATE THRU I1000-EXIT.                      DTSBER31
00110      PERFORM P1000-SPIN-THRU-UNIVERSE THRU P1000-EXIT             DTSBER31
00111         UNTIL FILE-DONE.                                          DTSBER31
00112      PERFORM T1000-TERMINATE THRU T1000-EXIT.                     DTSBER31
00113      SKIP2                                                        DTSBER31
00114      GOBACK.                                                      DTSBER31
00115      EJECT                                                        DTSBER31
00116  I1000-INITIATE.                                                  DTSBER31
00117      SKIP1                                                        DTSBER31
00118      OPEN INPUT  PARM-FILE UNIVERSE-FILE                          DTSBER31
00119           OUTPUT CONTROL-FILE.                                    DTSBER31
00120      READ PARM-FILE                                               DTSBER31
00121         AT END                                                    DTSBER31
00122             DISPLAY ' DTSBER31 - MISSING PARM REC '                  CL**2
00123             PERFORM S999-ABEND THRU S999-EXIT.                    DTSBER31
00124      SKIP1                                                        DTSBER31
00125      IF PARM-RANDOM-NUMBER NUMERIC                                DTSBER31
00126          MOVE PARM-RANDOM-NUMBER TO CNTR-RANDOM-NUMBER            DTSBER31
00127      ELSE                                                         DTSBER31
00128          DISPLAY ' DTSBER31 - INVALID RANDOM NUMBER '                CL**2
00129          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBER31
00130      IF (PARM-NUMBER-SAMPLED NUMERIC)                             DTSBER31
00131                   AND                                             DTSBER31
00132         (PARM-NUMBER-SAMPLED > +0)                                DTSBER31
00133          MOVE PARM-NUMBER-SAMPLED TO CNTR-NUMBER-SAMPLED          DTSBER31
00134      ELSE                                                         DTSBER31
00135          DISPLAY ' DTSBER31 - INVALID NUMBER SAMPLED '               CL**2
00136          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBER31
00137      IF PARM-SAMPLE-TYPE = 'A1' OR 'A2' OR 'E1' OR 'O1' OR 'O2'   DTSBER31
00138          MOVE PARM-SAMPLE-TYPE TO CNTR-SAMPLE-TYPE                DTSBER31
00139      ELSE                                                         DTSBER31
00140          DISPLAY ' DTSBER31 - INVALID SAMPLE TYPE '                  CL**2
00141          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBER31
00142      IF PARM-YYYY NUMERIC                                         DTSBER31
00143          MOVE PARM-YYYY TO CNTR-YYYY                              DTSBER31
00144      ELSE                                                         DTSBER31
00145          DISPLAY ' DTSBER31 - INVALID YYYY '                         CL**2
00146          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBER31
00147      DISPLAY '                                   '                DTSBER31
00148         '         1         2         3         4         5'      DTSBER31
00149         '         6         7         8'.                         DTSBER31
00150      DISPLAY '                                   '                DTSBER31
00151         '12345678901234567890123456789012345678901234567890'      DTSBER31
00152         '123456789012345678901234567890'.                         DTSBER31
00153      DISPLAY ' '.                                                 DTSBER31
00154      DISPLAY ' DTSBER31 -     PARM RECORD INPUT: ' PARM-REC.         CL**2
00155      SKIP2                                                        DTSBER31
00156  I1000-EXIT.                                                      DTSBER31
00157      EXIT.                                                        DTSBER31
00158      EJECT                                                        DTSBER31
00159  P1000-SPIN-THRU-UNIVERSE.                                        DTSBER31
00160      SKIP1                                                        DTSBER31
00161      READ UNIVERSE-FILE                                           DTSBER31
00162         AT END                                                    DTSBER31
00163             SET FILE-DONE TO TRUE                                 DTSBER31
00164             GO TO P1000-EXIT.                                     DTSBER31
00165      ADD +1 TO CNTR-RECORD-COUNT.                                 DTSBER31
00166      SKIP2                                                        DTSBER31
00167  P1000-EXIT.                                                      DTSBER31
00168      EXIT.                                                        DTSBER31
00169      EJECT                                                        DTSBER31
00170  T1000-TERMINATE.                                                 DTSBER31
00171      SKIP1                                                        DTSBER31
00172      DISPLAY ' '.                                                 DTSBER31
00173      DISPLAY ' DTSBER31 - CONTROL RECORD OUTPUT: '                   CL**2
00174         WS-CONTROL-REC.                                           DTSBER31
00175      WRITE CONTROL-REC FROM WS-CONTROL-REC.                       DTSBER31
00176      CLOSE PARM-FILE UNIVERSE-FILE                                DTSBER31
00177            CONTROL-FILE.                                          DTSBER31
00178      SKIP2                                                        DTSBER31
00179  T1000-EXIT.                                                      DTSBER31
00180      EXIT.                                                        DTSBER31
00181      EJECT                                                        DTSBER31
00182  S999-ABEND.                                                      DTSBER31
00183      SKIP1                                                        DTSBER31
00184      CALL 'DTSBU999' USING WRK-ABEND-CD.                             CL**2
00185      SKIP2                                                        DTSBER31
00186  S999-EXIT.                                                       DTSBER31
00187      EXIT.                                                        DTSBER31
