Routine: XQLOCK

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

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

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

INIT ;Get things set up

 S XQBOSS=0 S:$D(^XUSEC("XUMGR",DUZ)) XQBOSS=1

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(%)

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

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

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

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

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

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

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

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

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

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," ??",!

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXQLOCK   4798     printed  Mar 13, 2025@21:10:42                                                                                                                                                                                                      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

XQLOCK.m