Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XQCHK3

XQCHK3.m

Go to the documentation of this file.
  1. XQCHK3 ; OAK-BY/BDT - This routine for XQCHK; 5/20/08
  1. ;;8.0;KERNEL;**503**;Jul 10, 1995;Build 2
  1. ;;"Per VHA Directive 2004-038, this routine should not be modified".
  1. ;
  1. Q
  1. 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.
  1. N DIC,X,Y,XQANS,XQOPN,XQUSER,XQUSN,XQOPT
  1. ;get user
  1. S DIC(0)="AEMNQ",DIC="^VA(200,",DIC("A")="Please enter the user's name: " D ^DIC
  1. I $D(DUOUT)!($D(DTOUT)) D KILLFM Q
  1. I Y=-1 W !!?5,"Sorry we couldn't find that user in the New Person File.",! D KILLFM Q
  1. S XQUSN=+Y,XQUSER=$P(Y,U,2) D KILLFM
  1. ;get option
  1. S DIC(0)="AEMNQ",DIC="^DIC(19,",DIC("A")="Please enter the name of the option: " D ^DIC
  1. I $D(DUOUT)!($D(DTOUT)) D KILLFM Q
  1. I Y=-1 W !!?5,"Sorry we couldn't find that option.",! D KILLFM Q
  1. S XQOPN=+Y,XQOPT=$P(Y,U,2) D KILLFM
  1. ;check keys
  1. S XQANS=$$ACCESS(XQUSN,XQOPN)
  1. ;print out
  1. D PRINT(XQANS)
  1. Q
  1. ;
  1. ACCESS(%XQUSR,%XQOP) ;Find out if a user has access to a particular option
  1. ;;W $$ACCESS(DUZ,Option IEN) returns:
  1. ;;
  1. ;;-1:no such user in the New Person File
  1. ;;-2: User terminated or has no access code
  1. ;;-3: no such option in the Option File
  1. ;;0: no access found in any menu tree the user owns
  1. ;;
  1. ;;All other cases return a 4-piece string stating
  1. ;;access ^ menu tree IEN ^ a set of codes ^ key
  1. ;;
  1. ;;O^tree^codes^key: No access because of locks (see XQCODES below)
  1. ;;where 'tree' is the menu where access WOULD be allowed
  1. ;;and 'key' is the key preventing access
  1. ;;
  1. ;;1^OpIEN^^: Access allowed through Primary Menu
  1. ;;2^OpIEN^codes^: Access found in the Common Options
  1. ;;3^OpIEN^codes^: Access found in top level of secondary option
  1. ;;4^OpIEN^codes^: Access through a the secondary menu tree OpIEN.
  1. ;;
  1. ;;XQCODES can contain:
  1. ;;N=No Primary Menu in the User File (warning only)
  1. ;;L=Locked and the user does not have the key (forces 0 in first piece)
  1. ;;R=Reverse lock and user has the key (forces 0 in first piece)
  1. ;
  1. N XQUSR,U S U="^"
  1. S XQUSR=$$ACTIVE^XUSER(%XQUSR)
  1. I XQUSR="" Q -1
  1. I +XQUSR=0 Q -2
  1. ;
  1. ;Convert %XQOP to its IEN if the name is passed
  1. I %XQOP'=+$G(%XQOP) D
  1. .I $D(^DIC(19,"B",%XQOP))<1 S %XQOP=0 Q
  1. .E S %XQOP=$O(^DIC(19,"B",%XQOP,0))
  1. .Q
  1. I '%XQOP Q -3
  1. I '$D(^DIC(19,%XQOP,0)) Q -3
  1. ;checking
  1. N XQRT,XQRT1 S XQRT="",XQRT1=""
  1. S XQRT=$$CKPM(%XQUSR,%XQOP) ;primary menu and sub-menu in the primary menu
  1. I $P(XQRT,U)=1 Q XQRT
  1. I $P(XQRT,U)="N" Q XQRT
  1. S XQRT1=XQRT
  1. S XQRT=$$CKCM(%XQUSR,%XQOP) ;common menu
  1. I $P(XQRT,U)=2 Q XQRT
  1. I $P(XQRT,U)=0 S XQRT1=XQRT
  1. S XQRT=$$CKTSM(%XQUSR,%XQOP) ;top level of secondary menus
  1. I $P(XQRT,U)=3 Q XQRT
  1. I $P(XQRT,U)=0 S XQRT1=XQRT
  1. S XQRT=$$CKTESM(%XQUSR,%XQOP) ;sub-menu in secondary menus
  1. I $P(XQRT,U)=4 Q XQRT
  1. I $P(XQRT,U)=0 S XQRT1=XQRT
  1. I XQRT1="" S XQRT1=0
  1. Q XQRT1
  1. ;
  1. CKPM(XQUSR,XQIEN) ;
  1. ;Look in the user's primary menu tree
  1. ;take in XQUSR = IEN in New Person file; XQIEN = IEN in the Option file
  1. ;Return = access ^ menu tree IEN ^ a set of codes ^ key
  1. N XQPM,XQDIC,XQTL,XQRT
  1. S XQPM=$P($G(^VA(200,XQUSR,201)),"^")
  1. I 'XQPM Q "N"
  1. ; check Lock on the Primary menu
  1. S XQRT=$$KEYSTOP(XQIEN,XQUSR)
  1. I XQRT'="OK" Q "0^"_XQPM_"^"_XQRT
  1. ;
  1. S XQDIC="P"_XQPM
  1. I '$D(^XUTL("XQO",XQDIC,"^",XQIEN)) Q ""
  1. S XQTL=$P($G(^XUTL("XQO",XQDIC,"^",XQIEN)),"^",2,99)
  1. I XQTL="" Q ""
  1. S XQRT=$$KEYS(XQTL,XQUSR)
  1. I XQRT="OK" Q "1^"_XQPM
  1. Q "0^"_XQPM_"^"_XQRT
  1. ;
  1. CKCM(XQUSR,XQIEN) ;
  1. ;Look in the user's primary menu tree
  1. ;take in XQUSR = IEN in New Person file; XQIEN = IEN in the Option file
  1. ;Return = access ^ menu tree IEN ^ a set of codes ^ key
  1. N XQTL,XQDIC,XQCOM,XQRT
  1. S XQCOM=$O(^DIC(19,"B","XUCOMMAND",0))
  1. S XQDIC="PXU"
  1. I '$D(^XUTL("XQO",XQDIC,"^",XQIEN)) Q "N"
  1. S XQTL=$P($G(^XUTL("XQO",XQDIC,"^",%XQOP)),"^",2,99)
  1. I XQTL="" Q ""
  1. S XQRT=$$KEYS(XQTL,XQUSR)
  1. I XQRT="OK" Q "2^"_"^^^"_XQCOM
  1. Q "0^"_"^"_XQRT_"^"_XQCOM
  1. ;
  1. CKTSM(XQUSR,XQIEN) ;
  1. ;Look in the user's primary menu tree
  1. ;take in XQUSR = IEN in New Person file; XQIEN = IEN in the Option file
  1. ;Return = access ^ menu tree IEN ^ a set of codes ^ key
  1. N XQDIC,XQRT,XQTL
  1. S XQDIC="U"_XQUSR
  1. I '$D(^VA(200,XQUSR,203,"B",XQIEN)) Q "N"
  1. S XQTL=$P($G(^XUTL("XQO",XQDIC,"^",XQIEN)),"^",2,99)
  1. I XQTL="" Q ""
  1. S XQRT=$$KEYS(XQTL,XQUSR)
  1. I XQRT="OK" Q "3^"_XQIEN
  1. Q "0^"_XQIEN_"^"_XQRT
  1. ;
  1. CKTESM(XQUSR,XQIEN) ;
  1. ;Look in the user's primary menu tree
  1. ;take in XQUSR = IEN in New Person file; XQIEN = IEN in the Option file
  1. ;Return = access ^ menu tree IEN ^ a set of codes ^ key
  1. N XQI,XQY,XQRT,XQDIC,XQTL S XQI=0,XQRT="",XQY=""
  1. F S XQI=$O(^VA(200,XQUSR,203,"B",XQI)) Q:XQI'>0 D
  1. .S XQDIC="P"_XQI
  1. .S XQTL=$G(^XUTL("XQO",XQDIC,"^",XQIEN)) I XQTL="" Q
  1. .S XQTL=$P(XQTL,"^",2,99) I XQTL="" Q
  1. .S XQRT=$$KEYSTOP(XQI,XQUSR)
  1. .I XQRT="OK" S XQRT=$$KEYS(XQTL,XQUSR)
  1. .S XQY=XQI
  1. .I XQRT="OK" S XQI="ZZZ" Q
  1. I XQRT="OK" Q "4^"_XQY
  1. I XQRT="" Q XQRT
  1. Q "0^"_XQY_"^"_XQRT
  1. ;
  1. KEYS(XQA,XQUSR) ;Check for keys, reverse keys...
  1. ;XQA = ^XUTL("XQO",XQDIC,"^",%XQOP) or U_^DIC(19,%XQOP,0)
  1. ;XQUSR = IEN user in the New Person #200 file
  1. ;Return XQRT = Null or Lock/ReLock if found
  1. ;
  1. N XQL,XQRL,XQRT S XQRT="OK"
  1. S XQL=$$CHCKL^XQCHK2(XQA,XQUSR) ;check for keys
  1. I +XQL>0 S XQRT="L^"_$P(XQL,"^",2)
  1. S XQRL=$$CHCKRL^XQCHK2(XQA,XQUSR) ;check for reverse keys
  1. I +XQRL>0 S XQRT="R^"_$P(XQRL,"^",2)
  1. Q XQRT
  1. ;
  1. KEYSTOP(XQIEN,XQUSR) ;check Lock and Reversed Lock on the top level menu
  1. ;;XQIEN = IEN option in the Option #19 file
  1. ;;XQUSR = IEN use in the New Person #200 file
  1. ;;Return XQRT = Null or Lock/ReLock if found
  1. N XQL,XQRL,XQRT S XQRT="OK"
  1. S XQL=$$CHKTOPL^XQCHK2(XQIEN,XQUSR) ;check for keys on top level
  1. I +XQL>0 S XQRT="L^"_$P(XQL,"^",2)
  1. S XQRL=$$CHKTOPRL^XQCHK2(XQIEN,XQUSR) ;check for reverse keys on top level
  1. I +XQRL>0 S XQRT="R^"_$P(XQRL,"^",2)
  1. Q XQRT
  1. ;
  1. PRINT(XQANS) ; print out the result
  1. N XQRSLT,XQTREE,XQPTR,XQCODES,XQKEY
  1. S XQRSLT=+XQANS,XQTREE=""
  1. S XQPTR=$P(XQANS,U,2)
  1. I XQPTR>0 S XQTREE=$P(^DIC(19,$P(XQANS,U,2),0),U)
  1. S XQCODES=$P(XQANS,U,3),XQKEY=$P(XQANS,U,4)
  1. ;-------------------------------------------------------------------------------
  1. I XQRSLT=-1 W !!?5,"User ",XQUSER," is not in the New Person File."
  1. I XQRSLT=-2 W !!?5,"User ",XQUSER," has an active termination date,",!?5,"or no verify code."
  1. I XQRSLT=-3 W !!?5,"Option ",XQOPT," is not in the Option File."
  1. I XQRSLT=0 D
  1. .W !!?5,"User ",XQUSER," does not have access to the option",!?5,XQOPT,"."
  1. .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_"."
  1. .I XQCODES["R" W !!?5,"There is a reverse lock somewhere in the menu tree "_XQTREE,!?5,"and the user holds the key "_XQKEY_"."
  1. .Q
  1. 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),")."
  1. I XQRSLT=2 W !!?5,"User ",XQUSER," has access to the option ",XQOPT,!?5,"through the Common Options (XUCOMMAND)."
  1. I XQRSLT=3 W !!?5,"User ",XQUSER," has access to the option ",XQOPT,!?5,"as a top-level secondary menu option."
  1. 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),")."
  1. W !
  1. Q
  1. ;
  1. KILLFM ;Kill off the FileMan variables
  1. K D0,DI,DIC,DIE,DISYS,DQ,DR,DUOUT,DTOUT,X,Y
  1. Q