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