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

XWBSEC.m

Go to the documentation of this file.
  1. XWBSEC ;ISF/VYD,ISD/HGW - RPC BROKER ; 7/21/16 4:34pm
  1. ;;1.1;RPC BROKER;**3,6,10,35,53,64**;Mar 28, 1997;Build 0
  1. ;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. CHKPRMIT(XWBRP) ;checks to see if remote procedure is permitted to run
  1. ;Input: XWBRP - Remote procedure to check
  1. ;Output: XWBSEC - Error message if RPC cannot be run
  1. ; ZEXCEPT: XQY0,XWBSEC - Kernel exemption for global variables
  1. N ERR,XWBPRMIT,XWBALLOW
  1. S U="^",XWBSEC="" ;Return XWBSEC="" if OK to run RPC
  1. Q:$$KCHK^XUSRB("XUPROGMODE")
  1. ;
  1. ;In the beginning, when no DUZ is defined and no context exist, setup
  1. ;default signon context
  1. S:'$G(DUZ) DUZ=0,XQY0="XUS SIGNON" ;set up default context
  1. ;
  1. ;These RPC's are allowed in any context, so we can just quit
  1. I "^XWB IM HERE^XWB CREATE CONTEXT^XWB RPC LIST^XWB IS RPC AVAILABLE^XUS GET USER INFO^XUS GET TOKEN^XUS SET VISITOR^"[(U_XWBRP_U) Q ;p53
  1. I "^XUS IAM BIND USER^XUS CVC^XUS KEY CHECK^XUS BSE TOKEN^"[(U_XWBRP_U) Q ;p64
  1. ;VistAlink RPC's that are always allowed.
  1. I "^XUS KAAJEE GET USER INFO^XUS KAAJEE LOGOUT^"[(U_XWBRP_U) Q
  1. ;
  1. ;If in Signon context, only allow XUS and XWB rpc's
  1. I $G(XQY0)="XUS SIGNON","^XUS^XWB^"'[(U_$E(XWBRP,1,3)_U) S XWBSEC="Application context has not been created!" Q
  1. ;XQCS allows all users access to the XUS SIGNON context.
  1. ;Also to any context in the XUCOMMAND menu.
  1. ;
  1. I $G(XQY0)'="" D ;1.1*6. XQY0="" after XUS SIGNON context deleted.
  1. . S XWBALLOW=$$CHK^XQCS(DUZ,$P(XQY0,U),XWBRP) ;do the check
  1. . I 'XWBALLOW S XWBSEC=XWBALLOW ;no access to RPC
  1. E S XWBSEC="Application context has not been created!"
  1. Q
  1. ;
  1. CRCONTXT(RESULT,OPTION,APPLCODE) ;creates context for the passed in option
  1. ; ZEXCEPT: XQY,XQY0,XWBSEC - Kernel exemption for global variables
  1. K XQY0,XQY
  1. N XWB1,XWB2,XABPGMOD,XWBPGMOD,XWBCODE
  1. S RESULT=0
  1. I $D(APPLCODE) D ;Assign an optional secondary menu option for user (SSOi, SSOe)
  1. . S XWBCODE=$$AESDECR^XUSHSH($$B64DECD^XUSHSH(APPLCODE),"tHiZZfnmYjkFinis")
  1. . S XWB2=$$SETCNTXT^XUESSO2(DUZ,XWBCODE)
  1. S OPTION=$$DECRYP^XUSRB1(OPTION)
  1. I OPTION="" S XQY=0,XQY0="",RESULT=1 Q ;delete context if "" passed in.
  1. S XWB1=$$OPTLK^XQCS(OPTION)
  1. I XWB1="" S (XWBSEC,RESULT)="The context '"_OPTION_"' does not exist on server." Q ;P10
  1. ;Check Access (User with XUPROGMODE security key always has access)
  1. S RESULT=$$CHK^XQCS(DUZ,XWB1)
  1. S XWBPGMOD=$$KCHK^XUSRB("XUPROGMODE")
  1. I RESULT!XWBPGMOD S XQY0=OPTION,XQY=XWB1,RESULT=1
  1. E S XWBSEC=RESULT
  1. Q
  1. ;
  1. STATE(%) ;Return a state value
  1. ; ZEXCEPT: XWBSTATE - Kernel exemption for global variable
  1. Q:'$L($G(%)) $G(XWBSTATE)
  1. Q $G(XWBSTATE(%))
  1. ;
  1. SET(%,VALUE) ;Set the state variable
  1. ; ZEXCEPT: XWBSTATE - Kernel exemption for global variable
  1. I $G(%)="" S XWBSTATE=VALUE
  1. S XWBSTATE(%)=VALUE
  1. Q
  1. ;
  1. KILL(%) ;Kill state variable
  1. ; ZEXCEPT: XWBSTATE - Kernel exemption for global variable
  1. I $L($G(%)) K XWBSTATE(%)
  1. Q