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/XQSMD5.m@ 701

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

initial load of WorldVistAEHR

File size: 5.9 KB
Line 
1XQSMD5 ;SEA/JLI,MJM - SECURE MENU DELEGATE EDIT USER OPTIONS ;10/15/98 12:22
2 ;;8.0;KERNEL;**72,99**;Jul 10, 1995
3 Q
4 ;
5ENTRY ; Main Entry point to edit primary (if applicable) and secondary options
6 ;
7 ; check to see if you have options to delegate
8 I $O(^VA(200,DUZ,19.5,0))'>0 W !,$C(7),"No Delegated Options Available to Give Out",! Q
9 ;
10 ; get user to delegate options to
11 S Y=$$LOOKUP^XUSER("QA") G:Y'>0 EXIT S (XQDA,DA)=+Y
12 ;
13 ; check user's primary menu, if user has primary and it's not one
14 ; of the ones that you can delegate, goto secondary options,
15 ; otherwise fall through and edit primary options
16 S XQPRI=$S($D(^VA(200,DA,201)):+^(201),1:0) I XQPRI,'$D(^VA(200,DUZ,19.5,XQPRI,0)) G SEC
17 ;
18 ; either change primary option or leave as is and go to secondary
19 K DIC
20 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
21 ;
22 ; changing primary option
23 S (X,XQPRI)=+Y,X=$P(^DIC(19,X,0),U,1),DIE="^VA(200,",DA=XQDA,DR="201///"_X_";" D ^DIE
24 ;
25 ; delete old keys associated with old primary menu
26 I XQOLD D
27 .S MENUOLD(0)=1,MENUOLD(1)=XQOLD,XQANS=""
28 .D KEYS^XQSMD6(.MENUOLD,.XQKEY,.ABORT) K MENUOLD
29 .I XQKEY(0) D
30 ..D ADJUST
31 ..Q:'ONEGOOD
32 ..M XQ2=XQKEY
33 ..W !,"...Removing KEYS associated with previous PRIMARY menu"
34 ..D KEYDEL
35 ..Q
36 K XQ2,XQKEY
37 ;
38 ; add new keys associated with new primary menu if you have
39 ; been delegated those keys
40 G:'$D(^VA(200,DUZ,52)) SEC
41 S MENUPRI(0)=1,MENUPRI(1)=XQPRI
42 D KEYS^XQSMD6(.MENUPRI,.XQKEY,.ABORT) K MENUPRI
43 D:XQKEY(0) KEYADD
44 K XQKEY
45 ;
46 ; fall through to secondary options
47 ;
48SEC ; Enter Secondary Menu Options from delegated options
49 K DIC
50 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
51 S XQX=$P(Y,U,2)
52 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
53 ;
54 S XQADD=+$P(Y,U,3),XQSEC=+Y D KEY:XQADD,DEL:'XQADD K ^DIC(200,XQDA,203.1)
55 G SEC
56 ;
57EXIT ;
58 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
59 Q
60 ;
61DEL ; delete delegated menu
62 W !,$C(7),"Want to Delete ",XQXNAME," as a Secondary Option? Y// "
63 R Z:DTIME Q:'$T!(Z[U) S:Z="" Z="Y" Q:"Yy"'[$E(Z)
64 ;
65 ; check to see if users has any keys delegated
66 G:'$D(^VA(200,DUZ,52,0)) MENUDEL
67 ;
68 ; build list of users primary ans secondary menus
69 S MENU1(0)=1,MENU1(1)=XQPRI,XQJ=""
70 F S XQJ=$O(^VA(200,XQDA,203,"B",XQJ)) Q:XQJ="" D
71 . Q:XQJ=XQX
72 . S MENU1(0)=MENU1(0)+1,MENU1(MENU1(0))=XQJ
73 . Q
74 ;
75 ; get list of keys for primary and all secondary menus in XQ1
76 D KEYS^XQSMD6(.MENU1,.XQ1,.ABORT) K MENU1
77 ;
78 ; get list of keys for delegated menu in XQ2
79 S MENU2(0)=1,MENU2(1)=XQX
80 D KEYS^XQSMD6(.MENU2,.XQ2,.ABORT) K MENU2
81 ;
82 ; compare the two list and inform the user if delegated menu
83 ; has keys unique to the delegated menu, store in XQ3
84 S XQANS="N",ONEGOOD=0
85 D:XQ2(0)>0 COMPARE
86 D:ONEGOOD INFORM
87 ;
88 ; user timeout or "^" aborted
89 I $G(DTOUT)!($G(DUOUT)) W !!,$C(7),"No action taken, menu delegation still active!" Q
90 ;
91 ; delete keys if user respond with 'Unique' or 'All'
92 I XQANS="U"!(XQANS="A") D KEYDEL
93 ;
94MENUDEL ;
95 ; delete menu from user's secondary menu's multiple
96 S DIE="^VA(200,"_XQDA_",203,",DR=".01///@",DA=XQSEC,DA(1)=XQDA D ^DIE
97 ;
98 W !!,$C(7),"Delegated Menu: "_XQXNAME_" has been removed!"
99 Q
100 ;
101KEY ; get list of keys
102 N MENULIST,XQKEY,ABORT
103 S MENULIST(0)=1,MENULIST(1)=XQX
104 D KEYS^XQSMD6(.MENULIST,.XQKEY,.ABORT)
105 Q:ABORT
106 D:XQKEY(0) KEYADD
107 W !!,$C(7),"Delegated Menu: "_XQXNAME_" has been added!"
108 Q
109 ;
110KEYDEL ; delete keys
111 F I=1:1:XQ2(0) D
112 .Q:XQ2(I)=""
113 .S XQCOMMON=0,XQKEYIEN=""
114 .I XQANS="U" F J=1:1:XQ3(0) S:XQ2(1)=XQ3(J) XQCOMMON=1
115 .Q:XQCOMMON
116 .S XQKEYIEN=$O(^DIC(19.1,"B",XQ2(I),0))
117 .S DIE="^VA(200,"_XQDA_",51,",DR=".01///@",DA=XQKEYIEN,DA(1)=XQDA D ^DIE
118 .W !,$C(7),"Key: "_XQ2(I)_" has been removed!"
119 .Q
120 Q
121 ;
122KEYADD ; add keys
123 ; adjust list to ones that have been delegated to you
124 D ADJUST Q:'ONEGOOD
125 W !!,$C(7),"The following Keys LOCK options within this menu structure",!
126 F I=1:1:XQKEY(0) W:XQKEY(I)'="" !,?5,XQKEY(I)
127 W !!,$C(7),"Do you want to ALLOCATE these Keys to this User? N// "
128 R Z:DTIME Q:'$T!(Z[U) S:Z="" Z="N" Q:"Nn"[$E(Z)
129 ;
130 K DIC
131 S DIC="^VA(200,"_XQDA_",51,",DIC(0)="NMQ",DIC("P")="200.051PA",DA(1)=XQDA
132 F I=1:1:XQKEY(0) D
133 .Q:XQKEY(I)=""
134 .S X=$O(^DIC(19.1,"B",XQKEY(I),0)),DINUM=X
135 .I '$D(^VA(200,XQDA,51,"B",X,X)) D FILE^DICN W !,$C(7),"Key: "_XQKEY(I)_" has been added!"
136 .Q
137 Q
138 ;
139COMPARE ; compare keys used in the delegated menu against keys the user
140 ; will need based on their primary and secondary menus
141 N KEYIEN
142 S XQ3="",XQ3(0)=0
143 F I=1:1:XQ2(0) D
144 .S KEYIEN=$O(^DIC(19.1,"B",XQ2(I),0))
145 .I '$G(^VA(200,DUZ,52,KEYIEN,0)) S XQ2(I)="" Q
146 .S ONEGOOD=1
147 .F J=1:1:XQ1(0) D
148 ..Q:XQ2(I)'=XQ1(J)
149 ..S XQ3(0)=XQ3(0)+1,XQ3(XQ3(0))=XQ2(I)
150 ..Q
151 Q
152 ;
153INFORM ; inform the user of the keys situation
154 W !!,$C(7),"The following Keys LOCK options within this menu structure.",!
155 F I=1:1:XQ2(0) W:XQ2(I)'="" !,?5,XQ2(I)
156 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)."
157 W:XQ3(0) !,"Selecting 'U' will remove all keys EXCEPT those noted below.",! F I=1:1:XQ3(0) W !,?5,XQ3(I)
158 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:"")
159 D ^DIR S XQANS=Y
160 Q
161 ;
162ADJUST ; adjust the list of keys to ones that the user (DUZ) has
163 ; been delegated [node ^VA(200,DUZ,52,]
164 N I,KEYIEN
165 S ONEGOOD=0
166 F I=1:1:XQKEY(0) D
167 . S KEYIEN=$O(^DIC(19.1,"B",XQKEY(I),0))
168 . I $G(^VA(200,DUZ,52,KEYIEN,0)) S ONEGOOD=1 Q
169 . S XQKEY(I)=""
170 . Q
171 Q
Note: See TracBrowser for help on using the repository browser.