XQOO ;SEATTLE/LUKE - Out Of Order, Man ;9/13/96 09:21
;;8.0;KERNEL;**10,21,47,520**;Jul 03, 1995;Build 5
;Per VHA Directive 2004-038, this routine should not be modified.
INIT(XQSET) ;Call for Out-of-order set creation, called by KIDS
;
;The variable XQSET should be null if this is the first pass
;or if KIDS thinks the user wants a new set of options
;
S XQINI="",XQK=0 ;XQINI used as a flag to see if it's KIDS calling
I XQSET]"" S:'$D(^XTMP("XQOO",XQSET,0)) XQSET="^"
I XQSET="^" G OUT
I XQSET]"" S XQMESS=$P(^XTMP("XQOO",XQSET,0),U) G ASK1
;
EN ;Entry point for Define Out Of Order Options Set option
S XQK=0,U="^",XQSET=U
;
NAME ;Get name for this option set
W !!,"Enter a short name for this set of options and or protocols: " R XQSET:DTIME S:'$T XQSET=U G:XQSET=U OUT
I XQSET="?" W !!,"Enter a name of 20 characters or less for this set, '^' to quit, or '??' for help" G NAME
I XQSET["??" S XQH="XQOO-NAME" D EN^XQH G NAME
I XQSET=""!($L(XQSET)>20) W !!,"Out-of-order sets must be named with 20 or less characters. Enter '^' to quit." G NAME
I $D(^XTMP("XQOO",XQSET,0)) D G:$D(DIRUT) OUT G:Y=0 NAME G ASK1
.S XQMESS=$P(^XTMP("XQOO",XQSET,0),U)
.W !!,"WARNING: The Out-of-order set '",XQSET,"' already exists.",!
.S DIR("A")="Do you want to modify it? (Y/N) " S DIR(0)="Y",DIR("B")="YES" D ^DIR K DIR
.Q
;
MESS ;Get the Out Of Order Message
R !!,"What should the Out Of Order message text be? :",XQMESS:DTIME S:'$T XQMESS=U G:XQMESS=U OUT
I XQMESS="?" W !!,"This is the message that will be shown with the options/protocols",!,"that are made out of order. For instance, ""Laboratory install in progress""" G MESS
I XQMESS["??" S XQH="XQOO-MESS" D EN^XQH G MESS
;
ASK1 S XQFIL=19
ASK ;Get options to mark
S (XQ,XQN)=""
W !!,"Enter "_$S(XQFIL=19:"options",1:"protocols")_" you wish to mark as 'Out Of Order': "
R XQ:DTIME S:'$T XQ=U G:XQ=U OUT G:XQ="" SET
I XQ="?" D G ASK
.W !!?5,"Enter "_$S(XQFIL=19:"an option",1:"a protocol")_" name,"
.W !?5,"a name preceded by a minus sign to remove "_$S(XQFIL=19:"an option,",1:"a protocol,")
.W !?5,$S(XQFIL=19:"'^PR'",1:"'^OP'")_" to switch to "_$S(XQFIL=19:"protocols,",1:"options,")
.W !?5,"an uparrow (that is '^') to quit,"
.W !?5,"or '??' for more help."
.Q
I XQ["??" S XQH="XQOO" D:XQ="??" EN^XQH D:XQ="???" LIST D:XQ="????" LSTFIL S XQH="XQOO-MAIN" D:XQ="?????" EN^XQH G ASK
I $E(XQ,1,3)="^OP"!($E(XQ,1,3)="^op") S XQFIL=19,XQSWTCH="" G ASK
I $E(XQ,1,3)="^PR"!($E(XQ,1,3)="^pr") S XQFIL=101,XQSWTCH="" G ASK
S XQDEL=0 I $E(XQ,1)="-" S XQDEL=1,XQ=$E(XQ,2,99)
I XQ="*",XQDEL K ^XTMP("XQOO",XQSET,XQFIL) W !," All "_$S(XQFIL=19:"options",1:"protocols")_" removed. Start again or '^' to quit. " G ASK
I XQ="*" S XQSTART=1,XQEND="ZZZZZ" D FIND G ASK
I XQ?.E1"*" S XQSTART=$E(XQ,1,$L(XQ)-1),XQEND=XQSTART_$C(127) D FIND G ASK
;Get a range of options allowing for name with hyphens in them
I XQ?1E.E1"-"1E.E S XQRNG=0 D G:'XQRNG ASK
.;Name has hyphen, echo back the name and quit
.S X=XQ,DIC=XQFIL,DIC(0)="EZ" D ^DIC I Y>0 S XQ=$P(Y,U,2),XQRNG=1 Q
.;It is a range, build prompt to verify range
.W ! K DIR S DIR("A")="Do mean the "_$S(XQFIL=19:"options",1:"protocols")_" from "_$P(XQ,"-")_" to "_$P(XQ,"-",2)_"? (Y/N)",DIR(0)="YA" D ^DIR K DIR I Y S (XQN,XQSTART)=$P(XQ,"-",1),XQEND=$P(XQ,"-",2) D FIND
.Q
;
I XQ'?1E.E1"-"1E.E S X=XQ,DIC=XQFIL,DIC(0)="MEZ" D ^DIC S:Y'<0 XQ=$P(Y,U,2) I Y<0 W " ??",*7 G ASK
I XQDEL K ^XTMP("XQOO",XQSET,XQFIL,+Y) G ASK
S:$E(Y(0),1,4)'="XQOO" ^XTMP("XQOO",XQSET,XQFIL,+Y)=$P(Y(0),U)_U_$P(Y(0),U,2) G ASK
;
FIND ;Find first option in wildcard list
S XQN="" S:$L(XQSTART)>2 XQN=$E(XQSTART,1,$L(XQSTART)-1)
I XQFIL=19 F XQI=0:0 S XQN=$O(^DIC(XQFIL,"B",XQN)) Q:XQN=""!($E(XQN,1,$L(XQSTART))=XQSTART)
E F XQI=0:0 S XQN=$O(^ORD(101,"B",XQN)) Q:XQN=""!($E(XQN,1,$L(XQSTART))=XQSTART)
I XQN="" W !," No such ",$S(XQFIL=19:"option(s).",1:"protocol(s).") Q
S XQSTART=XQN
;
FINDR I XQFIL=19 S XQON=$O(^DIC(XQFIL,"B",XQN,0)),XQON0=^DIC(XQFIL,+XQON,0)
E S XQON=$O(^ORD(XQFIL,"B",XQN,0)),XQON0=^ORD(XQFIL,+XQON,0)
I XQDEL D DELET Q
;
GET ;Get the first option selected and put it in ^XTMP
S XQN=XQSTART I $E(XQON,1,4)'="XQOO" S ^XTMP("XQOO",XQSET,XQFIL,+XQON)=$P(XQON0,U)_U_$P(XQON0,U,2),XQK=XQK+1
S DIC=XQFIL,DIC(0)="MZ"
;
NEXT ;Find the rest of the options in this range and do likewise
I XQFIL=19 F Q:XQN=XQEND S XQN=$O(^DIC(XQFIL,"B",XQN)) Q:XQN=""!(XQN]XQEND) S XQON=$O(^DIC(XQFIL,"B",XQN,0)),XQON0=^DIC(XQFIL,+XQON,0) I $E(XQON,1,4)'="XQOO" S ^XTMP("XQOO",XQSET,XQFIL,+XQON)=$P(XQON0,U)_U_$P(XQON0,U,2),XQK=XQK+1
E F Q:XQN=XQEND S XQN=$O(^ORD(XQFIL,"B",XQN)) Q:XQN=""!(XQN]XQEND) S XQON=$O(^ORD(XQFIL,"B",XQN,0)),XQON0=^ORD(XQFIL,+XQON,0) I $E(XQON,1,4)'="XQOO" S ^XTMP("XQOO",XQSET,XQFIL,+XQON)=$P(XQON0,U)_U_$P(XQON0,U,2),XQK=XQK+1
Q
;
DELET ;Delete option(s) from the list in ^XTMP
;W !,XQON," ",XQSTART," ",XQDEL
S XQN=XQSTART,XQDEL=0
I XQFIL=19 F K ^XTMP("XQOO",XQSET,XQFIL,+XQON) S XQN=$O(^DIC(XQFIL,"B",XQN)),XQX=XQK-1 Q:XQN=""!(XQN]XQEND) S XQON=$O(^DIC(XQFIL,"B",XQN,0))
E F K ^XTMP("XQOO",XQSET,XQFIL,+XQON) S XQN=$O(^ORD(XQFIL,"B",XQN)),XQX=XQK-1 Q:XQN=""!(XQN]XQEND) S XQON=$O(^ORD(XQFIL,"B",XQN,0))
Q
;
REMOV R !!,"Remove all options previously selected? ",XQ:DTIME S:'$T XQ=U G:XQ[U OUT I XQ["N"!(XQ["n") W !!,"OK, you may continue." G ASK
K ^XTMP("XQOO",XQSET)
Q
LSTFIL ;Show Option File
N XQE,XQR,XQS
D RANGE^XQOO2(.XQS,.XQE,.XQR) I XQR D BXREF^XQOO2(XQS,XQE)
Q
;
LIST ;List users and options selected so far.
W @IOF S (XQT,XQM)=0
F XQFIL0=19,101 D
.S XQT=0,XQN=0,XQN=$O(^XTMP("XQOO",XQSET,XQFIL0,XQN)) I XQN="" W !!,"No "_$S(XQFIL0=19:"menu options",1:"protocols")_" selected yet" Q
.W !!,"You will place Out Of Order the following "_$S(XQFIL0=19:"options:",1:"protocols:"),! F XQI=0:0 D:$Y+3>IOSL WAIT Q:XQ=U W !,$P(^XTMP("XQOO",XQSET,XQFIL0,XQN),U,2)_" ["_$P(^(XQN),U)_"] (IEN = "_XQN_")" S XQN=$O(^(XQN)) Q:XQN=""
.Q
Q
;
WAIT ;Skip to the head of the next page
I 1 S XQ="" R:IOST["C-" !!,"Press RETURN to continue, or '^' to quit.",XQ:DTIME S:'$T XQ=U W @IOF
Q
;
SET ;Set 0th node in ^XTMP global
I XQFIL=19,'$D(XQSWTCH) S XQFIL=101 G ASK
D ^XQDATE
I $D(^XTMP("XQOO",XQSET,0)) S XQMESS=$P(^(0),U)
S ^XTMP("XQOO",XQSET,0)=XQMESS_U_%Y_U_$P(^VA(200,DUZ,0),",")
S ^XTMP("XQOO",0)=DT_U_DT+7
;
OUT ;Clean up
;
I '$D(XPDNM),'$D(^XTMP("XQOO",XQSET,0)),$D(^XTMP("XQOO",XQSET)) D
.;Temporary Fix: ^ at protocol prompt leaves partial set (no 0th node)
.S DIR(0)="Y",DIR("B")="YES"
.S DIR("A")="Delete this set of options? (Y/N) "
.D ^DIR
.I Y K ^XTMP("XQOO",XQSET)
.E D ^XQDATE S ^XTMP("XQOO",XQSET,0)=XQMESS_U_%Y_U_$P(^VA(200,DUZ,0),","),^XTMP("XQOO",0)=DT_U_DT+7
.Q
;
I '$D(XPDNM),$D(^XTMP("XQOO",XQSET,0)) D
.S DIR(0)="Y",DIR("B")="NO"
.S DIR("A")="Should I mark these options/protocols out-of-order now? (Y/N) "
.D ^DIR I Y D OFF^XQOO1(XQSET)
.Q
;
K %,%Y,DIRUT,XQ,XQDEL,XQEND,XQFIL,XQFIL0,XQH,XQI,XQINI,XQK,XQM,XQMESS,XQN,XQON,XQON0,XQRNG,XQSTART,XQSWTCH,XQT,XQX,X,Y
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXQOO 7135 printed Oct 16, 2024@18:06:38 Page 2
XQOO ;SEATTLE/LUKE - Out Of Order, Man ;9/13/96 09:21
+1 ;;8.0;KERNEL;**10,21,47,520**;Jul 03, 1995;Build 5
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
INIT(XQSET) ;Call for Out-of-order set creation, called by KIDS
+1 ;
+2 ;The variable XQSET should be null if this is the first pass
+3 ;or if KIDS thinks the user wants a new set of options
+4 ;
+5 ;XQINI used as a flag to see if it's KIDS calling
SET XQINI=""
SET XQK=0
+6 IF XQSET]""
if '$DATA(^XTMP("XQOO",XQSET,0))
SET XQSET="^"
+7 IF XQSET="^"
GOTO OUT
+8 IF XQSET]""
SET XQMESS=$PIECE(^XTMP("XQOO",XQSET,0),U)
GOTO ASK1
+9 ;
EN ;Entry point for Define Out Of Order Options Set option
+1 SET XQK=0
SET U="^"
SET XQSET=U
+2 ;
NAME ;Get name for this option set
+1 WRITE !!,"Enter a short name for this set of options and or protocols: "
READ XQSET:DTIME
if '$TEST
SET XQSET=U
if XQSET=U
GOTO OUT
+2 IF XQSET="?"
WRITE !!,"Enter a name of 20 characters or less for this set, '^' to quit, or '??' for help"
GOTO NAME
+3 IF XQSET["??"
SET XQH="XQOO-NAME"
DO EN^XQH
GOTO NAME
+4 IF XQSET=""!($LENGTH(XQSET)>20)
WRITE !!,"Out-of-order sets must be named with 20 or less characters. Enter '^' to quit."
GOTO NAME
+5 IF $DATA(^XTMP("XQOO",XQSET,0))
Begin DoDot:1
+6 SET XQMESS=$PIECE(^XTMP("XQOO",XQSET,0),U)
+7 WRITE !!,"WARNING: The Out-of-order set '",XQSET,"' already exists.",!
+8 SET DIR("A")="Do you want to modify it? (Y/N) "
SET DIR(0)="Y"
SET DIR("B")="YES"
DO ^DIR
KILL DIR
+9 QUIT
End DoDot:1
if $DATA(DIRUT)
GOTO OUT
if Y=0
GOTO NAME
GOTO ASK1
+10 ;
MESS ;Get the Out Of Order Message
+1 READ !!,"What should the Out Of Order message text be? :",XQMESS:DTIME
if '$TEST
SET XQMESS=U
if XQMESS=U
GOTO OUT
+2 IF XQMESS="?"
WRITE !!,"This is the message that will be shown with the options/protocols",!,"that are made out of order. For instance, ""Laboratory install in progress"""
GOTO MESS
+3 IF XQMESS["??"
SET XQH="XQOO-MESS"
DO EN^XQH
GOTO MESS
+4 ;
ASK1 SET XQFIL=19
ASK ;Get options to mark
+1 SET (XQ,XQN)=""
+2 WRITE !!,"Enter "_$SELECT(XQFIL=19:"options",1:"protocols")_" you wish to mark as 'Out Of Order': "
+3 READ XQ:DTIME
if '$TEST
SET XQ=U
if XQ=U
GOTO OUT
if XQ=""
GOTO SET
+4 IF XQ="?"
Begin DoDot:1
+5 WRITE !!?5,"Enter "_$SELECT(XQFIL=19:"an option",1:"a protocol")_" name,"
+6 WRITE !?5,"a name preceded by a minus sign to remove "_$SELECT(XQFIL=19:"an option,",1:"a protocol,")
+7 WRITE !?5,$SELECT(XQFIL=19:"'^PR'",1:"'^OP'")_" to switch to "_$SELECT(XQFIL=19:"protocols,",1:"options,")
+8 WRITE !?5,"an uparrow (that is '^') to quit,"
+9 WRITE !?5,"or '??' for more help."
+10 QUIT
End DoDot:1
GOTO ASK
+11 IF XQ["??"
SET XQH="XQOO"
if XQ="??"
DO EN^XQH
if XQ="???"
DO LIST
if XQ="????"
DO LSTFIL
SET XQH="XQOO-MAIN"
if XQ="?????"
DO EN^XQH
GOTO ASK
+12 IF $EXTRACT(XQ,1,3)="^OP"!($EXTRACT(XQ,1,3)="^op")
SET XQFIL=19
SET XQSWTCH=""
GOTO ASK
+13 IF $EXTRACT(XQ,1,3)="^PR"!($EXTRACT(XQ,1,3)="^pr")
SET XQFIL=101
SET XQSWTCH=""
GOTO ASK
+14 SET XQDEL=0
IF $EXTRACT(XQ,1)="-"
SET XQDEL=1
SET XQ=$EXTRACT(XQ,2,99)
+15 IF XQ="*"
IF XQDEL
KILL ^XTMP("XQOO",XQSET,XQFIL)
WRITE !," All "_$SELECT(XQFIL=19:"options",1:"protocols")_" removed. Start again or '^' to quit. "
GOTO ASK
+16 IF XQ="*"
SET XQSTART=1
SET XQEND="ZZZZZ"
DO FIND
GOTO ASK
+17 IF XQ?.E1"*"
SET XQSTART=$EXTRACT(XQ,1,$LENGTH(XQ)-1)
SET XQEND=XQSTART_$CHAR(127)
DO FIND
GOTO ASK
+18 ;Get a range of options allowing for name with hyphens in them
+19 IF XQ?1E.E1"-"1E.E
SET XQRNG=0
Begin DoDot:1
+20 ;Name has hyphen, echo back the name and quit
+21 SET X=XQ
SET DIC=XQFIL
SET DIC(0)="EZ"
DO ^DIC
IF Y>0
SET XQ=$PIECE(Y,U,2)
SET XQRNG=1
QUIT
+22 ;It is a range, build prompt to verify range
+23 WRITE !
KILL DIR
SET DIR("A")="Do mean the "_$SELECT(XQFIL=19:"options",1:"protocols")_" from "_$PIECE(XQ,"-")_" to "_$PIECE(XQ,"-",2)_"? (Y/N)"
SET DIR(0)="YA"
DO ^DIR
KILL DIR
IF Y
SET (XQN,XQSTART)=$PIECE(XQ,"-",1)
SET XQEND=$PIECE(XQ,"-",2)
DO FIND
+24 QUIT
End DoDot:1
if 'XQRNG
GOTO ASK
+25 ;
+26 IF XQ'?1E.E1"-"1E.E
SET X=XQ
SET DIC=XQFIL
SET DIC(0)="MEZ"
DO ^DIC
if Y'<0
SET XQ=$PIECE(Y,U,2)
IF Y<0
WRITE " ??",*7
GOTO ASK
+27 IF XQDEL
KILL ^XTMP("XQOO",XQSET,XQFIL,+Y)
GOTO ASK
+28 if $EXTRACT(Y(0),1,4)'="XQOO"
SET ^XTMP("XQOO",XQSET,XQFIL,+Y)=$PIECE(Y(0),U)_U_$PIECE(Y(0),U,2)
GOTO ASK
+29 ;
FIND ;Find first option in wildcard list
+1 SET XQN=""
if $LENGTH(XQSTART)>2
SET XQN=$EXTRACT(XQSTART,1,$LENGTH(XQSTART)-1)
+2 IF XQFIL=19
FOR XQI=0:0
SET XQN=$ORDER(^DIC(XQFIL,"B",XQN))
if XQN=""!($EXTRACT(XQN,1,$LENGTH(XQSTART))=XQSTART)
QUIT
+3 IF '$TEST
FOR XQI=0:0
SET XQN=$ORDER(^ORD(101,"B",XQN))
if XQN=""!($EXTRACT(XQN,1,$LENGTH(XQSTART))=XQSTART)
QUIT
+4 IF XQN=""
WRITE !," No such ",$SELECT(XQFIL=19:"option(s).",1:"protocol(s).")
QUIT
+5 SET XQSTART=XQN
+6 ;
FINDR IF XQFIL=19
SET XQON=$ORDER(^DIC(XQFIL,"B",XQN,0))
SET XQON0=^DIC(XQFIL,+XQON,0)
+1 IF '$TEST
SET XQON=$ORDER(^ORD(XQFIL,"B",XQN,0))
SET XQON0=^ORD(XQFIL,+XQON,0)
+2 IF XQDEL
DO DELET
QUIT
+3 ;
GET ;Get the first option selected and put it in ^XTMP
+1 SET XQN=XQSTART
IF $EXTRACT(XQON,1,4)'="XQOO"
SET ^XTMP("XQOO",XQSET,XQFIL,+XQON)=$PIECE(XQON0,U)_U_$PIECE(XQON0,U,2)
SET XQK=XQK+1
+2 SET DIC=XQFIL
SET DIC(0)="MZ"
+3 ;
NEXT ;Find the rest of the options in this range and do likewise
+1 IF XQFIL=19
FOR
if XQN=XQEND
QUIT
SET XQN=$ORDER(^DIC(XQFIL,"B",XQN))
if XQN=""!(XQN]XQEND)
QUIT
SET XQON=$ORDER(^DIC(XQFIL,"B",XQN,0))
SET XQON0=^DIC(XQFIL,+XQON,0)
IF $EXTRACT(XQON,1,4)'="XQOO"
SET ^XTMP("XQOO",XQSET,XQFIL,+XQON)=$PIECE(XQON0,U)_U_$PIECE(XQON0,U,2)
SET XQK=XQK+1
+2 IF '$TEST
FOR
if XQN=XQEND
QUIT
SET XQN=$ORDER(^ORD(XQFIL,"B",XQN))
if XQN=""!(XQN]XQEND)
QUIT
SET XQON=$ORDER(^ORD(XQFIL,"B",XQN,0))
SET XQON0=^ORD(XQFIL,+XQON,0)
IF $EXTRACT(XQON,1,4)'="XQOO"
SET ^XTMP("XQOO",XQSET,XQFIL,+XQON)=$PIECE(XQON0,U)_U_$PIECE(XQON0,U,2)
SET XQK=XQK+1
+3 QUIT
+4 ;
DELET ;Delete option(s) from the list in ^XTMP
+1 ;W !,XQON," ",XQSTART," ",XQDEL
+2 SET XQN=XQSTART
SET XQDEL=0
+3 IF XQFIL=19
FOR
KILL ^XTMP("XQOO",XQSET,XQFIL,+XQON)
SET XQN=$ORDER(^DIC(XQFIL,"B",XQN))
SET XQX=XQK-1
if XQN=""!(XQN]XQEND)
QUIT
SET XQON=$ORDER(^DIC(XQFIL,"B",XQN,0))
+4 IF '$TEST
FOR
KILL ^XTMP("XQOO",XQSET,XQFIL,+XQON)
SET XQN=$ORDER(^ORD(XQFIL,"B",XQN))
SET XQX=XQK-1
if XQN=""!(XQN]XQEND)
QUIT
SET XQON=$ORDER(^ORD(XQFIL,"B",XQN,0))
+5 QUIT
+6 ;
REMOV READ !!,"Remove all options previously selected? ",XQ:DTIME
if '$TEST
SET XQ=U
if XQ[U
GOTO OUT
IF XQ["N"!(XQ["n")
WRITE !!,"OK, you may continue."
GOTO ASK
+1 KILL ^XTMP("XQOO",XQSET)
+2 QUIT
LSTFIL ;Show Option File
+1 NEW XQE,XQR,XQS
+2 DO RANGE^XQOO2(.XQS,.XQE,.XQR)
IF XQR
DO BXREF^XQOO2(XQS,XQE)
+3 QUIT
+4 ;
LIST ;List users and options selected so far.
+1 WRITE @IOF
SET (XQT,XQM)=0
+2 FOR XQFIL0=19,101
Begin DoDot:1
+3 SET XQT=0
SET XQN=0
SET XQN=$ORDER(^XTMP("XQOO",XQSET,XQFIL0,XQN))
IF XQN=""
WRITE !!,"No "_$SELECT(XQFIL0=19:"menu options",1:"protocols")_" selected yet"
QUIT
+4 WRITE !!,"You will place Out Of Order the following "_$SELECT(XQFIL0=19:"options:",1:"protocols:"),!
FOR XQI=0:0
if $Y+3>IOSL
DO WAIT
if XQ=U
QUIT
WRITE !,$PIECE(^XTMP("XQOO",XQSET,XQFIL0,XQN),U,2)_" ["_$PIECE(^(XQN),U)_"] (IEN = "_XQN_")"
SET XQN=$ORDER(^(XQN))
if XQN=""
QUIT
+5 QUIT
End DoDot:1
+6 QUIT
+7 ;
WAIT ;Skip to the head of the next page
+1 IF 1
SET XQ=""
if IOST["C-"
READ !!,"Press RETURN to continue, or '^' to quit.",XQ:DTIME
if '$TEST
SET XQ=U
WRITE @IOF
+2 QUIT
+3 ;
SET ;Set 0th node in ^XTMP global
+1 IF XQFIL=19
IF '$DATA(XQSWTCH)
SET XQFIL=101
GOTO ASK
+2 DO ^XQDATE
+3 IF $DATA(^XTMP("XQOO",XQSET,0))
SET XQMESS=$PIECE(^(0),U)
+4 SET ^XTMP("XQOO",XQSET,0)=XQMESS_U_%Y_U_$PIECE(^VA(200,DUZ,0),",")
+5 SET ^XTMP("XQOO",0)=DT_U_DT+7
+6 ;
OUT ;Clean up
+1 ;
+2 IF '$DATA(XPDNM)
IF '$DATA(^XTMP("XQOO",XQSET,0))
IF $DATA(^XTMP("XQOO",XQSET))
Begin DoDot:1
+3 ;Temporary Fix: ^ at protocol prompt leaves partial set (no 0th node)
+4 SET DIR(0)="Y"
SET DIR("B")="YES"
+5 SET DIR("A")="Delete this set of options? (Y/N) "
+6 DO ^DIR
+7 IF Y
KILL ^XTMP("XQOO",XQSET)
+8 IF '$TEST
DO ^XQDATE
SET ^XTMP("XQOO",XQSET,0)=XQMESS_U_%Y_U_$PIECE(^VA(200,DUZ,0),",")
SET ^XTMP("XQOO",0)=DT_U_DT+7
+9 QUIT
End DoDot:1
+10 ;
+11 IF '$DATA(XPDNM)
IF $DATA(^XTMP("XQOO",XQSET,0))
Begin DoDot:1
+12 SET DIR(0)="Y"
SET DIR("B")="NO"
+13 SET DIR("A")="Should I mark these options/protocols out-of-order now? (Y/N) "
+14 DO ^DIR
IF Y
DO OFF^XQOO1(XQSET)
+15 QUIT
End DoDot:1
+16 ;
+17 KILL %,%Y,DIRUT,XQ,XQDEL,XQEND,XQFIL,XQFIL0,XQH,XQI,XQINI,XQK,XQM,XQMESS,XQN,XQON,XQON0,XQRNG,XQSTART,XQSWTCH,XQT,XQX,X,Y
+18 QUIT
