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("_%_")"))
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("_%_")"))
+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
