source: BMXNET_RPMS_dotNET_UTILITIES-BMX/branch/BMX41000/routines/BMXMBRK.m@ 1396

Last change on this file since 1396 was 1147, checked in by Sam Habiel, 14 years ago

Mumps Routines 4 BMX4

File size: 6.1 KB
Line 
1BMXMBRK ; IHS/OIT/HMW - BMXNet MONITOR ;
2 ;;4.1000;BMX;;Apr 17, 2011
3 ;
4 ;
5PRSP(P) ;EP -Parse Protocol
6 ;M Extrinsic Function
7 ;
8 ;Inputs
9 ;P Protocol string with the form
10 ; Protocol := Protocol Header^Message where
11 ; Protocol Header := LLLWKID;WINH;PRCH;WISH;MESG
12 ; LLL := length of protocol header (3 numeric)
13 ; WKID := Workstation ID (ALPHA)
14 ; WINH := Window handle (ALPHA)
15 ; PRCH := Process handle (ALPHA)
16 ; WISH := Window server handle (ALPHA)
17 ; MESG := Unparsed message
18 ;Outputs
19 ;ERR 0 for success, "-1^Text" if error
20 ;
21 N ERR,C,M,R,X
22 S R=0,C=";",ERR=0,M=512 ;Maximum buffer input
23 IF $E(P,1,5)="{BMX}" S P=$E(P,6,$L(P)) ;drop out prefix
24 IF '+$G(P) S ERR="-1^Required input reference is NULL"
25 IF +ERR=0 D
26 . S BMXZ(R,"LENG")=+$E(P,1,3)
27 . S X=$E(P,4,BMXZ(R,"LENG")+3)
28 . S BMXZ(R,"MESG")=$E(P,BMXZ(R,"LENG")+4,M)
29 . S BMXZ(R,"WKID")=$P(X,C)
30 . S BMXZ(R,"WINH")=$P(X,C,2)
31 . S BMXZ(R,"PRCH")=$P(X,C,3)
32 . S BMXZ(R,"WISH")=$P(X,C,4)
33 Q ERR
34 ;
35PRSM(P) ;EP - Parse message
36 ;M Extrinsic Function
37 ;
38 ;Inputs
39 ;P Message string with the form
40 ; Message := Header^Content
41 ; Header := LLL;FLAG
42 ; LLL := length of entire message (3 numeric)
43 ; FLAG := 1 indicates variables follow
44 ; Content := Contains API call information
45 ;Outputs
46 ;ERR 0 for success, "-1^Text" if error
47 N C,ERR,M,R,X,U
48 S U="^",R=1,C=";",ERR=0,M=512 ;Max buffer
49 IF '+$G(P) S ERR="-1^Required input reference is NULL"
50 IF +ERR=0 D
51 . S BMXZ(R,"LENG")=+$E(P,1,5)
52 . S BMXZ(R,"FLAG")=$E(P,6,6)
53 . S BMXZ(R,"TEXT")=$E(P,7,M)
54 Q ERR
55 ;
56PRSA(P) ;EP - Parse API information, get calling info
57 ;M Extrinsic Function
58 ;Inputs
59 ;P Content := API Name^Param string
60 ; API := .01 field of API file
61 ; Param := Parameter information
62 ;Outputs
63 ;ERR 0 for success, "-1^Text" if error
64 ;
65 N C,DR,ERR,M,R,T,X,U
66 S U="^",R=2,C=";",ERR=0,M=512 ;Max buffer
67 IF '+$L(P) S ERR="-1^Required input reference is NULL"
68 IF +ERR=0 D
69 . S BMXZ(R,"CAPI")=$P(P,U)
70 . S BMXZ(R,"PARM")=$E(P,$F(P,U),M)
71 . S T=$O(^XWB(8994,"B",BMXZ(R,"CAPI"),0))
72 . I '+T S ERR="-1^Remote Procedure '"_BMXZ(R,"CAPI")_"' doesn't exist on the server." Q ;P10 - dpc
73 . S T(0)=$G(^XWB(8994,T,0))
74 . 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.
75 . S BMXZ(R,"NAME")=$P(T(0),"^")
76 . S BMXZ(R,"RTAG")=$P(T(0),"^",2)
77 . S BMXZ(R,"RNAM")=$P(T(0),"^",3)
78 . S BMXPTYPE=$P(T(0),"^",4)
79 . S BMXWRAP=+$P(T(0),"^",8)
80 Q ERR
81 ;information
82PRSB(P) ;EP - Parse Parameter
83 ;M Extrinsic Function
84 ;Inputs
85 ;P Param := M parameter list
86 ; Param := LLL,Name,Value
87 ; LLL := length of variable name and value
88 ; Name := name of M variable
89 ; Value := a string
90 ;Outputs
91 ;ERR 0 for success, "-1^Text" if error
92 ;
93 N A,ERR,F,FL,I,K,L,M,P1,P2,P3,P4,P5,MAXP,R
94 S R=3,MAXP=+$E(P,1,5)
95 S P1=$E(P,6,MAXP+5) ;only param string
96 S ERR=0,F=3,M=512
97 IF '+$D(P) S ERR="-1^Required input reference is NULL"
98 S FL=+$G(BMXZ(1,"FLAG"))
99 S I=0
100 IF '+ERR D
101 . IF 'FL,+MAXP=0 S P1="",ERR=1 Q
102 . F D Q:P1=""
103 . . Q:P1=""
104 . . S L=+$E(P1,1,3)-1
105 . . S P3=+$E(P1,4,4)
106 . . S P1=$E(P1,5,MAXP)
107 . . S BMXZ(R,"P",I)=$S(P3'=1:$E(P1,1,L),1:$$GETV($E(P1,1,L)))
108 . . IF FL=1,P3=2 D ;XWB*1.1*2
109 . . . S A=$$OARY^BMXMBRK2,BMXARY=A
110 . . . S BMXZ(R,"P",I)=$$CREF^BMXMBRK2(A,BMXZ(R,"P",I))
111 . . S P1=$E(P1,L+1,MAXP)
112 . . S K=I,I=I+1
113 . IF 'FL Q
114 . S P3=P
115 . S L=+$E(P3,1,5)
116 . S P1=$E(P3,F+3,L+F)
117 . S P2=$E(P3,L+F+3,M)
118 . ;instantiate array
119 . F D Q:+L=0
120 . . S L=$$BREAD(3) Q:+L=0 S P3=$$BREAD(L)
121 . . S L=$$BREAD(3) IF +L'=0 S P4=$$BREAD(L)
122 . . IF +L=0 Q
123 . . IF P3=0,P4=0 S L=0 Q
124 . . IF FL=1 D LINST(A,P3,P4)
125 . . IF FL=2 D GINST
126 IF ERR Q P1
127 S P1=""
128 D Q P1
129 . F I=0:1:K D
130 . . IF FL,$E(BMXZ(R,"P",I),1,5)=".BMXS" D Q ;XWB*1.1*2
131 . . . S P1=P1_"."_$E(BMXZ(R,"P",I),2,$L(BMXZ(R,"P",I)))
132 . . . IF I'=K S P1=P1_","
133 . . S P1=P1_"BMXZ("_R_",""P"","_I_")"
134 . . IF I'=K S P1=P1_","
135 IF '+ERR Q P1
136 Q ERR
137 ;
138BREAD(L) ;read tcp buffer, L is length
139 N E,X,DONE
140 S (E,DONE)=0
141 R X#L:BMXDTIME(1) ;IHS/OIT/HMW SAC Exemption Applied For
142 S E=X
143 IF $L(E)<L F D Q:'DONE
144 . IF $L(E)=L S DONE=1 Q
145 . R X#(L-$L(E)):BMXDTIME(1) ;IHS/OIT/HMW SAC Exemption Applied For
146 . S E=E_X
147 Q E
148 ;
149CALLP(BMXP,P,DEBUG) ;EP - make API call using Protocol string
150 N ERR,S
151 S ERR=0
152 K BMXSEC
153 IF '$D(DEBUG) S DEBUG=0
154 S ERR=$$PRSP(P)
155 IF '+ERR S ERR=$$PRSM(BMXZ(0,"MESG"))
156 IF '+ERR S ERR=$$PRSA(BMXZ(1,"TEXT")) ;I $G(BMXZ(2,"CAPI"))="XUS SET SHARED" S XWBSHARE=1 Q
157 I +ERR S BMXSEC=$P(ERR,U,2) ;P10 -- dpc
158 IF '+ERR S S=$$PRSB(BMXZ(2,"PARM"))
159 ;IF (+S=0)!(+S>0) D
160 I '+ERR D CHKPRMIT^BMXMSEC(BMXZ(2,"CAPI")) ;checks if RPC allowed to run
161 S:$L($G(BMXSEC)) ERR="-1^"_BMXSEC
162 ;IF 'DEBUG S:$D(XRT0) XRTN="RPC BROKER READ/PARSE" D:$D(XRT0) T1^%ZOSV ;stop RTL
163 IF '+ERR,(+S=0)!(+S>0) D
164 . D CAPI^BMXMBRK2(.BMXP,BMXZ(2,"RTAG"),BMXZ(2,"RNAM"),S)
165 E D CLRBUF ;p10
166 IF 'DEBUG K BMXZ
167 IF $D(BMXARY) K @BMXARY,BMXARY
168 Q
169 ;
170LINST(A,X,BMXY) ;instantiate local array
171 IF BMXY=$C(1) S BMXY=""
172 S X=A_"("_X_")"
173 S @X=BMXY
174 Q
175GINST ;instantiate global
176 N DONE,N,T,T1
177 S (DONE,I)=0
178 ;find piece with global ref - recover $C(44)
179 S REF=$TR(REF,$C(23),$C(44))
180 F D Q:DONE
181 . S N=$NA(^TMP("BMXZ",$J,$P($H,",",2)))
182 . S BMXZ("FRM")=REF
183 . S BMXZ("TO")=N
184 . IF '$D(@N) S DONE=1 Q
185 ;loop through all and instantiate
186 S DONE=0
187 F D Q:DONE
188 . S T=$E(@REF@(I),4,M)
189 . IF T="" S DONE=1 Q
190 . S @N@("BMXZ")="" ;set naked indicator
191 . S @T
192 . S I=I+1
193 K @N@("BMXZ")
194 Q
195 ;
196GETV(V) ;get value of V - reference parameter
197 N X
198 S X=V
199 IF $E(X,1,2)="$$" Q ""
200 IF $C(34,36)[$E(V) X "S V="_$$VCHK(V)
201 E S V=@V
202 Q V
203 ;
204VCHK(S) ;Parse string for first argument
205 N C,I,P
206 F I=1:1 S C=$E(S,I) D VCHKP:C="(",VCHKQ:C=$C(34) Q:" ,"[C
207 Q $E(S,1,I-1)
208VCHKP S P=1 ;Find closing paren
209 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)
210 Q
211VCHKQ ;Find closing quote
212 F I=I+1:1 S C=$E(S,I) Q:C=""!(C=$C(34))
213 Q
214CLRBUF ;p10 Empties Input buffer
215 N %
216 F R %#1:BMXDTIME(1) Q:%="" ;IHS/OIT/HMW SAC Exemption Applied For
217 Q
Note: See TracBrowser for help on using the repository browser.