AMQQMGR.m

AMQQMGR ; IHS/CMI/THL - MANAGER'S UTILITIES ;

 ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 ;-----

 S IOP=0

 D ^%ZIS

 S X=$P(^AMQQ(8,DUZ(2),0),U,6)

 F %=3,6,16 S AMQQ200(%)=$S(X:"^VA(200)",1:("^DIC("_%_")"))

MENU ;

 I '$O(^AMQQ(8,0)) D INIT I '$O(^AMQQ(8,0)) Q

 S DIC="^AMQQ(8,"

 S DIC(0)=""

 S X="`"_DUZ(2)

 D ^DIC

 K DIC

 I Y=-1 W !!,*7,"DUZ(2) MUST BE SET TO THE FACILITY INDICATED IN THE QMAN SITE PARAMETERS FILE!" H 2 Q

ASK W !! S DIR(0)="SO^1:CHECK security keys;2:DEVICE management;3:INDEX setup;4:INTEG check;5:LAB setup;6:LOG of queries;7:SECONDARY facilities;8:DELETE Search Template;9:HELP;0:EXIT"

 ;W !! S DIR(0)="SO^1:CHECK security keys;2:DEVICE management;3:INDEX setup;4:INTEG check;5:LAB setup;6:LOG of queries;7:SECONDARY facilities;8:DELETE Search Template;9:HELP;11:IMMunizaiton Update;0:EXIT"

 S DIR("??")="AMQQMGR"

 S DIR("A")=$C(10)_"     Your choice"

 S DIR("?")="Enter a code from the list or type '??' for more information"

 D ^DIR

 K DIR

 D CHK

 I $D(AMQQQUIT) G EXIT

 I Y=0 G EXIT

 I Y=9 W !!,"Enter a code from the list or type '??' for more information." G ASK

 D @("M"_Y)

 I '$D(AMQQQUIT) G MENU

EXIT K AMQQQUIT,X,Y,%,AMQQMGRL,AMQQMGRN,AMQQMGRS,AMQQMGRF,AMQQLSSX

 Q

 ;

CHK I $D(DTOUT)+$D(DUOUT)+(Y=-1)+(Y="") K DIRUT,DUOUT,DTOUT S AMQQQUIT="" Q

 Q

