This is code that I haven't documented yet, and am trying to make sure works.
As a learning exercise, I've decided to post it. feedback is welcome...
KBADSELR ;DJW; Select a Random Sample of the Patient Population ; K RAND S RAND("S")="I 1",U="^" K DIR S DIR("A")="Include Vets Only ?",DIR("B")="YES" S DIR(0)="Y" D ^DIR G QX:$D(DIRUT) S VETSONLY=Y I VETSONLY="Y" S RAND("S")=RAND("S")_",$P($G(^DPT(Y,""VET"")),U)=""Y""" K DIR S DIR("A")="Y^Include Deceased Persons ?",DIR("B")="YES" S DIR(0)="Y" D ^DIR G QX:$D(DIRUT) S DEAD=Y I DEAD="N" S RAND("S")=RAND("S")_",$P($G(^DPT(Y,.35)),""^"")" S RAND="^DPT",RAND("OUT")="^UTILITY($J,$T(+0))" D RAND(.RAND) ; do something with results stored in @RAND("OUT")@(foo) QX ; Q ; ; Rand() is called with a variable named after itself, following the design ; of classic FileMan and Kernel calls. RAND(RAND) ; N ROOT S ROOT="^DPT" S:$D(RAND)#2 ROOT=RAND N IENLIST S IENLIST="IENLIST" S:$D(RAND("OUT"))#2 IENLIST=RAND("OUT") N CHECK S CHECK="I 1" S:$D(RAND("S"))#2 CHECK=RAND("S") N LIM S LIM=1 S:$D(RAND("LIM")) LIM=RAND("LIM") N CURIEN,INDX,RANDOFFS,RINDX,RLIST,OFS ;if you are excluding some entries with a RAND("S") check ; you should assume you don't know how many entries you have, ; so you have to count them. ;otherwise, pass in how many entries known N TOTAL I $D(RAND("TOTAL"))[0 D . S (CURIEN,TOTAL)=0 . F S CURIEN=$O(@ROOT@(CURIEN)) Q:CURIEN'=+CURIEN D .. N Y S Y=CURIEN X:$D(CHECK)#2 CHECK E Q .. S TOTAL=TOTAL+1 E S TOTAL=RAND("TOTAL") ; get LIM unique random numbers S INDX=1 F Q:LIM+1=INDX D . S RANDOFFS=1+$RANDOM(TOTAL) ; shift random number to range 1..COUNT . Q:$D(RLIST(RANDOFFS))'=0 ; ignore if we already chose this one . S RINDX(INDX)=RANDOFFS ; offset of the I-th random entry is RINDX() . S RLIST(RANDOFFS)=INDX ;put the offset in our list to guarantee uns . S INDX=INDX+1 ;up the current count, until we get to the t ;loop thru the given global to find the identity ; of each of the random entries ;small optimization to not examine offsets after the maximum we chose ;B "S+" B S CURIEN=0,OFS=0,INDX=1 F S CURIEN=$ORDER(@ROOT@(CURIEN)) D Q:OFS>TOTAL Q:$O(RLIST(OFS))="" . N Y S Y=CURIEN X:$D(CHECK)#2 CHECK E Q . S OFS=OFS+1 . Q:$DATA(RLIST(OFS))=0 ;this offset is not one of the chosen ones. . S @IENLIST@(INDX)=CURIEN ; the I-th random entry is at IENLIST(INDX) . S INDX=INDX+1 I 1+LIM'=INDX WRITE !,"Bug in Code ("_(1+LIM)_"'="_INDX_")",! B "S+"B ;I $D(RAND("OUT"))#2 K @RAND("OUT") M @RAND("OUT")=IENLIST I $D(RAND("RLIST"))#2 K @RAND("RLIST") M @RAND("RLIST")=RLIST I $D(RAND("RINDX"))#2 K @RAND("RINDX") M @RAND("RINDX")=RINDX Q TEST ; K RAND S RAND("LIM")=3,ROOT="^UTILITY($J,""SAMPLE"")" K @ROOT F I=1:1:10 S @ROOT@(1+$R(25000),0)=I S J=0 F I=0:1 S J=$O(@ROOT@(J)) Q:J="" W !,$J(J,5)_",0) ="_$G(@ROOT@(J,0)) W !," Total Entries in test case: ",I W !," Selecting number of entries:",RAND("LIM") S RAND=ROOT W !,"For Global Root: ",ROOT S RAND("S")="I Y#2=1" W !,"Allowing only Odd IENs" W ! K ROOT,PATLST,RANDLST,RINDXLST S RAND("OUT")="PATLST",RAND("RLIST")="RANDLST",RAND("RINDX")="RINDXLST" D RAND(.RAND) ZWRITE PATLST,RANDLST,RINDXLST Q
|