XWBLIB ;SFISC/VYD - Various remote procedure library ;06/16/2004 17:53
;;1.1;RPC BROKER;**6,10,26,35**;Mar 28, 1997
Q
;
BROKER() ;EF. Running under the Broker or Vlink
Q $D(XWBOS)!$D(XOBDATA)
;
RTRNFMT(X,WRAP) ;EF. set the RPC return type and wrap flag
N Y
S:$D(WRAP) XWBWRAP=+WRAP
S X=$G(X)
IF X=+X,X>0,X<6 S XWBPTYPE=X Q X
S X=$$UP^XLFSTR(X)
S X=$S(X="SINGLE VALUE":1,X="ARRAY":2,X="WORD PROCESSING":3,X="GLOBAL ARRAY":4,X="GLOBAL INSTANCE":5,1:0)
IF X=0 Q 0
S XWBPTYPE=X
Q X
;
VARVAL(RESULT,VARIABLE) ;returns value of passed in variable
S RESULT=VARIABLE ;can do this with the REFERENCE type parameter
Q
;See GETV^XWBBRK for how we get the REFERENCE type parameter
;
IMHERE(RESULT) ;P6
;Entry point for XWB IM HERE remote procedure
S RESULT=1
Q
;
BRKRINFO(RESULT) ;P6
;Entry point for XWB GET BROKER INFO RPC.
;R(0) = Length of handler read timeout
S RESULT(0)=$$BAT^XUPARAM
Q
;
CKRPC(RESULT,RPCNAME,RPCUSE,VERNUM) ;P10
;Entry point for "XWB IS RPC AVIALABLE" RPC.
;RPCUSE("L" or "R") and VERNUM are optional.
;Checks if RPC exists and if INACTIVE flag is set for specified use.
;Also checks version number if passed.
;Result = 1 for can be run; 0 for can't be run.
N RPCIEN
S RESULT=0
S RPCIEN=$$RPCIEN($G(RPCNAME))
I RPCIEN,$$RPCAVAIL(RPCIEN,$G(RPCUSE),$G(VERNUM)) S RESULT=1
Q
;
CKRPCS(RESULT,RPCUSE,RPC) ;P10
;Entry point for "XWB ARE RPCS AVIALABLE" RPC.
;RPCUSE("L" or "R") and VERNUM are optional.
;RPC() array has format RPCName^RPCVersionNumber.
;Checks if RPC exists and version number (if not null).
;Check INACTIVE flag if set for specified use.
;Result(I) = 1 for can be run; 0 for can't be run.
N I
S I=""
F S I=$O(RPC(I)) Q:I="" D
. N RPCNAME,VERNUM,RPCIEN
. S RESULT(I)=0
. S RPCNAME=$P(RPC(I),U)
. S VERNUM=$P(RPC(I),U,2)
. S RPCIEN=$$RPCIEN($G(RPCNAME))
. I RPCIEN,$$RPCAVAIL(RPCIEN,$G(RPCUSE),$G(VERNUM)) S RESULT(I)=1
Q
;
RPCIEN(RPCNAME) ;P10
;Function that returns IEN of RPC based on name.
;Returns 0 if RPC does not exist.
I RPCNAME="" Q 0
Q +$O(^XWB(8994,"B",RPCNAME,0))
;
RPCAVAIL(RPCIEN,RPCUSE,VERNUM) ;P10
;Boolean function, identifies if RPC is active and correct version.
;RPCUSE (optional) = L check local use; R check remote use.
;VERNUM (optional) only checked for remote RPCs.
N RPC0,INACT
S RPC0=$G(^XWB(8994,+RPCIEN,0))
Q:RPC0="" 0
S INACT=+$P(RPC0,U,6)
I INACT=1 Q 0 ;RPC marked inactive.
S RPCUSE=$G(RPCUSE)
I RPCUSE="" Q 1 ;Local and remote check not needed.
I RPCUSE="L",INACT=2 Q 0 ;Local use, RPC is remote only.
I RPCUSE="R",INACT=3 Q 0 ;Remote use, RPC is local only.
I RPCUSE="R",+$G(VERNUM),'$$CKVERNUM(VERNUM,+$P(RPC0,U,9)) Q 0 ;Failed version # check.
Q 1 ;Must be ok.
;
CKVERNUM(VERNUM,RPCVER,RPCIEN) ;P10
;Boolean function. Returns 1 if RPC verion is > or = version number to be checked.
;VERNUM = version number passed in (i.e., from client ap) to be checked.
;RPCVER = version number in Remote Procedure file. (optional)
;RPCIEN of RPC being checked. Needed if RPCVER not sent.
I +$G(RPCIEN),'+$G(RPCVER) S RPCVER=$P($G(^XWB(8994,RPCIEN,0)),U,9)
I +RPCVER<+VERNUM Q 0
Q 1
;
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
;P10. Variable for exclusive NEW in KILL^XUSCLEAN
;P26. Added XWBSHARE
;P35. Added XWBDEBUG,XWBT
XWBLIB ;SFISC/VYD - Various remote procedure library ;06/16/2004 17:53
+1 ;;1.1;RPC BROKER;**6,10,26,35**;Mar 28, 1997
+2 QUIT
+3 ;
BROKER() ;EF. Running under the Broker or Vlink
+1 QUIT $DATA(XWBOS)!$DATA(XOBDATA)
+2 ;
RTRNFMT(X,WRAP) ;EF. set the RPC return type and wrap flag
+1 NEW Y
+2 IF $DATA(WRAP)
SET XWBWRAP=+WRAP
+3 SET X=$GET(X)
+4 IF X=+X
IF X>0
IF X<6
SET XWBPTYPE=X
QUIT X
+5 SET X=$$UP^XLFSTR(X)
+6 SET X=$SELECT(X="SINGLE VALUE":1,X="ARRAY":2,X="WORD PROCESSING":3,X="GLOBAL ARRAY":4,X="GLOBAL INSTANCE":5,1:0)
+7 IF X=0
QUIT 0
+8 SET XWBPTYPE=X
+9 QUIT X
+10 ;
VARVAL(RESULT,VARIABLE) ;returns value of passed in variable
+1 ;can do this with the REFERENCE type parameter
SET RESULT=VARIABLE
+2 QUIT
+3 ;See GETV^XWBBRK for how we get the REFERENCE type parameter
+4 ;
IMHERE(RESULT) ;P6
+1 ;Entry point for XWB IM HERE remote procedure
+2 SET RESULT=1
+3 QUIT
+4 ;
BRKRINFO(RESULT) ;P6
+1 ;Entry point for XWB GET BROKER INFO RPC.
+2 ;R(0) = Length of handler read timeout
+3 SET RESULT(0)=$$BAT^XUPARAM
+4 QUIT
+5 ;
CKRPC(RESULT,RPCNAME,RPCUSE,VERNUM) ;P10
+1 ;Entry point for "XWB IS RPC AVIALABLE" RPC.
+2 ;RPCUSE("L" or "R") and VERNUM are optional.
+3 ;Checks if RPC exists and if INACTIVE flag is set for specified use.
+4 ;Also checks version number if passed.
+5 ;Result = 1 for can be run; 0 for can't be run.
+6 NEW RPCIEN
+7 SET RESULT=0
+8 SET RPCIEN=$$RPCIEN($GET(RPCNAME))
+9 IF RPCIEN
IF $$RPCAVAIL(RPCIEN,$GET(RPCUSE),$GET(VERNUM))
SET RESULT=1
+10 QUIT
+11 ;
CKRPCS(RESULT,RPCUSE,RPC) ;P10
+1 ;Entry point for "XWB ARE RPCS AVIALABLE" RPC.
+2 ;RPCUSE("L" or "R") and VERNUM are optional.
+3 ;RPC() array has format RPCName^RPCVersionNumber.
+4 ;Checks if RPC exists and version number (if not null).
+5 ;Check INACTIVE flag if set for specified use.
+6 ;Result(I) = 1 for can be run; 0 for can't be run.
+7 NEW I
+8 SET I=""
+9 FOR
SET I=$ORDER(RPC(I))
IF I=""
QUIT
Begin DoDot:1
+10 NEW RPCNAME,VERNUM,RPCIEN
+11 SET RESULT(I)=0
+12 SET RPCNAME=$PIECE(RPC(I),U)
+13 SET VERNUM=$PIECE(RPC(I),U,2)
+14 SET RPCIEN=$$RPCIEN($GET(RPCNAME))
+15 IF RPCIEN
IF $$RPCAVAIL(RPCIEN,$GET(RPCUSE),$GET(VERNUM))
SET RESULT(I)=1
End DoDot:1
+16 QUIT
+17 ;
RPCIEN(RPCNAME) ;P10
+1 ;Function that returns IEN of RPC based on name.
+2 ;Returns 0 if RPC does not exist.
+3 IF RPCNAME=""
QUIT 0
+4 QUIT +$ORDER(^XWB(8994,"B",RPCNAME,0))
+5 ;
RPCAVAIL(RPCIEN,RPCUSE,VERNUM) ;P10
+1 ;Boolean function, identifies if RPC is active and correct version.
+2 ;RPCUSE (optional) = L check local use; R check remote use.
+3 ;VERNUM (optional) only checked for remote RPCs.
+4 NEW RPC0,INACT
+5 SET RPC0=$GET(^XWB(8994,+RPCIEN,0))
+6 IF RPC0=""
QUIT 0
+7 SET INACT=+$PIECE(RPC0,U,6)
+8 ;RPC marked inactive.
IF INACT=1
QUIT 0
+9 SET RPCUSE=$GET(RPCUSE)
+10 ;Local and remote check not needed.
IF RPCUSE=""
QUIT 1
+11 ;Local use, RPC is remote only.
IF RPCUSE="L"
IF INACT=2
QUIT 0
+12 ;Remote use, RPC is local only.
IF RPCUSE="R"
IF INACT=3
QUIT 0
+13 ;Failed version # check.
IF RPCUSE="R"
IF +$GET(VERNUM)
IF '$$CKVERNUM(VERNUM,+$PIECE(RPC0,U,9))
QUIT 0
+14 ;Must be ok.
QUIT 1
+15 ;
CKVERNUM(VERNUM,RPCVER,RPCIEN) ;P10
+1 ;Boolean function. Returns 1 if RPC verion is > or = version number to be checked.
+2 ;VERNUM = version number passed in (i.e., from client ap) to be checked.
+3 ;RPCVER = version number in Remote Procedure file. (optional)
+4 ;RPCIEN of RPC being checked. Needed if RPCVER not sent.
+5 IF +$GET(RPCIEN)
IF '+$GET(RPCVER)
SET RPCVER=$PIECE($GET(^XWB(8994,RPCIEN,0)),U,9)
+6 IF +RPCVER<+VERNUM
QUIT 0
+7 QUIT 1
+8 ;
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
+1 ;P10. Variable for exclusive NEW in KILL^XUSCLEAN
+2 ;P26. Added XWBSHARE
+3 ;P35. Added XWBDEBUG,XWBT
