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