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/XQCHK3.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: 7.1 KB
Line 
1XQCHK3 ; OAK-BY/BDT - This routine for XQCHK; 5/20/08
2 ;;8.0;KERNEL;**503**;Jul 10, 1995;Build 2
3 ;;"Per VHA Directive 2004-038, this routine should not be modified".
4 ;
5 Q
6OPACCES ;Entry point for the option that checks to see if a user has
7 ;access to a particular option by calling the above function.
8 N DIC,X,Y,XQANS,XQOPN,XQUSER,XQUSN,XQOPT
9 ;get user
10 S DIC(0)="AEMNQ",DIC="^VA(200,",DIC("A")="Please enter the user's name: " D ^DIC
11 I $D(DUOUT)!($D(DTOUT)) D KILLFM Q
12 I Y=-1 W !!?5,"Sorry we couldn't find that user in the New Person File.",! D KILLFM Q
13 S XQUSN=+Y,XQUSER=$P(Y,U,2) D KILLFM
14 ;get option
15 S DIC(0)="AEMNQ",DIC="^DIC(19,",DIC("A")="Please enter the name of the option: " D ^DIC
16 I $D(DUOUT)!($D(DTOUT)) D KILLFM Q
17 I Y=-1 W !!?5,"Sorry we couldn't find that option.",! D KILLFM Q
18 S XQOPN=+Y,XQOPT=$P(Y,U,2) D KILLFM
19 ;check keys
20 S XQANS=$$ACCESS(XQUSN,XQOPN)
21 ;print out
22 D PRINT(XQANS)
23 Q
24 ;
25ACCESS(%XQUSR,%XQOP) ;Find out if a user has access to a particular option
26 ;;W $$ACCESS(DUZ,Option IEN) returns:
27 ;;
28 ;;-1:no such user in the New Person File
29 ;;-2: User terminated or has no access code
30 ;;-3: no such option in the Option File
31 ;;0: no access found in any menu tree the user owns
32 ;;
33 ;;All other cases return a 4-piece string stating
34 ;;access ^ menu tree IEN ^ a set of codes ^ key
35 ;;
36 ;;O^tree^codes^key: No access because of locks (see XQCODES below)
37 ;;where 'tree' is the menu where access WOULD be allowed
38 ;;and 'key' is the key preventing access
39 ;;
40 ;;1^OpIEN^^: Access allowed through Primary Menu
41 ;;2^OpIEN^codes^: Access found in the Common Options
42 ;;3^OpIEN^codes^: Access found in top level of secondary option
43 ;;4^OpIEN^codes^: Access through a the secondary menu tree OpIEN.
44 ;;
45 ;;XQCODES can contain:
46 ;;N=No Primary Menu in the User File (warning only)
47 ;;L=Locked and the user does not have the key (forces 0 in first piece)
48 ;;R=Reverse lock and user has the key (forces 0 in first piece)
49 ;
50 N XQUSR,U S U="^"
51 S XQUSR=$$ACTIVE^XUSER(%XQUSR)
52 I XQUSR="" Q -1
53 I +XQUSR=0 Q -2
54 ;
55 ;Convert %XQOP to its IEN if the name is passed
56 I %XQOP'=+$G(%XQOP) D
57 .I $D(^DIC(19,"B",%XQOP))<1 S %XQOP=0 Q
58 .E S %XQOP=$O(^DIC(19,"B",%XQOP,0))
59 .Q
60 I '%XQOP Q -3
61 I '$D(^DIC(19,%XQOP,0)) Q -3
62 ;checking
63 N XQRT,XQRT1 S XQRT="",XQRT1=""
64 S XQRT=$$CKPM(%XQUSR,%XQOP) ;primary menu and sub-menu in the primary menu
65 I $P(XQRT,U)=1 Q XQRT
66 I $P(XQRT,U)="N" Q XQRT
67 S XQRT1=XQRT
68 S XQRT=$$CKCM(%XQUSR,%XQOP) ;common menu
69 I $P(XQRT,U)=2 Q XQRT
70 I $P(XQRT,U)=0 S XQRT1=XQRT
71 S XQRT=$$CKTSM(%XQUSR,%XQOP) ;top level of secondary menus
72 I $P(XQRT,U)=3 Q XQRT
73 I $P(XQRT,U)=0 S XQRT1=XQRT
74 S XQRT=$$CKTESM(%XQUSR,%XQOP) ;sub-menu in secondary menus
75 I $P(XQRT,U)=4 Q XQRT
76 I $P(XQRT,U)=0 S XQRT1=XQRT
77 I XQRT1="" S XQRT1=0
78 Q XQRT1
79 ;
80CKPM(XQUSR,XQIEN) ;
81 ;Look in the user's primary menu tree
82 ;take in XQUSR = IEN in New Person file; XQIEN = IEN in the Option file
83 ;Return = access ^ menu tree IEN ^ a set of codes ^ key
84 N XQPM,XQDIC,XQTL,XQRT
85 S XQPM=$P($G(^VA(200,XQUSR,201)),"^")
86 I 'XQPM Q "N"
87 ; check Lock on the Primary menu
88 S XQRT=$$KEYSTOP(XQIEN,XQUSR)
89 I XQRT'="OK" Q "0^"_XQPM_"^"_XQRT
90 ;
91 S XQDIC="P"_XQPM
92 I '$D(^XUTL("XQO",XQDIC,"^",XQIEN)) Q ""
93 S XQTL=$P($G(^XUTL("XQO",XQDIC,"^",XQIEN)),"^",2,99)
94 I XQTL="" Q ""
95 S XQRT=$$KEYS(XQTL,XQUSR)
96 I XQRT="OK" Q "1^"_XQPM
97 Q "0^"_XQPM_"^"_XQRT
98 ;
99CKCM(XQUSR,XQIEN) ;
100 ;Look in the user's primary menu tree
101 ;take in XQUSR = IEN in New Person file; XQIEN = IEN in the Option file
102 ;Return = access ^ menu tree IEN ^ a set of codes ^ key
103 N XQTL,XQDIC,XQCOM,XQRT
104 S XQCOM=$O(^DIC(19,"B","XUCOMMAND",0))
105 S XQDIC="PXU"
106 I '$D(^XUTL("XQO",XQDIC,"^",XQIEN)) Q "N"
107 S XQTL=$P($G(^XUTL("XQO",XQDIC,"^",%XQOP)),"^",2,99)
108 I XQTL="" Q ""
109 S XQRT=$$KEYS(XQTL,XQUSR)
110 I XQRT="OK" Q "2^"_"^^^"_XQCOM
111 Q "0^"_"^"_XQRT_"^"_XQCOM
112 ;
113CKTSM(XQUSR,XQIEN) ;
114 ;Look in the user's primary menu tree
115 ;take in XQUSR = IEN in New Person file; XQIEN = IEN in the Option file
116 ;Return = access ^ menu tree IEN ^ a set of codes ^ key
117 N XQDIC,XQRT,XQTL
118 S XQDIC="U"_XQUSR
119 I '$D(^VA(200,XQUSR,203,"B",XQIEN)) Q "N"
120 S XQTL=$P($G(^XUTL("XQO",XQDIC,"^",XQIEN)),"^",2,99)
121 I XQTL="" Q ""
122 S XQRT=$$KEYS(XQTL,XQUSR)
123 I XQRT="OK" Q "3^"_XQIEN
124 Q "0^"_XQIEN_"^"_XQRT
125 ;
126CKTESM(XQUSR,XQIEN) ;
127 ;Look in the user's primary menu tree
128 ;take in XQUSR = IEN in New Person file; XQIEN = IEN in the Option file
129 ;Return = access ^ menu tree IEN ^ a set of codes ^ key
130 N XQI,XQY,XQRT,XQDIC,XQTL S XQI=0,XQRT="",XQY=""
131 F S XQI=$O(^VA(200,XQUSR,203,"B",XQI)) Q:XQI'>0 D
132 .S XQDIC="P"_XQI
133 .S XQTL=$G(^XUTL("XQO",XQDIC,"^",XQIEN)) I XQTL="" Q
134 .S XQTL=$P(XQTL,"^",2,99) I XQTL="" Q
135 .S XQRT=$$KEYSTOP(XQI,XQUSR)
136 .I XQRT="OK" S XQRT=$$KEYS(XQTL,XQUSR)
137 .S XQY=XQI
138 .I XQRT="OK" S XQI="ZZZ" Q
139 I XQRT="OK" Q "4^"_XQY
140 I XQRT="" Q XQRT
141 Q "0^"_XQY_"^"_XQRT
142 ;
143KEYS(XQA,XQUSR) ;Check for keys, reverse keys...
144 ;XQA = ^XUTL("XQO",XQDIC,"^",%XQOP) or U_^DIC(19,%XQOP,0)
145 ;XQUSR = IEN user in the New Person #200 file
146 ;Return XQRT = Null or Lock/ReLock if found
147 ;
148 N XQL,XQRL,XQRT S XQRT="OK"
149 S XQL=$$CHCKL^XQCHK2(XQA,XQUSR) ;check for keys
150 I +XQL>0 S XQRT="L^"_$P(XQL,"^",2)
151 S XQRL=$$CHCKRL^XQCHK2(XQA,XQUSR) ;check for reverse keys
152 I +XQRL>0 S XQRT="R^"_$P(XQRL,"^",2)
153 Q XQRT
154 ;
155KEYSTOP(XQIEN,XQUSR) ;check Lock and Reversed Lock on the top level menu
156 ;;XQIEN = IEN option in the Option #19 file
157 ;;XQUSR = IEN use in the New Person #200 file
158 ;;Return XQRT = Null or Lock/ReLock if found
159 N XQL,XQRL,XQRT S XQRT="OK"
160 S XQL=$$CHKTOPL^XQCHK2(XQIEN,XQUSR) ;check for keys on top level
161 I +XQL>0 S XQRT="L^"_$P(XQL,"^",2)
162 S XQRL=$$CHKTOPRL^XQCHK2(XQIEN,XQUSR) ;check for reverse keys on top level
163 I +XQRL>0 S XQRT="R^"_$P(XQRL,"^",2)
164 Q XQRT
165 ;
166PRINT(XQANS) ; print out the result
167 N XQRSLT,XQTREE,XQPTR,XQCODES,XQKEY
168 S XQRSLT=+XQANS,XQTREE=""
169 S XQPTR=$P(XQANS,U,2)
170 I XQPTR>0 S XQTREE=$P(^DIC(19,$P(XQANS,U,2),0),U)
171 S XQCODES=$P(XQANS,U,3),XQKEY=$P(XQANS,U,4)
172 ;-------------------------------------------------------------------------------
173 I XQRSLT=-1 W !!?5,"User ",XQUSER," is not in the New Person File."
174 I XQRSLT=-2 W !!?5,"User ",XQUSER," has an active termination date,",!?5,"or no verify code."
175 I XQRSLT=-3 W !!?5,"Option ",XQOPT," is not in the Option File."
176 I XQRSLT=0 D
177 .W !!?5,"User ",XQUSER," does not have access to the option",!?5,XQOPT,"."
178 .I XQCODES["L" W !!?5,"There is a lock somewhere in the menu tree "_XQTREE,!?5,"and the user does not hold the key "_XQKEY_"."
179 .I XQCODES["R" W !!?5,"There is a reverse lock somewhere in the menu tree "_XQTREE,!?5,"and the user holds the key "_XQKEY_"."
180 .Q
181 I XQRSLT=1 W !!?5,"User ",XQUSER," has access to the option ",XQOPT,!?5,"through the primary menu ",XQTREE," (",$P(^DIC(19,XQPTR,0),U,2),")."
182 I XQRSLT=2 W !!?5,"User ",XQUSER," has access to the option ",XQOPT,!?5,"through the Common Options (XUCOMMAND)."
183 I XQRSLT=3 W !!?5,"User ",XQUSER," has access to the option ",XQOPT,!?5,"as a top-level secondary menu option."
184 I XQRSLT=4 W !!?5,"User ",XQUSER," has access to the option ",XQOPT,!?5,"through the secondary menu tree ",XQTREE," (",$P(^DIC(19,XQPTR,0),U,2),")."
185 W !
186 Q
187 ;
188KILLFM ;Kill off the FileMan variables
189 K D0,DI,DIC,DIE,DISYS,DQ,DR,DUOUT,DTOUT,X,Y
190 Q
Note: See TracBrowser for help on using the repository browser.