source: fmts/trunk/p/C0XGET1.m@ 1717

Last change on this file since 1717 was 1629, checked in by George Lilly, 11 years ago

misc updates
File size: 15.5 KB
RevLine 
[1539]1C0XGET1 ; GPL - Fileman Triples entry point routine ;1/12/12 17:05
[1629]2 ;;1.0;FILEMAN TRIPLE STORE;;Sep 26, 2012;Build 11
[1539]3 ;Copyright 2011 George Lilly. Licensed under the terms of the GNU
4 ;General Public License See attached copy of the License.
5 ;
6 ;This program is free software; you can redistribute it and/or modify
7 ;it under the terms of the GNU General Public License as published by
8 ;the Free Software Foundation; either version 2 of the License, or
9 ;(at your option) any later version.
10 ;
11 ;This program is distributed in the hope that it will be useful,
12 ;but WITHOUT ANY WARRANTY; without even the implied warranty of
13 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 ;GNU General Public License for more details.
15 ;
16 ;You should have received a copy of the GNU General Public License along
17 ;with this program; if not, write to the Free Software Foundation, Inc.,
18 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19 ;
20 Q
21 ;
22LSSUBJ(RTN,ZSUBJ,C0XFARY) ; LIST NODES WITH SUBJECT ZSUBJ
23 ;
24 I '$D(C0XFARY) D INITFARY^C0XF2N("C0XFARY")
25 D USEFARY^C0XF2N("C0XFARY")
26 Q
27 ;
28graph(sub,pred,obj,form,fary) ; extrinsic which returns a graph name
29 I '$D(fary) D ;
30 . S fary="C0XFARY"
31 . D INITFARY^C0XF2N(fary)
32 D USEFARY^C0XF2N(fary)
33 k triplertn ; start with a clean return
34 n zsub,zpred,zobj,zgraph,tmprtn
35 s zsub=$$IENOF($$EXT^C0XUTIL($g(sub)),fary) ; ien of subject
36 s zpred=$$IENOF($$EXT^C0XUTIL($g(pred)),fary) ; ien of predicate
37 s zobj=$$IENOF($$EXT^C0XUTIL($g(obj)),fary) ; ien of object
38 s zgraph=$$IENOF($g(graph),fary) ; ien of graph
39 I $G(DEBUG) W !,"s:",zsub," p:",zpred," o:",zobj
40 d trip(.tmprtn,zsub,zpred,zobj,zgraph,fary)
41 n ztmp
42 d trip(.ztmp,$g(sub),$g(pred),$g(obj),"",$g(fary))
43 n zi,zg,zrtn
44 s zi=$o(tmprtn(""))
45 s zg=$$GET1^DIQ(C0XTFN,zi,.02,"E") ;
46 i zg="" q ""
47 s zrtn=zg
48 i $o(tmprtn(zi))'="" d
49 . s zrtn=""
50 q zrtn
51 ;
52GRAPHS(RTN,C0XFARY) ; LIST ALL GRAPHS
53 ;
54 I '$D(C0XFARY) D INITFARY^C0XF2N("C0XFARY")
55 D USEFARY^C0XF2N("C0XFARY")
56 N ZI S ZI=""
57 F S ZI=$O(@C0XTN@("G",ZI)) Q:ZI="" D ;
58 . S RTN(ZI,$$STR(ZI))=""
59 Q
60 ;
61STR(ZIN,C0XFARY) ; EXTRINSIC RETURNS A STRING
62 I '$D(C0XFARY) D INITFARY^C0XF2N("C0XFARY")
63 Q $$GET1^DIQ(C0XSFN,ZIN,.01,"E")
64 ;
65SPO(ZRTN,ZNODE,C0XFARY)
66 I '$D(C0XFARY) D INITFARY^C0XF2N("C0XFARY")
67 N ZI S ZI=$$NXT(.ZRTN)
68 S ZRTN(ZI,"S")=$$S(ZNODE)
69 S ZRTN(ZI,"P")=$$P(ZNODE)
70 S ZRTN(ZI,"O")=$$O(ZNODE)
71 Q
72 ;
73S(ZNODE,C0XFARY) ; EXTRINSIC RETURNING THE SUBJECT
74 Q $$STR($$GET1^DIQ(C0XTFN,ZNODE,.03,"I")) ;
75 ;
76P(ZNODE,C0XFARY) ; EXTRINSIC RETURNING THE PREDICATE
77 Q $$STR($$GET1^DIQ(C0XTFN,ZNODE,.04,"I")) ;
78 ;
79O(ZNODE,C0XFARY) ; EXTRINSIC RETURNING THE OBJECT
80 Q $$STR($$GET1^DIQ(C0XTFN,ZNODE,.05,"I")) ;
81 ;
82NXT(ZRTN) ;EXTRINSIC FOR THE NEXT NODE IN ARRAY ZRTN, PASSED BY REF
83 I '$D(ZRTN) S ZRTN=""
84 Q $O(ZRTN(""),-1)+1
85 ;
86SING(ZRTN,ZG) ; SUBJECTS IN GRAPH
87 ;
88 I '$D(C0XFARY) D INITFARY^C0XF2N("C0XFARY")
89 I '$D(ZRTN) S ZRTN=""
90 N ZI,ZN S ZI=""
91 F S ZI=$O(@C0XTN@("GSPO",ZG,ZI)) Q:ZI="" D ;
92 . S ZRTN($$NXT(.ZRTN),"S")=$$STR(ZI)
93 Q
94 ;
95qparse(qrtn,zquery) ; parses the query
96 ; want this to be able to handle the WHERE clause of SPARQL eventually
97 ;
98 n q1,q2,q3,qq
99 ;s qq=$tr(zquery," ","^")
100 s qq=query ; really want to remove whitespace here
101 s q1=$p(qq," ",1)
102 i q1["?" s q1=""
103 s q2=$p(qq," ",2)
104 i q2["?" s q2=""
105 s q3=$p(qq," ",3)
106 i q3["?" s q3=""
107 s qrtn(1)=q1_"^"_q2_"^"_q3 ; more lines to come later
108 q
109 ;
110getGraph(zrtn,zgrf,form) ; get all triples in graph zgrf
111 ; forms planned: "rdf" "json" "array" "turtle" "triples" "raw"
112 ; forms supported: "rdf" "json" "array" "raw"
113 I '$D(form) S form="rdf"
114 N ZIENS,ZTRIP
115 D TING^C0XF2N(.ZIENS,zgrf)
116 I '$D(ZIENS) Q ;
117 D ien2tary(.ZTRIP,"ZIENS")
118 I form="json" d jsonout(.zrtn,.ZTRIP) q ; what follows is else
119 i form="rdf" d rdfout^C0XRDF(.zrtn,.ZTRIP) q ;
120 i form="array" d arrayout^C0XGET1(.zrtn,.ZTRIP) q ;
121 i form="raw" d rawout^C0XGET1(.zrtn,.ZTRIP) q ;
122 W !,"Form not supported: ",form
123 Q
124 ;
125rpctrip(rtn,query,limit,offset) ; rpc to access triples with a query
126 ;
127 n zoff,zlim,zcount,zq
128 k rtn
129 i '$d(limit) s limit=250
130 i '$d(offset) s offset=0
131 d qparse(.zq,query) ; parse the query
132 n qsub,qpred,qobj,qtmp
133 W !,zq(1)
134 s qsub=$p(zq(1),"^",1)
135 s qpred=$p(zq(1),"^",2)
136 s qobj=$p(zq(1),"^",3)
137 d triples(.qtmp,qsub,qpred,qobj)
138 f zcount=offset+1:1:offset+limit q:'$d(qtmp(zcount)) d ;
139 . s rtn(zcount)=qtmp(zcount)
140 q
141 ;
142triples(triplertn,sub,pred,obj,graph,form,fary) ; returns triples
143 I '$D(fary) D ;
144 . D INITFARY^C0XF2N("C0XFARY")
145 . S fary="C0XFARY"
146 D USEFARY^C0XF2N(fary)
147 I '$D(form) S form="json"
148 k triplertn ; start with a clean return
149 n zsub,zpred,zobj,zgraph,tmprtn
150 s zsub=$$IENOF($$EXT^C0XUTIL($g(sub)),fary) ; ien of subject
151 s zpred=$$IENOF($$EXT^C0XUTIL($g(pred)),fary) ; ien of predicate
152 s zobj=$$IENOF($$EXT^C0XUTIL($g(obj)),fary) ; ien of object
153 s zgraph=$$IENOF($g(graph),fary) ; ien of graph
154 I $G(DEBUG) W !,"s:",zsub," p:",zpred," o:",zobj
155 d trip(.tmprtn,zsub,zpred,zobj,zgraph,fary)
156 d ien2tary(.zrary,"tmprtn") ; convert to triples
157 ;
158 i form="json" d jsonout(.triplertn,.zrary) q ; what follows is 'else'
159 i form="rdf" d rdfout^C0XRDF(.triplertn,.zrary) q ;
160 i form="array" d arrayout(.triplertn,.zrary) q ;
161 i form="raw" d rawout(.triplertn,.zrary) q ;
162 w !,"form not supported: ",form
163 q
164 ;
165subjects(listrtn,pred,obj,graph,form,fary) ; return list of subjects
166 d onelist("S",,$g(pred),$g(obj),$g(fary)) ;subjects
167 q
168 ;
169subject(pred,obj,graph,form,fary) ; extrinsic which returns the first
170 ; multiple of return from subjects - returns null if more than one
171 ; subjects(.G,sub,pred)
172 ; G("nodeID:1234") ==> "nodeID:1234"
173 n zin,zrtn
174 d subjects(.zin,$g(pred),$g(obj),$g(form),$g(fary))
175 s zrtn=$o(zin(""))
176 i $o(zin(zrtn))'="" s zrtn=""
177 q zrtn
178 ;
179preds(listrtn,sub,obj,graph,form,fary) ; return list of subjects
180 d onelist("P",$g(sub),,$g(obj),$g(fary)) ;subjects
181 q
182 ;
183objects(listrtn,sub,pred,graph,form,fary) ; return list of subjects
184 d onelist("O",$g(sub),$g(pred),"",$g(fary)) ;subjects
185 q
186 ;
187object(sub,pred,graph,form,fary) ; extrinsic which returns the first
188 ; multiple of return from objects - returns null if more than one
189 ; objects(.G,sub,pred)
190 ; G("location") ==> "location"
191 n zin,zrtn
192 d objects(.zin,$g(sub),$g(pred),$g(form),$g(fary))
193 s zrtn=$o(zin(""))
194 i $o(zin(zrtn))'="" s zrtn=""
195 q zrtn
196 ;
197onelist(zw,sub,pred,obj,fary) ; returns list
198 ; zw is S P or O depending on what should be returned
199 I $g(fary)="" D ;
200 . D INITFARY^C0XF2N("C0XFARY")
201 . S fary="C0XFARY"
202 D USEFARY^C0XF2N(fary)
203 I '$D(form) S form="json"
204 k listrtn ; start with a clean return
205 n zsub,zpred,zobj,zgraph,tmprtn
206 s zsub=$$IENOF($$EXT^C0XUTIL($g(sub)),fary) ; ien of sub
207 s zpred=$$IENOF($$EXT^C0XUTIL($g(pred)),fary) ; ien of pred
208 s zobj=$$IENOF($$EXT^C0XUTIL($g(obj)),fary) ; ien of obj
209 s zgraph=$$IENOF($g(graph),fary) ; ien of graph
210 I $G(DEBUG) W !,"s:",zsub," p:",zpred," o:",zobj
211 n c0xflag,zi,zx,zt
212 s zt=$na(^C0X(101)) ;
213 s c0xflag=$$mask(zsub,zpred,zobj) ; get mask flags
214 k tmprtn
215 n itbl,ii,ix
216 s ii=$s(zw="S":"SPO",zw="P":"POS",zw="O":"OSP") ; no constraint
217 s itbl("I000",ii)="d zip(.tmprtn,zt,zi)"
218 s ii=$s(zw="S":"OSP",zw="P":"OPS",zw="O":"OSP") ; obj constraint
219 s ix=$s(zw="O":"d just(zobj)",1:"d zip1(.tmprtn,zt,zi,zobj)")
220 s itbl("I001",ii)=ix
221 s ii=$s(zw="S":"PSO",zw="P":"POS",zw="O":"POS") ; pred constraint
222 s ix=$s(zw="P":"d just(zpred)",1:"d zip1(.tmprtn,zt,zi,zpred)")
223 s itbl("I010",ii)=ix
224 s ii=$s(zw="S":"POS",zw="P":"OPS",zw="O":"OSP") ; pred + obj constraint
225 s ix=$s(zw="S":"d zip2(.tmprtn,zt,zi,zpred,zobj)",zw="P":"d just(zpred)",zw="O":"d just(zobj)",1:"d just(zobj)")
226 s itbl("I011",ii)=ix
227 s ii=$s(zw="S":"SPO",zw="P":"SPO",zw="O":"SOP") ; sub constraint
228 s ix=$s(zw="S":"d just(zsub)",1:"d zip1(.tmprtn,zt,zi,zsub)")
229 s itbl("I100",ii)=ix
230 s ii=$s(zw="S":"SPO",zw="P":"SOP",zw="O":"OSP") ; sub + obj constraint
231 s ix=$s(zw="P":"d zip2(.tmprtn,zt,zi,zsub,zobj)",zw="S":"d just(zsub)",zw="O":"d just(zobj)",1:"d just(zobj)")
232 s itbl("I101",ii)=ix
233 s ii=$s(zw="S":"SPO",zw="P":"POS",zw="O":"SPO") ; sub + pred constraint
234 s ix=$s(zw="O":"d zip2(.tmprtn,zt,zi,zsub,zpred)",zw="S":"d just(zsub)",zw="P":"d just(zpred)",1:"d just(zsub)")
235 s itbl("I110",ii)=ix
236 s ii=$s(zw="S":"SPO",zw="P":"POS",zw="O":"OSP") ; sub + pred + obj constraint
237 s ix=$s(zw="O":"d just(zobj)",zw="S":"d just(zsub)",zw="P":"d just(zpred)",1:"d just(zsub)")
238 s itbl("I111",ii)=ix
239 ; end itbl definition
240 ;
241 s zi=$o(itbl(c0xflag,"")) ; find index to use
242 s zx=itbl(c0xflag,zi) ; executable instruction to run
243 ;i $g(ngraph)'="" s zi="G"_zi ; this is wrong.. don't do graphs yet
244 i $g(DEBUG) w !,c0xflag," ",zw," ",zt," ",zi," ",zx,!
245 ;zwr itbl
246 x zx
247 k listrtn
248 d strings(.listrtn,"tmprtn") ; convert pointer to strings
249 q
250 ;
251just(zin) ; add one element to tmprtn
252 s tmprtn(zin)=""
253 q
254 ;
255zip(zrtn,zt,zi) ; pull out just the first element of the index
256 ;
257 n zii s zii=""
258 f s zii=$o(@zt@(zi,zii)) q:zii="" d ;
259 . s zrtn(zii)=""
260 q
261 ;
262zip1(zrtn,zt,zi,zn) ; pull out just the first element of the index
263 ;
264 n zii s zii=""
265 f s zii=$o(@zt@(zi,zn,zii)) q:zii="" d ;
266 . s zrtn(zii)=""
267 q
268 ;
269zip2(zrtn,zt,zi,zn,zn1) ; pull out just the first element of the index
270 ;
271 n zii s zii=""
272 f s zii=$o(@zt@(zi,zn,zn1,zii)) q:zii="" d ;
273 . s zrtn(zii)=""
274 q
275 ;
276arrayout(rtn,zary) ; output an array of triples
277 ;
278 s zrsub=""
279 s zcnt=1
280 f s zrsub=$o(zary(zrsub)) q:zrsub="" d ; organized by subject
281 . s zzz=""
282 . f s zzz=$o(zary(zrsub,zzz)) q:zzz="" d ; pred and obj
283 . . s rtn(zcnt)=zrsub_"^"_zzz
284 . . s zcnt=zcnt+1
285 q
286 ;
287rawout(rtn,zary) ; output a mumps array of triples
288 ;
289 s zrsub=""
290 ;s zcnt=1
291 f s zrsub=$o(zary(zrsub)) q:zrsub="" d ; organized by subject
292 . s zzz=""
293 . f s zzz=$o(zary(zrsub,zzz)) q:zzz="" d ; pred and obj
294 . . s rtn(zrsub,$p(zzz,"^",1))=$p(zzz,"^",2)
295 . . ;s zcnt=zcnt+1
296 q
297 ;
298strings(zrary,zinary) ; convert pointers to strings
299 ;
300 k zrary
301 n zzz s zzz=""
302 f s zzz=$o(@zinary@(zzz)) q:zzz="" d ;
303 . n zs
304 . ;s zs=$$GET1^DIQ(C0XSFN,zzz_",",.01)
305 . s zs=$$NSP^C0XUTIL(zzz) ; get namespaced string
306 . q:zs=""
307 . s zrary(zs)="" ;
308 q
309 ;
310ien2tary(zrary,zinary) ; zinary is an array of iens passed by name
311 ; zrary is passed by reference and is return array of triples
312 ; format zrary(zsub,"zpred^zobj")=""
313 ;
314 k zrary ; start out clean
315 n zzz,zrsub,zrpred,zrobj,zgraph,zcnt
316 s zzz=""
317 f s zzz=$o(@zinary@(zzz)) q:zzz="" d ;
318 . s zrsub=$$GET1^DIQ(C0XTFN,zzz_",",.03,"E")
319 . s zrpred=$$GET1^DIQ(C0XTFN,zzz_",",.04,"E")
320 . s zrobj=$$GET1^DIQ(C0XTFN,zzz_",",.05,"E")
321 . s zrgraph=$$GET1^DIQ(C0XTFN,zzz_",",.02,"E")
322 . s zrary(zrsub,zrpred_"^"_zrobj)=""
323 q
324 ;
325jsonout(jout,zary) ;
326 d REPLYSTART^FMQLJSON("jout")
327 d LISTSTART^FMQLJSON("jout","results")
328 n zi s zi=""
329 f s zi=$o(zary(zi)) q:zi="" d ; for each subject
330 . n zii s zii=""
331 . D DICTSTART^FMQLJSON("jout",zi)
332 . f s zii=$o(zary(zi,zii)) q:zii="" d ; for each pred^obj pair
333 . . d DASSERT^FMQLJSON("jout",$p(zii,"^",1),$p(zii,"^",2))
334 . D DICTEND^FMQLJSON("jout")
335 d LISTEND^FMQLJSON("jout")
336 d REPLYEND^FMQLJSON("jout")
337 q
338 ;
339mask(zsub,zpred,zobj) ; function to return mask information
340 ; about the inputs ie I100 for just a subject and no pred or obj
341 n zf1,zf2,zf3,zflag
342 s zf1=$s($g(zsub)="":0,1:1)
343 s zf2=$s($g(zpred)="":0,1:1)
344 s zf3=$s($g(zobj)="":0,1:1)
345 s zflag="I"_zf1_zf2_zf3
346 q zflag
347 ;
348trip(triprtn,nsub,npred,nobj,ngraph,fary) ; returns triples iens
349 ; nsub,npred,nobj are all optional
350 ; graf is also optional, and will limit the search to a particular ngraph
351 ; fary is which triple store (not implemented yet)
352 n c0xflag,zi,zx,zt
353 s zt=$na(^C0X(101)) ;
354 s c0xflag=$$mask(nsub,npred,nobj) ; get mask flags
355 n itbl
356 s itbl("I000","SPO")="d do3(.triprtn,zt,zi)"
357 s itbl("I001","OSP")="d do2(.triprtn,zt,zi,nobj)"
358 s itbl("I010","PSO")="d do2(.triprtn,zt,zi,npred)"
359 s itbl("I011","POS")="d do1(.triprtn,zt,zi,npred,nobj)"
360 s itbl("I100","SPO")="d do2(.triprtn,zt,zi,nsub)"
361 s itbl("I101","SOP")="d do1(.triprtn,zt,zi,nsub,nobj)"
362 s itbl("I110","SPO")="d do1(.triprtn,zt,zi,nsub,npred)"
363 s itbl("I111","SPO")="d do0(.triprtn,zt,zi,nsub,npred,nobj)"
364 s zi=$o(itbl(c0xflag,""))
365 s zx=itbl(c0xflag,zi) ; executable instruction to run
366 i $g(ngraph)'="" s zi="G"_zi
367 i $g(DEBUG) w !,zx
368 x zx
369 q
370 ;
371do0(dortn,zt,zi,z1,z2,z3)
372 ; looking for only one triple
373 n zz
374 s zz=$o(@zt@(zi,z1,z2,z3,""))
375 i zz'="" s dortn(zz)=""
376 q
377 ;
378do1(dortn,zt,zi,z1,z2) ; have 2, looking for one
379 n zr,zx1
380 s zx1=""
381 f s zx1=$o(@zt@(zi,z1,z2,zx1)) q:zx1="" d ;
382 . s zr=$o(@zt@(zi,z1,z2,zx1,""))
383 . s dortn(zr)=""
384 q
385 ;
386do2(dortn,zt,zi,z1) ; have one, looking for 2
387 n zr,zx1,zx2
388 s (zx1,zx2)=""
389 f s zx1=$o(@zt@(zi,z1,zx1)) q:zx1="" d ;
390 . f s zx2=$o(@zt@(zi,z1,zx1,zx2)) q:zx2="" d ;
391 . . s zr=$o(@zt@(zi,z1,zx1,zx2,""))
392 . . s dortn(zr)=""
393 q
394 ;
395do3(dortn,zt,zi) ; have none, looking for three
396 n zr,zx1,zx2,zx3
397 s (zx1,zx2,zx3)=""
398 f s zx1=$o(@zt@(zi,zx1)) q:zx1="" d ;
399 . f s zx2=$o(@zt@(zi,zx1,zx2)) q:zx2="" d ;
400 . . f s zx3=$o(@zt@(zi,zx1,zx2,zx3)) q:zx3="" d ;
401 . . . s zr=$o(@zt@(zi,zx1,zx2,zx3,""))
402 . . . s dortn(zr)=""
403 q
404 ;
[1629]405ISSUB(STR) ; returns true if STR is a subject of some triples
406 N ZZIEN
407 S ZZIEN=$$IENOF(STR) ; string pointer value
408 N ZTN S ZTN=C0XFARY("C0XTN") ; location of triples
409 ;N ZTN S ZTN=$NA(^C0X(101)) ; location of triples -- change this to use FARY --- gpl
410 I $O(@ZTN@("SPO",ZZIEN,""))'="" Q 1
411 E Q ""
412 Q
413 ;
[1539]414IENOF(ZSTRING,FARY) ; EXTRINSIC WHICH RETURNS THE IEN OF ZS IN THE STRINGS FILE
415 I '$D(FARY) D ;
416 . D INITFARY^C0XF2N("C0XFARY")
417 . S FARY="C0XFARY"
418 N ZIEN
419 I $G(ZSTRING)="" Q "" ; NO STRING
420 S ZIEN=$O(@C0XSN@("B",$$EXT^C0XUTIL(ZSTRING),""))
421 I ZIEN="" S ZIEN=-1
422 Q ZIEN
423 ;
424IENOFA(ZOUTARY,INARY,FARY) ; RESOLVE STRINGS TO IEN IN STRINGS FILE
425 ; RETURNS IN ZOUTARY OF THE FORM ZOUTARY("IEN","VAR",IEN)=""
426 I '$D(FARY) D ;
427 . D INITFARY^C0XF2N("C0XFARY")
428 . S FARY="C0XFARY"
429 K ZOUTARY ; START WITH CLEAN RESULTS
430 K C0XFDA2 ; USE A SEPARATE FDA FOR THIS
431 I '$D(C0XVOC) D VOCINIT^C0XUTIL
432 N ZINARY
433 N ZI S ZI=""
434 F S ZI=$O(INARY(ZI)) Q:ZI="" D ;
435 . N ZK
436 . S ZK=$O(INARY(ZI,""))
437 . S ZINARY($$EXT^C0XUTIL(ZI),$$EXT^C0XUTIL(ZK))=""
438 N ZV,ZIEN
439 N ZCNT S ZCNT=0
440 F S ZI=$O(ZINARY(ZI)) Q:ZI="" D ; LOOK FOR MISSING STRINGS
441 . S ZV=$O(ZINARY(ZI,""))
442 . I ZV["^" S ZV=$TR(ZV,"^","|")
443 F S ZI=$O(ZINARY(ZI)) Q:ZI="" D ; NOW GET ALL IENS
444 . S ZV=$O(ZINARY(ZI,""))
445 . I ZV["^" S ZV=$TR(ZV,"^","|")
446 . S ZIEN=$O(@C0XSN@("B",ZV,"")) ; THEY SHOULD BE THERE NOW
447 . I ZIEN="" S ZOUTARY("IEN",ZI)=""
448 . E S ZOUTARY("IEN",ZI,ZIEN)=""
449 Q
450 ;
451output(zwhat,zfname,zdir) ; function to write an array to a host file
452 ; if zdir is ommitted, will output to the CCR directory
453 ; ^TMP("C0CCCR","ODIR")
454 ; if fname is ommitted, will output yyyy-mm-dd-hh-mm-ss-C0XOUT.out
455 ; zwhat is passed by name
456 ;
457 i '$d(zdir) s zdir=$G(^TMP("C0CCCR","ODIR"))
458 i '$d(zfname) d ;
459 . s zfname=$$FMTE^XLFDT($$NOW^XLFDT,7)
460 . s zfname=$tr(zfname,"/","-")
461 . s zfname=$tr(zfname,"@","-")
462 . s zfname=$tr(zfname,":","-")
463 . s zfname=zfname_".out"
464 i $e(zwhat,1,1)'="^" d ; not a global
465 . k ^TMP("C0XOUT",$J)
466 . m ^TMP("C0XOUT",$J)=@zwhat
467 . s zwhat=$na(^TMP("C0XOUT",$J,1))
468 n zout s zout=""
469 s zout=$$OUTPUT^C0CXPATH(zwhat,zfname,zdir)
470 K ^TMP("C0XOUT",$J)
471 Q zout
472 ;
473tagText(ztag) ; extrinsic which returns the location of the text
474 ; associated with ztag
475 n zs,zo
476 s zs=$$subject("fmts:fileTag",ztag)
477 i zs="" d q "" ;
478 . w !,"error, tag is either missing or there are more than one ",ztag
479 s zo=$$object(zs,"fmts:fileSource")
480 i zo="" d q "" ;
481 . w !,"error, tag source not found ",zs
482 w !,zo
483 q $$WHERETXT^C0XF2N(zo)
484 ;
485tagRoot(ztag) ; extrinsic which returns the root for graphs and subjects
486 ; associated with ztag
487 n zs,zo
488 s zs=$$subject("fmts:fileTag",ztag)
489 i zs="" d q "" ;
490 . w !,"error, tag is either missing or there are more than one ",ztag
491 s zo=$$object(zs,"fmts:root")
492 i zo="" d q "" ;
493 . w !,"error, root not found ",zs
494 ;w !,zo
495 q zo
496 ;
Note: See TracBrowser for help on using the repository browser.