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