XQLOCK ;SEA/Luke - Find all the keys in the tree; [6/28/02 5:55am]
;;8.0;KERNEL;**20,157,237**;Jul 10, 1995
;
;
;Input: XQX is the internal number of the parent menu
; XQUSR is the DUZ of the owner of that menu
;
EN1 ;Look up menu trees by user. Entry for option ENLOCK1.
S XQEN=0 D INIT,USR G:Y=-1 OUT D BLD G:'XQN OUT D DISP,SHOW,CHUZ1,OUT
Q
;
EN2 ;Look up keys for a given menu tree. Entry for option ENLOCK2.
S XQEN=1 D INIT,TREE G:Y=-1 OUT D BLD G:'XQN OUT D DISP,SHOW,CHUZ1,OUT
Q
EN3 ;Look up Keys for menu delegation.
S XQEN=2,XQUSR=XQDA,XQDIC=XQX D INIT,BLD G:'XQN OUT D DISP,SHOW,CHUZ1,OUT
Q
;
INIT ;Get things set up
S XQBOSS=0 S:$D(^XUSEC("XUMGR",DUZ)) XQBOSS=1
Q
USR ;Find the user and the menu in question
Q:XQEN=2
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
;
W !!,"Enter a menu tree by number : " R %:DTIME S:%="" %=U S:(%=0)!('$D(XQMENU(%)))!(%'=+%) %=U
I %=U S Y=-1 Q
S XQX=+XQMENU(%)
Q
;
TREE ;Get the name of the menu tree in question
S DIC="^DIC(19,",DIC(0)="AEMQZ",DIC("A")="Please enter the parent menu: " D ^DIC Q:Y=-1 S XQX=+Y
Q
;
BLD ;See if the menu tree has been built if not, do it
S:$D(XQDIC) XQSAV=XQDIC S:XQX'["P" XQX="P"_XQX S XQDIC=XQX
I '$D(^XUTL("XQO",XQDIC)) S XQXUF="" W !!,"==> Working... "
D PM1^XQ8
I $D(XQPSM) S XQSAVE1=XQPSM
S XQPSM="P"_XQDIC
D MERGE^XQ12
I $D(XQSAVE1) S XQPSM=XQSAVE1
;
FIND ;Order through the child options and find the locks
S XQJ=0,XQN=0
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
;
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
Q
;
DISP ;Display the locked options with their keys
W !!,"There ",$S(XQN=1:"is one ",1:"are some "),"locked option",$S(XQN=1:":",1:"s:")
W !!," Option Name",?23,"Option Text",?62,"Locked With",!
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
Q
;
SHOW ;Show the current set of keys
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
Q
;
CHUZ1 W !!,"Please enter one of the following codes:",!!?5,"'A' means allocate these keys",!?5,"'D' means delegate this key set"
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."
R !!,"Enter A, D, E, ^, L, or S: ",XQUR:DTIME S:XQUR="" XQUR=U Q:XQUR=U
I "AaDdEe^LlSs"'[$E(XQUR,1) W $C(7),"?? " G CHUZ1
I XQUR="A"!(XQUR="a") S XQAL=1 D:'$D(XQUSR) USR D:$D(XQUSR) DOIT K XQUS Q:XQEN=2 G CHUZ1
I XQUR="D"!(XQUR="d") S XQAL=0 D:'$D(XQUSR) USR D:$D(XQUSR) DOIT K XQUSR Q:XQEN=2 G CHUZ1
I XQUR="E"!(XQUR="e") D EDIT^XQLOCK1 Q:XQUR=U G CHUZ1
I XQUR="L"!(XQUR="l") D DISP G CHUZ1
I XQUR="S"!(XQUR="s") D SHOW G CHUZ1
Q
;
DOIT ;Add the key set to a user's Aloocated or Delegated Keys file
N DA,DIC,X
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
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
K DINUM
S XQZZGOOD=1
Q
;
OUT ;Clean up and quit
S:$D(XQSAV) XQDIC=XQSAV
K ^TMP($J,"XQ")
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
Q
;
GOT1 ;Record a lock
S XQKN=$O(^DIC(19.1,"B",XQK,0))
I 'XQBOSS Q:'$D(^VA(200,DUZ,52,XQKN)) ;DUZ can't allocate that key
I $D(XQUSR) Q:$D(^VA(200,+XQUSR,51,"B",XQKN)) ;User already owns that key
S:'$D(ZTQUEUED) ^TMP($J,"XQ",XQN)="["_XQNM_"] "_U_XQTXT_U_" <== "_XQK
S XQN=XQN+1
S XQKEY(XQK)=XQKN
Q
;
SHO ;Show the primary and secondary menus of +XQUSR
S %=+$G(^VA(200,+XQUSR,201)),XQMENU(1)=$S(%<1:"",1:%_U_$P($G(^DIC(19,%,0)),U,1,2))
I XQMENU(1)="" W !!?5,"==> ",$P(XQUSR,U,2)," has no primary menu." S Y=-1 Q
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)
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
Q
;
KEY ;Look up a key in the Key file and get its number
S XQ=$O(^DIC(19.1,"B",XQK,0)) I XQ="" W $C(7),!!?5,"==> A key named ",XQK," ??",!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXQLOCK 4798 printed Apr 09, 2024@21:17:05 Page 2
XQLOCK ;SEA/Luke - Find all the keys in the tree; [6/28/02 5:55am]
+1 ;;8.0;KERNEL;**20,157,237**;Jul 10, 1995
+2 ;
+3 ;
+4 ;Input: XQX is the internal number of the parent menu
+5 ; XQUSR is the DUZ of the owner of that menu
+6 ;
EN1 ;Look up menu trees by user. Entry for option ENLOCK1.
+1 SET XQEN=0
DO INIT
DO USR
if Y=-1
GOTO OUT
DO BLD
if 'XQN
GOTO OUT
DO DISP
DO SHOW
DO CHUZ1
DO OUT
+2 QUIT
+3 ;
EN2 ;Look up keys for a given menu tree. Entry for option ENLOCK2.
+1 SET XQEN=1
DO INIT
DO TREE
if Y=-1
GOTO OUT
DO BLD
if 'XQN
GOTO OUT
DO DISP
DO SHOW
DO CHUZ1
DO OUT
+2 QUIT
EN3 ;Look up Keys for menu delegation.
+1 SET XQEN=2
SET XQUSR=XQDA
SET XQDIC=XQX
DO INIT
DO BLD
if 'XQN
GOTO OUT
DO DISP
DO SHOW
DO CHUZ1
DO OUT
+2 QUIT
+3 ;
INIT ;Get things set up
+1 SET XQBOSS=0
if $DATA(^XUSEC("XUMGR",DUZ))
SET XQBOSS=1
+2 QUIT
USR ;Find the user and the menu in question
+1 if XQEN=2
QUIT
+2 SET DIC="^VA(200,"
SET DIC(0)="AEMQZ"
SET DIC("A")="Please enter the user's name: "
WRITE !
DO ^DIC
if Y=-1
QUIT
SET XQUSR=+Y
if XQEN
QUIT
DO SHO
if Y=-1
QUIT
+3 ;
+4 WRITE !!,"Enter a menu tree by number : "
READ %:DTIME
if %=""
SET %=U
if (%=0)!('$DATA(XQMENU(%)))!(%'=+%)
SET %=U
+5 IF %=U
SET Y=-1
QUIT
+6 SET XQX=+XQMENU(%)
+7 QUIT
+8 ;
TREE ;Get the name of the menu tree in question
+1 SET DIC="^DIC(19,"
SET DIC(0)="AEMQZ"
SET DIC("A")="Please enter the parent menu: "
DO ^DIC
if Y=-1
QUIT
SET XQX=+Y
+2 QUIT
+3 ;
BLD ;See if the menu tree has been built if not, do it
+1 if $DATA(XQDIC)
SET XQSAV=XQDIC
if XQX'["P"
SET XQX="P"_XQX
SET XQDIC=XQX
+2 IF '$DATA(^XUTL("XQO",XQDIC))
SET XQXUF=""
WRITE !!,"==> Working... "
+3 DO PM1^XQ8
+4 IF $DATA(XQPSM)
SET XQSAVE1=XQPSM
+5 SET XQPSM="P"_XQDIC
+6 DO MERGE^XQ12
+7 IF $DATA(XQSAVE1)
SET XQPSM=XQSAVE1
+8 ;
FIND ;Order through the child options and find the locks
+1 SET XQJ=0
SET XQN=0
+2 FOR
SET XQJ=$ORDER(^XUTL("XQO",XQDIC,"^",XQJ))
if XQJ=""
QUIT
IF $PIECE(^(XQJ),U,7)]""&($PIECE(^DIC(19,XQJ,0),U,6)]"")
SET XQNM=$PIECE(^(0),U,1)
SET XQTXT=$PIECE(^(0),U,2)
SET XQK=$PIECE(^(0),U,6)
DO GOT1
+3 ;
+4 ;There are no keys to give, so quit
IF 'XQN
if '$DATA(ZTQUEUED)
WRITE !!,"No keys need to be given to this user for this menu tree."
QUIT
+5 QUIT
+6 ;
DISP ;Display the locked options with their keys
+1 WRITE !!,"There ",$SELECT(XQN=1:"is one ",1:"are some "),"locked option",$SELECT(XQN=1:":",1:"s:")
+2 WRITE !!," Option Name",?23,"Option Text",?62,"Locked With",!
+3 FOR XQI=0:1:XQN-1
WRITE !,$PIECE(^TMP($JOB,"XQ",XQI),U),?22,$PIECE(^TMP($JOB,"XQ",XQI),U,2),?60,$PIECE(^TMP($JOB,"XQ",XQI),U,3)
if XQI&'(XQI#15)
DO PAUSE^XQLOCK1
if XQI=-1
QUIT
+4 QUIT
+5 ;
SHOW ;Show the current set of keys
+1 WRITE !!,"This is the current set of keys we are working with: ",!
SET XQJ=""
SET XQI=5
FOR XQK=0:1
SET XQJ=$ORDER(XQKEY(XQJ))
if XQJ=""
QUIT
if '(XQK#XQI)
WRITE !
WRITE ?(XQK#XQI*15),XQJ
+2 QUIT
+3 ;
CHUZ1 WRITE !!,"Please enter one of the following codes:",!!?5,"'A' means allocate these keys",!?5,"'D' means delegate this key set"
+1 WRITE !?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."
+2 READ !!,"Enter A, D, E, ^, L, or S: ",XQUR:DTIME
if XQUR=""
SET XQUR=U
if XQUR=U
QUIT
+3 IF "AaDdEe^LlSs"'[$EXTRACT(XQUR,1)
WRITE $CHAR(7),"?? "
GOTO CHUZ1
+4 IF XQUR="A"!(XQUR="a")
SET XQAL=1
if '$DATA(XQUSR)
DO USR
if $DATA(XQUSR)
DO DOIT
KILL XQUS
if XQEN=2
QUIT
GOTO CHUZ1
+5 IF XQUR="D"!(XQUR="d")
SET XQAL=0
if '$DATA(XQUSR)
DO USR
if $DATA(XQUSR)
DO DOIT
KILL XQUSR
if XQEN=2
QUIT
GOTO CHUZ1
+6 IF XQUR="E"!(XQUR="e")
DO EDIT^XQLOCK1
if XQUR=U
QUIT
GOTO CHUZ1
+7 IF XQUR="L"!(XQUR="l")
DO DISP
GOTO CHUZ1
+8 IF XQUR="S"!(XQUR="s")
DO SHOW
GOTO CHUZ1
+9 QUIT
+10 ;
DOIT ;Add the key set to a user's Aloocated or Delegated Keys file
+1 NEW DA,DIC,X
+2 SET XQFL=$SELECT(XQAL:51,1:52)
SET DIC="^VA(200,"_+XQUSR_","_XQFL_","
SET DIC(0)="NMQ"
SET DIC("P")=$SELECT(XQAL:"200.051PA",1:"200.052P")
SET DA(1)=XQUSR
+3 SET XQNXT=""
FOR
SET XQNXT=$ORDER(XQKEY(XQNXT))
if XQNXT=""
QUIT
SET X=XQKEY(XQNXT)
SET DINUM=X
IF '$DATA(^VA(200,XQUSR,XQFL,"B",X,X))
DO FILE^DICN
+4 KILL DINUM
+5 SET XQZZGOOD=1
+6 QUIT
+7 ;
OUT ;Clean up and quit
+1 if $DATA(XQSAV)
SET XQDIC=XQSAV
+2 KILL ^TMP($JOB,"XQ")
+3 KILL %,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
+4 QUIT
+5 ;
GOT1 ;Record a lock
+1 SET XQKN=$ORDER(^DIC(19.1,"B",XQK,0))
+2 ;DUZ can't allocate that key
IF 'XQBOSS
if '$DATA(^VA(200,DUZ,52,XQKN))
QUIT
+3 ;User already owns that key
IF $DATA(XQUSR)
if $DATA(^VA(200,+XQUSR,51,"B",XQKN))
QUIT
+4 if '$DATA(ZTQUEUED)
SET ^TMP($JOB,"XQ",XQN)="["_XQNM_"] "_U_XQTXT_U_" <== "_XQK
+5 SET XQN=XQN+1
+6 SET XQKEY(XQK)=XQKN
+7 QUIT
+8 ;
SHO ;Show the primary and secondary menus of +XQUSR
+1 SET %=+$GET(^VA(200,+XQUSR,201))
SET XQMENU(1)=$SELECT(%<1:"",1:%_U_$PIECE($GET(^DIC(19,%,0)),U,1,2))
+2 IF XQMENU(1)=""
WRITE !!?5,"==> ",$PIECE(XQUSR,U,2)," has no primary menu."
SET Y=-1
QUIT
+3 SET %=0
FOR XQI=2:1
SET %=$ORDER(^VA(200,+XQUSR,203,%))
if %'>0
QUIT
SET XQSM=+^(%,0)
IF $DATA(^DIC(19,XQSM,0))#2
SET XQMENU(XQI)=XQSM_U_$PIECE(^(0),U,1,2)
+4 IF '$DATA(ZTQUEUED)
WRITE !
SET XQIJ=0
FOR
SET XQIJ=$ORDER(XQMENU(XQIJ))
if XQIJ=""
QUIT
WRITE !,XQIJ,". ",$PIECE(XQMENU(XQIJ),U,2),?23,$PIECE(XQMENU(XQIJ),U,3),?62,$SELECT(XQIJ=1:"Primary Menu",1:"Secondary")
if '(XQIJ#22)
DO PAUSE^XQLOCK1
+5 QUIT
+6 ;
KEY ;Look up a key in the Key file and get its number
+1 SET XQ=$ORDER(^DIC(19.1,"B",XQK,0))
IF XQ=""
WRITE $CHAR(7),!!?5,"==> A key named ",XQK," ??",!
+2 QUIT
