AGSAMPG ; IHS/ASDS/EFG - DRAW RANDOM SAMPLE OF FACILITY CHARTS ;
;;7.1;PATIENT REGISTRATION;;AUG 25,2005
W @IOF,?10,"*** GENERATE RANDOM SAMPLE OF PATIENTS ***",!!
G:$D(DUZ)=0!($D(DUZ)=10) NOUSER D ^XBSITE G:'$D(DUZ(2)) NOUSER
S AGTMP="^AGSAMPLE" K @AGTMP S ^AGSAMPLE(0)=DUZ(2)
A1 W !!,?10,"ENTER SAMPLE SIZE BETWEEN 1 AND 1000 " D READ I +Y<1!(+Y>1000) W *7," ??" G A1
S AGV("SIZE")=+Y,AGRANGE=+$P(^AUPNPAT(0),U,3),AGV("SKIP")=0,AGV("SEL")=0,AGV("TRY")=0 W !!
B0 S XX=$R(AGRANGE),AGV("TRY")=AGV("TRY")+1 G B0:'$D(^AUPNPAT(XX)),B0:'$D(^AUPNPAT(XX,41,DUZ(2)))
S AGHRN=$P(^AUPNPAT(XX,41,DUZ(2),0),U,2),AGLEN=$L(AGHRN),AGV("TDIG")=$E(AGHRN,AGLEN-1,AGLEN) I AGLEN>6 G B0
ELIG ;
S (AGSTRIBE,AGSBEN,AGSBLOOD)=""
G:'$D(^AUPNPAT(XX,11)) B0 S:$P(^AUPNPAT(XX,11),U,8)'="" AGSTRIBE=$P($G(^AUTTTRI($P(^AUPNPAT(XX,11),U,8),0)),U,2)
S:$P(^AUPNPAT(XX,11),U,11)'="" AGSBEN=$P(^AUTTBEN($P(^AUPNPAT(XX,11),U,11),0),U,2)
S AGSBLOOD=$P(^AUPNPAT(XX,11),U,10)
G:AGSBEN'="01"!(AGSTRIBE="000")!(AGSTRIBE="998")!(AGSTRIBE="999")!(AGSBLOOD="NONE")!(AGSBLOOD="UNSPECIFIED")!(AGSBLOOD="UNKNOWN")!(AGSBLOOD="") B0
K AGSTRIBE,AGSBEN,AGSBLOOD
RES ;
G:'$D(^AUPNPAT(XX,51)) B0
S AGS=0,(AGS1,AGSRES,AGSLOC)=""
RES1 ;
S AGS=$O(^AUPNPAT(XX,51,AGS)) G:AGS="" RES2
S AGS1=AGS G RES1
RES2 G:AGS1="" B0 S AGS=AGS1
G:$P(^AUPNPAT(XX,51,AGS,0),U,3)="" B0 ;COMMUNITY OF RESIDENCE
G:$P(^AUTTCOM($P(^AUPNPAT(XX,51,AGS,0),U,3),0),U,6)="" B0 ;AREA
G:$P(^AUTTCOM($P(^AUPNPAT(XX,51,AGS,0),U,3),0),U,5)="" B0 ;SERVICE UNIT
S AGSRES=$P(^AUTTAREA($P(^AUTTCOM($P(^AUPNPAT(XX,51,AGS,0),U,3),0),U,6),0),U,2) ;CODE
S AGSRES=AGSRES_$P(^AUTTSU($P(^AUTTCOM($P(^AUPNPAT(XX,51,AGS,0),U,3),0),U,5),0),U,3) ;CODE
S AGSLOC=$P(^AUTTLOC(DUZ(2),0),U,10) ;ASUFAC INDEX
G:$E(AGSLOC,1,4)'=AGSRES B0
K AGS,AGS1,AGSLOC,AGSRES
G:+AGV("SKIP")>100 B9
S AGV("SKIP")=AGV("SKIP")+1
I $D(^AGSAMPLE(AGV("TDIG"),AGHRN)) G B0
S AGV("SKIP")=0
W $J(AGV("SEL")+1,5),". ",$J(AGV("TDIG"),2),?18,AGHRN,?28,$P(^DPT(XX,0),U),!
S ^AGSAMPLE(AGV("TDIG"),AGHRN)=AGV("TDIG")_U_AGHRN_U_$P(^DPT(XX,0),U),AGV("SEL")=AGV("SEL")+1
G:AGV("SEL")<AGV("SIZE") B0
B9 W !!,"NUMBER OF RECORDS EXAMINED = ",$J(AGV("TRY"),5),!!,"NUMBER OF RECORDS SELECTED = ",$J(AGV("SEL"),5)
K AGLEN,AGHRN,AGV("TDIG"),AGRANGE,AGV("SKIP"),AGV("SEL"),AGV("SIZE"),AGV("TRY")
Q
NOUSER W !,"The USER has not been set - please set it thru the KERNEL "
Q
READ K DFOUT,DTOUT,DUOUT,DQOUT,DLOUT R Y:DTIME I '$T W *7 R Y:5 G READ:Y="." I '$T S (DTOUT,Y)="" Q
S:Y="/.," (DFOUT,Y)="" S:Y="" DLOUT="" S:Y="^" (DUOUT,Y)="" S:Y?1"?".E!(Y["^") (DQOUT,Y)=""
Q
AGSAMPG ; IHS/ASDS/EFG - DRAW RANDOM SAMPLE OF FACILITY CHARTS ;
+1 ;;7.1;PATIENT REGISTRATION;;AUG 25,2005
+2 WRITE @IOF,?10,"*** GENERATE RANDOM SAMPLE OF PATIENTS ***",!!
+3 IF $DATA(DUZ)=0!($DATA(DUZ)=10)
GOTO NOUSER
DO ^XBSITE
IF '$DATA(DUZ(2))
GOTO NOUSER
+4 SET AGTMP="^AGSAMPLE"
KILL @AGTMP
SET ^AGSAMPLE(0)=DUZ(2)
A1 WRITE !!,?10,"ENTER SAMPLE SIZE BETWEEN 1 AND 1000 "
DO READ
IF +Y<1!(+Y>1000)
WRITE *7," ??"
GOTO A1
+1 SET AGV("SIZE")=+Y
SET AGRANGE=+$PIECE(^AUPNPAT(0),U,3)
SET AGV("SKIP")=0
SET AGV("SEL")=0
SET AGV("TRY")=0
WRITE !!
B0 SET XX=$RANDOM(AGRANGE)
SET AGV("TRY")=AGV("TRY")+1
IF '$DATA(^AUPNPAT(XX))
GOTO B0
IF '$DATA(^AUPNPAT(XX,41,DUZ(2)))
GOTO B0
+1 SET AGHRN=$PIECE(^AUPNPAT(XX,41,DUZ(2),0),U,2)
SET AGLEN=$LENGTH(AGHRN)
SET AGV("TDIG")=$EXTRACT(AGHRN,AGLEN-1,AGLEN)
IF AGLEN>6
GOTO B0
ELIG ;
+1 SET (AGSTRIBE,AGSBEN,AGSBLOOD)=""
+2 IF '$DATA(^AUPNPAT(XX,11))
GOTO B0
IF $PIECE(^AUPNPAT(XX,11),U,8)'=""
SET AGSTRIBE=$PIECE($GET(^AUTTTRI($PIECE(^AUPNPAT(XX,11),U,8),0)),U,2)
+3 IF $PIECE(^AUPNPAT(XX,11),U,11)'=""
SET AGSBEN=$PIECE(^AUTTBEN($PIECE(^AUPNPAT(XX,11),U,11),0),U,2)
+4 SET AGSBLOOD=$PIECE(^AUPNPAT(XX,11),U,10)
+5 IF AGSBEN'="01"!(AGSTRIBE="000")!(AGSTRIBE="998")!(AGSTRIBE="999")!(AGSBLOOD="NONE")!(AGSBLOOD="UNSPECIFIED")!(AGSBLOOD="UNKNOWN")!(AGSBLOOD="")
GOTO B0
+6 KILL AGSTRIBE,AGSBEN,AGSBLOOD
RES ;
+1 IF '$DATA(^AUPNPAT(XX,51))
GOTO B0
+2 SET AGS=0
SET (AGS1,AGSRES,AGSLOC)=""
RES1 ;
+1 SET AGS=$ORDER(^AUPNPAT(XX,51,AGS))
IF AGS=""
GOTO RES2
+2 SET AGS1=AGS
GOTO RES1
RES2 IF AGS1=""
GOTO B0
SET AGS=AGS1
+1 ;COMMUNITY OF RESIDENCE
IF $PIECE(^AUPNPAT(XX,51,AGS,0),U,3)=""
GOTO B0
+2 ;AREA
IF $PIECE(^AUTTCOM($PIECE(^AUPNPAT(XX,51,AGS,0),U,3),0),U,6)=""
GOTO B0
+3 ;SERVICE UNIT
IF $PIECE(^AUTTCOM($PIECE(^AUPNPAT(XX,51,AGS,0),U,3),0),U,5)=""
GOTO B0
+4 ;CODE
SET AGSRES=$PIECE(^AUTTAREA($PIECE(^AUTTCOM($PIECE(^AUPNPAT(XX,51,AGS,0),U,3),0),U,6),0),U,2)
+5 ;CODE
SET AGSRES=AGSRES_$PIECE(^AUTTSU($PIECE(^AUTTCOM($PIECE(^AUPNPAT(XX,51,AGS,0),U,3),0),U,5),0),U,3)
+6 ;ASUFAC INDEX
SET AGSLOC=$PIECE(^AUTTLOC(DUZ(2),0),U,10)
+7 IF $EXTRACT(AGSLOC,1,4)'=AGSRES
GOTO B0
+8 KILL AGS,AGS1,AGSLOC,AGSRES
+9 IF +AGV("SKIP")>100
GOTO B9
+10 SET AGV("SKIP")=AGV("SKIP")+1
+11 IF $DATA(^AGSAMPLE(AGV("TDIG"),AGHRN))
GOTO B0
+12 SET AGV("SKIP")=0
+13 WRITE $JUSTIFY(AGV("SEL")+1,5),". ",$JUSTIFY(AGV("TDIG"),2),?18,AGHRN,?28,$PIECE(^DPT(XX,0),U),!
+14 SET ^AGSAMPLE(AGV("TDIG"),AGHRN)=AGV("TDIG")_U_AGHRN_U_$PIECE(^DPT(XX,0),U)
SET AGV("SEL")=AGV("SEL")+1
+15 IF AGV("SEL")<AGV("SIZE")
GOTO B0
B9 WRITE !!,"NUMBER OF RECORDS EXAMINED = ",$JUSTIFY(AGV("TRY"),5),!!,"NUMBER OF RECORDS SELECTED = ",$JUSTIFY(AGV("SEL"),5)
+1 KILL AGLEN,AGHRN,AGV("TDIG"),AGRANGE,AGV("SKIP"),AGV("SEL"),AGV("SIZE"),AGV("TRY")
+2 QUIT
NOUSER WRITE !,"The USER has not been set - please set it thru the KERNEL "
+1 QUIT
READ KILL DFOUT,DTOUT,DUOUT,DQOUT,DLOUT
READ Y:DTIME
IF '$TEST
WRITE *7
READ Y:5
IF Y="."
GOTO READ
IF '$TEST
SET (DTOUT,Y)=""
QUIT
+1 IF Y="/.,"
SET (DFOUT,Y)=""
IF Y=""
SET DLOUT=""
IF Y="^"
SET (DUOUT,Y)=""
IF Y?1"?".E!(Y["^")
SET (DQOUT,Y)=""
+2 QUIT
