source: WorldVistAEHR/trunk/r/RPC_BROKER-XWB/XWBSEC.m@ 1766

Last change on this file since 1766 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.0 KB
Line 
1XWBSEC ;SFISC/VYD - RPC BROKER ;09/23/2004 13:01
2 ;;1.1;RPC BROKER;**3,6,10,35**;Mar 28, 1997
3CHKPRMIT(XWBRP) ;checks to see if remote procedure is permited to run
4 ;Input: XWBRP - Remote procedure to check
5 Q:$$KCHK^XUSRB("XUPROGMODE")
6 N ERR,XWBPRMIT,XWBALLOW
7 S U="^",XWBSEC="" ;Return XWBSEC="" if OK to run RPC
8 ;
9 ;In the beginning, when no DUZ is defined and no context exist, setup
10 ;default signon context
11 S:'$G(DUZ) DUZ=0,XQY0="XUS SIGNON" ;set up default context
12 ;
13 ;These RPC's are allowed in any context, so we can just quit
14 I "^XWB IM HERE^XWB CREATE CONTEXT^XWB RPC LIST^XWB IS RPC AVAILABLE^XUS GET USER INFO^XUS GET TOKEN^"[(U_XWBRP_U) Q
15 ;VistAlink RPC's that are always allowed.
16 I "^XUS KAAJEE GET USER INFO^XUS KAAJEE LOGOUT^"[(U_XWBRP_U) Q
17 ;
18 ;If in Signon context, only allow XUS and XWB rpc's
19 I $G(XQY0)="XUS SIGNON","^XUS^XWB^"'[(U_$E(XWBRP,1,3)_U) S XWBSEC="Application context has not been created!" Q
20 ;XQCS allows all users access to the XUS SIGNON context.
21 ;Also to any context in the XUCOMMAND menu.
22 ;
23 I $G(XQY0)'="" D ;1.1*6. XQY0="" after XUS SIGNON context deleted.
24 . S XWBALLOW=$$CHK^XQCS(DUZ,$P(XQY0,U),XWBRP) ;do the check
25 . S:'XWBALLOW XWBSEC=XWBALLOW
26 E S XWBSEC="Application context has not been created!"
27 Q
28 ;
29 ;
30CRCONTXT(RESULT,OPTION) ;creates context for the passed in option
31 K XQY0,XQY N XWB1,XABPGMOD,XWBPGMOD S RESULT=0
32 S OPTION=$$DECRYP^XUSRB1(OPTION) ;S:OPTION="" OPTION="\"
33 I OPTION="" S XQY=0,XQY0="",RESULT=1 Q ;delete context if "" passed in.
34 S XWB1=$$OPTLK^XQCS(OPTION)
35 I XWB1="" S (XWBSEC,RESULT)="The context '"_OPTION_"' does not exist on server." Q ;P10
36 S RESULT=$$CHK^XQCS(DUZ,XWB1)
37 ;Access or programmer
38 S XWBPGMOD=$$KCHK^XUSRB("XUPROGMODE")
39 I RESULT!XWBPGMOD S XQY0=OPTION,XQY=XWB1,RESULT=1
40 E S XWBSEC=RESULT
41 Q
42 ;
43 ;
44STATE(%) ;Return a state value
45 Q:'$L($G(%)) $G(XWBSTATE)
46 Q $G(XWBSTATE(%))
47 ;
48 ;
49SET(%,VALUE) ;Set the state variable
50 I $G(%)="" S XWBSTATE=VALUE
51 S XWBSTATE(%)=VALUE
52 Q
53KILL(%) ;Kill state variable
54 I $L($G(%)) K XWBSTATE(%)
55 Q
Note: See TracBrowser for help on using the repository browser.