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