| 1 | BMXMBRK2 ;IHS/OIT/HMW - BMXNet MONITOR ;
|
|---|
| 2 | ;;4.1000;BMX;;Apr 17, 2011
|
|---|
| 3 | ;
|
|---|
| 4 | ;
|
|---|
| 5 | CAPI(BMXY,TAG,NAM,PAR) ;EP - make API call
|
|---|
| 6 | N R,T,DX,DY
|
|---|
| 7 | IF BMXZ(1,"FLAG")=2 D
|
|---|
| 8 | . S PAR=$P(PAR,BMXZ("FRM"))_BMXZ("TO")_$P(PAR,BMXZ("FRM"),2)
|
|---|
| 9 | S R=$S(PAR'=+PAR&(PAR=""):TAG_"^"_NAM_"(.BMXY)",1:TAG_"^"_NAM_"(.BMXY,"_PAR_")")
|
|---|
| 10 | U IO
|
|---|
| 11 | D @R
|
|---|
| 12 | U $P
|
|---|
| 13 | Q
|
|---|
| 14 | ;
|
|---|
| 15 | BHDR(WKID,WINH,PRCH,WISH) ;Build a protocol header
|
|---|
| 16 | N S,L
|
|---|
| 17 | S S=""
|
|---|
| 18 | S S=WKID_";"_WINH_";"_PRCH_";"_WISH_";"
|
|---|
| 19 | S L=$L(S)
|
|---|
| 20 | S S=$E("000"_L,$L(L)+1,$L(L)+3)_S
|
|---|
| 21 | Q S
|
|---|
| 22 | ;
|
|---|
| 23 | BARY(A,R,V) ;add array elements+values to storage array
|
|---|
| 24 | IF A'["BMXS" Q "-1^ARRAY NAME MUST BE BMXS"
|
|---|
| 25 | S @A@(R)=V
|
|---|
| 26 | Q 0
|
|---|
| 27 | ;
|
|---|
| 28 | BLDB(P) ;Build formatted string
|
|---|
| 29 | N L
|
|---|
| 30 | S L=$L(P)
|
|---|
| 31 | Q $E("000"_L,$L(L)+1,$L(L)+3)_P
|
|---|
| 32 | ;
|
|---|
| 33 | BLDA(N,P) ;Build API string
|
|---|
| 34 | ;M Extrinsic Function
|
|---|
| 35 | ;Inputs
|
|---|
| 36 | ;N API name
|
|---|
| 37 | ;P Comma delimited parameter string
|
|---|
| 38 | ;Outputs
|
|---|
| 39 | ;String API string if successful, "-1^Text" if error
|
|---|
| 40 | ;
|
|---|
| 41 | N I,F,L,T,U,T1,T2
|
|---|
| 42 | IF '+$D(N) Q "-1^Required input reference is NULL"
|
|---|
| 43 | S U="^"
|
|---|
| 44 | S (F,T,Y)=0
|
|---|
| 45 | IF '$D(P) S P=""
|
|---|
| 46 | IF P'="" D
|
|---|
| 47 | . S L=$L(P)-$L($TR(P,$C(44)))+1
|
|---|
| 48 | . IF L=0 S L=1
|
|---|
| 49 | . F I=1:1:L D Q:T
|
|---|
| 50 | . . S T1=$P(P,",",I)
|
|---|
| 51 | . . S T2=$E(T1,1,1)="."
|
|---|
| 52 | . . IF T1=+T1 Q
|
|---|
| 53 | . . IF $E(T1,1,1)="^" S F=2,T=1 Q
|
|---|
| 54 | . . IF T2&($E(T1,2,$L(T1))?.ANP) S F=1,T=1 Q
|
|---|
| 55 | S P=$$BLDB(P)
|
|---|
| 56 | S L=$L(P)+$L(P)-3
|
|---|
| 57 | S P=F_N_U_P
|
|---|
| 58 | S L=$L(P)
|
|---|
| 59 | Q $E("000"_L,$L(L)+1,$L(L)+3)_P
|
|---|
| 60 | ;
|
|---|
| 61 | BLDS(R) ;Build a parameter string from an array
|
|---|
| 62 | N L,T,Y
|
|---|
| 63 | S Y=""
|
|---|
| 64 | F D Q:R=""
|
|---|
| 65 | . S R=$Q(@R)
|
|---|
| 66 | . IF R="" Q
|
|---|
| 67 | . S L=$L(R)+$L(@R)+1
|
|---|
| 68 | . S T=@R
|
|---|
| 69 | . S T=$TR(T,$C(44),$C(23))
|
|---|
| 70 | . S Y=Y_$E("000"_L,$L(L)+1,$L(L)+3)_R_"="_T
|
|---|
| 71 | Q Y_"000"
|
|---|
| 72 | ;
|
|---|
| 73 | BLDU(R) ;Build a parameter string from a scalar
|
|---|
| 74 | N DONE,L,N,N1,P1
|
|---|
| 75 | IF R=+R Q R
|
|---|
| 76 | S N=$F(R,$C(34))
|
|---|
| 77 | IF N=0 Q $C(34)_R_$C(34)
|
|---|
| 78 | S P1=$E(R,1,N-2)
|
|---|
| 79 | S (L,DONE)=0
|
|---|
| 80 | F D Q:DONE
|
|---|
| 81 | . S N1=$F(R,$C(34),N)
|
|---|
| 82 | . IF N1=0 S L=$L(R)+2,N1=L
|
|---|
| 83 | . S P1=P1_$C(34,34)_$E(R,N,N1-2)
|
|---|
| 84 | . IF N1=L S DONE=1,P1=$C(34)_P1_$C(34) Q
|
|---|
| 85 | . S N=N1
|
|---|
| 86 | Q $TR(P1,$C(44),$C(23))
|
|---|
| 87 | ;
|
|---|
| 88 | BLDG(R) ;build a parameter string from a global reference
|
|---|
| 89 | N I,L,L1,M,T,T1,T2,Y
|
|---|
| 90 | K ^TMP("BMXZ",$J)
|
|---|
| 91 | IF '$D(R) Q "-1^Reference does not exist"
|
|---|
| 92 | S Y=$NA(^TMP("BMXZ",$J,$P($H,",",2)))
|
|---|
| 93 | S I=0
|
|---|
| 94 | S M=512
|
|---|
| 95 | S T1=$P(R,")")
|
|---|
| 96 | S L1=$L($P(R,"("))
|
|---|
| 97 | F D Q:R=""
|
|---|
| 98 | . S R=$Q(@R)
|
|---|
| 99 | . S T2=$F(R,"(")
|
|---|
| 100 | . IF R=""!(R'[T1) Q
|
|---|
| 101 | . S L=$L(R)+$L(@R)-L1
|
|---|
| 102 | . S T=@R
|
|---|
| 103 | . S T=$TR(T,$C(44),$C(23))
|
|---|
| 104 | . S @Y@(I)=$E("000"_L,$L(L)+1,$L(L)+3)_U_"("_$E(R,T2,M)_"="_$$BLDU(T)
|
|---|
| 105 | . S I=I+1
|
|---|
| 106 | S @Y@(I)="000"
|
|---|
| 107 | S Y=$TR(Y,$C(44),$C(23))
|
|---|
| 108 | Q Y
|
|---|
| 109 | ;
|
|---|
| 110 | OARY() ;EP - create storage array
|
|---|
| 111 | N A,DONE,I
|
|---|
| 112 | S (DONE,I)=0
|
|---|
| 113 | F I=1:1 D Q:DONE
|
|---|
| 114 | . S A="BMXS"_I
|
|---|
| 115 | . K @A ;temp fix for single array
|
|---|
| 116 | . IF '$D(@A) S DONE=1
|
|---|
| 117 | S @A="" ;set naked
|
|---|
| 118 | Q A
|
|---|
| 119 | ;
|
|---|
| 120 | CREF(R,P) ;EP - Convert array contained in P to reference A
|
|---|
| 121 | N I,X,DONE,F1,S
|
|---|
| 122 | S DONE=0
|
|---|
| 123 | S S=""
|
|---|
| 124 | F I=1:1 D Q:DONE
|
|---|
| 125 | . IF $P(P,",",I)="" S DONE=1 Q
|
|---|
| 126 | . S X(I)=$P(P,",",I)
|
|---|
| 127 | . IF X(I)?1"."1A.E D
|
|---|
| 128 | . . S F1=$F(X(I),".")
|
|---|
| 129 | . . S X(I)="."_R
|
|---|
| 130 | . S S=S_X(I)_","
|
|---|
| 131 | Q $E(S,1,$L(S)-1)
|
|---|
| 132 | ;
|
|---|
| 133 | GETP(P) ;returns various parameters out of the Protocol string
|
|---|
| 134 | N M,T,BMXZ
|
|---|
| 135 | S M=512
|
|---|
| 136 | S T=$$PRSP^BMXMBRK(P)
|
|---|
| 137 | IF '+T D
|
|---|
| 138 | . S T=$$PRSM^BMXMBRK(BMXZ(0,"MESG"))
|
|---|
| 139 | . IF '+T S T=BMXZ(0,"WKID")_";"_BMXZ(0,"WINH")_";"_BMXZ(0,"PRCH")_";"_BMXZ(0,"WISH")_";"_$P(BMXZ(1,"TEXT"),"^")
|
|---|
| 140 | Q T
|
|---|
| 141 | ;
|
|---|
| 142 | CALLM(X,P,DEBUG) ;make call using Message string
|
|---|
| 143 | N ERR,S
|
|---|
| 144 | S X="",ERR=0
|
|---|
| 145 | S ERR=$$PRSM^BMXMBRK(P)
|
|---|
| 146 | IF '+ERR S ERR=$$PRSA^BMXMBRK(BMXZ(1,"TEXT"))
|
|---|
| 147 | IF '+ERR S S=$$PRSB^BMXMBRK(BMXZ(2,"PARM"))
|
|---|
| 148 | IF (+S=0)!(+S>0) D
|
|---|
| 149 | . D CAPI(.X,BMXZ(2,"RTAG"),BMXZ(2,"RNAM"),S)
|
|---|
| 150 | IF 'DEBUG K BMXZ
|
|---|
| 151 | K @(X("BMXS")),X("BMXS")
|
|---|
| 152 | Q
|
|---|
| 153 | ;
|
|---|
| 154 | CALLA(X,P,DEBUG) ;make call using API string
|
|---|
| 155 | N ERR,S
|
|---|
| 156 | S X="",ERR=0
|
|---|
| 157 | S ERR=$$PRSA^BMXMBRK(P)
|
|---|
| 158 | IF '+ERR S S=$$PRSB^BMXMBRK(BMXZ(2,"PARM"))
|
|---|
| 159 | IF (+S=0)!(+S>0) D
|
|---|
| 160 | . D CAPI(.X,BMXZ(2,"RTAG"),BMXZ(2,"RNAM"),S)
|
|---|
| 161 | IF 'DEBUG K BMXZ
|
|---|
| 162 | K @(X("BMXS")),X("BMXS")
|
|---|
| 163 | Q
|
|---|
| 164 | ;
|
|---|
| 165 | TRANSPRT() ;Determine the Transport Method
|
|---|
| 166 | ;DDP is local :=0
|
|---|
| 167 | ;TCP/IP is remote :=1
|
|---|
| 168 | ;Serial/RS-232 is remote :=2
|
|---|
| 169 | Q 1
|
|---|
| 170 | ;Q 0 ;Do DDP for Now
|
|---|
