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