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