XQCHK3 ; OAK-BY/BDT - This routine for XQCHK; 5/20/08
;;8.0;KERNEL;**503**;Jul 10, 1995;Build 2
;;"Per VHA Directive 2004-038, this routine should not be modified".
;
Q
OPACCES ;Entry point for the option that checks to see if a user has
;access to a particular option by calling the above function.
N DIC,X,Y,XQANS,XQOPN,XQUSER,XQUSN,XQOPT
;get user
S DIC(0)="AEMNQ",DIC="^VA(200,",DIC("A")="Please enter the user's name: " D ^DIC
I $D(DUOUT)!($D(DTOUT)) D KILLFM Q
I Y=-1 W !!?5,"Sorry we couldn't find that user in the New Person File.",! D KILLFM Q
S XQUSN=+Y,XQUSER=$P(Y,U,2) D KILLFM
;get option
S DIC(0)="AEMNQ",DIC="^DIC(19,",DIC("A")="Please enter the name of the option: " D ^DIC
I $D(DUOUT)!($D(DTOUT)) D KILLFM Q
I Y=-1 W !!?5,"Sorry we couldn't find that option.",! D KILLFM Q
S XQOPN=+Y,XQOPT=$P(Y,U,2) D KILLFM
;check keys
S XQANS=$$ACCESS(XQUSN,XQOPN)
;print out
D PRINT(XQANS)
Q
;
ACCESS(%XQUSR,%XQOP) ;Find out if a user has access to a particular option
;;W $$ACCESS(DUZ,Option IEN) returns:
;;
;;-1:no such user in the New Person File
;;-2: User terminated or has no access code
;;-3: no such option in the Option File
;;0: no access found in any menu tree the user owns
;;
;;All other cases return a 4-piece string stating
;;access ^ menu tree IEN ^ a set of codes ^ key
;;
;;O^tree^codes^key: No access because of locks (see XQCODES below)
;;where 'tree' is the menu where access WOULD be allowed
;;and 'key' is the key preventing access
;;
;;1^OpIEN^^: Access allowed through Primary Menu
;;2^OpIEN^codes^: Access found in the Common Options
;;3^OpIEN^codes^: Access found in top level of secondary option
;;4^OpIEN^codes^: Access through a the secondary menu tree OpIEN.
;;
;;XQCODES can contain:
;;N=No Primary Menu in the User File (warning only)
;;L=Locked and the user does not have the key (forces 0 in first piece)
;;R=Reverse lock and user has the key (forces 0 in first piece)
;
N XQUSR,U S U="^"
S XQUSR=$$ACTIVE^XUSER(%XQUSR)
I XQUSR="" Q -1
I +XQUSR=0 Q -2
;
;Convert %XQOP to its IEN if the name is passed
I %XQOP'=+$G(%XQOP) D
.I $D(^DIC(19,"B",%XQOP))<1 S %XQOP=0 Q
.E S %XQOP=$O(^DIC(19,"B",%XQOP,0))
.Q
I '%XQOP Q -3
I '$D(^DIC(19,%XQOP,0)) Q -3
;checking
N XQRT,XQRT1 S XQRT="",XQRT1=""
S XQRT=$$CKPM(%XQUSR,%XQOP) ;primary menu and sub-menu in the primary menu
I $P(XQRT,U)=1 Q XQRT
I $P(XQRT,U)="N" Q XQRT
S XQRT1=XQRT
S XQRT=$$CKCM(%XQUSR,%XQOP) ;common menu
I $P(XQRT,U)=2 Q XQRT
I $P(XQRT,U)=0 S XQRT1=XQRT
S XQRT=$$CKTSM(%XQUSR,%XQOP) ;top level of secondary menus
I $P(XQRT,U)=3 Q XQRT
I $P(XQRT,U)=0 S XQRT1=XQRT
S XQRT=$$CKTESM(%XQUSR,%XQOP) ;sub-menu in secondary menus
I $P(XQRT,U)=4 Q XQRT
I $P(XQRT,U)=0 S XQRT1=XQRT
I XQRT1="" S XQRT1=0
Q XQRT1
;
CKPM(XQUSR,XQIEN) ;
;Look in the user's primary menu tree
;take in XQUSR = IEN in New Person file; XQIEN = IEN in the Option file
;Return = access ^ menu tree IEN ^ a set of codes ^ key
N XQPM,XQDIC,XQTL,XQRT
S XQPM=$P($G(^VA(200,XQUSR,201)),"^")
I 'XQPM Q "N"
; check Lock on the Primary menu
S XQRT=$$KEYSTOP(XQIEN,XQUSR)
I XQRT'="OK" Q "0^"_XQPM_"^"_XQRT
;
S XQDIC="P"_XQPM
I '$D(^XUTL("XQO",XQDIC,"^",XQIEN)) Q ""
S XQTL=$P($G(^XUTL("XQO",XQDIC,"^",XQIEN)),"^",2,99)
I XQTL="" Q ""
S XQRT=$$KEYS(XQTL,XQUSR)
I XQRT="OK" Q "1^"_XQPM
Q "0^"_XQPM_"^"_XQRT
;
CKCM(XQUSR,XQIEN) ;
;Look in the user's primary menu tree
;take in XQUSR = IEN in New Person file; XQIEN = IEN in the Option file
;Return = access ^ menu tree IEN ^ a set of codes ^ key
N XQTL,XQDIC,XQCOM,XQRT
S XQCOM=$O(^DIC(19,"B","XUCOMMAND",0))
S XQDIC="PXU"
I '$D(^XUTL("XQO",XQDIC,"^",XQIEN)) Q "N"
S XQTL=$P($G(^XUTL("XQO",XQDIC,"^",%XQOP)),"^",2,99)
I XQTL="" Q ""
S XQRT=$$KEYS(XQTL,XQUSR)
I XQRT="OK" Q "2^"_"^^^"_XQCOM
Q "0^"_"^"_XQRT_"^"_XQCOM
;
CKTSM(XQUSR,XQIEN) ;
;Look in the user's primary menu tree
;take in XQUSR = IEN in New Person file; XQIEN = IEN in the Option file
;Return = access ^ menu tree IEN ^ a set of codes ^ key
N XQDIC,XQRT,XQTL
S XQDIC="U"_XQUSR
I '$D(^VA(200,XQUSR,203,"B",XQIEN)) Q "N"
S XQTL=$P($G(^XUTL("XQO",XQDIC,"^",XQIEN)),"^",2,99)
I XQTL="" Q ""
S XQRT=$$KEYS(XQTL,XQUSR)
I XQRT="OK" Q "3^"_XQIEN
Q "0^"_XQIEN_"^"_XQRT
;
CKTESM(XQUSR,XQIEN) ;
;Look in the user's primary menu tree
;take in XQUSR = IEN in New Person file; XQIEN = IEN in the Option file
;Return = access ^ menu tree IEN ^ a set of codes ^ key
N XQI,XQY,XQRT,XQDIC,XQTL S XQI=0,XQRT="",XQY=""
F S XQI=$O(^VA(200,XQUSR,203,"B",XQI)) Q:XQI'>0 D
.S XQDIC="P"_XQI
.S XQTL=$G(^XUTL("XQO",XQDIC,"^",XQIEN)) I XQTL="" Q
.S XQTL=$P(XQTL,"^",2,99) I XQTL="" Q
.S XQRT=$$KEYSTOP(XQI,XQUSR)
.I XQRT="OK" S XQRT=$$KEYS(XQTL,XQUSR)
.S XQY=XQI
.I XQRT="OK" S XQI="ZZZ" Q
I XQRT="OK" Q "4^"_XQY
I XQRT="" Q XQRT
Q "0^"_XQY_"^"_XQRT
;
KEYS(XQA,XQUSR) ;Check for keys, reverse keys...
;XQA = ^XUTL("XQO",XQDIC,"^",%XQOP) or U_^DIC(19,%XQOP,0)
;XQUSR = IEN user in the New Person #200 file
;Return XQRT = Null or Lock/ReLock if found
;
N XQL,XQRL,XQRT S XQRT="OK"
S XQL=$$CHCKL^XQCHK2(XQA,XQUSR) ;check for keys
I +XQL>0 S XQRT="L^"_$P(XQL,"^",2)
S XQRL=$$CHCKRL^XQCHK2(XQA,XQUSR) ;check for reverse keys
I +XQRL>0 S XQRT="R^"_$P(XQRL,"^",2)
Q XQRT
;
KEYSTOP(XQIEN,XQUSR) ;check Lock and Reversed Lock on the top level menu
;;XQIEN = IEN option in the Option #19 file
;;XQUSR = IEN use in the New Person #200 file
;;Return XQRT = Null or Lock/ReLock if found
N XQL,XQRL,XQRT S XQRT="OK"
S XQL=$$CHKTOPL^XQCHK2(XQIEN,XQUSR) ;check for keys on top level
I +XQL>0 S XQRT="L^"_$P(XQL,"^",2)
S XQRL=$$CHKTOPRL^XQCHK2(XQIEN,XQUSR) ;check for reverse keys on top level
I +XQRL>0 S XQRT="R^"_$P(XQRL,"^",2)
Q XQRT
;
PRINT(XQANS) ; print out the result
N XQRSLT,XQTREE,XQPTR,XQCODES,XQKEY
S XQRSLT=+XQANS,XQTREE=""
S XQPTR=$P(XQANS,U,2)
I XQPTR>0 S XQTREE=$P(^DIC(19,$P(XQANS,U,2),0),U)
S XQCODES=$P(XQANS,U,3),XQKEY=$P(XQANS,U,4)
;-------------------------------------------------------------------------------
I XQRSLT=-1 W !!?5,"User ",XQUSER," is not in the New Person File."
I XQRSLT=-2 W !!?5,"User ",XQUSER," has an active termination date,",!?5,"or no verify code."
I XQRSLT=-3 W !!?5,"Option ",XQOPT," is not in the Option File."
I XQRSLT=0 D
.W !!?5,"User ",XQUSER," does not have access to the option",!?5,XQOPT,"."
.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_"."
.I XQCODES["R" W !!?5,"There is a reverse lock somewhere in the menu tree "_XQTREE,!?5,"and the user holds the key "_XQKEY_"."
.Q
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),")."
I XQRSLT=2 W !!?5,"User ",XQUSER," has access to the option ",XQOPT,!?5,"through the Common Options (XUCOMMAND)."
I XQRSLT=3 W !!?5,"User ",XQUSER," has access to the option ",XQOPT,!?5,"as a top-level secondary menu option."
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),")."
W !
Q
;
KILLFM ;Kill off the FileMan variables
K D0,DI,DIC,DIE,DISYS,DQ,DR,DUOUT,DTOUT,X,Y
Q
XQCHK3 ; OAK-BY/BDT - This routine for XQCHK; 5/20/08
+1 ;;8.0;KERNEL;**503**;Jul 10, 1995;Build 2
+2 ;;"Per VHA Directive 2004-038, this routine should not be modified".
+3 ;
+4 QUIT
OPACCES ;Entry point for the option that checks to see if a user has
+1 ;access to a particular option by calling the above function.
+2 NEW DIC,X,Y,XQANS,XQOPN,XQUSER,XQUSN,XQOPT
+3 ;get user
+4 SET DIC(0)="AEMNQ"
SET DIC="^VA(200,"
SET DIC("A")="Please enter the user's name: "
DO ^DIC
+5 IF $DATA(DUOUT)!($DATA(DTOUT))
DO KILLFM
QUIT
+6 IF Y=-1
WRITE !!?5,"Sorry we couldn't find that user in the New Person File.",!
DO KILLFM
QUIT
+7 SET XQUSN=+Y
SET XQUSER=$PIECE(Y,U,2)
DO KILLFM
+8 ;get option
+9 SET DIC(0)="AEMNQ"
SET DIC="^DIC(19,"
SET DIC("A")="Please enter the name of the option: "
DO ^DIC
+10 IF $DATA(DUOUT)!($DATA(DTOUT))
DO KILLFM
QUIT
+11 IF Y=-1
WRITE !!?5,"Sorry we couldn't find that option.",!
DO KILLFM
QUIT
+12 SET XQOPN=+Y
SET XQOPT=$PIECE(Y,U,2)
DO KILLFM
+13 ;check keys
+14 SET XQANS=$$ACCESS(XQUSN,XQOPN)
+15 ;print out
+16 DO PRINT(XQANS)
+17 QUIT
+18 ;
ACCESS(%XQUSR,%XQOP) ;Find out if a user has access to a particular option
+1 ;;W $$ACCESS(DUZ,Option IEN) returns:
+2 ;;
+3 ;;-1:no such user in the New Person File
+4 ;;-2: User terminated or has no access code
+5 ;;-3: no such option in the Option File
+6 ;;0: no access found in any menu tree the user owns
+7 ;;
+8 ;;All other cases return a 4-piece string stating
+9 ;;access ^ menu tree IEN ^ a set of codes ^ key
+10 ;;
+11 ;;O^tree^codes^key: No access because of locks (see XQCODES below)
+12 ;;where 'tree' is the menu where access WOULD be allowed
+13 ;;and 'key' is the key preventing access
+14 ;;
+15 ;;1^OpIEN^^: Access allowed through Primary Menu
+16 ;;2^OpIEN^codes^: Access found in the Common Options
+17 ;;3^OpIEN^codes^: Access found in top level of secondary option
+18 ;;4^OpIEN^codes^: Access through a the secondary menu tree OpIEN.
+19 ;;
+20 ;;XQCODES can contain:
+21 ;;N=No Primary Menu in the User File (warning only)
+22 ;;L=Locked and the user does not have the key (forces 0 in first piece)
+23 ;;R=Reverse lock and user has the key (forces 0 in first piece)
+24 ;
+25 NEW XQUSR,U
SET U="^"
+26 SET XQUSR=$$ACTIVE^XUSER(%XQUSR)
+27 IF XQUSR=""
QUIT -1
+28 IF +XQUSR=0
QUIT -2
+29 ;
+30 ;Convert %XQOP to its IEN if the name is passed
+31 IF %XQOP'=+$GET(%XQOP)
Begin DoDot:1
+32 IF $DATA(^DIC(19,"B",%XQOP))<1
SET %XQOP=0
QUIT
+33 IF '$TEST
SET %XQOP=$ORDER(^DIC(19,"B",%XQOP,0))
+34 QUIT
End DoDot:1
+35 IF '%XQOP
QUIT -3
+36 IF '$DATA(^DIC(19,%XQOP,0))
QUIT -3
+37 ;checking
+38 NEW XQRT,XQRT1
SET XQRT=""
SET XQRT1=""
+39 ;primary menu and sub-menu in the primary menu
SET XQRT=$$CKPM(%XQUSR,%XQOP)
+40 IF $PIECE(XQRT,U)=1
QUIT XQRT
+41 IF $PIECE(XQRT,U)="N"
QUIT XQRT
+42 SET XQRT1=XQRT
+43 ;common menu
SET XQRT=$$CKCM(%XQUSR,%XQOP)
+44 IF $PIECE(XQRT,U)=2
QUIT XQRT
+45 IF $PIECE(XQRT,U)=0
SET XQRT1=XQRT
+46 ;top level of secondary menus
SET XQRT=$$CKTSM(%XQUSR,%XQOP)
+47 IF $PIECE(XQRT,U)=3
QUIT XQRT
+48 IF $PIECE(XQRT,U)=0
SET XQRT1=XQRT
+49 ;sub-menu in secondary menus
SET XQRT=$$CKTESM(%XQUSR,%XQOP)
+50 IF $PIECE(XQRT,U)=4
QUIT XQRT
+51 IF $PIECE(XQRT,U)=0
SET XQRT1=XQRT
+52 IF XQRT1=""
SET XQRT1=0
+53 QUIT XQRT1
+54 ;
CKPM(XQUSR,XQIEN) ;
+1 ;Look in the user's primary menu tree
+2 ;take in XQUSR = IEN in New Person file; XQIEN = IEN in the Option file
+3 ;Return = access ^ menu tree IEN ^ a set of codes ^ key
+4 NEW XQPM,XQDIC,XQTL,XQRT
+5 SET XQPM=$PIECE($GET(^VA(200,XQUSR,201)),"^")
+6 IF 'XQPM
QUIT "N"
+7 ; check Lock on the Primary menu
+8 SET XQRT=$$KEYSTOP(XQIEN,XQUSR)
+9 IF XQRT'="OK"
QUIT "0^"_XQPM_"^"_XQRT
+10 ;
+11 SET XQDIC="P"_XQPM
+12 IF '$DATA(^XUTL("XQO",XQDIC,"^",XQIEN))
QUIT ""
+13 SET XQTL=$PIECE($GET(^XUTL("XQO",XQDIC,"^",XQIEN)),"^",2,99)
+14 IF XQTL=""
QUIT ""
+15 SET XQRT=$$KEYS(XQTL,XQUSR)
+16 IF XQRT="OK"
QUIT "1^"_XQPM
+17 QUIT "0^"_XQPM_"^"_XQRT
+18 ;
CKCM(XQUSR,XQIEN) ;
+1 ;Look in the user's primary menu tree
+2 ;take in XQUSR = IEN in New Person file; XQIEN = IEN in the Option file
+3 ;Return = access ^ menu tree IEN ^ a set of codes ^ key
+4 NEW XQTL,XQDIC,XQCOM,XQRT
+5 SET XQCOM=$ORDER(^DIC(19,"B","XUCOMMAND",0))
+6 SET XQDIC="PXU"
+7 IF '$DATA(^XUTL("XQO",XQDIC,"^",XQIEN))
QUIT "N"
+8 SET XQTL=$PIECE($GET(^XUTL("XQO",XQDIC,"^",%XQOP)),"^",2,99)
+9 IF XQTL=""
QUIT ""
+10 SET XQRT=$$KEYS(XQTL,XQUSR)
+11 IF XQRT="OK"
QUIT "2^"_"^^^"_XQCOM
+12 QUIT "0^"_"^"_XQRT_"^"_XQCOM
+13 ;
CKTSM(XQUSR,XQIEN) ;
+1 ;Look in the user's primary menu tree
+2 ;take in XQUSR = IEN in New Person file; XQIEN = IEN in the Option file
+3 ;Return = access ^ menu tree IEN ^ a set of codes ^ key
+4 NEW XQDIC,XQRT,XQTL
+5 SET XQDIC="U"_XQUSR
+6 IF '$DATA(^VA(200,XQUSR,203,"B",XQIEN))
QUIT "N"
+7 SET XQTL=$PIECE($GET(^XUTL("XQO",XQDIC,"^",XQIEN)),"^",2,99)
+8 IF XQTL=""
QUIT ""
+9 SET XQRT=$$KEYS(XQTL,XQUSR)
+10 IF XQRT="OK"
QUIT "3^"_XQIEN
+11 QUIT "0^"_XQIEN_"^"_XQRT
+12 ;
CKTESM(XQUSR,XQIEN) ;
+1 ;Look in the user's primary menu tree
+2 ;take in XQUSR = IEN in New Person file; XQIEN = IEN in the Option file
+3 ;Return = access ^ menu tree IEN ^ a set of codes ^ key
+4 NEW XQI,XQY,XQRT,XQDIC,XQTL
SET XQI=0
SET XQRT=""
SET XQY=""
+5 FOR
SET XQI=$ORDER(^VA(200,XQUSR,203,"B",XQI))
IF XQI'>0
QUIT
Begin DoDot:1
+6 SET XQDIC="P"_XQI
+7 SET XQTL=$GET(^XUTL("XQO",XQDIC,"^",XQIEN))
IF XQTL=""
QUIT
+8 SET XQTL=$PIECE(XQTL,"^",2,99)
IF XQTL=""
QUIT
+9 SET XQRT=$$KEYSTOP(XQI,XQUSR)
+10 IF XQRT="OK"
SET XQRT=$$KEYS(XQTL,XQUSR)
+11 SET XQY=XQI
+12 IF XQRT="OK"
SET XQI="ZZZ"
QUIT
End DoDot:1
+13 IF XQRT="OK"
QUIT "4^"_XQY
+14 IF XQRT=""
QUIT XQRT
+15 QUIT "0^"_XQY_"^"_XQRT
+16 ;
KEYS(XQA,XQUSR) ;Check for keys, reverse keys...
+1 ;XQA = ^XUTL("XQO",XQDIC,"^",%XQOP) or U_^DIC(19,%XQOP,0)
+2 ;XQUSR = IEN user in the New Person #200 file
+3 ;Return XQRT = Null or Lock/ReLock if found
+4 ;
+5 NEW XQL,XQRL,XQRT
SET XQRT="OK"
+6 ;check for keys
SET XQL=$$CHCKL^XQCHK2(XQA,XQUSR)
+7 IF +XQL>0
SET XQRT="L^"_$PIECE(XQL,"^",2)
+8 ;check for reverse keys
SET XQRL=$$CHCKRL^XQCHK2(XQA,XQUSR)
+9 IF +XQRL>0
SET XQRT="R^"_$PIECE(XQRL,"^",2)
+10 QUIT XQRT
+11 ;
KEYSTOP(XQIEN,XQUSR) ;check Lock and Reversed Lock on the top level menu
+1 ;;XQIEN = IEN option in the Option #19 file
+2 ;;XQUSR = IEN use in the New Person #200 file
+3 ;;Return XQRT = Null or Lock/ReLock if found
+4 NEW XQL,XQRL,XQRT
SET XQRT="OK"
+5 ;check for keys on top level
SET XQL=$$CHKTOPL^XQCHK2(XQIEN,XQUSR)
+6 IF +XQL>0
SET XQRT="L^"_$PIECE(XQL,"^",2)
+7 ;check for reverse keys on top level
SET XQRL=$$CHKTOPRL^XQCHK2(XQIEN,XQUSR)
+8 IF +XQRL>0
SET XQRT="R^"_$PIECE(XQRL,"^",2)
+9 QUIT XQRT
+10 ;
PRINT(XQANS) ; print out the result
+1 NEW XQRSLT,XQTREE,XQPTR,XQCODES,XQKEY
+2 SET XQRSLT=+XQANS
SET XQTREE=""
+3 SET XQPTR=$PIECE(XQANS,U,2)
+4 IF XQPTR>0
SET XQTREE=$PIECE(^DIC(19,$PIECE(XQANS,U,2),0),U)
+5 SET XQCODES=$PIECE(XQANS,U,3)
SET XQKEY=$PIECE(XQANS,U,4)
+6 ;-------------------------------------------------------------------------------
+7 IF XQRSLT=-1
WRITE !!?5,"User ",XQUSER," is not in the New Person File."
+8 IF XQRSLT=-2
WRITE !!?5,"User ",XQUSER," has an active termination date,",!?5,"or no verify code."
+9 IF XQRSLT=-3
WRITE !!?5,"Option ",XQOPT," is not in the Option File."
+10 IF XQRSLT=0
Begin DoDot:1
+11 WRITE !!?5,"User ",XQUSER," does not have access to the option",!?5,XQOPT,"."
+12 IF XQCODES["L"
WRITE !!?5,"There is a lock somewhere in the menu tree "_XQTREE,!?5,"and the user does not hold the key "_XQKEY_"."
+13 IF XQCODES["R"
WRITE !!?5,"There is a reverse lock somewhere in the menu tree "_XQTREE,!?5,"and the user holds the key "_XQKEY_"."
+14 QUIT
End DoDot:1
+15 IF XQRSLT=1
WRITE !!?5,"User ",XQUSER," has access to the option ",XQOPT,!?5,"through the primary menu ",XQTREE," (",$PIECE(^DIC(19,XQPTR,0),U,2),")."
+16 IF XQRSLT=2
WRITE !!?5,"User ",XQUSER," has access to the option ",XQOPT,!?5,"through the Common Options (XUCOMMAND)."
+17 IF XQRSLT=3
WRITE !!?5,"User ",XQUSER," has access to the option ",XQOPT,!?5,"as a top-level secondary menu option."
+18 IF XQRSLT=4
WRITE !!?5,"User ",XQUSER," has access to the option ",XQOPT,!?5,"through the secondary menu tree ",XQTREE," (",$PIECE(^DIC(19,XQPTR,0),U,2),")."
+19 WRITE !
+20 QUIT
+21 ;
KILLFM ;Kill off the FileMan variables
+1 KILL D0,DI,DIC,DIE,DISYS,DQ,DR,DUOUT,DTOUT,X,Y
+2 QUIT
