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