| 1 | XWBLIB ;SFISC/VYD - Various remote procedure library ;06/16/2004 17:53
|
|---|
| 2 | ;;1.1;RPC BROKER;**6,10,26,35**;Mar 28, 1997
|
|---|
| 3 | Q
|
|---|
| 4 | ;
|
|---|
| 5 | BROKER() ;EF. Running under the Broker or Vlink
|
|---|
| 6 | Q $D(XWBOS)!$D(XOBDATA)
|
|---|
| 7 | ;
|
|---|
| 8 | RTRNFMT(X,WRAP) ;EF. set the RPC return type and wrap flag
|
|---|
| 9 | N Y
|
|---|
| 10 | S:$D(WRAP) XWBWRAP=+WRAP
|
|---|
| 11 | S X=$G(X)
|
|---|
| 12 | IF X=+X,X>0,X<6 S XWBPTYPE=X Q X
|
|---|
| 13 | S X=$$UP^XLFSTR(X)
|
|---|
| 14 | S X=$S(X="SINGLE VALUE":1,X="ARRAY":2,X="WORD PROCESSING":3,X="GLOBAL ARRAY":4,X="GLOBAL INSTANCE":5,1:0)
|
|---|
| 15 | IF X=0 Q 0
|
|---|
| 16 | S XWBPTYPE=X
|
|---|
| 17 | Q X
|
|---|
| 18 | ;
|
|---|
| 19 | VARVAL(RESULT,VARIABLE) ;returns value of passed in variable
|
|---|
| 20 | S RESULT=VARIABLE ;can do this with the REFERENCE type parameter
|
|---|
| 21 | Q
|
|---|
| 22 | ;See GETV^XWBBRK for how we get the REFERENCE type parameter
|
|---|
| 23 | ;
|
|---|
| 24 | IMHERE(RESULT) ;P6
|
|---|
| 25 | ;Entry point for XWB IM HERE remote procedure
|
|---|
| 26 | S RESULT=1
|
|---|
| 27 | Q
|
|---|
| 28 | ;
|
|---|
| 29 | BRKRINFO(RESULT) ;P6
|
|---|
| 30 | ;Entry point for XWB GET BROKER INFO RPC.
|
|---|
| 31 | ;R(0) = Length of handler read timeout
|
|---|
| 32 | S RESULT(0)=$$BAT^XUPARAM
|
|---|
| 33 | Q
|
|---|
| 34 | ;
|
|---|
| 35 | CKRPC(RESULT,RPCNAME,RPCUSE,VERNUM) ;P10
|
|---|
| 36 | ;Entry point for "XWB IS RPC AVIALABLE" RPC.
|
|---|
| 37 | ;RPCUSE("L" or "R") and VERNUM are optional.
|
|---|
| 38 | ;Checks if RPC exists and if INACTIVE flag is set for specified use.
|
|---|
| 39 | ;Also checks version number if passed.
|
|---|
| 40 | ;Result = 1 for can be run; 0 for can't be run.
|
|---|
| 41 | N RPCIEN
|
|---|
| 42 | S RESULT=0
|
|---|
| 43 | S RPCIEN=$$RPCIEN($G(RPCNAME))
|
|---|
| 44 | I RPCIEN,$$RPCAVAIL(RPCIEN,$G(RPCUSE),$G(VERNUM)) S RESULT=1
|
|---|
| 45 | Q
|
|---|
| 46 | ;
|
|---|
| 47 | CKRPCS(RESULT,RPCUSE,RPC) ;P10
|
|---|
| 48 | ;Entry point for "XWB ARE RPCS AVIALABLE" RPC.
|
|---|
| 49 | ;RPCUSE("L" or "R") and VERNUM are optional.
|
|---|
| 50 | ;RPC() array has format RPCName^RPCVersionNumber.
|
|---|
| 51 | ;Checks if RPC exists and version number (if not null).
|
|---|
| 52 | ;Check INACTIVE flag if set for specified use.
|
|---|
| 53 | ;Result(I) = 1 for can be run; 0 for can't be run.
|
|---|
| 54 | N I
|
|---|
| 55 | S I=""
|
|---|
| 56 | F S I=$O(RPC(I)) Q:I="" D
|
|---|
| 57 | . N RPCNAME,VERNUM,RPCIEN
|
|---|
| 58 | . S RESULT(I)=0
|
|---|
| 59 | . S RPCNAME=$P(RPC(I),U)
|
|---|
| 60 | . S VERNUM=$P(RPC(I),U,2)
|
|---|
| 61 | . S RPCIEN=$$RPCIEN($G(RPCNAME))
|
|---|
| 62 | . I RPCIEN,$$RPCAVAIL(RPCIEN,$G(RPCUSE),$G(VERNUM)) S RESULT(I)=1
|
|---|
| 63 | Q
|
|---|
| 64 | ;
|
|---|
| 65 | RPCIEN(RPCNAME) ;P10
|
|---|
| 66 | ;Function that returns IEN of RPC based on name.
|
|---|
| 67 | ;Returns 0 if RPC does not exist.
|
|---|
| 68 | I RPCNAME="" Q 0
|
|---|
| 69 | Q +$O(^XWB(8994,"B",RPCNAME,0))
|
|---|
| 70 | ;
|
|---|
| 71 | RPCAVAIL(RPCIEN,RPCUSE,VERNUM) ;P10
|
|---|
| 72 | ;Boolean function, identifies if RPC is active and correct version.
|
|---|
| 73 | ;RPCUSE (optional) = L check local use; R check remote use.
|
|---|
| 74 | ;VERNUM (optional) only checked for remote RPCs.
|
|---|
| 75 | N RPC0,INACT
|
|---|
| 76 | S RPC0=$G(^XWB(8994,+RPCIEN,0))
|
|---|
| 77 | Q:RPC0="" 0
|
|---|
| 78 | S INACT=+$P(RPC0,U,6)
|
|---|
| 79 | I INACT=1 Q 0 ;RPC marked inactive.
|
|---|
| 80 | S RPCUSE=$G(RPCUSE)
|
|---|
| 81 | I RPCUSE="" Q 1 ;Local and remote check not needed.
|
|---|
| 82 | I RPCUSE="L",INACT=2 Q 0 ;Local use, RPC is remote only.
|
|---|
| 83 | I RPCUSE="R",INACT=3 Q 0 ;Remote use, RPC is local only.
|
|---|
| 84 | I RPCUSE="R",+$G(VERNUM),'$$CKVERNUM(VERNUM,+$P(RPC0,U,9)) Q 0 ;Failed version # check.
|
|---|
| 85 | Q 1 ;Must be ok.
|
|---|
| 86 | ;
|
|---|
| 87 | CKVERNUM(VERNUM,RPCVER,RPCIEN) ;P10
|
|---|
| 88 | ;Boolean function. Returns 1 if RPC verion is > or = version number to be checked.
|
|---|
| 89 | ;VERNUM = version number passed in (i.e., from client ap) to be checked.
|
|---|
| 90 | ;RPCVER = version number in Remote Procedure file. (optional)
|
|---|
| 91 | ;RPCIEN of RPC being checked. Needed if RPCVER not sent.
|
|---|
| 92 | I +$G(RPCIEN),'+$G(RPCVER) S RPCVER=$P($G(^XWB(8994,RPCIEN,0)),U,9)
|
|---|
| 93 | I +RPCVER<+VERNUM Q 0
|
|---|
| 94 | Q 1
|
|---|
| 95 | ;
|
|---|
| 96 | VARLST ;;XWB,XWBAPVER,XWBCLMAN,XWBNULL,XWBODEV,XWBOS,XWBP,XWBPTYPE,XWBR,XWBSEC,XWBSTATE,XWBTBUF,XWBTDEV,XWBTIME,XWBTIP,XWBTOS,XWBTSKT,XWBVER,XWBWRAP,XWBY,DEBUG,XWBSHARE,XWBDEBUG,XWBT
|
|---|
| 97 | ;P10. Variable for exclusive NEW in KILL^XUSCLEAN
|
|---|
| 98 | ;P26. Added XWBSHARE
|
|---|
| 99 | ;P35. Added XWBDEBUG,XWBT
|
|---|
