source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XQLOCK.m@ 1524

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

initial load of WorldVistAEHR

File size: 4.6 KB
Line 
1XQLOCK ;SEA/Luke - Find all the keys in the tree; [6/28/02 5:55am]
2 ;;8.0;KERNEL;**20,157,237**;Jul 10, 1995
3 ;
4 ;
5 ;Input: XQX is the internal number of the parent menu
6 ; XQUSR is the DUZ of the owner of that menu
7 ;
8EN1 ;Look up menu trees by user. Entry for option ENLOCK1.
9 S XQEN=0 D INIT,USR G:Y=-1 OUT D BLD G:'XQN OUT D DISP,SHOW,CHUZ1,OUT
10 Q
11 ;
12EN2 ;Look up keys for a given menu tree. Entry for option ENLOCK2.
13 S XQEN=1 D INIT,TREE G:Y=-1 OUT D BLD G:'XQN OUT D DISP,SHOW,CHUZ1,OUT
14 Q
15EN3 ;Look up Keys for menu delegation.
16 S XQEN=2,XQUSR=XQDA,XQDIC=XQX D INIT,BLD G:'XQN OUT D DISP,SHOW,CHUZ1,OUT
17 Q
18 ;
19INIT ;Get things set up
20 S XQBOSS=0 S:$D(^XUSEC("XUMGR",DUZ)) XQBOSS=1
21 Q
22USR ;Find the user and the menu in question
23 Q:XQEN=2
24 S DIC="^VA(200,",DIC(0)="AEMQZ",DIC("A")="Please enter the user's name: " W ! D ^DIC Q:Y=-1 S XQUSR=+Y Q:XQEN D SHO Q:Y=-1
25 ;
26 W !!,"Enter a menu tree by number : " R %:DTIME S:%="" %=U S:(%=0)!('$D(XQMENU(%)))!(%'=+%) %=U
27 I %=U S Y=-1 Q
28 S XQX=+XQMENU(%)
29 Q
30 ;
31TREE ;Get the name of the menu tree in question
32 S DIC="^DIC(19,",DIC(0)="AEMQZ",DIC("A")="Please enter the parent menu: " D ^DIC Q:Y=-1 S XQX=+Y
33 Q
34 ;
35BLD ;See if the menu tree has been built if not, do it
36 S:$D(XQDIC) XQSAV=XQDIC S:XQX'["P" XQX="P"_XQX S XQDIC=XQX
37 I '$D(^XUTL("XQO",XQDIC)) S XQXUF="" W !!,"==> Working... "
38 D PM1^XQ8
39 I $D(XQPSM) S XQSAVE1=XQPSM
40 S XQPSM="P"_XQDIC
41 D MERGE^XQ12
42 I $D(XQSAVE1) S XQPSM=XQSAVE1
43 ;
44FIND ;Order through the child options and find the locks
45 S XQJ=0,XQN=0
46 F S XQJ=$O(^XUTL("XQO",XQDIC,"^",XQJ)) Q:XQJ="" I $P(^(XQJ),U,7)]""&($P(^DIC(19,XQJ,0),U,6)]"") S XQNM=$P(^(0),U,1),XQTXT=$P(^(0),U,2),XQK=$P(^(0),U,6) D GOT1
47 ;
48 I 'XQN W:'$D(ZTQUEUED) !!,"No keys need to be given to this user for this menu tree." Q ;There are no keys to give, so quit
49 Q
50 ;
51DISP ;Display the locked options with their keys
52 W !!,"There ",$S(XQN=1:"is one ",1:"are some "),"locked option",$S(XQN=1:":",1:"s:")
53 W !!," Option Name",?23,"Option Text",?62,"Locked With",!
54 F XQI=0:1:XQN-1 W !,$P(^TMP($J,"XQ",XQI),U),?22,$P(^TMP($J,"XQ",XQI),U,2),?60,$P(^TMP($J,"XQ",XQI),U,3) D:XQI&'(XQI#15) PAUSE^XQLOCK1 Q:XQI=-1
55 Q
56 ;
57SHOW ;Show the current set of keys
58 W !!,"This is the current set of keys we are working with: ",! S XQJ="",XQI=5 F XQK=0:1 S XQJ=$O(XQKEY(XQJ)) Q:XQJ="" W:'(XQK#XQI) ! W ?(XQK#XQI*15),XQJ
59 Q
60 ;
61CHUZ1 W !!,"Please enter one of the following codes:",!!?5,"'A' means allocate these keys",!?5,"'D' means delegate this key set"
62 W !?5,"'E' to edit the set of keys you wish to allocate",!?5,"'^' or 'RETURN' to quit",!?5,"'L' to list the locked options again, or",!?5,"'S' to show the set of keys you are allocating again."
63 R !!,"Enter A, D, E, ^, L, or S: ",XQUR:DTIME S:XQUR="" XQUR=U Q:XQUR=U
64 I "AaDdEe^LlSs"'[$E(XQUR,1) W $C(7),"?? " G CHUZ1
65 I XQUR="A"!(XQUR="a") S XQAL=1 D:'$D(XQUSR) USR D:$D(XQUSR) DOIT K XQUS Q:XQEN=2 G CHUZ1
66 I XQUR="D"!(XQUR="d") S XQAL=0 D:'$D(XQUSR) USR D:$D(XQUSR) DOIT K XQUSR Q:XQEN=2 G CHUZ1
67 I XQUR="E"!(XQUR="e") D EDIT^XQLOCK1 Q:XQUR=U G CHUZ1
68 I XQUR="L"!(XQUR="l") D DISP G CHUZ1
69 I XQUR="S"!(XQUR="s") D SHOW G CHUZ1
70 Q
71 ;
72DOIT ;Add the key set to a user's Aloocated or Delegated Keys file
73 N DA,DIC,X
74 S XQFL=$S(XQAL:51,1:52),DIC="^VA(200,"_+XQUSR_","_XQFL_",",DIC(0)="NMQ",DIC("P")=$S(XQAL:"200.051PA",1:"200.052P"),DA(1)=XQUSR
75 S XQNXT="" F S XQNXT=$O(XQKEY(XQNXT)) Q:XQNXT="" S X=XQKEY(XQNXT),DINUM=X I '$D(^VA(200,XQUSR,XQFL,"B",X,X)) D FILE^DICN
76 K DINUM
77 S XQZZGOOD=1
78 Q
79 ;
80OUT ;Clean up and quit
81 S:$D(XQSAV) XQDIC=XQSAV
82 K ^TMP($J,"XQ")
83 K %,DA,DIC,X,XQ,XQAL,XQEN,XQBOSS,XQI,XQIJ,XQJ,XQK,XQKEY,XQKN,XQMENU,XQN,XQNM,XQNXT,XQOP,XQSAV,XQSAVE1,XQTXT,XQUR,XQUSR,XQX,XQZZGOOD,Y
84 Q
85 ;
86GOT1 ;Record a lock
87 S XQKN=$O(^DIC(19.1,"B",XQK,0))
88 I 'XQBOSS Q:'$D(^VA(200,DUZ,52,XQKN)) ;DUZ can't allocate that key
89 I $D(XQUSR) Q:$D(^VA(200,+XQUSR,51,"B",XQKN)) ;User already owns that key
90 S:'$D(ZTQUEUED) ^TMP($J,"XQ",XQN)="["_XQNM_"] "_U_XQTXT_U_" <== "_XQK
91 S XQN=XQN+1
92 S XQKEY(XQK)=XQKN
93 Q
94 ;
95SHO ;Show the primary and secondary menus of +XQUSR
96 S %=+$G(^VA(200,+XQUSR,201)),XQMENU(1)=$S(%<1:"",1:%_U_$P($G(^DIC(19,%,0)),U,1,2))
97 I XQMENU(1)="" W !!?5,"==> ",$P(XQUSR,U,2)," has no primary menu." S Y=-1 Q
98 S %=0 F XQI=2:1 S %=$O(^VA(200,+XQUSR,203,%)) Q:%'>0 S XQSM=+^(%,0) I $D(^DIC(19,XQSM,0))#2 S XQMENU(XQI)=XQSM_U_$P(^(0),U,1,2)
99 I '$D(ZTQUEUED) W ! S XQIJ=0 F S XQIJ=$O(XQMENU(XQIJ)) Q:XQIJ="" W !,XQIJ,". ",$P(XQMENU(XQIJ),U,2),?23,$P(XQMENU(XQIJ),U,3),?62,$S(XQIJ=1:"Primary Menu",1:"Secondary") D:'(XQIJ#22) PAUSE^XQLOCK1
100 Q
101 ;
102KEY ;Look up a key in the Key file and get its number
103 S XQ=$O(^DIC(19.1,"B",XQK,0)) I XQ="" W $C(7),!!?5,"==> A key named ",XQK," ??",!
104 Q
Note: See TracBrowser for help on using the repository browser.