XQSMD5 ;SEA/JLI,MJM - SECURE MENU DELEGATE EDIT USER OPTIONS ;10/15/98 12:22
;;8.0;KERNEL;**72,99**;Jul 10, 1995
Q
;
ENTRY ; Main Entry point to edit primary (if applicable) and secondary options
;
; check to see if you have options to delegate
I $O(^VA(200,DUZ,19.5,0))'>0 W !,$C(7),"No Delegated Options Available to Give Out",! Q
;
; get user to delegate options to
S Y=$$LOOKUP^XUSER("QA") G:Y'>0 EXIT S (XQDA,DA)=+Y
;
; check user's primary menu, if user has primary and it's not one
; of the ones that you can delegate, goto secondary options,
; otherwise fall through and edit primary options
S XQPRI=$S($D(^VA(200,DA,201)):+^(201),1:0) I XQPRI,'$D(^VA(200,DUZ,19.5,XQPRI,0)) G SEC
;
; either change primary option or leave as is and go to secondary
K DIC
S XQOLD=XQPRI,DIC="^VA(200,"_DUZ_",19.5,",DIC(0)="QMAE",DA(1)=DUZ,DIC("A")=" PRIMARY MENU OPTION: " S:XQPRI>0 DIC("B")=$P(^DIC(19,XQPRI,0),U,1) D ^DIC I +Y=XQOLD!(+Y'>0) G SEC
;
; changing primary option
S (X,XQPRI)=+Y,X=$P(^DIC(19,X,0),U,1),DIE="^VA(200,",DA=XQDA,DR="201///"_X_";" D ^DIE
;
; delete old keys associated with old primary menu
I XQOLD D
.S MENUOLD(0)=1,MENUOLD(1)=XQOLD,XQANS=""
.D KEYS^XQSMD6(.MENUOLD,.XQKEY,.ABORT) K MENUOLD
.I XQKEY(0) D
..D ADJUST
..Q:'ONEGOOD
..M XQ2=XQKEY
..W !,"...Removing KEYS associated with previous PRIMARY menu"
..D KEYDEL
..Q
K XQ2,XQKEY
;
; add new keys associated with new primary menu if you have
; been delegated those keys
G:'$D(^VA(200,DUZ,52)) SEC
S MENUPRI(0)=1,MENUPRI(1)=XQPRI
D KEYS^XQSMD6(.MENUPRI,.XQKEY,.ABORT) K MENUPRI
D:XQKEY(0) KEYADD
K XQKEY
;
; fall through to secondary options
;
SEC ; Enter Secondary Menu Options from delegated options
K DIC
W ! S DIC="^VA(200,"_DUZ_",19.5,",DIC(0)="QMAE",DA(1)=DUZ,DIC("A")=" SECONDARY MENU OPTION: " D ^DIC G:Y'>0 ENTRY
S XQX=$P(Y,U,2)
S:'$D(^VA(200,XQDA,203,0)) ^(0)="^200.03P" S (XQXNAME,X)=$P(^DIC(19,+Y,0),U,1),DIC="^VA(200,"_XQDA_",203,",DIC(0)="ML",DLAYGO=200,DA(1)=XQDA D ^DIC
;
S XQADD=+$P(Y,U,3),XQSEC=+Y D KEY:XQADD,DEL:'XQADD K ^DIC(200,XQDA,203.1)
G SEC
;
EXIT ;
K D0,DA,DI,DIC,DIE,DR,DQ,I,J,ONEGOOD,P,X,XQ1,XQ2,XQ3,XQADD,XQANS,XQCOMMON,XQDA,XQJ,XQKEY,XQKEYIEN,XQOLD,XQPRI,XQSEC,XQX,XQXNAME,Y,Z
Q
;
DEL ; delete delegated menu
W !,$C(7),"Want to Delete ",XQXNAME," as a Secondary Option? Y// "
R Z:DTIME Q:'$T!(Z[U) S:Z="" Z="Y" Q:"Yy"'[$E(Z)
;
; check to see if users has any keys delegated
G:'$D(^VA(200,DUZ,52,0)) MENUDEL
;
; build list of users primary ans secondary menus
S MENU1(0)=1,MENU1(1)=XQPRI,XQJ=""
F S XQJ=$O(^VA(200,XQDA,203,"B",XQJ)) Q:XQJ="" D
. Q:XQJ=XQX
. S MENU1(0)=MENU1(0)+1,MENU1(MENU1(0))=XQJ
. Q
;
; get list of keys for primary and all secondary menus in XQ1
D KEYS^XQSMD6(.MENU1,.XQ1,.ABORT) K MENU1
;
; get list of keys for delegated menu in XQ2
S MENU2(0)=1,MENU2(1)=XQX
D KEYS^XQSMD6(.MENU2,.XQ2,.ABORT) K MENU2
;
; compare the two list and inform the user if delegated menu
; has keys unique to the delegated menu, store in XQ3
S XQANS="N",ONEGOOD=0
D:XQ2(0)>0 COMPARE
D:ONEGOOD INFORM
;
; user timeout or "^" aborted
I $G(DTOUT)!($G(DUOUT)) W !!,$C(7),"No action taken, menu delegation still active!" Q
;
; delete keys if user respond with 'Unique' or 'All'
I XQANS="U"!(XQANS="A") D KEYDEL
;
; delete menu from user's secondary menu's multiple
S DIE="^VA(200,"_XQDA_",203,",DR=".01///@",DA=XQSEC,DA(1)=XQDA D ^DIE
;
W !!,$C(7),"Delegated Menu: "_XQXNAME_" has been removed!"
Q
;
KEY ; get list of keys
N MENULIST,XQKEY,ABORT
S MENULIST(0)=1,MENULIST(1)=XQX
D KEYS^XQSMD6(.MENULIST,.XQKEY,.ABORT)
Q:ABORT
D:XQKEY(0) KEYADD
W !!,$C(7),"Delegated Menu: "_XQXNAME_" has been added!"
Q
;
KEYDEL ; delete keys
F I=1:1:XQ2(0) D
.Q:XQ2(I)=""
.S XQCOMMON=0,XQKEYIEN=""
.I XQANS="U" F J=1:1:XQ3(0) S:XQ2(1)=XQ3(J) XQCOMMON=1
.Q:XQCOMMON
.S XQKEYIEN=$O(^DIC(19.1,"B",XQ2(I),0))
.S DIE="^VA(200,"_XQDA_",51,",DR=".01///@",DA=XQKEYIEN,DA(1)=XQDA D ^DIE
.W !,$C(7),"Key: "_XQ2(I)_" has been removed!"
.Q
Q
;
KEYADD ; add keys
; adjust list to ones that have been delegated to you
D ADJUST Q:'ONEGOOD
W !!,$C(7),"The following Keys LOCK options within this menu structure",!
F I=1:1:XQKEY(0) W:XQKEY(I)'="" !,?5,XQKEY(I)
W !!,$C(7),"Do you want to ALLOCATE these Keys to this User? N// "
R Z:DTIME Q:'$T!(Z[U) S:Z="" Z="N" Q:"Nn"[$E(Z)
;
K DIC
S DIC="^VA(200,"_XQDA_",51,",DIC(0)="NMQ",DIC("P")="200.051PA",DA(1)=XQDA
F I=1:1:XQKEY(0) D
.Q:XQKEY(I)=""
.S X=$O(^DIC(19.1,"B",XQKEY(I),0)),DINUM=X
.I '$D(^VA(200,XQDA,51,"B",X,X)) D FILE^DICN W !,$C(7),"Key: "_XQKEY(I)_" has been added!"
.Q
Q
;
COMPARE ; compare keys used in the delegated menu against keys the user
; will need based on their primary and secondary menus
N KEYIEN
S XQ3="",XQ3(0)=0
F I=1:1:XQ2(0) D
.S KEYIEN=$O(^DIC(19.1,"B",XQ2(I),0))
.I '$G(^VA(200,DUZ,52,KEYIEN,0)) S XQ2(I)="" Q
.S ONEGOOD=1
.F J=1:1:XQ1(0) D
..Q:XQ2(I)'=XQ1(J)
..S XQ3(0)=XQ3(0)+1,XQ3(XQ3(0))=XQ2(I)
..Q
Q
;
INFORM ; inform the user of the keys situation
W !!,$C(7),"The following Keys LOCK options within this menu structure.",!
F I=1:1:XQ2(0) W:XQ2(I)'="" !,?5,XQ2(I)
W:XQ3(0) !!,$C(7),"The following are Keys from the list above that this User has potential needs",!,"for within their current assigned Menu's (Primary and all Secondaries)."
W:XQ3(0) !,"Selecting 'U' will remove all keys EXCEPT those noted below.",! F I=1:1:XQ3(0) W !,?5,XQ3(I)
S DIR(0)="S^A:ALL Remove all Keys associated with this Menu;N:NONE Do not remove any Keys associated with this Menu"_$S(XQ3(0):";U:UNIQUE Only remove Keys unique to this Menu",1:"")
D ^DIR S XQANS=Y
Q
;
ADJUST ; adjust the list of keys to ones that the user (DUZ) has
; been delegated [node ^VA(200,DUZ,52,]
N I,KEYIEN
S ONEGOOD=0
F I=1:1:XQKEY(0) D
. S KEYIEN=$O(^DIC(19.1,"B",XQKEY(I),0))
. I $G(^VA(200,DUZ,52,KEYIEN,0)) S ONEGOOD=1 Q
. S XQKEY(I)=""
. Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXQSMD5 6174 printed Nov 22, 2024@17:16:43 Page 2
XQSMD5 ;SEA/JLI,MJM - SECURE MENU DELEGATE EDIT USER OPTIONS ;10/15/98 12:22
+1 ;;8.0;KERNEL;**72,99**;Jul 10, 1995
+2 QUIT
+3 ;
ENTRY ; Main Entry point to edit primary (if applicable) and secondary options
+1 ;
+2 ; check to see if you have options to delegate
+3 IF $ORDER(^VA(200,DUZ,19.5,0))'>0
WRITE !,$CHAR(7),"No Delegated Options Available to Give Out",!
QUIT
+4 ;
+5 ; get user to delegate options to
+6 SET Y=$$LOOKUP^XUSER("QA")
if Y'>0
GOTO EXIT
SET (XQDA,DA)=+Y
+7 ;
+8 ; check user's primary menu, if user has primary and it's not one
+9 ; of the ones that you can delegate, goto secondary options,
+10 ; otherwise fall through and edit primary options
+11 SET XQPRI=$SELECT($DATA(^VA(200,DA,201)):+^(201),1:0)
IF XQPRI
IF '$DATA(^VA(200,DUZ,19.5,XQPRI,0))
GOTO SEC
+12 ;
+13 ; either change primary option or leave as is and go to secondary
+14 KILL DIC
+15 SET XQOLD=XQPRI
SET DIC="^VA(200,"_DUZ_",19.5,"
SET DIC(0)="QMAE"
SET DA(1)=DUZ
SET DIC("A")=" PRIMARY MENU OPTION: "
if XQPRI>0
SET DIC("B")=$PIECE(^DIC(19,XQPRI,0),U,1)
DO ^DIC
IF +Y=XQOLD!(+Y'>0)
GOTO SEC
+16 ;
+17 ; changing primary option
+18 SET (X,XQPRI)=+Y
SET X=$PIECE(^DIC(19,X,0),U,1)
SET DIE="^VA(200,"
SET DA=XQDA
SET DR="201///"_X_";"
DO ^DIE
+19 ;
+20 ; delete old keys associated with old primary menu
+21 IF XQOLD
Begin DoDot:1
+22 SET MENUOLD(0)=1
SET MENUOLD(1)=XQOLD
SET XQANS=""
+23 DO KEYS^XQSMD6(.MENUOLD,.XQKEY,.ABORT)
KILL MENUOLD
+24 IF XQKEY(0)
Begin DoDot:2
+25 DO ADJUST
+26 if 'ONEGOOD
QUIT
+27 MERGE XQ2=XQKEY
+28 WRITE !,"...Removing KEYS associated with previous PRIMARY menu"
+29 DO KEYDEL
+30 QUIT
End DoDot:2
End DoDot:1
+31 KILL XQ2,XQKEY
+32 ;
+33 ; add new keys associated with new primary menu if you have
+34 ; been delegated those keys
+35 if '$DATA(^VA(200,DUZ,52))
GOTO SEC
+36 SET MENUPRI(0)=1
SET MENUPRI(1)=XQPRI
+37 DO KEYS^XQSMD6(.MENUPRI,.XQKEY,.ABORT)
KILL MENUPRI
+38 if XQKEY(0)
DO KEYADD
+39 KILL XQKEY
+40 ;
+41 ; fall through to secondary options
+42 ;
SEC ; Enter Secondary Menu Options from delegated options
+1 KILL DIC
+2 WRITE !
SET DIC="^VA(200,"_DUZ_",19.5,"
SET DIC(0)="QMAE"
SET DA(1)=DUZ
SET DIC("A")=" SECONDARY MENU OPTION: "
DO ^DIC
if Y'>0
GOTO ENTRY
+3 SET XQX=$PIECE(Y,U,2)
+4 if '$DATA(^VA(200,XQDA,203,0))
SET ^(0)="^200.03P"
SET (XQXNAME,X)=$PIECE(^DIC(19,+Y,0),U,1)
SET DIC="^VA(200,"_XQDA_",203,"
SET DIC(0)="ML"
SET DLAYGO=200
SET DA(1)=XQDA
DO ^DIC
+5 ;
+6 SET XQADD=+$PIECE(Y,U,3)
SET XQSEC=+Y
if XQADD
DO KEY
if 'XQADD
DO DEL
KILL ^DIC(200,XQDA,203.1)
+7 GOTO SEC
+8 ;
EXIT ;
+1 KILL D0,DA,DI,DIC,DIE,DR,DQ,I,J,ONEGOOD,P,X,XQ1,XQ2,XQ3,XQADD,XQANS,XQCOMMON,XQDA,XQJ,XQKEY,XQKEYIEN,XQOLD,XQPRI,XQSEC,XQX,XQXNAME,Y,Z
+2 QUIT
+3 ;
DEL ; delete delegated menu
+1 WRITE !,$CHAR(7),"Want to Delete ",XQXNAME," as a Secondary Option? Y// "
+2 READ Z:DTIME
if '$TEST!(Z[U)
QUIT
if Z=""
SET Z="Y"
if "Yy"'[$EXTRACT(Z)
QUIT
+3 ;
+4 ; check to see if users has any keys delegated
+5 if '$DATA(^VA(200,DUZ,52,0))
GOTO MENUDEL
+6 ;
+7 ; build list of users primary ans secondary menus
+8 SET MENU1(0)=1
SET MENU1(1)=XQPRI
SET XQJ=""
+9 FOR
SET XQJ=$ORDER(^VA(200,XQDA,203,"B",XQJ))
if XQJ=""
QUIT
Begin DoDot:1
+10 if XQJ=XQX
QUIT
+11 SET MENU1(0)=MENU1(0)+1
SET MENU1(MENU1(0))=XQJ
+12 QUIT
End DoDot:1
+13 ;
+14 ; get list of keys for primary and all secondary menus in XQ1
+15 DO KEYS^XQSMD6(.MENU1,.XQ1,.ABORT)
KILL MENU1
+16 ;
+17 ; get list of keys for delegated menu in XQ2
+18 SET MENU2(0)=1
SET MENU2(1)=XQX
+19 DO KEYS^XQSMD6(.MENU2,.XQ2,.ABORT)
KILL MENU2
+20 ;
+21 ; compare the two list and inform the user if delegated menu
+22 ; has keys unique to the delegated menu, store in XQ3
+23 SET XQANS="N"
SET ONEGOOD=0
+24 if XQ2(0)>0
DO COMPARE
+25 if ONEGOOD
DO INFORM
+26 ;
+27 ; user timeout or "^" aborted
+28 IF $GET(DTOUT)!($GET(DUOUT))
WRITE !!,$CHAR(7),"No action taken, menu delegation still active!"
QUIT
+29 ;
+30 ; delete keys if user respond with 'Unique' or 'All'
+31 IF XQANS="U"!(XQANS="A")
DO KEYDEL
+32 ;
+1 ; delete menu from user's secondary menu's multiple
+2 SET DIE="^VA(200,"_XQDA_",203,"
SET DR=".01///@"
SET DA=XQSEC
SET DA(1)=XQDA
DO ^DIE
+3 ;
+4 WRITE !!,$CHAR(7),"Delegated Menu: "_XQXNAME_" has been removed!"
+5 QUIT
+6 ;
KEY ; get list of keys
+1 NEW MENULIST,XQKEY,ABORT
+2 SET MENULIST(0)=1
SET MENULIST(1)=XQX
+3 DO KEYS^XQSMD6(.MENULIST,.XQKEY,.ABORT)
+4 if ABORT
QUIT
+5 if XQKEY(0)
DO KEYADD
+6 WRITE !!,$CHAR(7),"Delegated Menu: "_XQXNAME_" has been added!"
+7 QUIT
+8 ;
KEYDEL ; delete keys
+1 FOR I=1:1:XQ2(0)
Begin DoDot:1
+2 if XQ2(I)=""
QUIT
+3 SET XQCOMMON=0
SET XQKEYIEN=""
+4 IF XQANS="U"
FOR J=1:1:XQ3(0)
if XQ2(1)=XQ3(J)
SET XQCOMMON=1
+5 if XQCOMMON
QUIT
+6 SET XQKEYIEN=$ORDER(^DIC(19.1,"B",XQ2(I),0))
+7 SET DIE="^VA(200,"_XQDA_",51,"
SET DR=".01///@"
SET DA=XQKEYIEN
SET DA(1)=XQDA
DO ^DIE
+8 WRITE !,$CHAR(7),"Key: "_XQ2(I)_" has been removed!"
+9 QUIT
End DoDot:1
+10 QUIT
+11 ;
KEYADD ; add keys
+1 ; adjust list to ones that have been delegated to you
+2 DO ADJUST
if 'ONEGOOD
QUIT
+3 WRITE !!,$CHAR(7),"The following Keys LOCK options within this menu structure",!
+4 FOR I=1:1:XQKEY(0)
if XQKEY(I)'=""
WRITE !,?5,XQKEY(I)
+5 WRITE !!,$CHAR(7),"Do you want to ALLOCATE these Keys to this User? N// "
+6 READ Z:DTIME
if '$TEST!(Z[U)
QUIT
if Z=""
SET Z="N"
if "Nn"[$EXTRACT(Z)
QUIT
+7 ;
+8 KILL DIC
+9 SET DIC="^VA(200,"_XQDA_",51,"
SET DIC(0)="NMQ"
SET DIC("P")="200.051PA"
SET DA(1)=XQDA
+10 FOR I=1:1:XQKEY(0)
Begin DoDot:1
+11 if XQKEY(I)=""
QUIT
+12 SET X=$ORDER(^DIC(19.1,"B",XQKEY(I),0))
SET DINUM=X
+13 IF '$DATA(^VA(200,XQDA,51,"B",X,X))
DO FILE^DICN
WRITE !,$CHAR(7),"Key: "_XQKEY(I)_" has been added!"
+14 QUIT
End DoDot:1
+15 QUIT
+16 ;
COMPARE ; compare keys used in the delegated menu against keys the user
+1 ; will need based on their primary and secondary menus
+2 NEW KEYIEN
+3 SET XQ3=""
SET XQ3(0)=0
+4 FOR I=1:1:XQ2(0)
Begin DoDot:1
+5 SET KEYIEN=$ORDER(^DIC(19.1,"B",XQ2(I),0))
+6 IF '$GET(^VA(200,DUZ,52,KEYIEN,0))
SET XQ2(I)=""
QUIT
+7 SET ONEGOOD=1
+8 FOR J=1:1:XQ1(0)
Begin DoDot:2
+9 if XQ2(I)'=XQ1(J)
QUIT
+10 SET XQ3(0)=XQ3(0)+1
SET XQ3(XQ3(0))=XQ2(I)
+11 QUIT
End DoDot:2
End DoDot:1
+12 QUIT
+13 ;
INFORM ; inform the user of the keys situation
+1 WRITE !!,$CHAR(7),"The following Keys LOCK options within this menu structure.",!
+2 FOR I=1:1:XQ2(0)
if XQ2(I)'=""
WRITE !,?5,XQ2(I)
+3 if XQ3(0)
WRITE !!,$CHAR(7),"The following are Keys from the list above that this User has potential needs",!,"for within their current assigned Menu's (Primary and all Secondaries)."
+4 if XQ3(0)
WRITE !,"Selecting 'U' will remove all keys EXCEPT those noted below.",!
FOR I=1:1:XQ3(0)
WRITE !,?5,XQ3(I)
+5 SET DIR(0)="S^A:ALL Remove all Keys associated with this Menu;N:NONE Do not remove any Keys associated with this Menu"_$SELECT(XQ3(0):";U:UNIQUE Only remove Keys unique to this Menu",1:"")
+6 DO ^DIR
SET XQANS=Y
+7 QUIT
+8 ;
ADJUST ; adjust the list of keys to ones that the user (DUZ) has
+1 ; been delegated [node ^VA(200,DUZ,52,]
+2 NEW I,KEYIEN
+3 SET ONEGOOD=0
+4 FOR I=1:1:XQKEY(0)
Begin DoDot:1
+5 SET KEYIEN=$ORDER(^DIC(19.1,"B",XQKEY(I),0))
+6 IF $GET(^VA(200,DUZ,52,KEYIEN,0))
SET ONEGOOD=1
QUIT
+7 SET XQKEY(I)=""
+8 QUIT
End DoDot:1
+9 QUIT
