DUTAS re-platformed to Raincode - Initial Source Code
This commit is contained in:
Neeraj Kumar
981
Batch/PICKNMBR.cob
Normal file
981
Batch/PICKNMBR.cob
Normal file
@ -0,0 +1,981 @@
|
||||
00001 IDENTIFICATION DIVISION. 02/13/04
|
||||
00002 PROGRAM-ID. PICKNMBR. PICKNMBR
|
||||
00003 AUTHOR YU-SHING(ELSA) CHEN. LV001
|
||||
00004 DATE-WRITTEN. NOV. 24, 1992. PICKNMBR
|
||||
00005 ** PICKNMBR
|
||||
00006 *************************************************************** PICKNMBR
|
||||
00007 ** -----------------PROGRAM DESCRIPTION--------------------- ** PICKNMBR
|
||||
00008 ** VS COBOL VERSION ** PICKNMBR
|
||||
00009 *************************************************************** PICKNMBR
|
||||
00010 ** THIS PROGRAM CALCULATES WHICH RECORDS ARE TO BE SELECTED ** PICKNMBR
|
||||
00011 ** FOR THE SAMPLE. TO EXECUTE THE PICKNMBR PROGRAM THE ** PICKNMBR
|
||||
00012 ** FOLLOWING FIELDS ARE REQUIRED, A RANDOM NUMBER, THE ** PICKNMBR
|
||||
00013 ** NUMBER OF RECORDS TO BE SELECTED, AND THE TOTAL NUMBER OF ** PICKNMBR
|
||||
00014 ** RECORDS ON THE TRANSACTION FILE. ** PICKNMBR
|
||||
00015 ** ** PICKNMBR
|
||||
00016 ** (THIS INFO COMES IN ON A PARM CARD - JHP) ** PICKNMBR
|
||||
00017 *************************************************************** PICKNMBR
|
||||
00018 ** MAINTENANCE HISTORY: ** PICKNMBR
|
||||
00019 ** ** PICKNMBR
|
||||
00020 ** 06-15-00 CHANGED TO ENSURE THAT THE 'SKIP INTERVAL' FIELD ** PICKNMBR
|
||||
00021 ** HAS A MINIMUM VALUE OF ONE (1) ** PICKNMBR
|
||||
00022 ** PROGRAMMER - JHP ** PICKNMBR
|
||||
00023 ** ** PICKNMBR
|
||||
00024 *************************************************************** PICKNMBR
|
||||
00025 * PICKNMBR
|
||||
00026 ENVIRONMENT DIVISION. PICKNMBR
|
||||
00027 CONFIGURATION SECTION. PICKNMBR
|
||||
00028 INPUT-OUTPUT SECTION. PICKNMBR
|
||||
00029 FILE-CONTROL. PICKNMBR
|
||||
00030 SELECT CNTRL-DATA ASSIGN TO UT-S-CNTRLDTA. PICKNMBR
|
||||
00031 SELECT SELECT-NUMBERS ASSIGN TO UT-S-SELNMBR. PICKNMBR
|
||||
00032 SELECT PICKNUM-LIST ASSIGN TO UT-S-PICKLST. PICKNMBR
|
||||
00033 ** PICKNMBR
|
||||
00034 DATA DIVISION. PICKNMBR
|
||||
00035 FILE SECTION. PICKNMBR
|
||||
00036 *************************************************************** PICKNMBR
|
||||
00037 ** CNTRL-DATA CONTAINS SOME OF THE PROCESSING INFORMATION ** PICKNMBR
|
||||
00038 ** NEEDED FOR SAMPLING. IT CONTAINS THE RANDOM NUMBER ** PICKNMBR
|
||||
00039 ** (CNTRL-RANDOM), THE NUMBER OF RECORDS TO BE SELECTED FOR ** PICKNMBR
|
||||
00040 ** THE SAMPLE (SAMPLED-NMBR), AND THE RECORD COUNT OF THE ** PICKNMBR
|
||||
00041 ** NUMBER OF RECORDS (TRANS-REC-CNTR) CONTAINED ON THE ** PICKNMBR
|
||||
00042 ** TRANS-FILE. ** PICKNMBR
|
||||
00043 *************************************************************** PICKNMBR
|
||||
00044 ** PICKNMBR
|
||||
00045 FD CNTRL-DATA PICKNMBR
|
||||
00046 RECORDING MODE IS F PICKNMBR
|
||||
00047 LABEL RECORD IS OMITTED PICKNMBR
|
||||
00048 BLOCK CONTAINS 1 RECORDS. PICKNMBR
|
||||
00049 01 CNTRL-DATA-REC. PICKNMBR
|
||||
00050 05 CNTRL-TYPE PIC X(5). PICKNMBR
|
||||
00051 05 CNTRL-TRANS-TYPE PIC X. PICKNMBR
|
||||
00052 05 CNTRL-SESA-ID PIC XX. PICKNMBR
|
||||
00053 05 CNTRL-RANDOM PIC V999. PICKNMBR
|
||||
00054 05 CNTRL-RANDOM-ALF REDEFINES CNTRL-RANDOM PIC X(3). PICKNMBR
|
||||
00055 05 SAMPLED-NMBR PIC 9(4). PICKNMBR
|
||||
00056 05 SAMPLED-NMBR-ALF REDEFINES SAMPLED-NMBR PIC X(4). PICKNMBR
|
||||
00057 05 TRANS-REC-CNTR PIC 9(8). PICKNMBR
|
||||
00058 05 TRANS-REC-CNTR-ALF REDEFINES TRANS-REC-CNTR PIC X(8). PICKNMBR
|
||||
00059 05 SAMPLE-TYPE PIC XX. PICKNMBR
|
||||
00060 05 CNTRL-YEAR-QTR PIC X(8). PICKNMBR
|
||||
00061 ** PICKNMBR
|
||||
00062 FD SELECT-NUMBERS PICKNMBR
|
||||
00063 RECORDING MODE IS F PICKNMBR
|
||||
00064 LABEL RECORD IS STANDARD PICKNMBR
|
||||
00065 BLOCK CONTAINS 0 RECORDS. PICKNMBR
|
||||
00066 01 SELECTED-REC. PICKNMBR
|
||||
00067 05 SEL-REC-NO PIC 9(8). PICKNMBR
|
||||
00068 ** PICKNMBR
|
||||
00069 *************************************************************** PICKNMBR
|
||||
00070 ** PICKNUM-LIST IS AN OUTPUT LISTING WHICH CONTAINS THE ** PICKNMBR
|
||||
00071 ** CALCULATED NUMBERS OF THE RECORDS WHICH WILL BE PULLED ** PICKNMBR
|
||||
00072 ** FOR SAMPLING AND THE CORRESPONDING CASE NUMBERS. ** PICKNMBR
|
||||
00073 *************************************************************** PICKNMBR
|
||||
00074 * PICKNMBR
|
||||
00075 FD PICKNUM-LIST PICKNMBR
|
||||
00076 RECORDING MODE IS F PICKNMBR
|
||||
00077 LABEL RECORD IS STANDARD PICKNMBR
|
||||
00078 BLOCK CONTAINS 0 RECORDS. PICKNMBR
|
||||
00079 01 PICKNUM-REC PIC X(132). PICKNMBR
|
||||
00080 ** PICKNMBR
|
||||
00081 WORKING-STORAGE SECTION. PICKNMBR
|
||||
000815 77 PAN-VALET PICTURE X(24) VALUE '001PICKNMBR 02/13/04'. PICKNMBR
|
||||
00082 77 SKIP-INTERVAL PIC 9(8) VALUE 0. PICKNMBR
|
||||
00083 77 SKIP-INTERVAL-B PIC 9(8)V999 VALUE 0.000. PICKNMBR
|
||||
00084 77 SELECT-CNTR PIC 9(5) VALUE 0. PICKNMBR
|
||||
00085 77 INITIAL-CASE PIC 9(5) VALUE 0. PICKNMBR
|
||||
00086 77 ODD-EVEN-CNTL PIC 9 VALUE 0. PICKNMBR
|
||||
00087 77 TEMP-LOOP-NBR PIC 9(8) VALUE 0. PICKNMBR
|
||||
00088 77 LOOP-NBR PIC S9(8) VALUE +0. PICKNMBR
|
||||
00089 77 ONE-MORE-REC PIC 9(8) VALUE 0. PICKNMBR
|
||||
00090 77 MATCH-CNTR PIC 9(5) VALUE 0. PICKNMBR
|
||||
00091 77 CNTRL-FLAG PIC X VALUE 'N'. PICKNMBR
|
||||
00092 77 ODD-LOOP-NBR PIC 9(8) VALUE 0. PICKNMBR
|
||||
00093 77 SEL-1 PIC 9(8) VALUE 0. PICKNMBR
|
||||
00094 77 SEL-2 PIC 9(8) VALUE 0. PICKNMBR
|
||||
00095 77 SEL-NMBR PIC 9(8) VALUE 0. PICKNMBR
|
||||
00096 77 SEL-ACCU PIC 9(8)V999 VALUE 0.000. PICKNMBR
|
||||
00097 77 STOP-FLAG PIC 9 VALUE 0. PICKNMBR
|
||||
00098 77 EOF PIC 9 VALUE 0. PICKNMBR
|
||||
00099 77 LIST-PAGE PIC 9(6) VALUE 0. PICKNMBR
|
||||
00100 77 LIST-COUNTER PIC 999 VALUE 0. PICKNMBR
|
||||
00101 77 FIPS-FLAG PIC 9 VALUE 0. PICKNMBR
|
||||
00102 ** PICKNMBR
|
||||
00103 01 CASE-NUM PIC 9(8) VALUE 0. PICKNMBR
|
||||
00104 ** PICKNMBR
|
||||
00105 01 WS-CURRENT-DATE. PICKNMBR
|
||||
00106 05 WS-DATE PIC 9(06) VALUE ZEROES. PICKNMBR
|
||||
00107 05 WS-DATE-R REDEFINES WS-DATE. PICKNMBR
|
||||
00108 10 WS-YY PIC 9(02). PICKNMBR
|
||||
00109 10 WS-MM PIC 9(02). PICKNMBR
|
||||
00110 10 WS-DD PIC 9(02). PICKNMBR
|
||||
00111 PICKNMBR
|
||||
00112 05 WRK-DATE-AREA. PICKNMBR
|
||||
00113 10 WRK-MM PIC X(02). PICKNMBR
|
||||
00114 10 FILLER PIC X(01) VALUE '/'. PICKNMBR
|
||||
00115 10 WRK-DD PIC X(02). PICKNMBR
|
||||
00116 10 FILLER PIC X(01) VALUE '/'. PICKNMBR
|
||||
00117 10 WRK-YY PIC X(02). PICKNMBR
|
||||
00118 ** PICKNMBR
|
||||
00119 01 RUN-DATE PIC 9(6). PICKNMBR
|
||||
00120 01 FILLER REDEFINES RUN-DATE. PICKNMBR
|
||||
00121 05 RUN-DATE-MM PIC 99. PICKNMBR
|
||||
00122 05 RUN-DATE-DD PIC 99. PICKNMBR
|
||||
00123 05 RUN-DATE-YY PIC 99. PICKNMBR
|
||||
00124 ** PICKNMBR
|
||||
00125 01 O-PICKNUM-REC. PICKNMBR
|
||||
00126 05 FILLER PIC X(10) VALUE SPACES. PICKNMBR
|
||||
00127 05 O-CASE-NUM PIC ZZZZZZZ9. PICKNMBR
|
||||
00128 05 FILLER PIC X(7) VALUE SPACES. PICKNMBR
|
||||
00129 05 O-PICK-NUM PIC ZZZZZZZ9. PICKNMBR
|
||||
00130 05 FILLER PIC X(99) VALUE SPACES. PICKNMBR
|
||||
00131 ** PICKNMBR
|
||||
00132 01 O-LIST-1-REC. PICKNMBR
|
||||
00133 05 FILLER PIC X(10) VALUE SPACES. PICKNMBR
|
||||
00134 05 FILLER PIC X(30) PICKNMBR
|
||||
00135 VALUE '******************************'. PICKNMBR
|
||||
00136 05 FILLER PIC X(30) PICKNMBR
|
||||
00137 VALUE '******************************'. PICKNMBR
|
||||
00138 05 FILLER PIC X(62) VALUE SPACES. PICKNMBR
|
||||
00139 ** PICKNMBR
|
||||
00140 01 O-LIST-2-REC. PICKNMBR
|
||||
00141 05 FILLER PIC X(10) VALUE SPACES. PICKNMBR
|
||||
00142 05 FILLER PIC X(27) PICKNMBR
|
||||
00143 VALUE '* INFORMATION USED'. PICKNMBR
|
||||
00144 05 FILLER PIC X(33) PICKNMBR
|
||||
00145 VALUE ' IN THE CALCULATIONS *'. PICKNMBR
|
||||
00146 05 FILLER PIC X(62) VALUE SPACES. PICKNMBR
|
||||
00147 ** PICKNMBR
|
||||
00148 01 O-LIST-3-REC. PICKNMBR
|
||||
00149 05 FILLER PIC X(10) VALUE SPACES. PICKNMBR
|
||||
00150 05 FILLER PIC X VALUE '*'. PICKNMBR
|
||||
00151 05 CNTL-ITEM PIC X(40) VALUE SPACES. PICKNMBR
|
||||
00152 05 FILLER PIC X(09) VALUE SPACES. PICKNMBR
|
||||
00153 05 CNTL-VALUE PIC ZZZZZZZ9. PICKNMBR
|
||||
00154 05 CNTL-VALUE-X REDEFINES CNTL-VALUE PICKNMBR
|
||||
00155 PIC X(8). PICKNMBR
|
||||
00156 05 FILLER PIC X(2) VALUE ' *'. PICKNMBR
|
||||
00157 05 FILLER PIC X(52) VALUE SPACES. PICKNMBR
|
||||
00158 ** PICKNMBR
|
||||
00159 01 O-LIST-4-REC. PICKNMBR
|
||||
00160 05 FILLER PIC X(10) VALUE SPACES. PICKNMBR
|
||||
00161 05 FILLER PIC X VALUE '*'. PICKNMBR
|
||||
00162 05 CNTL-ITEM-2 PIC X(39) VALUE SPACES. PICKNMBR
|
||||
00163 05 FILLER PIC X(6) VALUE SPACES. PICKNMBR
|
||||
00164 05 CNTL-VALUE-2 PIC ZZZZZZZ9.999. PICKNMBR
|
||||
00165 05 FILLER PIC X(2) VALUE ' *'. PICKNMBR
|
||||
00166 05 FILLER PIC X(52) VALUE SPACES. PICKNMBR
|
||||
00167 ** PICKNMBR
|
||||
00168 01 O-LIST-5-REC. PICKNMBR
|
||||
00169 05 FILLER PIC X(10) VALUE SPACES. PICKNMBR
|
||||
00170 05 FILLER PIC X VALUE '*'. PICKNMBR
|
||||
00171 05 FILLER PIC X(58) VALUE SPACES. PICKNMBR
|
||||
00172 05 FILLER PIC X VALUE '*'. PICKNMBR
|
||||
00173 05 FILLER PIC X(62) VALUE SPACES. PICKNMBR
|
||||
00174 ** PICKNMBR
|
||||
00175 01 DIGIT-8 PIC X(8) VALUE SPACES. PICKNMBR
|
||||
00176 01 FILLER REDEFINES DIGIT-8. PICKNMBR
|
||||
00177 05 DIGIT-8-4-A PIC X(4). PICKNMBR
|
||||
00178 05 DIGIT-8-MM-A PIC X(2). PICKNMBR
|
||||
00179 05 DIGIT-8-DD-A PIC X(2). PICKNMBR
|
||||
00180 ** PICKNMBR
|
||||
00181 01 DIGIT-8-2-2. PICKNMBR
|
||||
00182 05 DIGIT-8-4-B PIC X(4) VALUE SPACES. PICKNMBR
|
||||
00183 05 FILLER PIC X VALUE '/'. PICKNMBR
|
||||
00184 05 DIGIT-8-MM-B PIC X(2) VALUE SPACES. PICKNMBR
|
||||
00185 05 FILLER PIC X VALUE '/'. PICKNMBR
|
||||
00186 05 DIGIT-8-DD-B PIC X(2) VALUE SPACES. PICKNMBR
|
||||
00187 ** PICKNMBR
|
||||
00188 01 DIGIT-5 PIC X(8) VALUE SPACES. PICKNMBR
|
||||
00189 01 FILLER REDEFINES DIGIT-5. PICKNMBR
|
||||
00190 05 DIGIT-5-4-A PIC X(4). PICKNMBR
|
||||
00191 05 DIGIT-5-1-A PIC X(1). PICKNMBR
|
||||
00192 05 DIGIT-5-3-A PIC X(3). PICKNMBR
|
||||
00193 ** PICKNMBR
|
||||
00194 01 DIGIT-5-3. PICKNMBR
|
||||
00195 05 DIGIT-5-4-B PIC X(4) VALUE SPACES. PICKNMBR
|
||||
00196 05 FILLER PIC X VALUE '/'. PICKNMBR
|
||||
00197 05 DIGIT-5-1-B PIC X(1) VALUE SPACES. PICKNMBR
|
||||
00198 05 FILLER PIC X(2) VALUE SPACES. PICKNMBR
|
||||
00199 ** PICKNMBR
|
||||
00200 01 DIGIT-4-4. PICKNMBR
|
||||
00201 05 DIGIT-4 PIC X(4) VALUE SPACES. PICKNMBR
|
||||
00202 05 DIGIT-2-4 PIC X(4) VALUE SPACES. PICKNMBR
|
||||
00203 ** PICKNMBR
|
||||
00204 01 PERIOD-Y PIC X(12) VALUE ' (YYYY): '. PICKNMBR
|
||||
00205 01 PERIOD-YQ PIC X(12) VALUE ' (YYYYQ): '. PICKNMBR
|
||||
00206 01 PERIOD-YMD PIC X(12) VALUE '(YYYYMMDD): '. PICKNMBR
|
||||
00207 * PICKNMBR
|
||||
00208 *************************************************************** PICKNMBR
|
||||
00209 ** STATE-TABLE: ** PICKNMBR
|
||||
00210 ** CONTAINS THE STATE NAME. ** PICKNMBR
|
||||
00211 *************************************************************** PICKNMBR
|
||||
00212 * PICKNMBR
|
||||
00213 01 STATE-TABLE. PICKNMBR
|
||||
00214 03 STATE-NAME-TABLE. PICKNMBR
|
||||
00215 05 FILLER PIC X(20) VALUE 'ALABAMA'. PICKNMBR
|
||||
00216 05 FILLER PIC X(20) VALUE 'ALASKA'. PICKNMBR
|
||||
00217 05 FILLER PIC X(20) VALUE 'ARIZONA'. PICKNMBR
|
||||
00218 05 FILLER PIC X(20) VALUE 'ARKANSAS'. PICKNMBR
|
||||
00219 05 FILLER PIC X(20) VALUE 'CALIFORNIA'. PICKNMBR
|
||||
00220 05 FILLER PIC X(20) VALUE 'COLORADO'. PICKNMBR
|
||||
00221 05 FILLER PIC X(20) VALUE 'CONNECTICUT'. PICKNMBR
|
||||
00222 05 FILLER PIC X(20) VALUE 'DELAWARE'. PICKNMBR
|
||||
00223 05 FILLER PIC X(20) VALUE 'DISTRICT OF COLUMBIA'. PICKNMBR
|
||||
00224 05 FILLER PIC X(20) VALUE 'FLORIDA'. PICKNMBR
|
||||
00225 05 FILLER PIC X(20) VALUE 'GEORGIA'. PICKNMBR
|
||||
00226 05 FILLER PIC X(20) VALUE 'HAWAII'. PICKNMBR
|
||||
00227 05 FILLER PIC X(20) VALUE 'IDAHO'. PICKNMBR
|
||||
00228 05 FILLER PIC X(20) VALUE 'ILLINOIS'. PICKNMBR
|
||||
00229 05 FILLER PIC X(20) VALUE 'INDIANA'. PICKNMBR
|
||||
00230 05 FILLER PIC X(20) VALUE 'IOWA'. PICKNMBR
|
||||
00231 05 FILLER PIC X(20) VALUE 'KANSAS'. PICKNMBR
|
||||
00232 05 FILLER PIC X(20) VALUE 'KENTUCKY'. PICKNMBR
|
||||
00233 05 FILLER PIC X(20) VALUE 'LOUISIANA'. PICKNMBR
|
||||
00234 05 FILLER PIC X(20) VALUE 'MAINE'. PICKNMBR
|
||||
00235 05 FILLER PIC X(20) VALUE 'MARYLAND'. PICKNMBR
|
||||
00236 05 FILLER PIC X(20) VALUE 'MASSACHUSETTS'. PICKNMBR
|
||||
00237 05 FILLER PIC X(20) VALUE 'MICHIGAN'. PICKNMBR
|
||||
00238 05 FILLER PIC X(20) VALUE 'MINNESOTA'. PICKNMBR
|
||||
00239 05 FILLER PIC X(20) VALUE 'MISSISSIPPI'. PICKNMBR
|
||||
00240 05 FILLER PIC X(20) VALUE 'MISSOURI'. PICKNMBR
|
||||
00241 05 FILLER PIC X(20) VALUE 'MONTANA'. PICKNMBR
|
||||
00242 05 FILLER PIC X(20) VALUE 'NEBRASKA'. PICKNMBR
|
||||
00243 05 FILLER PIC X(20) VALUE 'NEVADA'. PICKNMBR
|
||||
00244 05 FILLER PIC X(20) VALUE 'NEW HAMPSHIRE'. PICKNMBR
|
||||
00245 05 FILLER PIC X(20) VALUE 'NEW JERSEY'. PICKNMBR
|
||||
00246 05 FILLER PIC X(20) VALUE 'NEW MEXICO'. PICKNMBR
|
||||
00247 05 FILLER PIC X(20) VALUE 'NEW YORK'. PICKNMBR
|
||||
00248 05 FILLER PIC X(20) VALUE 'NORTH CAROLINA'. PICKNMBR
|
||||
00249 05 FILLER PIC X(20) VALUE 'NORTH DAKOTA'. PICKNMBR
|
||||
00250 05 FILLER PIC X(20) VALUE 'OHIO'. PICKNMBR
|
||||
00251 05 FILLER PIC X(20) VALUE 'OKLAHOMA'. PICKNMBR
|
||||
00252 05 FILLER PIC X(20) VALUE 'OREGON'. PICKNMBR
|
||||
00253 05 FILLER PIC X(20) VALUE 'PENNSYLVANIA'. PICKNMBR
|
||||
00254 05 FILLER PIC X(20) VALUE 'PUERTO RICO'. PICKNMBR
|
||||
00255 05 FILLER PIC X(20) VALUE 'RHODE ISLAND'. PICKNMBR
|
||||
00256 05 FILLER PIC X(20) VALUE 'SOUTH CAROLINA'. PICKNMBR
|
||||
00257 05 FILLER PIC X(20) VALUE 'SOUTH DAKOTA'. PICKNMBR
|
||||
00258 05 FILLER PIC X(20) VALUE 'TENNESSEE'. PICKNMBR
|
||||
00259 05 FILLER PIC X(20) VALUE 'TEXAS'. PICKNMBR
|
||||
00260 05 FILLER PIC X(20) VALUE 'UTAH'. PICKNMBR
|
||||
00261 05 FILLER PIC X(20) VALUE 'VERMONT'. PICKNMBR
|
||||
00262 05 FILLER PIC X(20) VALUE 'VIRGINIA'. PICKNMBR
|
||||
00263 05 FILLER PIC X(20) VALUE 'VIRGIN ISLANDS'. PICKNMBR
|
||||
00264 05 FILLER PIC X(20) VALUE 'WASHINGTON'. PICKNMBR
|
||||
00265 05 FILLER PIC X(20) VALUE 'WEST VIRGINIA'. PICKNMBR
|
||||
00266 05 FILLER PIC X(20) VALUE 'WISCONSIN'. PICKNMBR
|
||||
00267 05 FILLER PIC X(20) VALUE 'WYOMING'. PICKNMBR
|
||||
00268 03 STATE-NAME REDEFINES STATE-NAME-TABLE OCCURS 53 TIMES INPICKNMBR
|
||||
00269 - DEXED BY STATE-NAME-INDEX PIC X(20). PICKNMBR
|
||||
00270 * PICKNMBR
|
||||
00271 *************************************************************** PICKNMBR
|
||||
00272 ** STATE-ID-TABLE: ** PICKNMBR
|
||||
00273 ** CONTAINS THE FIPS CODE. ** PICKNMBR
|
||||
00274 *************************************************************** PICKNMBR
|
||||
00275 * PICKNMBR
|
||||
00276 03 STATE-ID-TABLE. PICKNMBR
|
||||
00277 05 FILLER PIC X(2) VALUE 'AL'. PICKNMBR
|
||||
00278 05 FILLER PIC X(2) VALUE 'AK'. PICKNMBR
|
||||
00279 05 FILLER PIC X(2) VALUE 'AZ'. PICKNMBR
|
||||
00280 05 FILLER PIC X(2) VALUE 'AR'. PICKNMBR
|
||||
00281 05 FILLER PIC X(2) VALUE 'CA'. PICKNMBR
|
||||
00282 05 FILLER PIC X(2) VALUE 'CO'. PICKNMBR
|
||||
00283 05 FILLER PIC X(2) VALUE 'CT'. PICKNMBR
|
||||
00284 05 FILLER PIC X(2) VALUE 'DE'. PICKNMBR
|
||||
00285 05 FILLER PIC X(2) VALUE 'DC'. PICKNMBR
|
||||
00286 05 FILLER PIC X(2) VALUE 'FL'. PICKNMBR
|
||||
00287 05 FILLER PIC X(2) VALUE 'GA'. PICKNMBR
|
||||
00288 05 FILLER PIC X(2) VALUE 'HI'. PICKNMBR
|
||||
00289 05 FILLER PIC X(2) VALUE 'ID'. PICKNMBR
|
||||
00290 05 FILLER PIC X(2) VALUE 'IL'. PICKNMBR
|
||||
00291 05 FILLER PIC X(2) VALUE 'IN'. PICKNMBR
|
||||
00292 05 FILLER PIC X(2) VALUE 'IA'. PICKNMBR
|
||||
00293 05 FILLER PIC X(2) VALUE 'KS'. PICKNMBR
|
||||
00294 05 FILLER PIC X(2) VALUE 'KY'. PICKNMBR
|
||||
00295 05 FILLER PIC X(2) VALUE 'LA'. PICKNMBR
|
||||
00296 05 FILLER PIC X(2) VALUE 'ME'. PICKNMBR
|
||||
00297 05 FILLER PIC X(2) VALUE 'MD'. PICKNMBR
|
||||
00298 05 FILLER PIC X(2) VALUE 'MA'. PICKNMBR
|
||||
00299 05 FILLER PIC X(2) VALUE 'MI'. PICKNMBR
|
||||
00300 05 FILLER PIC X(2) VALUE 'MN'. PICKNMBR
|
||||
00301 05 FILLER PIC X(2) VALUE 'MS'. PICKNMBR
|
||||
00302 05 FILLER PIC X(2) VALUE 'MO'. PICKNMBR
|
||||
00303 05 FILLER PIC X(2) VALUE 'MT'. PICKNMBR
|
||||
00304 05 FILLER PIC X(2) VALUE 'NE'. PICKNMBR
|
||||
00305 05 FILLER PIC X(2) VALUE 'NV'. PICKNMBR
|
||||
00306 05 FILLER PIC X(2) VALUE 'NH'. PICKNMBR
|
||||
00307 05 FILLER PIC X(2) VALUE 'NJ'. PICKNMBR
|
||||
00308 05 FILLER PIC X(2) VALUE 'NM'. PICKNMBR
|
||||
00309 05 FILLER PIC X(2) VALUE 'NY'. PICKNMBR
|
||||
00310 05 FILLER PIC X(2) VALUE 'NC'. PICKNMBR
|
||||
00311 05 FILLER PIC X(2) VALUE 'ND'. PICKNMBR
|
||||
00312 05 FILLER PIC X(2) VALUE 'OH'. PICKNMBR
|
||||
00313 05 FILLER PIC X(2) VALUE 'OK'. PICKNMBR
|
||||
00314 05 FILLER PIC X(2) VALUE 'OR'. PICKNMBR
|
||||
00315 05 FILLER PIC X(2) VALUE 'PA'. PICKNMBR
|
||||
00316 05 FILLER PIC X(2) VALUE 'PR'. PICKNMBR
|
||||
00317 05 FILLER PIC X(2) VALUE 'RI'. PICKNMBR
|
||||
00318 05 FILLER PIC X(2) VALUE 'SC'. PICKNMBR
|
||||
00319 05 FILLER PIC X(2) VALUE 'SD'. PICKNMBR
|
||||
00320 05 FILLER PIC X(2) VALUE 'TN'. PICKNMBR
|
||||
00321 05 FILLER PIC X(2) VALUE 'TX'. PICKNMBR
|
||||
00322 05 FILLER PIC X(2) VALUE 'UT'. PICKNMBR
|
||||
00323 05 FILLER PIC X(2) VALUE 'VT'. PICKNMBR
|
||||
00324 05 FILLER PIC X(2) VALUE 'VA'. PICKNMBR
|
||||
00325 05 FILLER PIC X(2) VALUE 'VI'. PICKNMBR
|
||||
00326 05 FILLER PIC X(2) VALUE 'WA'. PICKNMBR
|
||||
00327 05 FILLER PIC X(2) VALUE 'WV'. PICKNMBR
|
||||
00328 05 FILLER PIC X(2) VALUE 'WI'. PICKNMBR
|
||||
00329 05 FILLER PIC X(2) VALUE 'WY'. PICKNMBR
|
||||
00330 03 STATE-ID REDEFINES STATE-ID-TABLE OCCURS 53 TIMES INPICKNMBR
|
||||
00331 - DEXED BY STATE-ID-INDEX PIC X(2). PICKNMBR
|
||||
00332 ****** PICKNMBR
|
||||
00333 01 SPL-TABLE-CONTROLS. PICKNMBR
|
||||
00334 05 SPL-ENTRY-FOUND-SWITCH PIC X(03). PICKNMBR
|
||||
00335 88 SPL-ENTRY-FOUND VALUE 'YES'. PICKNMBR
|
||||
00336 88 SPL-END-OF-TABLE VALUE 'END'. PICKNMBR
|
||||
00337 * PICKNMBR
|
||||
00338 *************************************************************** PICKNMBR
|
||||
00339 ** SPL-TYPE-DATA. ** PICKNMBR
|
||||
00340 ** CONTAINS THE RQC SAMPLE TYPES, A 2 CHARACTER CODE AND A ** PICKNMBR
|
||||
00341 ** 25 CHARACTER DEFINITION. ** PICKNMBR
|
||||
00342 *************************************************************** PICKNMBR
|
||||
00343 * PICKNMBR
|
||||
00344 01 SPL-TYPE-DATA. PICKNMBR
|
||||
00345 05 FILLER PIC X(27) VALUE 'A11ST ACCEPTANCE SAMPLE '. PICKNMBR
|
||||
00346 05 FILLER PIC X(27) VALUE 'A22ND ACCEPTANCE SAMPLE '. PICKNMBR
|
||||
00347 05 FILLER PIC X(27) VALUE 'E1EXPANDED SAMPLE '. PICKNMBR
|
||||
00348 05 FILLER PIC X(27) VALUE 'O11ST SESA OPTIONAL SAMPLE '. PICKNMBR
|
||||
00349 05 FILLER PIC X(27) VALUE 'O22ND SESA OPTIONAL SAMPLE '. PICKNMBR
|
||||
00350 01 SPL-TYPE-TABLE REDEFINES SPL-TYPE-DATA. PICKNMBR
|
||||
00351 05 SPL-TABLE-ENTRY OCCURS 5 TIMES PICKNMBR
|
||||
00352 INDEXED BY SPL-INDEX. PICKNMBR
|
||||
00353 10 SPL-ID PIC X(2). PICKNMBR
|
||||
00354 10 SPL-NAME PIC X(25). PICKNMBR
|
||||
00355 ** PICKNMBR
|
||||
00356 *************************************************************** PICKNMBR
|
||||
00357 ** (OUTPUT-TITLES) DESCRIBES THE LINES FOR EACH LINE OF THE ** PICKNMBR
|
||||
00358 ** REPORT TITLE. ** PICKNMBR
|
||||
00359 *************************************************************** PICKNMBR
|
||||
00360 01 LIST-HEADING-1. PICKNMBR
|
||||
00361 10 FILLER PIC X(1) VALUE SPACES. PICKNMBR
|
||||
00362 10 FILLER PIC X(9) VALUE 'RUN DATE:'. PICKNMBR
|
||||
00363 10 FILLER PIC X(1) VALUE SPACES. PICKNMBR
|
||||
00364 10 O-RUN-DATE PIC X(8) VALUE SPACES. PICKNMBR
|
||||
00365 10 FILLER PIC X(14) VALUE SPACES. PICKNMBR
|
||||
00366 10 O-TITLE PIC X(35) VALUE SPACES. PICKNMBR
|
||||
00367 10 FILLER PIC X(33) VALUE SPACES. PICKNMBR
|
||||
00368 10 FILLER PIC X(5) VALUE 'PAGE:'. PICKNMBR
|
||||
00369 10 FILLER PIC X(1) VALUE SPACES. PICKNMBR
|
||||
00370 10 O-LIST-PAGE PIC ZZZZZ9 VALUE ZEROS. PICKNMBR
|
||||
00371 10 FILLER PIC X(19) VALUE SPACES. PICKNMBR
|
||||
00372 ** PICKNMBR
|
||||
00373 01 LIST-HEADING-2. PICKNMBR
|
||||
00374 10 FILLER PIC X(37) VALUE SPACES. PICKNMBR
|
||||
00375 10 FILLER PIC X(20) PICKNMBR
|
||||
00376 VALUE 'RECORDS FOR SAMPLING'. PICKNMBR
|
||||
00377 10 FILLER PIC X(75) VALUE SPACES. PICKNMBR
|
||||
00378 ** PICKNMBR
|
||||
00379 01 LIST-HEADING-3. PICKNMBR
|
||||
00380 10 FILLER PIC X(1) VALUE SPACES. PICKNMBR
|
||||
00381 10 FILLER PIC X(6) VALUE 'PERIOD'. PICKNMBR
|
||||
00382 10 O-PERIOD-MARK PIC X(12) VALUE SPACES. PICKNMBR
|
||||
00383 10 O-PERIOD PIC X(12) VALUE SPACES. PICKNMBR
|
||||
00384 10 FILLER PIC X(9) VALUE SPACES. PICKNMBR
|
||||
00385 10 FILLER PIC X(9) VALUE 'STATE OF '. PICKNMBR
|
||||
00386 10 O-SESA-NAME PIC X(20) VALUE SPACES. PICKNMBR
|
||||
00387 10 FILLER PIC X(3) VALUE SPACES. PICKNMBR
|
||||
00388 10 FILLER PIC X(13) VALUE 'SAMPLE TYPE: '. PICKNMBR
|
||||
00389 10 O-SAMPLE-TYPE PIC X(27) VALUE SPACES. PICKNMBR
|
||||
00390 10 FILLER PIC X(20) VALUE SPACES. PICKNMBR
|
||||
00391 ** PICKNMBR
|
||||
00392 01 LIST-HEADING-4. PICKNMBR
|
||||
00393 10 FILLER PIC X(10) VALUE SPACES. PICKNMBR
|
||||
00394 10 FILLER PIC X(11) VALUE 'CASE NUMBER'. PICKNMBR
|
||||
00395 10 FILLER PIC X(4) VALUE SPACES. PICKNMBR
|
||||
00396 10 FILLER PIC X(15) VALUE 'SEQUENCE NUMBER'. PICKNMBR
|
||||
00397 10 FILLER PIC X(82) VALUE SPACES. PICKNMBR
|
||||
00398 01 BLANK-LINE. PICKNMBR
|
||||
00399 10 FILLER PIC X(132) VALUE SPACES. PICKNMBR
|
||||
00400 *** PICKNMBR
|
||||
00401 PROCEDURE DIVISION. PICKNMBR
|
||||
00402 *************************************************************** PICKNMBR
|
||||
00403 ** 0000-DRIVER-ROUTINE. ** PICKNMBR
|
||||
00404 ** THIS SECTION PERFORMS THE MAIN PROCESSING OF THE PROGRAM. ** PICKNMBR
|
||||
00405 *************************************************************** PICKNMBR
|
||||
00406 0000-DRIVER-ROUTINE. PICKNMBR
|
||||
00407 ACCEPT WS-DATE FROM DATE. PICKNMBR
|
||||
00408 MOVE WS-YY TO WRK-YY. PICKNMBR
|
||||
00409 MOVE WS-MM TO WRK-MM. PICKNMBR
|
||||
00410 MOVE WS-DD TO WRK-DD. PICKNMBR
|
||||
00411 MOVE WRK-DATE-AREA TO O-RUN-DATE. PICKNMBR
|
||||
00412 PERFORM 0100-OPEN-ROUTINE THRU 0100-OPEN-ROUTINE-EXIT. PICKNMBR
|
||||
00413 PERFORM 0110-CNTL-OPTION THRU 0110-CNTL-OPTION-EXIT. PICKNMBR
|
||||
00414 PERFORM 0120-CNTL-ERROR THRU 0120-CNTL-ERROR-EXIT. PICKNMBR
|
||||
00415 PERFORM 0130-FIPS-TABLE THRU 0130-FIPS-TABLE-EXIT. PICKNMBR
|
||||
00416 PERFORM 0140-SPL-TABLE THRU 0140-SPL-TABLE-EXIT. PICKNMBR
|
||||
00417 PERFORM 0001-LIST-HEADING THRU 0001-LIST-EXIT. PICKNMBR
|
||||
00418 IF (TRANS-REC-CNTR > 200 ) PICKNMBR
|
||||
00419 PERFORM 0200-CALC-SKIP-INTERVAL PICKNMBR
|
||||
00420 PERFORM 0300-CALC-INITIAL-CASE PICKNMBR
|
||||
00421 PERFORM 0400-REMAINING-NUMBERS PICKNMBR
|
||||
00422 THRU 0400-REMAINING-NUMBERS-EXIT PICKNMBR
|
||||
00423 UNTIL LOOP-NBR < 0 PICKNMBR
|
||||
00424 ELSE PICKNMBR
|
||||
00425 PERFORM 0500-CALC-SKIPINTERVAL PICKNMBR
|
||||
00426 PERFORM 0600-CALC-INITIAL-CASE PICKNMBR
|
||||
00427 PERFORM 0700-SELECTED-NUMBERS PICKNMBR
|
||||
00428 THRU 0700-SELECTED-NUMBERS-EXIT PICKNMBR
|
||||
00429 UNTIL CASE-NUM = SAMPLED-NMBR. PICKNMBR
|
||||
00430 PERFORM 0900-TRAILER-LIST THRU 0900-TRAILER-EXIT. PICKNMBR
|
||||
00431 PERFORM 9999-CLOSE-FILES. PICKNMBR
|
||||
00432 STOP RUN. PICKNMBR
|
||||
00433 ** PICKNMBR
|
||||
00434 ********************************************************* PICKNMBR
|
||||
00435 ** 0001-LIST-HEADING. ** PICKNMBR
|
||||
00436 ** 0002-LIST-HEADING. ** PICKNMBR
|
||||
00437 ** THESE SECTIONS CONTROL PRINTING OF REPORT PAGE AND ** PICKNMBR
|
||||
00438 ** COLUMN HEADER INFORMATION, LINE COUNT, AND PAGE ** PICKNMBR
|
||||
00439 ** ADVANCEMENT. ** PICKNMBR
|
||||
00440 ********************************************************* PICKNMBR
|
||||
00441 ** PICKNMBR
|
||||
00442 0001-LIST-HEADING. PICKNMBR
|
||||
00443 ADD 1 TO LIST-PAGE. PICKNMBR
|
||||
00444 MOVE LIST-PAGE TO O-LIST-PAGE. PICKNMBR
|
||||
00445 WRITE PICKNUM-REC FROM LIST-HEADING-1 PICKNMBR
|
||||
00446 AFTER ADVANCING PAGE. PICKNMBR
|
||||
00447 WRITE PICKNUM-REC FROM LIST-HEADING-2 AFTER 1 LINES. PICKNMBR
|
||||
00448 WRITE PICKNUM-REC FROM LIST-HEADING-3 AFTER 1 LINES. PICKNMBR
|
||||
00449 WRITE PICKNUM-REC FROM LIST-HEADING-4 AFTER 3 LINES. PICKNMBR
|
||||
00450 WRITE PICKNUM-REC FROM BLANK-LINE AFTER 1 LINES. PICKNMBR
|
||||
00451 0001-LIST-EXIT. PICKNMBR
|
||||
00452 EXIT. PICKNMBR
|
||||
00453 ** PICKNMBR
|
||||
00454 0002-LIST-HEADING. PICKNMBR
|
||||
00455 ADD 1 TO LIST-PAGE. PICKNMBR
|
||||
00456 MOVE LIST-PAGE TO O-LIST-PAGE. PICKNMBR
|
||||
00457 WRITE PICKNUM-REC FROM LIST-HEADING-1 PICKNMBR
|
||||
00458 AFTER ADVANCING PAGE. PICKNMBR
|
||||
00459 WRITE PICKNUM-REC FROM LIST-HEADING-2 AFTER 1 LINES. PICKNMBR
|
||||
00460 WRITE PICKNUM-REC FROM LIST-HEADING-3 AFTER 1 LINES. PICKNMBR
|
||||
00461 0002-LIST-EXIT. PICKNMBR
|
||||
00462 EXIT. PICKNMBR
|
||||
00463 ** PICKNMBR
|
||||
00464 ********************************************************* PICKNMBR
|
||||
00465 ** 0011-CS011, 0031-CS031, 0041-CS041, 0042-CS042, ** PICKNMBR
|
||||
00466 ** 0043-CS043, 0051-CS051, 0061-CS061. ** PICKNMBR
|
||||
00467 ** THIS SECTIONS IDENTIFY EACH OF THE TAX FUNCTIONS ** PICKNMBR
|
||||
00468 ** AND CORRESPONDING YEAR/QUARTER FIELDS FOR THE ** PICKNMBR
|
||||
00469 ** INDIVIDUAL TAX FUNCTION BEING PROCESSED. ** PICKNMBR
|
||||
00470 ********************************************************* PICKNMBR
|
||||
00471 ** PICKNMBR
|
||||
00472 0011-CS011. PICKNMBR
|
||||
00473 IF CNTRL-TRANS-TYPE = '1' THEN PICKNMBR
|
||||
00474 MOVE ' STATUS DETERMINATION - NEW ' TO O-TITLE PICKNMBR
|
||||
00475 ELSE IF CNTRL-TRANS-TYPE = '2' THEN PICKNMBR
|
||||
00476 MOVE ' STATUS DETERMINATION - SUCCESSOR ' TO O-TITLE PICKNMBR
|
||||
00477 ELSE IF CNTRL-TRANS-TYPE = '3' THEN PICKNMBR
|
||||
00478 MOVE ' STATUS DETERMINATION - INACTIVE ' TO O-TITLE. PICKNMBR
|
||||
00479 PERFORM 0071-Y-FORMATE THRU 0071-Y-FORMATE-EXIT. PICKNMBR
|
||||
00480 0011-CS011-EXIT. PICKNMBR
|
||||
00481 EXIT. PICKNMBR
|
||||
00482 ** PICKNMBR
|
||||
00483 0021-CS021. PICKNMBR
|
||||
00484 IF CNTRL-TRANS-TYPE = '1' THEN PICKNMBR
|
||||
00485 MOVE ' CASHIERING - ACCURACY ' TO O-TITLE PICKNMBR
|
||||
00486 ELSE IF CNTRL-TRANS-TYPE = '2' THEN PICKNMBR
|
||||
00487 MOVE ' CASHIERING - TIMELINESS ' TO O-TITLE. PICKNMBR
|
||||
00488 PERFORM 0071-Y-FORMATE THRU 0071-Y-FORMATE-EXIT. PICKNMBR
|
||||
00489 0021-CS021-EXIT. PICKNMBR
|
||||
00490 EXIT. PICKNMBR
|
||||
00491 ** PICKNMBR
|
||||
00492 0031-CS031. PICKNMBR
|
||||
00493 IF CNTRL-TRANS-TYPE = '1' THEN PICKNMBR
|
||||
00494 MOVE ' FIELD AUDIT - RANDOM ' TO O-TITLE PICKNMBR
|
||||
00495 ELSE IF CNTRL-TRANS-TYPE = '2' THEN PICKNMBR
|
||||
00496 MOVE ' FIELD AUDIT - OTHER ' TO O-TITLE. PICKNMBR
|
||||
00497 PERFORM 0071-Y-FORMATE THRU 0071-Y-FORMATE-EXIT. PICKNMBR
|
||||
00498 0031-CS031-EXIT. PICKNMBR
|
||||
00499 EXIT. PICKNMBR
|
||||
00500 ** PICKNMBR
|
||||
00501 0041-CS041. PICKNMBR
|
||||
00502 MOVE ' CONTRIBUTION REPORT ' TO O-TITLE. PICKNMBR
|
||||
00503 PERFORM 0072-YQ-FORMATE THRU 0072-YQ-FORMATE-EXIT. PICKNMBR
|
||||
00504 0041-CS041-EXIT. PICKNMBR
|
||||
00505 EXIT. PICKNMBR
|
||||
00506 ** PICKNMBR
|
||||
00507 0042-CS042. PICKNMBR
|
||||
00508 IF CNTRL-TRANS-TYPE = '1' THEN PICKNMBR
|
||||
00509 MOVE 'EMPLOYER BILLINGS - CONTRIBUTORY ' TO O-TITLE PICKNMBR
|
||||
00510 ELSE IF CNTRL-TRANS-TYPE = '2' THEN PICKNMBR
|
||||
00511 MOVE 'EMPLOYER BILLINGS - REIMBURSING ' TO O-TITLE. PICKNMBR
|
||||
00512 PERFORM 0072-YQ-FORMATE THRU 0072-YQ-FORMATE-EXIT. PICKNMBR
|
||||
00513 0042-CS042-EXIT. PICKNMBR
|
||||
00514 EXIT. PICKNMBR
|
||||
00515 ** PICKNMBR
|
||||
00516 0043-CS043. PICKNMBR
|
||||
00517 MOVE ' CREDITS/REFUNDS ' TO O-TITLE. PICKNMBR
|
||||
00518 PERFORM 0072-YQ-FORMATE THRU 0072-YQ-FORMATE-EXIT. PICKNMBR
|
||||
00519 0043-CS043-EXIT. PICKNMBR
|
||||
00520 EXIT. PICKNMBR
|
||||
00521 ** PICKNMBR
|
||||
00522 0044-CS044. PICKNMBR
|
||||
00523 MOVE ' EMPLOYER BENEFIT CHARGING ' TO O-TITLE. PICKNMBR
|
||||
00524 PERFORM 0072-YQ-FORMATE THRU 0072-YQ-FORMATE-EXIT. PICKNMBR
|
||||
00525 0044-CS044-EXIT. PICKNMBR
|
||||
00526 EXIT. PICKNMBR
|
||||
00527 ** PICKNMBR
|
||||
00528 0045-CS045. PICKNMBR
|
||||
00529 MOVE ' EXPERIENCE RATING ' TO O-TITLE. PICKNMBR
|
||||
00530 PERFORM 0071-Y-FORMATE THRU 0071-Y-FORMATE-EXIT. PICKNMBR
|
||||
00531 0045-CS045-EXIT. PICKNMBR
|
||||
00532 EXIT. PICKNMBR
|
||||
00533 ** PICKNMBR
|
||||
00534 0051-CS051. PICKNMBR
|
||||
00535 MOVE ' COLLECTIONS ' TO O-TITLE. PICKNMBR
|
||||
00536 PERFORM 0073-YMD-FORMATE THRU 0073-YMD-FORMATE-EXIT. PICKNMBR
|
||||
00537 0051-CS051-EXIT. PICKNMBR
|
||||
00538 EXIT. PICKNMBR
|
||||
00539 ** PICKNMBR
|
||||
00540 0061-CS061. PICKNMBR
|
||||
00541 MOVE ' REPORT DELINQUENCY ' TO O-TITLE. PICKNMBR
|
||||
00542 PERFORM 0072-YQ-FORMATE THRU 0072-YQ-FORMATE-EXIT. PICKNMBR
|
||||
00543 0061-CS061-EXIT. PICKNMBR
|
||||
00544 EXIT. PICKNMBR
|
||||
00545 ** PICKNMBR
|
||||
00546 0071-Y-FORMATE. PICKNMBR
|
||||
00547 MOVE CNTRL-YEAR-QTR TO DIGIT-4-4. PICKNMBR
|
||||
00548 MOVE SPACES TO DIGIT-2-4. PICKNMBR
|
||||
00549 MOVE DIGIT-4-4 TO O-PERIOD. PICKNMBR
|
||||
00550 MOVE PERIOD-Y TO O-PERIOD-MARK. PICKNMBR
|
||||
00551 0071-Y-FORMATE-EXIT. PICKNMBR
|
||||
00552 EXIT. PICKNMBR
|
||||
00553 ** PICKNMBR
|
||||
00554 0072-YQ-FORMATE. PICKNMBR
|
||||
00555 MOVE CNTRL-YEAR-QTR TO DIGIT-5. PICKNMBR
|
||||
00556 MOVE DIGIT-5-4-A TO DIGIT-5-4-B. PICKNMBR
|
||||
00557 MOVE DIGIT-5-1-A TO DIGIT-5-1-B. PICKNMBR
|
||||
00558 MOVE DIGIT-5-3 TO O-PERIOD. PICKNMBR
|
||||
00559 MOVE PERIOD-YQ TO O-PERIOD-MARK. PICKNMBR
|
||||
00560 0072-YQ-FORMATE-EXIT. PICKNMBR
|
||||
00561 EXIT. PICKNMBR
|
||||
00562 ** PICKNMBR
|
||||
00563 0073-YMD-FORMATE. PICKNMBR
|
||||
00564 MOVE CNTRL-YEAR-QTR TO DIGIT-8. PICKNMBR
|
||||
00565 MOVE DIGIT-8-4-A TO DIGIT-8-4-B. PICKNMBR
|
||||
00566 MOVE DIGIT-8-MM-A TO DIGIT-8-MM-B. PICKNMBR
|
||||
00567 MOVE DIGIT-8-DD-A TO DIGIT-8-DD-B. PICKNMBR
|
||||
00568 MOVE DIGIT-8-2-2 TO O-PERIOD. PICKNMBR
|
||||
00569 MOVE PERIOD-YMD TO O-PERIOD-MARK. PICKNMBR
|
||||
00570 0073-YMD-FORMATE-EXIT. PICKNMBR
|
||||
00571 EXIT. PICKNMBR
|
||||
00572 ** PICKNMBR
|
||||
00573 *************************************************************** PICKNMBR
|
||||
00574 ** 0100-OPEN-ROUTINE. ** PICKNMBR
|
||||
00575 ** THIS SECTION OPENS THE INPUT CNTRL-DATA FILE, OUTPUT ** PICKNMBR
|
||||
00576 ** SELECT-NUMBERS FILE AND PICKNUM-LIST. ** PICKNMBR
|
||||
00577 *************************************************************** PICKNMBR
|
||||
00578 0100-OPEN-ROUTINE. PICKNMBR
|
||||
00579 OPEN INPUT CNTRL-DATA. PICKNMBR
|
||||
00580 OPEN OUTPUT SELECT-NUMBERS. PICKNMBR
|
||||
00581 OPEN OUTPUT PICKNUM-LIST. PICKNMBR
|
||||
00582 MOVE 1 TO O-CASE-NUM, O-PICK-NUM. PICKNMBR
|
||||
00583 READ CNTRL-DATA AT END MOVE 'Y' TO CNTRL-FLAG. PICKNMBR
|
||||
00584 0100-OPEN-ROUTINE-EXIT. PICKNMBR
|
||||
00585 EXIT. PICKNMBR
|
||||
00586 *************************************************************** PICKNMBR
|
||||
00587 ** 0110-CNTL-OPTION. ** PICKNMBR
|
||||
00588 ** THIS SECTION DETERMINES WHICH TAX FUNCTION IS BEING ** PICKNMBR
|
||||
00589 ** PROCESSED. ** PICKNMBR
|
||||
00590 *************************************************************** PICKNMBR
|
||||
00591 0110-CNTL-OPTION. PICKNMBR
|
||||
00592 IF CNTRL-TYPE = 'CS011' THEN PICKNMBR
|
||||
00593 PERFORM 0011-CS011 THRU 0011-CS011-EXIT PICKNMBR
|
||||
00594 ELSE IF CNTRL-TYPE = 'CS021' THEN PICKNMBR
|
||||
00595 PERFORM 0021-CS021 THRU 0021-CS021-EXIT PICKNMBR
|
||||
00596 ELSE IF CNTRL-TYPE = 'CS031' THEN PICKNMBR
|
||||
00597 PERFORM 0031-CS031 THRU 0031-CS031-EXIT PICKNMBR
|
||||
00598 ELSE IF CNTRL-TYPE = 'CS041' THEN PICKNMBR
|
||||
00599 PERFORM 0041-CS041 THRU 0041-CS041-EXIT PICKNMBR
|
||||
00600 ELSE IF CNTRL-TYPE = 'CS042' THEN PICKNMBR
|
||||
00601 PERFORM 0042-CS042 THRU 0042-CS042-EXIT PICKNMBR
|
||||
00602 ELSE IF CNTRL-TYPE = 'CS043' THEN PICKNMBR
|
||||
00603 PERFORM 0043-CS043 THRU 0043-CS043-EXIT PICKNMBR
|
||||
00604 ELSE IF CNTRL-TYPE = 'CS044' THEN PICKNMBR
|
||||
00605 PERFORM 0044-CS044 THRU 0044-CS044-EXIT PICKNMBR
|
||||
00606 ELSE IF CNTRL-TYPE = 'CS045' THEN PICKNMBR
|
||||
00607 PERFORM 0045-CS045 THRU 0045-CS045-EXIT PICKNMBR
|
||||
00608 ELSE IF CNTRL-TYPE = 'CS051' THEN PICKNMBR
|
||||
00609 PERFORM 0051-CS051 THRU 0051-CS051-EXIT PICKNMBR
|
||||
00610 ELSE IF CNTRL-TYPE = 'CS061' THEN PICKNMBR
|
||||
00611 PERFORM 0061-CS061 THRU 0061-CS061-EXIT PICKNMBR
|
||||
00612 ELSE DISPLAY 'INVALID RECORD TYPE IN CONTROL RECORD.' PICKNMBR
|
||||
00613 STOP RUN. PICKNMBR
|
||||
00614 0110-CNTL-OPTION-EXIT. PICKNMBR
|
||||
00615 EXIT. PICKNMBR
|
||||
00616 *************************************************************** PICKNMBR
|
||||
00617 ** 0120-CNTL-ERROR. ** PICKNMBR
|
||||
00618 ** THIS SECTION VALIDATES THE THREE CNTRL-DATA FILE FIELDS ** PICKNMBR
|
||||
00619 ** CNTRL-RANDOM-ALF, TRANS-REC-CNTRL-ALF, AND SAMPLED-NMBR ** PICKNMBR
|
||||
00620 ** FOR NON-NUMERIC VALUES. THESE FIELDS MUST BE NUMERIC FOR ** PICKNMBR
|
||||
00621 ** THE PROGRAM TO EXECUTE. TO ASSIST IN THE VALIDATION, A ** PICKNMBR
|
||||
00622 ** STOP-FLAG FIELD IS INCREMENTED BY A CERTAIN AMOUNT. AS A ** PICKNMBR
|
||||
00623 ** RESULT, A COMPARISON IS MADE BETWEEN THE INCREMENTED ** PICKNMBR
|
||||
00624 ** STOP-FLAG AND A VALUE IN THE RANGE 0 THROUGH 7. WITHIN ** PICKNMBR
|
||||
00625 ** THIS RANGE, DIFFERENT ERROR MESSAGES WILL BE DISPLAYED ** PICKNMBR
|
||||
00626 ** DEPENDING UPON THE ERROR DETECTED, THEN THE PROGRAM IS ** PICKNMBR
|
||||
00627 ** TERMINATED. ** PICKNMBR
|
||||
00628 *************************************************************** PICKNMBR
|
||||
00629 0120-CNTL-ERROR. PICKNMBR
|
||||
00630 IF CNTRL-RANDOM-ALF NOT NUMERIC PICKNMBR
|
||||
00631 ADD 1 TO STOP-FLAG. PICKNMBR
|
||||
00632 IF TRANS-REC-CNTR-ALF NOT NUMERIC PICKNMBR
|
||||
00633 ADD 2 TO STOP-FLAG. PICKNMBR
|
||||
00634 IF SAMPLED-NMBR-ALF NOT NUMERIC PICKNMBR
|
||||
00635 ADD 4 TO STOP-FLAG. PICKNMBR
|
||||
00636 PICKNMBR
|
||||
00637 IF STOP-FLAG = 7 THEN PICKNMBR
|
||||
00638 DISPLAY 'CNTRL-RANDOM, TRANS-REC-CNTR, AND ', PICKNMBR
|
||||
00639 'SAMPLED-NMBR FIELDS IN ERROR.' PICKNMBR
|
||||
00640 ELSE IF STOP-FLAG = 6 THEN PICKNMBR
|
||||
00641 DISPLAY 'TRANS-REC-CNTR, AND ', PICKNMBR
|
||||
00642 'SAMPLED-NMBR FIELDS IN ERROR.' PICKNMBR
|
||||
00643 ELSE IF STOP-FLAG = 5 THEN PICKNMBR
|
||||
00644 DISPLAY 'CNTRL-RANDOM AND TRANS-REC-CNTR ', PICKNMBR
|
||||
00645 'FIELDS IN ERROR.' PICKNMBR
|
||||
00646 ELSE IF STOP-FLAG = 4 THEN PICKNMBR
|
||||
00647 DISPLAY 'SAMPLED-NMBR FIELD IN ERROR.' PICKNMBR
|
||||
00648 ELSE IF STOP-FLAG = 3 THEN PICKNMBR
|
||||
00649 DISPLAY 'CNTRL-RANDOM AND TRANS-REC-CNTR ', PICKNMBR
|
||||
00650 'FIELDS IN ERROR.' PICKNMBR
|
||||
00651 ELSE IF STOP-FLAG = 2 THEN PICKNMBR
|
||||
00652 DISPLAY 'TRANS-REC-CNTR FIELD IN ERROR.' PICKNMBR
|
||||
00653 ELSE IF STOP-FLAG = 1 THEN PICKNMBR
|
||||
00654 DISPLAY 'CNTRL-RANDOM FIELD IN ERROR.'. PICKNMBR
|
||||
00655 PICKNMBR
|
||||
00656 IF STOP-FLAG > 0 THEN PICKNMBR
|
||||
00657 DISPLAY 'NON-NUMERIC DATA IN CONTROL CARD.' PICKNMBR
|
||||
00658 DISPLAY 'CNTRL-RANDOM-ALF', CNTRL-RANDOM-ALF PICKNMBR
|
||||
00659 DISPLAY 'SAMPLED-NMBR ALF', SAMPLED-NMBR-ALF PICKNMBR
|
||||
00660 DISPLAY 'TRANS-REC-CNTR ALF', TRANS-REC-CNTR-ALF PICKNMBR
|
||||
00661 PERFORM 9999-CLOSE-FILES PICKNMBR
|
||||
00662 STOP RUN. PICKNMBR
|
||||
00663 0120-CNTL-ERROR-EXIT. PICKNMBR
|
||||
00664 EXIT. PICKNMBR
|
||||
00665 *************************************************************** PICKNMBR
|
||||
00666 ** 0130-FIPS-TABLE. ** PICKNMBR
|
||||
00667 ** THIS SECTION SEARCHES SESA-ID IN THE FIPS TABLE TO FIND ** PICKNMBR
|
||||
00668 ** THE EXACT STATE NAME ASSOCIATED WITH ITS ABBREVIATION. ** PICKNMBR
|
||||
00669 *************************************************************** PICKNMBR
|
||||
00670 0130-FIPS-TABLE. PICKNMBR
|
||||
00671 SET STATE-NAME-INDEX, STATE-ID-INDEX TO 1. PICKNMBR
|
||||
00672 SEARCH STATE-ID VARYING STATE-NAME-INDEX, PICKNMBR
|
||||
00673 AT END MOVE 0 TO FIPS-FLAG, PICKNMBR
|
||||
00674 WHEN CNTRL-SESA-ID = STATE-ID (STATE-ID-INDEX) PICKNMBR
|
||||
00675 MOVE STATE-NAME (STATE-NAME-INDEX) TO O-SESA-NAME PICKNMBR
|
||||
00676 MOVE 1 TO FIPS-FLAG. PICKNMBR
|
||||
00677 IF FIPS-FLAG = 0 PICKNMBR
|
||||
00678 DISPLAY 'SESA ID NOT FOUND ON FIPS TABLE'. PICKNMBR
|
||||
00679 0130-FIPS-TABLE-EXIT. PICKNMBR
|
||||
00680 EXIT. PICKNMBR
|
||||
00681 *************************************************************** PICKNMBR
|
||||
00682 ** 0140-SPL-TABLE. ** PICKNMBR
|
||||
00683 ** THIS SECTION SEARCHES THE SAMPLE-TYPE FIELD OF THE ** PICKNMBR
|
||||
00684 ** CNTRL-DATA FILE FOR A CORRESPONDING MATCH IN THE SAMPLE ** PICKNMBR
|
||||
00685 ** TABLE(SPL-TYPE-DATA). IF A MATCH OCCURS, THE SAMPLE TYPE ** PICKNMBR
|
||||
00686 ** ABBREVIATION IS REPLACED BY THE EXACT SAMPLE TYPE ** PICKNMBR
|
||||
00687 ** DESCRIPTION TO BE UTILIZED IN THE OUTPUT REPORT FORMATS. ** PICKNMBR
|
||||
00688 *************************************************************** PICKNMBR
|
||||
00689 0140-SPL-TABLE. PICKNMBR
|
||||
00690 SEARCH SPL-TABLE-ENTRY PICKNMBR
|
||||
00691 AT END MOVE 'END' TO SPL-ENTRY-FOUND-SWITCH PICKNMBR
|
||||
00692 WHEN SAMPLE-TYPE PICKNMBR
|
||||
00693 IS EQUAL TO SPL-ID (SPL-INDEX) PICKNMBR
|
||||
00694 MOVE 'YES' TO SPL-ENTRY-FOUND-SWITCH. PICKNMBR
|
||||
00695 IF SPL-ENTRY-FOUND PICKNMBR
|
||||
00696 MOVE SPL-NAME (SPL-INDEX) PICKNMBR
|
||||
00697 TO O-SAMPLE-TYPE PICKNMBR
|
||||
00698 ELSE PICKNMBR
|
||||
00699 DISPLAY SAMPLE-TYPE ' IS INCORRECT SAMPLE TYPE.'. PICKNMBR
|
||||
00700 0140-SPL-TABLE-EXIT. PICKNMBR
|
||||
00701 EXIT. PICKNMBR
|
||||
00702 *************************************************************** PICKNMBR
|
||||
00703 ** TO ENSURE A BALANCED SYSTEMATIC SAMPLE, THE FOLLOWING ** PICKNMBR
|
||||
00704 ** CALCULATIONS ARE USED TO DETERMINE THE NUMBERS SELECTED ** PICKNMBR
|
||||
00705 ** FOR THE SAMPLE. ** PICKNMBR
|
||||
00706 ** P = THE TOTAL NUMBER OF RECORDS ON THE VSAM FILE ** PICKNMBR
|
||||
00707 ** (TRANS-REC-CNTR) FROM THE CNTRL-DATA FILE. ** PICKNMBR
|
||||
00708 ** N = SAMPLE SIZE (SAMPLED-NMBR) FROM THE CNTRL-DATA FILE. ** PICKNMBR
|
||||
00709 ** R = RANDOM NUMBER (CNTRL-RANDOM) FROM CNTRL-DATA FILE. ** PICKNMBR
|
||||
00710 ** K = SKIP INTERVAL (CALCULATED IN THIS PROGRAM). ** PICKNMBR
|
||||
00711 ** I = INITIAL SAMPLE CASE (CALCULATED IN THIS PROGRAM). ** PICKNMBR
|
||||
00712 ** THE FOLLOWING FORMULAS ARE USED: ** PICKNMBR
|
||||
00713 ** K = P/N, I = (R*K) + .5, J = 0, 1, 2, ... (1/2N - 1) ** PICKNMBR
|
||||
00714 ** IF N IS EVEN, N/2 PAIRS OF RECORDS ARE SELECTED ACCORDING ** PICKNMBR
|
||||
00715 ** TO THE FORMULA: I + JK AND (P - JK) - I + 1 ** PICKNMBR
|
||||
00716 ** IF N IS ODD, J = 0, 1, 2, ... 1/2(N-1) - 1 ** PICKNMBR
|
||||
00717 ** I + JK AND (P - JK) - I + 1 AND THE REMAINING CASE ** PICKNMBR
|
||||
00718 ** IS CALCULATED BY: I + 1/2(N - 1)K ** PICKNMBR
|
||||
00719 ** EXAMPLE: P = 43 N = 5 R = .261 K = 43/5 = 8.6 => 9 ** PICKNMBR
|
||||
00720 ** I = (.261 * 9) +.5 =2.849 => 2 (TRUNCATED) ** PICKNMBR
|
||||
00721 ** THE FOLLOWING RECORDS WOULD BE SELECTED - ** PICKNMBR
|
||||
00722 ** 2, 11, 33, 42 AND 20. ** PICKNMBR
|
||||
00723 *************************************************************** PICKNMBR
|
||||
00724 ** PICKNMBR
|
||||
00725 *************************************************************** PICKNMBR
|
||||
00726 ** 0200-CALC-SKIP-INTERVAL. ** PICKNMBR
|
||||
00727 ** THIS SECTION WILL CALCULATE THE SKIP-INTERVAL(K) BASED ON ** PICKNMBR
|
||||
00728 ** THE FOLLOWING EQUATION K=P/N AS DEFINED ABOVE(COMMENT BOX)** PICKNMBR
|
||||
00729 *************************************************************** PICKNMBR
|
||||
00730 0200-CALC-SKIP-INTERVAL. PICKNMBR
|
||||
00731 DIVIDE TRANS-REC-CNTR BY SAMPLED-NMBR PICKNMBR
|
||||
00732 GIVING SKIP-INTERVAL ROUNDED. PICKNMBR
|
||||
00733 ** PICKNMBR
|
||||
00734 ** GIVEN A LARGE ENOUGH SAMPLE REQUESTED (E.G., INADVERTENTLY) PICKNMBR
|
||||
00735 ** IN RELATION TO THE POPULATION SIZE FROM WHICH THE SAMPLE IS PICKNMBR
|
||||
00736 ** TO BE TAKEN, THE 'SKIP-INTERVAL' COULD BE CALCULATED TO BE: PICKNMBR
|
||||
00737 ** PICKNMBR
|
||||
00738 ** FROM .99 TO .50 - WHICH LEADS TO THE SAME EMPLOYER NUMBER PICKNMBR
|
||||
00739 ** BE CHOSEN FOR MORE THAN ONE CASE -OR- PICKNMBR
|
||||
00740 ** FROM .49 TO .00 - WHICH ALSO LEADS TO AN 'INITIAL-CASE' OF PICKNMBR
|
||||
00741 ** ZERO (WHICH CAN NEVER EXIST). PICKNMBR
|
||||
00742 ** ERGO; PICKNMBR
|
||||
00743 ** PICKNMBR
|
||||
00744 IF SKIP-INTERVAL < 1 PICKNMBR
|
||||
00745 MOVE 1 TO SKIP-INTERVAL. PICKNMBR
|
||||
00746 *************************************************************** PICKNMBR
|
||||
00747 ** 0300-CALC-INITIAL-CASE. ** PICKNMBR
|
||||
00748 ** THIS SECTION CALCULATES THE INITIAL CASE (I). IT IS ** PICKNMBR
|
||||
00749 ** DETERMINED BY TRUNCATING THE RESULT OF I = R * K + .5. ** PICKNMBR
|
||||
00750 ** THE INITIAL-CASE FIELD (I) IS DEFINED AS A 5-POSITION ** PICKNMBR
|
||||
00751 ** NUMERIC INTEGER. THE RIGHT SIDE OF EQUATION I= R*K + .5 ** PICKNMBR
|
||||
00752 ** YIELD A REAL NUMBER, THUS ALLOWING(I) TO TRUNCATE THE ** PICKNMBR
|
||||
00753 ** RESULT OF THE CALCULATION. R:CNTRL-RANDOM-ALF, AND ** PICKNMBR
|
||||
00754 ** K:SKIP-INTERVAL. ** PICKNMBR
|
||||
00755 *************************************************************** PICKNMBR
|
||||
00756 0300-CALC-INITIAL-CASE. PICKNMBR
|
||||
00757 COMPUTE INITIAL-CASE = (SKIP-INTERVAL * CNTRL-RANDOM) + 0.5.PICKNMBR
|
||||
00758 ** ERGO; (JUST TO REAL SURE) PICKNMBR
|
||||
00759 IF INITIAL-CASE < 1 PICKNMBR
|
||||
00760 MOVE SKIP-INTERVAL TO INITIAL-CASE. PICKNMBR
|
||||
00761 PERFORM 0310-CHECK-ODD-EVEN. PICKNMBR
|
||||
00762 *************************************************************** PICKNMBR
|
||||
00763 ** 0310-CHECK-ODD-EVEN. ** PICKNMBR
|
||||
00764 ** THIS SECTION DETERMINES WHETHER THE NUMBER OF RECORDS (N) ** PICKNMBR
|
||||
00765 ** TO BE SELECTED (SAMPLED-NUMBER) IS EITHER ODD OR EVEN,IF N** PICKNMBR
|
||||
00766 ** IS ODD, 0320-ODD-ROUTINE IS PERFORMED. ** PICKNMBR
|
||||
00767 *************************************************************** PICKNMBR
|
||||
00768 0310-CHECK-ODD-EVEN. PICKNMBR
|
||||
00769 DIVIDE SAMPLED-NMBR BY 2 GIVING TEMP-LOOP-NBR PICKNMBR
|
||||
00770 REMAINDER ODD-EVEN-CNTL. PICKNMBR
|
||||
00771 SUBTRACT 1 FROM TEMP-LOOP-NBR GIVING LOOP-NBR. PICKNMBR
|
||||
00772 IF ODD-EVEN-CNTL = 1 THEN PICKNMBR
|
||||
00773 PERFORM 0320-ODD-RTN. PICKNMBR
|
||||
00774 *************************************************************** PICKNMBR
|
||||
00775 ** 0320-ODD-RTN. ** PICKNMBR
|
||||
00776 ** THIS ROUTINE CALCULATES THE ADDITIONAL NUMBER FOR THE ** PICKNMBR
|
||||
00777 ** SAMPLE UTILIZING THE FOLLOWING FORMULA:I+ 1/2(N-1)*K. ** PICKNMBR
|
||||
00778 ** THIS NUMBER(ONE-MORE-REC) IS WRITTEN TO THE ** PICKNMBR
|
||||
00779 ** (SELECT-NUMBERS) FILE. ** PICKNMBR
|
||||
00780 *************************************************************** PICKNMBR
|
||||
00781 0320-ODD-RTN. PICKNMBR
|
||||
00782 COMPUTE ODD-LOOP-NBR = (SAMPLED-NMBR - 1) / 2. PICKNMBR
|
||||
00783 COMPUTE ONE-MORE-REC = INITIAL-CASE + PICKNMBR
|
||||
00784 (ODD-LOOP-NBR * SKIP-INTERVAL). PICKNMBR
|
||||
00785 MOVE ONE-MORE-REC TO O-PICK-NUM, SELECTED-REC. PICKNMBR
|
||||
00786 PERFORM 0330-CREATE-REC THRU 0330-CREATE-REC-EXIT. PICKNMBR
|
||||
00787 *************************************************************** PICKNMBR
|
||||
00788 ** 0330-CREATE-REC. ** PICKNMBR
|
||||
00789 ** THIS ROUTINE WRITES THE CALCULATED NUMBERS TO AN OUTPUT ** PICKNMBR
|
||||
00790 ** DATA FILE(SELECT-NUMBERS) AND AN OUTPUT PRINT FILE ** PICKNMBR
|
||||
00791 ** (PICKNUM-LIST). A RECORD COUNTER(MATCH-CNTR) IS ** PICKNMBR
|
||||
00792 ** INCREMENTED BY ONE EACH TIME A RECORD IS ADDED TO THE ** PICKNMBR
|
||||
00793 ** FILES. ** PICKNMBR
|
||||
00794 *************************************************************** PICKNMBR
|
||||
00795 ** LET'S JUST MAKE SURE THAT WE DON'T CREATE A CASE PICKNMBR
|
||||
00796 ** NUMBER BEYOND THE SIZE OF THE POPULATION. PICKNMBR
|
||||
00797 0330-CREATE-REC. PICKNMBR
|
||||
00798 IF (CASE-NUM + 1) < TRANS-REC-CNTR OR PICKNMBR
|
||||
00799 (CASE-NUM + 1) = TRANS-REC-CNTR PICKNMBR
|
||||
00800 PERFORM 0331-OK-2-CREATE THRU 0331-EXIT PICKNMBR
|
||||
00801 ELSE PICKNMBR
|
||||
00802 ADD 1 TO CASE-NUM. PICKNMBR
|
||||
00803 0330-CREATE-REC-EXIT. PICKNMBR
|
||||
00804 EXIT. PICKNMBR
|
||||
00805 0331-OK-2-CREATE. PICKNMBR
|
||||
00806 ADD 1 TO CASE-NUM. PICKNMBR
|
||||
00807 MOVE CASE-NUM TO O-CASE-NUM. PICKNMBR
|
||||
00808 ADD 1 TO LIST-COUNTER. PICKNMBR
|
||||
00809 PICKNMBR
|
||||
00810 IF LIST-COUNTER > 50 PICKNMBR
|
||||
00811 MOVE 1 TO LIST-COUNTER PICKNMBR
|
||||
00812 PERFORM 0001-LIST-HEADING THRU 0001-LIST-EXIT. PICKNMBR
|
||||
00813 PICKNMBR
|
||||
00814 WRITE PICKNUM-REC FROM O-PICKNUM-REC PICKNMBR
|
||||
00815 AFTER ADVANCING 1 LINE. PICKNMBR
|
||||
00816 ADD 1 TO SELECT-CNTR. PICKNMBR
|
||||
00817 WRITE SELECTED-REC. PICKNMBR
|
||||
00818 0331-EXIT. PICKNMBR
|
||||
00819 EXIT. PICKNMBR
|
||||
00820 *************************************************************** PICKNMBR
|
||||
00821 ** 0400-REMAINING-NUMBERS. ** PICKNMBR
|
||||
00822 ** THIS SECTION PERFORMS THE CALCULATIONS TO DETERMINE THE ** PICKNMBR
|
||||
00823 ** REMAINING NUMBERS FOR THE SAMPLE. AS STATED ABOVE, IF ** PICKNMBR
|
||||
00824 ** N IS EVEN, N/2 PAIRS OF RECORDS ARE SELECTED. IF N IS ** PICKNMBR
|
||||
00825 ** ODD, J = 0, 1, 2, .... 1/2(N - 1) - 1. ** PICKNMBR
|
||||
00826 ** THIS ROUTINE IS PERFORMED UNTIL J < 0. ** PICKNMBR
|
||||
00827 *************************************************************** PICKNMBR
|
||||
00828 0400-REMAINING-NUMBERS. PICKNMBR
|
||||
00829 COMPUTE SEL-1 = PICKNMBR
|
||||
00830 INITIAL-CASE + PICKNMBR
|
||||
00831 (LOOP-NBR * SKIP-INTERVAL). PICKNMBR
|
||||
00832 COMPUTE SEL-2 = PICKNMBR
|
||||
00833 TRANS-REC-CNTR - PICKNMBR
|
||||
00834 (LOOP-NBR * SKIP-INTERVAL) - PICKNMBR
|
||||
00835 INITIAL-CASE + 1. PICKNMBR
|
||||
00836 MOVE SEL-1 TO O-PICK-NUM, SELECTED-REC. PICKNMBR
|
||||
00837 PERFORM 0330-CREATE-REC THRU 0330-CREATE-REC-EXIT. PICKNMBR
|
||||
00838 MOVE SEL-2 TO O-PICK-NUM, SELECTED-REC. PICKNMBR
|
||||
00839 PERFORM 0330-CREATE-REC THRU 0330-CREATE-REC-EXIT. PICKNMBR
|
||||
00840 SUBTRACT 1 FROM LOOP-NBR. PICKNMBR
|
||||
00841 MOVE ZEROS TO SEL-1 SEL-2. PICKNMBR
|
||||
00842 0400-REMAINING-NUMBERS-EXIT. PICKNMBR
|
||||
00843 EXIT. PICKNMBR
|
||||
00844 *************************************************************** PICKNMBR
|
||||
00845 ** 0500-CALC-SKIPINTERVAL. ** PICKNMBR
|
||||
00846 ** THIS SECTION WILL CALCULATE THE SKIP-INTERVAL FOR A ** PICKNMBR
|
||||
00847 ** TRANSACTION SAMPLE SIZE LESS THAN 200. ** PICKNMBR
|
||||
00848 *************************************************************** PICKNMBR
|
||||
00849 0500-CALC-SKIPINTERVAL. PICKNMBR
|
||||
00850 DIVIDE TRANS-REC-CNTR BY SAMPLED-NMBR PICKNMBR
|
||||
00851 GIVING SKIP-INTERVAL-B. PICKNMBR
|
||||
00852 ** PICKNMBR
|
||||
00853 ** GIVEN A LARGE ENOUGH SAMPLE REQUESTED (E.G., INADVERTENTLY) PICKNMBR
|
||||
00854 ** IN RELATION TO THE POPULATION SIZE FROM WHICH THE SAMPLE IS PICKNMBR
|
||||
00855 ** TO BE TAKEN, THE 'SKIP-INTERVAL' COULD BE CALCULATED TO BE: PICKNMBR
|
||||
00856 ** PICKNMBR
|
||||
00857 ** FROM .99 TO .50 - WHICH LEADS TO THE SAME EMPLOYER NUMBER PICKNMBR
|
||||
00858 ** BE CHOSEN FOR MORE THAN ONE CASE -OR- PICKNMBR
|
||||
00859 ** FROM .49 TO .00 - WHICH ALSO LEADS TO AN 'INITIAL-CASE' OF PICKNMBR
|
||||
00860 ** ZERO (WHICH CAN NEVER EXIST). PICKNMBR
|
||||
00861 ** ERGO; PICKNMBR
|
||||
00862 ** PICKNMBR
|
||||
00863 IF SKIP-INTERVAL-B < 1 PICKNMBR
|
||||
00864 MOVE 1 TO SKIP-INTERVAL-B. PICKNMBR
|
||||
00865 **************************************************************** PICKNMBR
|
||||
00866 ** 0600-CALC-INITIAL-CASE. ** PICKNMBR
|
||||
00867 ** THIS SECTION CALCULATES THE INITIAL CASE (I) NUMBER. ** PICKNMBR
|
||||
00868 ** IT IS DETERMINED BY TRUNCATING THE RESULT OF I = R * K + .5** PICKNMBR
|
||||
00869 **************************************************************** PICKNMBR
|
||||
00870 0600-CALC-INITIAL-CASE. PICKNMBR
|
||||
00871 COMPUTE INITIAL-CASE = (SKIP-INTERVAL-B * CNTRL-RANDOM) PICKNMBR
|
||||
00872 + 0.5. PICKNMBR
|
||||
00873 ** ERGO; (JUST TO REAL SURE) PICKNMBR
|
||||
00874 IF INITIAL-CASE < 1 PICKNMBR
|
||||
00875 MOVE SKIP-INTERVAL-B TO INITIAL-CASE. PICKNMBR
|
||||
00876 MOVE INITIAL-CASE TO SEL-NMBR. PICKNMBR
|
||||
00877 MOVE SEL-NMBR TO O-PICK-NUM, SELECTED-REC, SEL-ACCU. PICKNMBR
|
||||
00878 PERFORM 0330-CREATE-REC THRU 0330-CREATE-REC-EXIT. PICKNMBR
|
||||
00879 ** PICKNMBR
|
||||
00880 *************************************************************** PICKNMBR
|
||||
00881 ** 0700-SELECTED-NUMBERS. ** PICKNMBR
|
||||
00882 ** THIS SECTION PERFORMS THE CALCULATIONS TO DETERMINE THE ** PICKNMBR
|
||||
00883 ** NUMBERS TO SELECT FOR THE SAMPLE. THE 2ND RECORD IS ** PICKNMBR
|
||||
00884 ** CALCULATED BY ADDING THE SKIP INTERVAL(NOT ROUNDED) TO THE** PICKNMBR
|
||||
00885 ** INITIAL CASE(TRUNCATED) AND ROUNDING THE RESULT. THE ** PICKNMBR
|
||||
00886 ** REMAINING NUMBERS ARE CALCULATED BY ADDING THE SKIP ** PICKNMBR
|
||||
00887 ** INTERVAL TO THE PREVIOUS (NOT ROUNDED) NUMBER AND THEN ** PICKNMBR
|
||||
00888 ** ROUNDING THE RESULT. THIS PROCESS IS CONTINUED UNTIL ALL ** PICKNMBR
|
||||
00889 ** OF THE RECORDS HAVE BEEN CALCULATED. ** PICKNMBR
|
||||
00890 *************************************************************** PICKNMBR
|
||||
00891 0700-SELECTED-NUMBERS. PICKNMBR
|
||||
00892 IF (SEL-NMBR > TRANS-REC-CNTR ) PICKNMBR
|
||||
00893 COMPUTE SEL-NMBR = SEL-NMBR - TRANS-REC-CNTR PICKNMBR
|
||||
00894 MOVE SEL-NMBR TO SEL-ACCU PICKNMBR
|
||||
00895 ELSE PICKNMBR
|
||||
00896 COMPUTE SEL-NMBR ROUNDED = SEL-ACCU + SKIP-INTERVAL-B PICKNMBR
|
||||
00897 COMPUTE SEL-ACCU = SEL-ACCU + SKIP-INTERVAL-B. PICKNMBR
|
||||
00898 MOVE SEL-NMBR TO O-PICK-NUM, SELECTED-REC. PICKNMBR
|
||||
00899 PERFORM 0330-CREATE-REC THRU 0330-CREATE-REC-EXIT. PICKNMBR
|
||||
00900 0700-SELECTED-NUMBERS-EXIT. PICKNMBR
|
||||
00901 EXIT. PICKNMBR
|
||||
00902 ** PICKNMBR
|
||||
00903 *************************************************************** PICKNMBR
|
||||
00904 ** 0800-CHK-SPL-NBR. ** PICKNMBR
|
||||
00905 ** THIS SECTION VERIFIES THAT THE NUMBER OF RECORDS WRITTEN ** PICKNMBR
|
||||
00906 ** TO THE (SELECT-NUMBERS) FILE IS EQUAL TO THE NUMBER OF ** PICKNMBR
|
||||
00907 ** RECORDS TO BE SAMPLED (SAMPLED-NMBR) IN THE CNTRL-DATA ** PICKNMBR
|
||||
00908 ** FILE. IF THESE FIELDS ARE NOT EQUAL, AN ERROR MESSAGE ** PICKNMBR
|
||||
00909 ** IS DISPLAYED. ** PICKNMBR
|
||||
00910 *************************************************************** PICKNMBR
|
||||
00911 0800-CHK-SPL-NBR. PICKNMBR
|
||||
00912 ** THROW A SYSOUT & AND A RPT LINE PICKNMBR
|
||||
00913 DISPLAY 'RECORDS SELECTED NE TO RECORDS DESIRED'. PICKNMBR
|
||||
00914 ** PICKNMBR
|
||||
00915 MOVE ' DID NOT FILL DESIRED NUMBER OF RECORDS' PICKNMBR
|
||||
00916 TO CNTL-ITEM. PICKNMBR
|
||||
00917 MOVE SPACE TO CNTL-VALUE-X. PICKNMBR
|
||||
00918 WRITE PICKNUM-REC FROM O-LIST-3-REC. PICKNMBR
|
||||
00919 0800-CHK-SPL-NBR-EXIT. PICKNMBR
|
||||
00920 EXIT. PICKNMBR
|
||||
00921 ** PICKNMBR
|
||||
00922 *************************************************************** PICKNMBR
|
||||
00923 ** 0900-TRAILER-LIST. ** PICKNMBR
|
||||
00924 ** THIS SECTION PRINTS THE INFORMATION THAT WAS USED TO ** PICKNMBR
|
||||
00925 ** CALCULATE THE RECORD NUMBERS FOR SAMPLING ** PICKNMBR
|
||||
00926 *************************************************************** PICKNMBR
|
||||
00927 0900-TRAILER-LIST. PICKNMBR
|
||||
00928 PERFORM 0002-LIST-HEADING THRU 0002-LIST-EXIT. PICKNMBR
|
||||
00929 WRITE PICKNUM-REC FROM O-LIST-1-REC AFTER 10 LINES. PICKNMBR
|
||||
00930 WRITE PICKNUM-REC FROM O-LIST-5-REC. PICKNMBR
|
||||
00931 WRITE PICKNUM-REC FROM O-LIST-2-REC. PICKNMBR
|
||||
00932 WRITE PICKNUM-REC FROM O-LIST-5-REC. PICKNMBR
|
||||
00933 WRITE PICKNUM-REC FROM O-LIST-5-REC. PICKNMBR
|
||||
00934 MOVE ' TOTAL TRANSACTION FILE RECORDS(P) ' PICKNMBR
|
||||
00935 TO CNTL-ITEM. PICKNMBR
|
||||
00936 MOVE TRANS-REC-CNTR TO CNTL-VALUE. PICKNMBR
|
||||
00937 WRITE PICKNUM-REC FROM O-LIST-3-REC. PICKNMBR
|
||||
00938 MOVE ' NUMBER OF RECORDS TO BE SELECTED(N) ' PICKNMBR
|
||||
00939 TO CNTL-ITEM. PICKNMBR
|
||||
00940 MOVE SAMPLED-NMBR TO CNTL-VALUE. PICKNMBR
|
||||
00941 WRITE PICKNUM-REC FROM O-LIST-3-REC. PICKNMBR
|
||||
00942 MOVE ' RANDOM NUMBER(R) ' PICKNMBR
|
||||
00943 TO CNTL-ITEM-2. PICKNMBR
|
||||
00944 MOVE CNTRL-RANDOM TO CNTL-VALUE-2. PICKNMBR
|
||||
00945 WRITE PICKNUM-REC FROM O-LIST-4-REC. PICKNMBR
|
||||
00946 PICKNMBR
|
||||
00947 IF (TRANS-REC-CNTR > 200 ) PICKNMBR
|
||||
00948 MOVE ' SKIP INTERVAL(K) ' PICKNMBR
|
||||
00949 TO CNTL-ITEM PICKNMBR
|
||||
00950 MOVE SKIP-INTERVAL TO CNTL-VALUE PICKNMBR
|
||||
00951 WRITE PICKNUM-REC FROM O-LIST-3-REC PICKNMBR
|
||||
00952 ELSE PICKNMBR
|
||||
00953 MOVE ' SKIP INTERVAL(K) ' PICKNMBR
|
||||
00954 TO CNTL-ITEM-2 PICKNMBR
|
||||
00955 MOVE SKIP-INTERVAL-B TO CNTL-VALUE-2 PICKNMBR
|
||||
00956 WRITE PICKNUM-REC FROM O-LIST-4-REC. PICKNMBR
|
||||
00957 PICKNMBR
|
||||
00958 MOVE ' INITIAL SAMPLE CASE(I) ' PICKNMBR
|
||||
00959 TO CNTL-ITEM. PICKNMBR
|
||||
00960 MOVE INITIAL-CASE TO CNTL-VALUE. PICKNMBR
|
||||
00961 WRITE PICKNUM-REC FROM O-LIST-3-REC. PICKNMBR
|
||||
00962 PICKNMBR
|
||||
00963 IF SELECT-CNTR NOT EQUAL SAMPLED-NMBR PICKNMBR
|
||||
00964 PERFORM 0800-CHK-SPL-NBR THRU 0800-CHK-SPL-NBR-EXIT. PICKNMBR
|
||||
00965 PICKNMBR
|
||||
00966 WRITE PICKNUM-REC FROM O-LIST-5-REC. PICKNMBR
|
||||
00967 WRITE PICKNUM-REC FROM O-LIST-5-REC. PICKNMBR
|
||||
00968 WRITE PICKNUM-REC FROM O-LIST-1-REC. PICKNMBR
|
||||
00969 0900-TRAILER-EXIT. PICKNMBR
|
||||
00970 EXIT. PICKNMBR
|
||||
00971 ** PICKNMBR
|
||||
00972 *************************************************************** PICKNMBR
|
||||
00973 ** 9999-CLOSE-FILES. ** PICKNMBR
|
||||
00974 ** THIS SECTION CLOSES THE FILES: CNTRL-DATA, PICKNUM-LIST ** PICKNMBR
|
||||
00975 ** SELECT-NUMBERS. ** PICKNMBR
|
||||
00976 *************************************************************** PICKNMBR
|
||||
00977 9999-CLOSE-FILES. PICKNMBR
|
||||
00978 CLOSE SELECT-NUMBERS. PICKNMBR
|
||||
00979 CLOSE CNTRL-DATA. PICKNMBR
|
||||
00980 CLOSE PICKNUM-LIST. PICKNMBR
|
||||
Reference in New Issue
Block a user