| 1 | XWBSEC ;SFISC/VYD - RPC BROKER ;09/23/2004 13:01
|
|---|
| 2 | ;;1.1;RPC BROKER;**3,6,10,35**;Mar 28, 1997
|
|---|
| 3 | CHKPRMIT(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 | ;
|
|---|
| 30 | CRCONTXT(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 | ;
|
|---|
| 44 | STATE(%) ;Return a state value
|
|---|
| 45 | Q:'$L($G(%)) $G(XWBSTATE)
|
|---|
| 46 | Q $G(XWBSTATE(%))
|
|---|
| 47 | ;
|
|---|
| 48 | ;
|
|---|
| 49 | SET(%,VALUE) ;Set the state variable
|
|---|
| 50 | I $G(%)="" S XWBSTATE=VALUE
|
|---|
| 51 | S XWBSTATE(%)=VALUE
|
|---|
| 52 | Q
|
|---|
| 53 | KILL(%) ;Kill state variable
|
|---|
| 54 | I $L($G(%)) K XWBSTATE(%)
|
|---|
| 55 | Q
|
|---|
