- 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
