source: BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXMBRK2.m

Last change on this file was 1209, checked in by Sam Habiel, 13 years ago

BMXMON fix; updated all routines to v 2.31

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