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