M1 ;

 D ^%ZIS

 I POP W:$D(IOF) @IOF Q

 U IO

 W:IOST["C-" @IOF

 W ?15,"*****  SECURITY KEY ASSIGNMENT CRITERIA  *****",!!

 W "Q-MAN DEMOGRAPHIC DATA ACCESS   Key = AMQQZMENU  Assign to all Q-Man users",!

 W "Q-MAN CLINICAL DATA ACCESS  Key = AMQQZCLIN  Assign to health professionals only",!

 W "Q-MAN PROGRAMMER ACCESS  Key = AMQQZPROG  Assign to PCC developers only",!

 W "Q-MAN MANAGERS UTILITIES   Key = AMQQZMGR   Only the site manager should hold it"

 W "PROMPT FOR WHO REPORT IS FOR   Key = AMQQZRPT   Assign to users running reports",!,"for others"

 S AMQQMGRL=6

 S Z=""

 F X="AMQQZMENU^Q-MAN ACCESS","AMQQZCLIN^CLINICAL DATA ACCESS","AMQQZPROG^Q-MAN PROGRAMMER ACCESS","AMQQZMGR^SITE MANAGER'S UTILITIES","AMQQZRPT^REPORT GENERATORS" D KEY I $G(Z)=U G M10

 I IOST["C-" R !,"<Press the ENTER key to go on>",X:DTIME K DUOUT,DTOUT,DIRUT Q

M10 W @IOF

 K AMQQMGRL

 D ^%ZISC

 Q

 ;

KEY S AMQQMGRL=AMQQMGRL+3

 W !!,?10,"*****  ",$P(X,U,2),"  *****",!

 S X=$P(X,U)

 F %=0:0 S %=$O(^XUSEC(X,%)) Q:'%  S AMQQMGRL=AMQQMGRL+1 W ! D WAIT Q:$G(Z)=U  W $S($D(@AMQQ200(3)@(%,0)):$P(^(0),U),1:(%_"  ??"))

 Q

 ;

WAIT I (AMQQMGRL<(IOSL-3)) Q

 S AMQQMGRL=0

 I IOST'["C-" W IOF Q

 R "<>",Z:DTIME E  S AMQQQUIT="",%=99999999999 W @IOF Q

 W @IOF

 Q

 ;

M2 D ^AMQQMGR5

 Q

 ;

M7 W @IOF,!!,?20,"*****  SECONDARY FACILITIES  *****",!!

 W !,"Normally, when the user requests patient reports, s/he will only see the chart"

 W !,"number at this facility.  The user may request other chart numbers provided"

 W !,"that you enter the other local facilities now.  You may enter up to three",!,"facilities, but do not enter this one!",!

 I $P(^AMQQ(8,DUZ(2),0),U,2) W !,"OTHER FACILITIES' CHART NUMBERS NOW DISPLAYED =>",! D

 .F %=2:1:4 Q:'$P(^AMQQ(8,DUZ(2),0),U,%)  W !,$P(^DIC(4,$P(^(0),U,%),0),U)

ASKFAC .W !!,"You may recreate this list if you want.  Do you want to remove this list"

 .W !,"and enter other local facilities"

 .S %=2

 .D YN^DICN

 .G:%=0 ASKFAC

 .I %=-1!(%=2) S AMQQSTP=""

 I $D(AMQQSTP) K AMQQSTP Q

 W !

 I $P(^AMQQ(8,DUZ(2),0),U,2) D

 .S DA=DUZ(2)

 .S DIE="^AMQQ(8,"

 .S DR=".02///@;.03///@;.04///@"

 .D ^DIE

 .K DIE,DR,DA

 .S DIE="^AMQQ(1,256,4,"

 .S DA=1

 .S DA(1)=256

 .S DR="4///@;5///@"

 .D ^DIE

 .K DIE,DR,DA

 S AMQQMGRF="@^@^@"

 F  D FAC Q:"^@"[X  I $G(AMQQMGRN)=3 Q

 I X="@" S AMQQMGRN=0 G SETM7

 I '+AMQQMGRF Q

SETM7 S %=AMQQMGRF

 S DA=DUZ(2)

 S DIE="^AMQQ(8,"

 S DR=".02////"_$P(%,U)_";.03////"_$P(%,U,2)_";.04////"_$P(%,U,3)

 D ^DIE

 K DIE,DR,DA

 S %=AMQQMGRN*10

 S DIE="^AMQQ(1,256,4,"

 S DA=1

 S DA(1)=256

 S DR="4///"_%_";5///"_%

 D ^DIE

 K DIE,DR,DA

 W !!,"Okay, the entered local facility or facilities' chart numbers will now appear"

 W !,"on all outputs"

 H 2

 K AMQQMGRF,AMQQMGRN,DIC

 Q

 ;

FAC S DIR(0)="PO^9999999.06:EMQ"

 D ^DIR

 I +Y=DUZ(2) W !,*7,"Enter a facility other than your local facility.",! G FAC

 I X=""!(X=U)!(X="@") Q

 D CHK

 I $D(AMQQQUIT) K AMQQQUIT Q

 S AMQQMGRN=$G(AMQQMGRN)+1

 S $P(AMQQMGRF,U,AMQQMGRN)=+Y

 Q

 ;

M3 D ^AMQQMGR1

 Q

 ;

M6 D ^AMQQMGR2

 Q

 ;

M4 D ^AMQQNTEG

 Q

 ;

M5 D ^AMQQMGR6

 Q

 ; 

VER W @IOF,!,?15,"*****  LAB RESULTS FOR Q-MAN  *****",!!

M51 W !

 S DIR(0)="SO^1:TOP 40 tests;2:INDIVIDUAL tests;3:VIEW Q-Man lab tests;9:HELP;0:EXIT"

 S DIR("A")=$C(10)_"Your choice"

 S DIR("??")="AMQQLABSTART"

 D ^DIR

 K DIR

 I Y=9 W !!,"Select a code from the list or type '??' for more info",!! G M51

 I 'Y Q

 I Y=1 D TOP^AMQQMGR4 G M5

 I Y=2 D GET^AMQQMGR4 G M5

 I Y=3 D LIST^AMQQMGR4 R !!,"<>",X:DTIME G M5

 G M5

 ;

INIT ;

 I '$D(DUZ(2)) W !!,"KERNEL VARIABLES NOT SET!!,",!! Q

 W !!,"Is the site where Q-Man is being installed ",$P(^DIC(4,DUZ(2),0),U)

 S %=0

 D YN^DICN

 I $E(%Y)?1A,"yYnN"[$E(%Y) D ISET

 K DUOUT,DTOUT,%,%Y

 Q

 ;

ISET I "nN"[$E(%Y) W !!,"Well then, you must log in again, and this time enter the correct site!",!!,*7 Q

 S X="`"_DUZ(2)

 S DIC="^AMQQ(8,"

 S DIC(0)="L"

 S DLAYGO=9009078

 D ^DIC

 I Y'=-1 D

 .S X="0:1;2:4;5:10;11:19;20:39;40:59;60:79;80:199"

 .X $P(^DD(9009078,30,0),U,5,99)

 .D:$D(X)

 ..S ^AMQQ(8,+Y,3)=X

 ..S DIK="^AMQQ(8,"

 ..S DIK(1)=30

 ..S DA=DUZ(2)

 ..D EN^DIK

 Q

 ;

TERMS ;EP;PROGRAMMER ENTRY POINT TO CREATE NEW METADICTIONARY ENTRIES

 S DIR(0)="NO^1:999"

 S DIR("A")="Enter the IEN to create"

 W !

 D ^DIR

 K DIR

 Q:'Y

 I $D(^AMQQ(5,Y)) W !!,"Entry already exists.",! G TERMS

 S IEN=+Y

 S DIC="^AMQQ(5,"

 S DIC(0)="AEMQZ"

 S DIC("A")="Pattern after which TERM: "

 W !

 D ^DIC

 K DIC

 Q:+Y<1

 S TERM=+Y

 S DIC="^AMQQ(1,"

 S DIC(0)="AEMQZ"

 S DIC("A")="Pattern after which LINK: "

 W !

 D ^DIC

 K DIC

 Q:+Y<1

 S LINK=+Y

 W !,"IEN: ",IEN," will be created patterned after"

 W !,"TERM: ",$P(^AMQQ(5,TERM,0),U)," and"

 W !,"LINK: ",$P(^AMQQ(1,LINK,0),U),"."

 S DIR(0)="YO"

 S DIR("A")="Are you certain"

 S DIR("B")="NO"

 W !

 D ^DIR

 K DIR

 Q:Y'=1

T1 M ^AMQQ(5,IEN)=^AMQQ(5,TERM)

 M ^AMQQ(1,IEN)=^AMQQ(1,LINK)

 Q

XXX F IEN=697,698 S TERM=690,LINK=690 D T1

 Q

M8 ;EP;TO DELETE A SEARCH TEMPLATE

 K AMQQQUIT

 F  D M81 Q:$D(AMQQQUIT)

 K AMQQQUIT

 Q

M81 ;

 W @IOF

 W !?10,"Qman Search Template Deletion Utility"

 W !!?10,"Select a Search Template to Delete.",!

 S DIC="^DIBT("

 S DIC(0)="AEMQZ"

 S DIC("A")="Delete which Template: "

 W !

 D ^DIC

 I Y<0 S AMQQQUIT="" Q

 S AMQQDA=+Y

 S X=$P(^DIBT(+Y,0),U)

 S DIR(0)="YO"

 S DIR("A")="Sure you want to delete Search Template ** "_X_" **"

 S DIR("B")="NO"

 W !

 D ^DIR

 K DIR

 Q:Y'=1

 S DA=AMQQDA

 S DIK="^DIBT("

 D ^DIK

 K DA,DIK

 Q

M11 ;EP;TO UPDATE IMMUNIZATIONS ENTRIES IN THE QMAN DICTIONARY OF TERMS

 D IMM^AMQQMGR9

 Q

AMQQMGR   ; IHS/CMI/THL - MANAGER'S UTILITIES ;

 +1       ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 +2       ;-----

 +3        SET IOP=0

 +4        DO ^%ZIS

 +5        SET X=$PIECE(^AMQQ(8,DUZ(2),0),U,6)

 +6        FOR %=3,6,16

               SET AMQQ200(%)=$SELECT(X:"^VA(200)",1:("^DIC("_%_")"))

MENU      ;

 +1        IF '$ORDER(^AMQQ(8,0))

               DO INIT

               IF '$ORDER(^AMQQ(8,0))

                   QUIT 

 +2        SET DIC="^AMQQ(8,"

 +3        SET DIC(0)=""

 +4        SET X="`"_DUZ(2)

 +5        DO ^DIC

 +6        KILL DIC

 +7        IF Y=-1

               WRITE !!,*7,"DUZ(2) MUST BE SET TO THE FACILITY INDICATED IN THE QMAN SITE PARAMETERS FILE!"

               HANG 2

               QUIT 

ASK        WRITE !!

           SET DIR(0)="SO^1:CHECK security keys;2:DEVICE management;3:INDEX setup;4:INTEG check;5:LAB setup;6:LOG of queries;7:SECONDARY facilities;8:DELETE Search Template;9:HELP;0:EXIT"

 +1       ;W !! S DIR(0)="SO^1:CHECK security keys;2:DEVICE management;3:INDEX setup;4:INTEG check;5:LAB setup;6:LOG of queries;7:SECONDARY facilities;8:DELETE Search Template;9:HELP;11:IMMunizaiton Update;0:EXIT"

 +2        SET DIR("??")="AMQQMGR"

 +3        SET DIR("A")=$CHAR(10)_"     Your choice"

 +4        SET DIR("?")="Enter a code from the list or type '??' for more information"

 +5        DO ^DIR

 +6        KILL DIR

 +7        DO CHK

 +8        IF $DATA(AMQQQUIT)

               GOTO EXIT

 +9        IF Y=0

               GOTO EXIT

 +10       IF Y=9

               WRITE !!,"Enter a code from the list or type '??' for more information."

               GOTO ASK

 +11       DO @("M"_Y)

 +12       IF '$DATA(AMQQQUIT)

               GOTO MENU

EXIT       KILL AMQQQUIT,X,Y,%,AMQQMGRL,AMQQMGRN,AMQQMGRS,AMQQMGRF,AMQQLSSX

 +1        QUIT 

 +2       ;

CHK        IF $DATA(DTOUT)+$DATA(DUOUT)+(Y=-1)+(Y="")

               KILL DIRUT,DUOUT,DTOUT

               SET AMQQQUIT=""

               QUIT 

 +1        QUIT 

M1        ;

 +1        DO ^%ZIS

 +2        IF POP

               IF $DATA(IOF)

                   WRITE @IOF

               QUIT 

 +3        USE IO

 +4        IF IOST["C-"

               WRITE @IOF

 +5        WRITE ?15,"*****  SECURITY KEY ASSIGNMENT CRITERIA  *****",!!

 +6        WRITE "Q-MAN DEMOGRAPHIC DATA ACCESS   Key = AMQQZMENU  Assign to all Q-Man users",!

 +7        WRITE "Q-MAN CLINICAL DATA ACCESS  Key = AMQQZCLIN  Assign to health professionals only",!

 +8        WRITE "Q-MAN PROGRAMMER ACCESS  Key = AMQQZPROG  Assign to PCC developers only",!

 +9        WRITE "Q-MAN MANAGERS UTILITIES   Key = AMQQZMGR   Only the site manager should hold it"

 +10       WRITE "PROMPT FOR WHO REPORT IS FOR   Key = AMQQZRPT   Assign to users running reports",!,"for others"

 +11       SET AMQQMGRL=6

 +12       SET Z=""

 +13       FOR X="AMQQZMENU^Q-MAN ACCESS","AMQQZCLIN^CLINICAL DATA ACCESS","AMQQZPROG^Q-MAN PROGRAMMER ACCESS","AMQQZMGR^SITE MANAGER'S UTILITIES","AMQQZRPT^REPORT GENERATORS"

               DO KEY

               IF $GET(Z)=U

                   GOTO M10

 +14       IF IOST["C-"

               READ !,"<Press the ENTER key to go on>",X:DTIME

               KILL DUOUT,DTOUT,DIRUT

               QUIT 

M10        WRITE @IOF

 +1        KILL AMQQMGRL

 +2        DO ^%ZISC

 +3        QUIT 

 +4       ;

KEY        SET AMQQMGRL=AMQQMGRL+3

 +1        WRITE !!,?10,"*****  ",$PIECE(X,U,2),"  *****",!

 +2        SET X=$PIECE(X,U)

 +3        FOR %=0:0

               SET %=$ORDER(^XUSEC(X,%))

               IF '%

                   QUIT 

               SET AMQQMGRL=AMQQMGRL+1

               WRITE !

               DO WAIT

               IF $GET(Z)=U

                   QUIT 

               WRITE $SELECT($DATA(@AMQQ200(3)@(%,0)):$PIECE(^(0),U),1:(%_"  ??"))

 +4        QUIT 

 +5       ;

WAIT       IF (AMQQMGRL<(IOSL-3))

               QUIT 

 +1        SET AMQQMGRL=0

 +2        IF IOST'["C-"

               WRITE IOF

               QUIT 

 +3        READ "<>",Z:DTIME

          IF '$TEST

               SET AMQQQUIT=""

               SET %=99999999999

               WRITE @IOF

               QUIT 

 +4        WRITE @IOF

 +5        QUIT 

 +6       ;

M2         DO ^AMQQMGR5

 +1        QUIT 

 +2       ;

M7         WRITE @IOF,!!,?20,"*****  SECONDARY FACILITIES  *****",!!

 +1        WRITE !,"Normally, when the user requests patient reports, s/he will only see the chart"

 +2        WRITE !,"number at this facility.  The user may request other chart numbers provided"

 +3        WRITE !,"that you enter the other local facilities now.  You may enter up to three",!,"facilities, but do not enter this one!",!

 +4        IF $PIECE(^AMQQ(8,DUZ(2),0),U,2)

               WRITE !,"OTHER FACILITIES' CHART NUMBERS NOW DISPLAYED =>",!

               Begin DoDot:1

 +5                FOR %=2:1:4

                       IF '$PIECE(^AMQQ(8,DUZ(2),0),U,%)

                           QUIT 

                       WRITE !,$PIECE(^DIC(4,$PIECE(^(0),U,%),0),U)

ASKFAC             WRITE !!,"You may recreate this list if you want.  Do you want to remove this list"

 +1                WRITE !,"and enter other local facilities"

 +2                SET %=2

 +3                DO YN^DICN

 +4                IF %=0

                       GOTO ASKFAC

 +5                IF %=-1!(%=2)

                       SET AMQQSTP=""

               End DoDot:1

 +6        IF $DATA(AMQQSTP)

               KILL AMQQSTP

               QUIT 

 +7        WRITE !

 +8        IF $PIECE(^AMQQ(8,DUZ(2),0),U,2)

               Begin DoDot:1

 +9                SET DA=DUZ(2)

 +10               SET DIE="^AMQQ(8,"

 +11               SET DR=".02///@;.03///@;.04///@"

 +12               DO ^DIE

 +13               KILL DIE,DR,DA

 +14               SET DIE="^AMQQ(1,256,4,"

 +15               SET DA=1

 +16               SET DA(1)=256

 +17               SET DR="4///@;5///@"

 +18               DO ^DIE

 +19               KILL DIE,DR,DA

               End DoDot:1

 +20       SET AMQQMGRF="@^@^@"

 +21       FOR 

               DO FAC

               IF "^@"[X

                   QUIT 

               IF $GET(AMQQMGRN)=3

                   QUIT 

 +22       IF X="@"

               SET AMQQMGRN=0

               GOTO SETM7

 +23       IF '+AMQQMGRF

               QUIT 

SETM7      SET %=AMQQMGRF

 +1        SET DA=DUZ(2)

 +2        SET DIE="^AMQQ(8,"

 +3        SET DR=".02////"_$PIECE(%,U)_";.03////"_$PIECE(%,U,2)_";.04////"_$PIECE(%,U,3)

 +4        DO ^DIE

 +5        KILL DIE,DR,DA

 +6        SET %=AMQQMGRN*10

 +7        SET DIE="^AMQQ(1,256,4,"

 +8        SET DA=1

 +9        SET DA(1)=256

 +10       SET DR="4///"_%_";5///"_%

 +11       DO ^DIE

 +12       KILL DIE,DR,DA

 +13       WRITE !!,"Okay, the entered local facility or facilities' chart numbers will now appear"

 +14       WRITE !,"on all outputs"

 +15       HANG 2

 +16       KILL AMQQMGRF,AMQQMGRN,DIC

 +17       QUIT 

 +18      ;

FAC        SET DIR(0)="PO^9999999.06:EMQ"

 +1        DO ^DIR

 +2        IF +Y=DUZ(2)

               WRITE !,*7,"Enter a facility other than your local facility.",!

               GOTO FAC

 +3        IF X=""!(X=U)!(X="@")

               QUIT 

 +4        DO CHK

 +5        IF $DATA(AMQQQUIT)

               KILL AMQQQUIT

               QUIT 

 +6        SET AMQQMGRN=$GET(AMQQMGRN)+1

 +7        SET $PIECE(AMQQMGRF,U,AMQQMGRN)=+Y

 +8        QUIT 

 +9       ;

M3         DO ^AMQQMGR1

 +1        QUIT 

 +2       ;

M6         DO ^AMQQMGR2

 +1        QUIT 

 +2       ;

M4         DO ^AMQQNTEG

 +1        QUIT 

 +2       ;

M5         DO ^AMQQMGR6

 +1        QUIT 

 +2       ; 

VER        WRITE @IOF,!,?15,"*****  LAB RESULTS FOR Q-MAN  *****",!!

M51        WRITE !

 +1        SET DIR(0)="SO^1:TOP 40 tests;2:INDIVIDUAL tests;3:VIEW Q-Man lab tests;9:HELP;0:EXIT"

 +2        SET DIR("A")=$CHAR(10)_"Your choice"

 +3        SET DIR("??")="AMQQLABSTART"

 +4        DO ^DIR

 +5        KILL DIR

 +6        IF Y=9

               WRITE !!,"Select a code from the list or type '??' for more info",!!

               GOTO M51

 +7        IF 'Y

               QUIT 

 +8        IF Y=1

               DO TOP^AMQQMGR4

               GOTO M5

 +9        IF Y=2

               DO GET^AMQQMGR4

               GOTO M5

 +10       IF Y=3

               DO LIST^AMQQMGR4

               READ !!,"<>",X:DTIME

               GOTO M5

 +11       GOTO M5

 +12      ;

INIT      ;

 +1        IF '$DATA(DUZ(2))

               WRITE !!,"KERNEL VARIABLES NOT SET!!,",!!

               QUIT 

 +2        WRITE !!,"Is the site where Q-Man is being installed ",$PIECE(^DIC(4,DUZ(2),0),U)

 +3        SET %=0

 +4        DO YN^DICN

 +5        IF $EXTRACT(%Y)?1A

               IF "yYnN"[$EXTRACT(%Y)

                   DO ISET

 +6        KILL DUOUT,DTOUT,%,%Y

 +7        QUIT 

 +8       ;

ISET       IF "nN"[$EXTRACT(%Y)

               WRITE !!,"Well then, you must log in again, and this time enter the correct site!",!!,*7

               QUIT 

 +1        SET X="`"_DUZ(2)

 +2        SET DIC="^AMQQ(8,"

 +3        SET DIC(0)="L"

 +4        SET DLAYGO=9009078

 +5        DO ^DIC

 +6        IF Y'=-1

               Begin DoDot:1

 +7                SET X="0:1;2:4;5:10;11:19;20:39;40:59;60:79;80:199"

 +8                XECUTE $PIECE(^DD(9009078,30,0),U,5,99)

 +9                IF $DATA(X)

                       Begin DoDot:2

 +10                       SET ^AMQQ(8,+Y,3)=X

 +11                       SET DIK="^AMQQ(8,"

 +12                       SET DIK(1)=30

 +13                       SET DA=DUZ(2)

 +14                       DO EN^DIK

                       End DoDot:2

               End DoDot:1

 +15       QUIT 

 +16      ;

TERMS     ;EP;PROGRAMMER ENTRY POINT TO CREATE NEW METADICTIONARY ENTRIES

 +1        SET DIR(0)="NO^1:999"

 +2        SET DIR("A")="Enter the IEN to create"

 +3        WRITE !

 +4        DO ^DIR

 +5        KILL DIR

 +6        IF 'Y

               QUIT 

 +7        IF $DATA(^AMQQ(5,Y))

               WRITE !!,"Entry already exists.",!

               GOTO TERMS

 +8        SET IEN=+Y

 +9        SET DIC="^AMQQ(5,"

 +10       SET DIC(0)="AEMQZ"

 +11       SET DIC("A")="Pattern after which TERM: "

 +12       WRITE !

 +13       DO ^DIC

 +14       KILL DIC

 +15       IF +Y<1

               QUIT 

 +16       SET TERM=+Y

 +17       SET DIC="^AMQQ(1,"

 +18       SET DIC(0)="AEMQZ"

 +19       SET DIC("A")="Pattern after which LINK: "

 +20       WRITE !

 +21       DO ^DIC

 +22       KILL DIC

 +23       IF +Y<1

               QUIT 

 +24       SET LINK=+Y

 +25       WRITE !,"IEN: ",IEN," will be created patterned after"

 +26       WRITE !,"TERM: ",$PIECE(^AMQQ(5,TERM,0),U)," and"

 +27       WRITE !,"LINK: ",$PIECE(^AMQQ(1,LINK,0),U),"."

 +28       SET DIR(0)="YO"

 +29       SET DIR("A")="Are you certain"

 +30       SET DIR("B")="NO"

 +31       WRITE !

 +32       DO ^DIR

 +33       KILL DIR

 +34       IF Y'=1

               QUIT 

T1         MERGE ^AMQQ(5,IEN)=^AMQQ(5,TERM)

 +1        MERGE ^AMQQ(1,IEN)=^AMQQ(1,LINK)

 +2        QUIT 

XXX        FOR IEN=697,698

               SET TERM=690

               SET LINK=690

               DO T1

 +1        QUIT 

M8        ;EP;TO DELETE A SEARCH TEMPLATE

 +1        KILL AMQQQUIT

 +2        FOR 

               DO M81

               IF $DATA(AMQQQUIT)

                   QUIT 

 +3        KILL AMQQQUIT

 +4        QUIT 

M81       ;

 +1        WRITE @IOF

 +2        WRITE !?10,"Qman Search Template Deletion Utility"

 +3        WRITE !!?10,"Select a Search Template to Delete.",!

 +4        SET DIC="^DIBT("

 +5        SET DIC(0)="AEMQZ"

 +6        SET DIC("A")="Delete which Template: "

 +7        WRITE !

 +8        DO ^DIC

 +9        IF Y<0

               SET AMQQQUIT=""

               QUIT 

 +10       SET AMQQDA=+Y

 +11       SET X=$PIECE(^DIBT(+Y,0),U)

 +12       SET DIR(0)="YO"

 +13       SET DIR("A")="Sure you want to delete Search Template ** "_X_" **"

 +14       SET DIR("B")="NO"

 +15       WRITE !

 +16       DO ^DIR

 +17       KILL DIR

 +18       IF Y'=1

               QUIT 

 +19       SET DA=AMQQDA

 +20       SET DIK="^DIBT("

 +21       DO ^DIK

 +22       KILL DA,DIK

 +23       QUIT 

M11       ;EP;TO UPDATE IMMUNIZATIONS ENTRIES IN THE QMAN DICTIONARY OF TERMS

 +1        DO IMM^AMQQMGR9

 +2        QUIT