source: FOIAVistA/tag/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XQOO.m@ 719

Last change on this file since 719 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 6.6 KB
Line 
1XQOO ;SEATTLE/LUKE - Out Of Order, Man ;9/13/96 09:21
2 ;;8.0;KERNEL;**10,21,47**;Jul 03, 1995
3INIT(XQSET) ;Call for Out-of-order set creation, called by KIDS
4 ;
5 ;The variable XQSET should be null if this is the first pass
6 ;or if KIDS thinks the user wants a new set of options
7 ;
8 S XQINI="",XQK=0 ;XQINI used as a flag to see if it's KIDS calling
9 I XQSET]"" S:'$D(^XTMP("XQOO",XQSET,0)) XQSET="^"
10 I XQSET="^" G OUT
11 I XQSET]"" S XQMESS=$P(^XTMP("XQOO",XQSET,0),U) G ASK1
12 ;
13EN ;Entry point for Define Out Of Order Options Set option
14 S XQK=0,U="^",XQSET=U
15 ;
16NAME ;Get name for this option set
17 W !!,"Enter a short name for this set of options and or protocols: " R XQSET:DTIME S:'$T XQSET=U G:XQSET=U OUT
18 I XQSET="?" W !!,"Enter a name of 20 characters or less for this set, '^' to quit, or '??' for help" G NAME
19 I XQSET["??" S XQH="XQOO-NAME" D EN^XQH G NAME
20 I XQSET=""!($L(XQSET)>20) W !!,"Out-of-order sets must be named with 20 or less characters. Enter '^' to quit." G NAME
21 I $D(^XTMP("XQOO",XQSET,0)) D G:$D(DIRUT) OUT G:Y=0 NAME G ASK1
22 .S XQMESS=$P(^XTMP("XQOO",XQSET,0),U)
23 .W !!,"WARNING: The Out-of-order set '",XQSET,"' already exists.",!
24 .S DIR("A")="Do you want to modify it? (Y/N) " S DIR(0)="Y",DIR("B")="YES" D ^DIR K DIR
25 .Q
26 ;
27MESS ;Get the Out Of Order Message
28 R !!,"What should the Out Of Order message text be? :",XQMESS:DTIME S:'$T XQMESS=U G:XQMESS=U OUT
29 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
30 I XQMESS["??" S XQH="XQOO-MESS" D EN^XQH G MESS
31 ;
32ASK1 S XQFIL=19
33ASK ;Get options to mark
34 S (XQ,XQN)=""
35 W !!,"Enter "_$S(XQFIL=19:"options",1:"protocols")_" you wish to mark as 'Out Of Order': "
36 R XQ:DTIME S:'$T XQ=U G:XQ=U OUT G:XQ="" SET
37 I XQ="?" D G ASK
38 .W !!?5,"Enter "_$S(XQFIL=19:"an option",1:"a protocol")_" name,"
39 .W !?5,"a name preceded by a minus sign to remove "_$S(XQFIL=19:"an option,",1:"a protocol,")
40 .W !?5,$S(XQFIL=19:"'^PR'",1:"'^OP'")_" to switch to "_$S(XQFIL=19:"protocols,",1:"options,")
41 .W !?5,"an uparrow (that is '^') to quit,"
42 .W !?5,"or '??' for more help."
43 .Q
44 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
45 I $E(XQ,1,3)="^OP"!($E(XQ,1,3)="^op") S XQFIL=19,XQSWTCH="" G ASK
46 I $E(XQ,1,3)="^PR"!($E(XQ,1,3)="^pr") S XQFIL=101,XQSWTCH="" G ASK
47 S XQDEL=0 I $E(XQ,1)="-" S XQDEL=1,XQ=$E(XQ,2,99)
48 I XQ="*",XQDEL K ^XTMP("XQOO",XQSET,XQFIL) W !," All "_$S(XQFIL=19:"options",1:"protocols")_" removed. Start again or '^' to quit. " G ASK
49 I XQ="*" S XQSTART=1,XQEND="ZZZZZ" D FIND G ASK
50 I XQ?.E1"*" S XQSTART=$E(XQ,1,$L(XQ)-1),XQEND=XQSTART_$C(127) D FIND G ASK
51 ;Get a range of options allowing for name with hyphens in them
52 I XQ?1E.E1"-"1E.E S XQRNG=0 D G:'XQRNG ASK
53 .S X=XQ,DIC=XQFIL,DIC(0)="Z" D ^DIC S:Y'<0 XQ=$P(Y,U,2) I Y>0 S XQRNG=1 Q
54 .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
55 .Q
56 ;
57 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
58 I XQDEL K ^XTMP("XQOO",XQSET,XQFIL,+Y) G ASK
59 S:$E(Y(0),1,4)'="XQOO" ^XTMP("XQOO",XQSET,XQFIL,+Y)=$P(Y(0),U)_U_$P(Y(0),U,2) G ASK
60 ;
61FIND ;Find first option in wildcard list
62 S XQN="" S:$L(XQSTART)>2 XQN=$E(XQSTART,1,$L(XQSTART)-1)
63 I XQFIL=19 F XQI=0:0 S XQN=$O(^DIC(XQFIL,"B",XQN)) Q:XQN=""!($E(XQN,1,$L(XQSTART))=XQSTART)
64 E F XQI=0:0 S XQN=$O(^ORD(101,"B",XQN)) Q:XQN=""!($E(XQN,1,$L(XQSTART))=XQSTART)
65 I XQN="" W !," No such ",$S(XQFIL=19:"option(s).",1:"protocol(s).") Q
66 S XQSTART=XQN
67 ;
68FINDR I XQFIL=19 S XQON=$O(^DIC(XQFIL,"B",XQN,0)),XQON0=^DIC(XQFIL,+XQON,0)
69 E S XQON=$O(^ORD(XQFIL,"B",XQN,0)),XQON0=^ORD(XQFIL,+XQON,0)
70 I XQDEL D DELET Q
71 ;
72GET ;Get the first option selected and put it in ^XTMP
73 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
74 S DIC=XQFIL,DIC(0)="MZ"
75 ;
76NEXT ;Find the rest of the options in this range and do likewise
77 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
78 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
79 Q
80 ;
81DELET ;Delete option(s) from the list in ^XTMP
82 ;W !,XQON," ",XQSTART," ",XQDEL
83 S XQN=XQSTART,XQDEL=0
84 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))
85 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))
86 Q
87 ;
88REMOV 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
89 K ^XTMP("XQOO",XQSET)
90 Q
91LSTFIL ;Show Option File
92 N XQE,XQR,XQS
93 D RANGE^XQOO2(.XQS,.XQE,.XQR) I XQR D BXREF^XQOO2(XQS,XQE)
94 Q
95 ;
96LIST ;List users and options selected so far.
97 W @IOF S (XQT,XQM)=0
98 F XQFIL0=19,101 D
99 .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
100 .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=""
101 .Q
102 Q
103 ;
104WAIT ;Skip to the head of the next page
105 I 1 S XQ="" R:IOST["C-" !!,"Press RETURN to continue, or '^' to quit.",XQ:DTIME S:'$T XQ=U W @IOF
106 Q
107 ;
108SET ;Set 0th node in ^XTMP global
109 I XQFIL=19,'$D(XQSWTCH) S XQFIL=101 G ASK
110 D ^XQDATE
111 I $D(^XTMP("XQOO",XQSET,0)) S XQMESS=$P(^(0),U)
112 S ^XTMP("XQOO",XQSET,0)=XQMESS_U_%Y_U_$P(^VA(200,DUZ,0),",")
113 S ^XTMP("XQOO",0)=DT_U_DT+7
114 ;
115OUT ;Clean up
116 ;
117 I '$D(XPDNM),'$D(^XTMP("XQOO",XQSET,0)),$D(^XTMP("XQOO",XQSET)) D
118 .;Temporary Fix: ^ at protocol prompt leaves partial set (no 0th node)
119 .S DIR(0)="Y",DIR("B")="Y"
120 .S DIR("A")="Delete this set of options? (Y/N) "
121 .D ^DIR
122 .I Y K ^XTMP("XQOO",XQSET)
123 .E D ^XQDATE S ^XTMP("XQOO",XQSET,0)=XQMESS_U_%Y_U_$P(^VA(200,DUZ,0),","),^XTMP("XQOO",0)=DT_U_DT+7
124 .Q
125 ;
126 I '$D(XPDNM),$D(^XTMP("XQOO",XQSET,0)) D
127 .S DIR(0)="Y",DIR("B")="N"
128 .S DIR("A")="Should I mark these options/protocols out-of-order now? (Y/N) "
129 .D ^DIR I Y D OFF^XQOO1(XQSET)
130 .Q
131 ;
132 K %,%Y,XQ,XQDEL,XQEND,XQFIL,XQFIL0,XQI,XQINI,XQK,XQMESS,XQN,XQON,XQON0,XQRNG,XQSTART,XQSWTCH,Y
133 Q
Note: See TracBrowser for help on using the repository browser.