source: WorldVistAEHR/trunk/r/RPC_BROKER-XWB/XWBLIB.m@ 701

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

initial load of WorldVistAEHR

File size: 3.3 KB
Line 
1XWBLIB ;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 ;
5BROKER() ;EF. Running under the Broker or Vlink
6 Q $D(XWBOS)!$D(XOBDATA)
7 ;
8RTRNFMT(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 ;
19VARVAL(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 ;
24IMHERE(RESULT) ;P6
25 ;Entry point for XWB IM HERE remote procedure
26 S RESULT=1
27 Q
28 ;
29BRKRINFO(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 ;
35CKRPC(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 ;
47CKRPCS(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 ;
65RPCIEN(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 ;
71RPCAVAIL(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 ;
87CKVERNUM(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 ;
96VARLST ;;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
Note: See TracBrowser for help on using the repository browser.