XWBLIB.m

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