Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BMXMBRK

BMXMBRK.m

Go to the documentation of this file. 
  1. BMXMBRK ; IHS/OIT/HMW - BMXNet MONITOR ;
  1.  ;;4.0;BMX;;JUN 28, 2010
  1.  ;
  1.  ;
  1. PRSP(P) ;EP -Parse Protocol
  1.  ;M Extrinsic Function
  1.  ;
  1.  ;Inputs
  1.  ;P        Protocol string with the form
  1.  ;         Protocol := Protocol Header^Message where
  1.  ;         Protocol Header := LLLWKID;WINH;PRCH;WISH;MESG
  1.  ;           LLL  := length of protocol header (3 numeric)
  1.  ;           WKID := Workstation ID (ALPHA)
  1.  ;           WINH := Window handle (ALPHA)
  1.  ;           PRCH := Process handle (ALPHA)
  1.  ;           WISH := Window server handle (ALPHA)
  1.  ;           MESG := Unparsed message
  1.  ;Outputs
  1.  ;ERR      0 for success, "-1^Text" if error
  1.  ;
  1.  N ERR,C,M,R,X
  1.  S R=0,C=";",ERR=0,M=512 ;Maximum buffer input
  1.  IF $E(P,1,5)="{BMX}" S P=$E(P,6,$L(P)) ;drop out prefix
  1.  IF '+$G(P) S ERR="-1^Required input reference is NULL"
  1.  IF +ERR=0 D
  1.  . S BMXZ(R,"LENG")=+$E(P,1,3)
  1.  . S X=$E(P,4,BMXZ(R,"LENG")+3)
  1.  . S BMXZ(R,"MESG")=$E(P,BMXZ(R,"LENG")+4,M)
  1.  . S BMXZ(R,"WKID")=$P(X,C)
  1.  . S BMXZ(R,"WINH")=$P(X,C,2)
  1.  . S BMXZ(R,"PRCH")=$P(X,C,3)
  1.  . S BMXZ(R,"WISH")=$P(X,C,4)
  1.  Q ERR
  1.  ;
  1. PRSM(P) ;EP - Parse message
  1.  ;M Extrinsic Function
  1.  ;
  1.  ;Inputs
  1.  ;P        Message string with the form
  1.  ;         Message := Header^Content
  1.  ;           Header  := LLL;FLAG
  1.  ;             LLL     := length of entire message (3 numeric)
  1.  ;             FLAG    := 1 indicates variables follow
  1.  ;           Content := Contains API call information
  1.  ;Outputs
  1.  ;ERR      0 for success, "-1^Text" if error
  1.  N C,ERR,M,R,X,U
  1.  S U="^",R=1,C=";",ERR=0,M=512 ;Max buffer
  1.  IF '+$G(P) S ERR="-1^Required input reference is NULL"
  1.  IF +ERR=0 D
  1.  . S BMXZ(R,"LENG")=+$E(P,1,5)
  1.  . S BMXZ(R,"FLAG")=$E(P,6,6)
  1.  . S BMXZ(R,"TEXT")=$E(P,7,M)
  1.  Q ERR
  1.  ;
  1. PRSA(P) ;EP - Parse API information, get calling info
  1.  ;M Extrinsic Function
  1.  ;Inputs
  1.  ;P        Content := API Name^Param string
  1.  ;           API     := .01 field of API file
  1.  ;           Param   := Parameter information
  1.  ;Outputs
  1.  ;ERR      0 for success, "-1^Text" if error
  1.  ;
  1.  N C,DR,ERR,M,R,T,X,U
  1.  S U="^",R=2,C=";",ERR=0,M=512 ;Max buffer
  1.  IF '+$L(P) S ERR="-1^Required input reference is NULL"
  1.  IF +ERR=0 D
  1.  . S BMXZ(R,"CAPI")=$P(P,U)
  1.  . S BMXZ(R,"PARM")=$E(P,$F(P,U),M)
  1.  . S T=$O(^XWB(8994,"B",BMXZ(R,"CAPI"),0))
  1.  . I '+T S ERR="-1^Remote Procedure '"_BMXZ(R,"CAPI")_"' doesn't exist on the server." Q  ;P10 - dpc
  1.  . S T(0)=$G(^XWB(8994,T,0))
  1.  . I $P(T(0),U,6)=1!($P(T(0),U,6)=2) S ERR="-1^Remote Procedure '"_BMXZ(R,"CAPI")_"' cannot be run at this time." Q  ;P10. Check INACTIVE field. - dpc.
  1.  . S BMXZ(R,"NAME")=$P(T(0),"^")
  1.  . S BMXZ(R,"RTAG")=$P(T(0),"^",2)
  1.  . S BMXZ(R,"RNAM")=$P(T(0),"^",3)
  1.  . S BMXPTYPE=$P(T(0),"^",4)
  1.  . S BMXWRAP=+$P(T(0),"^",8)
  1.  Q ERR
  1.  ;information
  1. PRSB(P) ;EP - Parse Parameter
  1.  ;M Extrinsic Function
  1.  ;Inputs
  1.  ;P        Param   := M parameter list
  1.  ;           Param   := LLL,Name,Value
  1.  ;             LLL     := length of variable name and value
  1.  ;             Name    := name of M variable
  1.  ;             Value   := a string
  1.  ;Outputs
  1.  ;ERR      0 for success, "-1^Text" if error
  1.  ;
  1.  N A,ERR,F,FL,I,K,L,M,P1,P2,P3,P4,P5,MAXP,R
  1.  S R=3,MAXP=+$E(P,1,5)
  1.  S P1=$E(P,6,MAXP+5) ;only param string
  1.  S ERR=0,F=3,M=512
  1.  IF '+$D(P) S ERR="-1^Required input reference is NULL"
  1.  S FL=+$G(BMXZ(1,"FLAG"))
  1.  S I=0
  1.  IF '+ERR D
  1.  . IF 'FL,+MAXP=0 S P1="",ERR=1 Q
  1.  . F  D  Q:P1=""
  1.  . . Q:P1=""
  1.  . . S L=+$E(P1,1,3)-1
  1.  . . S P3=+$E(P1,4,4)
  1.  . . S P1=$E(P1,5,MAXP)
  1.  . . S BMXZ(R,"P",I)=$S(P3'=1:$E(P1,1,L),1:$$GETV($E(P1,1,L)))
  1.  . . IF FL=1,P3=2 D  ;XWB*1.1*2
  1.  . . . S A=$$OARY^BMXMBRK2,BMXARY=A
  1.  . . . S BMXZ(R,"P",I)=$$CREF^BMXMBRK2(A,BMXZ(R,"P",I))
  1.  . . S P1=$E(P1,L+1,MAXP)
  1.  . . S K=I,I=I+1
  1.  . IF 'FL Q
  1.  . S P3=P
  1.  . S L=+$E(P3,1,5)
  1.  . S P1=$E(P3,F+3,L+F)
  1.  . S P2=$E(P3,L+F+3,M)
  1.  . ;instantiate array
  1.  . F  D  Q:+L=0
  1.  . . S L=$$BREAD(3) Q:+L=0  S P3=$$BREAD(L)
  1.  . . S L=$$BREAD(3) IF +L'=0 S P4=$$BREAD(L)
  1.  . . IF +L=0 Q
  1.  . . IF P3=0,P4=0 S L=0 Q
  1.  . . IF FL=1 D LINST(A,P3,P4)
  1.  . . IF FL=2 D GINST
  1.  IF ERR Q P1
  1.  S P1=""
  1.  D  Q P1
  1.  . F I=0:1:K D
  1.  . . IF FL,$E(BMXZ(R,"P",I),1,5)=".BMXS" D  Q  ;XWB*1.1*2
  1.  . . . S P1=P1_"."_$E(BMXZ(R,"P",I),2,$L(BMXZ(R,"P",I)))
  1.  . . . IF I'=K S P1=P1_","
  1.  . . S P1=P1_"BMXZ("_R_",""P"","_I_")"
  1.  . . IF I'=K S P1=P1_","
  1.  IF '+ERR Q P1
  1.  Q ERR
  1.  ;
  1. BREAD(L) ;read tcp buffer, L is length
  1.  N E,X,DONE
  1.  S (E,DONE)=0
  1.  R X#L:BMXDTIME(1) ;IHS/OIT/HMW SAC Exemption Applied For
  1.  S E=X
  1.  IF $L(E)<L F  D  Q:'DONE
  1.  . IF $L(E)=L S DONE=1 Q
  1.  . R X#(L-$L(E)):BMXDTIME(1) ;IHS/OIT/HMW SAC Exemption Applied For
  1.  . S E=E_X
  1.  Q E
  1.  ;
  1. CALLP(BMXP,P,DEBUG) ;EP - make API call using Protocol string
  1.  N ERR,S
  1.  S ERR=0
  1.  K BMXSEC
  1.  IF '$D(DEBUG) S DEBUG=0
  1.  S ERR=$$PRSP(P)
  1.  IF '+ERR S ERR=$$PRSM(BMXZ(0,"MESG"))
  1.  IF '+ERR S ERR=$$PRSA(BMXZ(1,"TEXT")) ;I $G(BMXZ(2,"CAPI"))="XUS SET SHARED" S XWBSHARE=1 Q
  1.  I +ERR S BMXSEC=$P(ERR,U,2) ;P10 -- dpc
  1.  IF '+ERR S S=$$PRSB(BMXZ(2,"PARM"))
  1.  ;IF (+S=0)!(+S>0) D
  1.  I '+ERR D CHKPRMIT^BMXMSEC(BMXZ(2,"CAPI")) ;checks if RPC allowed to run
  1.  S:$L($G(BMXSEC)) ERR="-1^"_BMXSEC
  1.  ;IF 'DEBUG S:$D(XRT0) XRTN="RPC BROKER READ/PARSE" D:$D(XRT0) T1^%ZOSV ;stop RTL
  1.  IF '+ERR,(+S=0)!(+S>0) D
  1.  . D CAPI^BMXMBRK2(.BMXP,BMXZ(2,"RTAG"),BMXZ(2,"RNAM"),S)
  1.  E  D CLRBUF ;p10
  1.  IF 'DEBUG K BMXZ
  1.  IF $D(BMXARY) K @BMXARY,BMXARY
  1.  Q
  1.  ;
  1. LINST(A,X,BMXY) ;instantiate local array
  1.  IF BMXY=$C(1) S BMXY=""
  1.  S X=A_"("_X_")"
  1.  S @X=BMXY
  1.  Q
  1. GINST ;instantiate global
  1.  N DONE,N,T,T1
  1.  S (DONE,I)=0
  1.  ;find piece with global ref - recover $C(44)
  1.  S REF=$TR(REF,$C(23),$C(44))
  1.  F  D  Q:DONE
  1.  . S N=$NA(^TMP("BMXZ",$J,$P($H,",",2)))
  1.  . S BMXZ("FRM")=REF
  1.  . S BMXZ("TO")=N
  1.  . IF '$D(@N) S DONE=1 Q
  1.  ;loop through all and instantiate
  1.  S DONE=0
  1.  F  D  Q:DONE
  1.  . S T=$E(@REF@(I),4,M)
  1.  . IF T="" S DONE=1 Q
  1.  . S @N@("BMXZ")="" ;set naked indicator
  1.  . S @T
  1.  . S I=I+1
  1.  K @N@("BMXZ")
  1.  Q
  1.  ;
  1. GETV(V) ;get value of V - reference parameter
  1.  N X
  1.  S X=V
  1.  IF $E(X,1,2)="$$" Q ""
  1.  IF $C(34,36)[$E(V) X "S V="_$$VCHK(V)
  1.  E  S V=@V
  1.  Q V
  1.  ;
  1. VCHK(S) ;Parse string for first argument
  1.  N C,I,P
  1.  F I=1:1 S C=$E(S,I) D VCHKP:C="(",VCHKQ:C=$C(34) Q:" ,"[C
  1.  Q $E(S,1,I-1)
  1. VCHKP S P=1 ;Find closing paren
  1.  F I=I+1:1 S C=$E(S,I) Q:P=0!(C="")  I "()"""[C D VCHKQ:C=$C(34) S P=P+$S("("[C:1,")"[C:-1,1:0)
  1.  Q
  1. VCHKQ ;Find closing quote
  1.  F I=I+1:1 S C=$E(S,I) Q:C=""!(C=$C(34))
  1.  Q
  1. CLRBUF ;p10  Empties Input buffer
  1.  N %
  1.  F  R %#1:BMXDTIME(1) Q:%=""  ;IHS/OIT/HMW SAC Exemption Applied For
  1.  Q