1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
* Written by Raynald Levesque rlevesque@videotron.ca 
* Nov 10,2000.
* www.spsstools.net
*.

GET
  FILE='C:\\data\\ExampleRDD.sav'.

* The number in the next DEFINE is the number of phone numbers you want.
* Of course if the difference of lowrange and uprange is less than that number then
* ALL the numbers in the range will be included.
DEFINE !nb()500!ENDDEFINE.

COMPUTE casen=$casenum.
COMPUTE delta = NUMBER(uprange,F8.0) - NUMBER(lowrange,F8.0)+1.
STRING lowr upr (A4) #tmp(A1).

* I assume the exchange has always either 3 or 4 digits.
DO IF length(RTRIM(lowrange))=4.
+	COMPUTE lowr=lowrange.
+	COMPUTE upr=uprange.
ELSE.
+	COMPUTE #tmp=SUBSTR(exchange,4).
+	COMPUTE lowr=CONCAT(#tmp,lowrange).
+	COMPUTE upr=CONCAT(#tmp,uprange).
END IF.
EXECUTE.

LOOP cnt=1 TO delta.
LEAVE ALL.
XSAVE OUTFILE='c:\\data\\numbers.sav' .
END LOOP.
EXECUTE.

GET FILE='c:\\data\\numbers.sav' .
COMPUTE rv=UNIFORM(1).
RANK
  VARIABLES=rv  (A) BY casen  /RANK /PRINT=NO
  /TIES=MEAN .

SELECT IF (rrv<=min(!nb,delta)).
STRING phonenb(A10).
COMPUTE phonenb=CONCAT(SUBSTR(dialcode,1,3),SUBSTR(exchange,1,3),STRING(NUMBER(lowr,F8.0)+rrv-1,N4.0)).

*Clean up.
MATCH FILES FILE=* /DROP=casen TO rrv.