AMQQAT2 ; IHS/CMI/THL - FILE AND TAXONOMY ATTRIBUTE ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;-----
FQ S DIC("A")="Which Fileman file: "
S DIC(0)="AEQ"
S DIC=1
D ^DIC
K DIC
I Y=-1,X'="",$E(X)=U S AMQQQUIT="" Q
I Y=-1 Q
I AMQQCCLS="P",+Y=2!(+Y=9000001) W !,"I assume that ALL patients are members of this file...Try another attribute.",*7,! Q
D CHECK
I '$D(AMQQFFLD) G FQ
D FSET
EXIT K AMQQFFLD,AMQQCHTT,AMQQRNDN,AMQQCRFG,AMQQFFIL,AMQQFFLD,AMQQFGBL,AMQQFPC,AMQQFSBS,AMQQFXR,%,I,N,Z
Q
;
CHECK K AMQQFFLD
F X=0:0 S X=$O(^DD(+Y,"IX",X)) Q:'X S %=$P(^DD(+Y,X,0),U,2) I %["P2"!(%["P9000001") D C1 I $D(AMQQFFLD) Q
I '$D(AMQQFFLD) W !,"Sorry...I cannot find any patient fields in this file which are indexed" Q
W !!,"OK, I'll check the ",$P(^DD(+Y,X,0),U)," field of this file."
Q
;
C1 F Z=0:0 S Z=$O(^DD(+Y,X,1,Z)) Q:'Z I $P(^(Z,0),U,3)="" S AMQQFFLD=X,AMQQFFIL=+Y,AMQQFXR=$P(^(0),U,2) Q
Q
;
FSET S AMQQFGBL=^DIC(AMQQFFIL,0,"GL")
S AMQQCHRT=$E(AMQQFGBL,2,99)_";"_AMQQFXR
S %=$P(^DD(AMQQFFIL,AMQQFFLD,0),U,4)
S AMQQFSBS=$P(%,";")
S AMQQFPC=$P(%,";",2)
S DIR(0)="SO^1:Look for patients entered in the file;2:Look for patients not entered in the file;3:Take a random sample of patients entered in the file;4:Count the number of patients in the file"
S DIR("A")="Your choice"
S DIR("B")="1"
S DIR("?")=""
D ^DIR
K DIR
I $E(Y)=U S AMQQQUIT="" Q
I Y=4 D FCOUNT K ^UTILITY("AMER TEMP",$J) G FSET
I Y=3 D FRAND Q
I Y=2 S AMQQLINK=177
W !!
Q
;
FCOUNT I IOST["C-" W !!!,"Counting...",!
S A=AMQQFGBL_""""_AMQQFXR_""",X)"
S %=0
K ^UTILITY("AMQQ TEMP",$J)
F X=0:0 S X=$O(@A) Q:'X I '$D(^UTILITY("AMQQ TEMP",$J,X)) S ^(X)="",%=%+1 W:IOST["C-" $C(13),% I $D(AMQQFFFG) S ^UTILITY("AMQQ FTEMP",$J,%,X)=""
S AMQQCHTT=%
Q
;
FRAND W !!
D WAIT^DICD
S AMQQFFFG=""
D FCOUNT
K AMQQFFFG
W $C(13)," ",$C(13),"There are ",AMQQCHTT," patients in this file"
W !!!
S AMQQRNDN=AMQQCHTT\2
S AMQQCRFL=""
D CNP1^AMQQAT1
I IOST["C-" W !!,"Collecting a random sample",!
K ^UTILITY("AMQQ FRAND",$J,AMQQATN)
S AMQQCHRT=AMQQCHRT_";"_$J_";"_AMQQCHNN_";"_AMQQCHTT_";"_AMQQUATN,I=0,N=AMQQCHTT-1
S AMQQLINK=178
FR1 ; ENTRY POINT FROM STUFF
F Q:I=AMQQCHNN S Y=$R(N)+1,Z=$O(^UTILITY("AMQQ FTEMP",$J,Y,"")) I Z,'$D(^UTILITY("AMQQ FRAND",$J,AMQQUATN,Z)) S ^(Z)="",I=I+1 W:IOST["C-" $C(13),I
K ^UTILITY("AMQQ FTEMP",$J),AMQQRNDN,^UTILITY("AMQQ TEMP",$J),AMQQCHNN,AMQQCHTT
Q
;
STUFF ; ENTRY POINT FROM METADICTIONARY
N AMQQFGBL,AMQQFXR,AMQQUATN,AMQQFFFG
S AMQQFGBL=U_%(1)
S AMQQFXR=%(2)
S AMQQCHNN=%(4)
S AMQQUATN=%(5)
S AMQQFFFG=""
D FCOUNT
I IOST["C-" W !! D WAIT^DICD W !!
S N=AMQQCHTT-1
S I=0
D FR1
K %
Q
;
AMQQAT2 ; IHS/CMI/THL - FILE AND TAXONOMY ATTRIBUTE ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;-----
FQ SET DIC("A")="Which Fileman file: "
+1 SET DIC(0)="AEQ"
+2 SET DIC=1
+3 DO ^DIC
+4 KILL DIC
+5 IF Y=-1
IF X'=""
IF $EXTRACT(X)=U
SET AMQQQUIT=""
QUIT
+6 IF Y=-1
QUIT
+7 IF AMQQCCLS="P"
IF +Y=2!(+Y=9000001)
WRITE !,"I assume that ALL patients are members of this file...Try another attribute.",*7,!
QUIT
+8 DO CHECK
+9 IF '$DATA(AMQQFFLD)
GOTO FQ
+10 DO FSET
EXIT KILL AMQQFFLD,AMQQCHTT,AMQQRNDN,AMQQCRFG,AMQQFFIL,AMQQFFLD,AMQQFGBL,AMQQFPC,AMQQFSBS,AMQQFXR,%,I,N,Z
+1 QUIT
+2 ;
CHECK KILL AMQQFFLD
+1 FOR X=0:0
SET X=$ORDER(^DD(+Y,"IX",X))
IF 'X
QUIT
SET %=$PIECE(^DD(+Y,X,0),U,2)
IF %["P2"!(%["P9000001")
DO C1
IF $DATA(AMQQFFLD)
QUIT
+2 IF '$DATA(AMQQFFLD)
WRITE !,"Sorry...I cannot find any patient fields in this file which are indexed"
QUIT
+3 WRITE !!,"OK, I'll check the ",$PIECE(^DD(+Y,X,0),U)," field of this file."
+4 QUIT
+5 ;
C1 FOR Z=0:0
SET Z=$ORDER(^DD(+Y,X,1,Z))
IF 'Z
QUIT
IF $PIECE(^(Z,0),U,3)=""
SET AMQQFFLD=X
SET AMQQFFIL=+Y
SET AMQQFXR=$PIECE(^(0),U,2)
QUIT
+1 QUIT
+2 ;
FSET SET AMQQFGBL=^DIC(AMQQFFIL,0,"GL")
+1 SET AMQQCHRT=$EXTRACT(AMQQFGBL,2,99)_";"_AMQQFXR
+2 SET %=$PIECE(^DD(AMQQFFIL,AMQQFFLD,0),U,4)
+3 SET AMQQFSBS=$PIECE(%,";")
+4 SET AMQQFPC=$PIECE(%,";",2)
+5 SET DIR(0)="SO^1:Look for patients entered in the file;2:Look for patients not entered in the file;3:Take a random sample of patients entered in the file;4:Count the number of patients in the file"
+6 SET DIR("A")="Your choice"
+7 SET DIR("B")="1"
+8 SET DIR("?")=""
+9 DO ^DIR
+10 KILL DIR
+11 IF $EXTRACT(Y)=U
SET AMQQQUIT=""
QUIT
+12 IF Y=4
DO FCOUNT
KILL ^UTILITY("AMER TEMP",$JOB)
GOTO FSET
+13 IF Y=3
DO FRAND
QUIT
+14 IF Y=2
SET AMQQLINK=177
+15 WRITE !!
+16 QUIT
+17 ;
FCOUNT IF IOST["C-"
WRITE !!!,"Counting...",!
+1 SET A=AMQQFGBL_""""_AMQQFXR_""",X)"
+2 SET %=0
+3 KILL ^UTILITY("AMQQ TEMP",$JOB)
+4 FOR X=0:0
SET X=$ORDER(@A)
IF 'X
QUIT
IF '$DATA(^UTILITY("AMQQ TEMP",$JOB,X))
SET ^(X)=""
SET %=%+1
IF IOST["C-"
WRITE $CHAR(13),%
IF $DATA(AMQQFFFG)
SET ^UTILITY("AMQQ FTEMP",$JOB,%,X)=""
+5 SET AMQQCHTT=%
+6 QUIT
+7 ;
FRAND WRITE !!
+1 DO WAIT^DICD
+2 SET AMQQFFFG=""
+3 DO FCOUNT
+4 KILL AMQQFFFG
+5 WRITE $CHAR(13)," ",$CHAR(13),"There are ",AMQQCHTT," patients in this file"
+6 WRITE !!!
+7 SET AMQQRNDN=AMQQCHTT\2
+8 SET AMQQCRFL=""
+9 DO CNP1^AMQQAT1
+10 IF IOST["C-"
WRITE !!,"Collecting a random sample",!
+11 KILL ^UTILITY("AMQQ FRAND",$JOB,AMQQATN)
+12 SET AMQQCHRT=AMQQCHRT_";"_$JOB_";"_AMQQCHNN_";"_AMQQCHTT_";"_AMQQUATN
SET I=0
SET N=AMQQCHTT-1
+13 SET AMQQLINK=178
FR1 ; ENTRY POINT FROM STUFF
+1 FOR
IF I=AMQQCHNN
QUIT
SET Y=$RANDOM(N)+1
SET Z=$ORDER(^UTILITY("AMQQ FTEMP",$JOB,Y,""))
IF Z
IF '$DATA(^UTILITY("AMQQ FRAND",$JOB,AMQQUATN,Z))
SET ^(Z)=""
SET I=I+1
IF IOST["C-"
WRITE $CHAR(13),I
+2 KILL ^UTILITY("AMQQ FTEMP",$JOB),AMQQRNDN,^UTILITY("AMQQ TEMP",$JOB),AMQQCHNN,AMQQCHTT
+3 QUIT
+4 ;
STUFF ; ENTRY POINT FROM METADICTIONARY
+1 NEW AMQQFGBL,AMQQFXR,AMQQUATN,AMQQFFFG
+2 SET AMQQFGBL=U_%(1)
+3 SET AMQQFXR=%(2)
+4 SET AMQQCHNN=%(4)
+5 SET AMQQUATN=%(5)
+6 SET AMQQFFFG=""
+7 DO FCOUNT
+8 IF IOST["C-"
WRITE !!
DO WAIT^DICD
WRITE !!
+9 SET N=AMQQCHTT-1
+10 SET I=0
+11 DO FR1
+12 KILL %
+13 QUIT
+14 ;
