| 1 | XQCHK3 ; 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
|
|---|
| 6 | OPACCES ;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 | ;
|
|---|
| 25 | ACCESS(%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 | ;
|
|---|
| 80 | CKPM(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 | ;
|
|---|
| 99 | CKCM(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 | ;
|
|---|
| 113 | CKTSM(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 | ;
|
|---|
| 126 | CKTESM(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 | ;
|
|---|
| 143 | KEYS(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 | ;
|
|---|
| 155 | KEYSTOP(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 | ;
|
|---|
| 166 | PRINT(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 | ;
|
|---|
| 188 | KILLFM ;Kill off the FileMan variables
|
|---|
| 189 | K D0,DI,DIC,DIE,DISYS,DQ,DR,DUOUT,DTOUT,X,Y
|
|---|
| 190 | Q
|
|---|
