Routine: AMQQAT2

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

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."

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

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 !!

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=%

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

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 %

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      ;

AMQQAT2.m