| [1343] | 1 | C0XGET1 ; GPL - Fileman Triples entry point routine ;1/12/12 17:05
|
|---|
| 2 | ;;0.1;C0X;nopatch;noreleasedate;Build 7
|
|---|
| 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 | ;
|
|---|
| 22 | LSSUBJ(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 | ;
|
|---|
| [1382] | 28 | graph(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
|
|---|
| [1388] | 39 | I $G(DEBUG) W !,"s:",zsub," p:",zpred," o:",zobj
|
|---|
| [1382] | 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 | ;
|
|---|
| [1349] | 52 | GRAPHS(RTN,C0XFARY) ; LIST ALL GRAPHS
|
|---|
| [1343] | 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 | ;
|
|---|
| 61 | STR(ZIN,C0XFARY) ; EXTRINSIC RETURNS A STRING
|
|---|
| 62 | I '$D(C0XFARY) D INITFARY^C0XF2N("C0XFARY")
|
|---|
| 63 | Q $$GET1^DIQ(C0XSFN,ZIN,.01,"E")
|
|---|
| 64 | ;
|
|---|
| 65 | SPO(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 | ;
|
|---|
| 73 | S(ZNODE,C0XFARY) ; EXTRINSIC RETURNING THE SUBJECT
|
|---|
| 74 | Q $$STR($$GET1^DIQ(C0XTFN,ZNODE,.03,"I")) ;
|
|---|
| 75 | ;
|
|---|
| 76 | P(ZNODE,C0XFARY) ; EXTRINSIC RETURNING THE PREDICATE
|
|---|
| 77 | Q $$STR($$GET1^DIQ(C0XTFN,ZNODE,.04,"I")) ;
|
|---|
| 78 | ;
|
|---|
| 79 | O(ZNODE,C0XFARY) ; EXTRINSIC RETURNING THE OBJECT
|
|---|
| 80 | Q $$STR($$GET1^DIQ(C0XTFN,ZNODE,.05,"I")) ;
|
|---|
| 81 | ;
|
|---|
| 82 | NXT(ZRTN) ;EXTRINSIC FOR THE NEXT NODE IN ARRAY ZRTN, PASSED BY REF
|
|---|
| [1349] | 83 | I '$D(ZRTN) S ZRTN=""
|
|---|
| [1343] | 84 | Q $O(ZRTN(""),-1)+1
|
|---|
| 85 | ;
|
|---|
| 86 | SING(ZRTN,ZG) ; SUBJECTS IN GRAPH
|
|---|
| 87 | ;
|
|---|
| 88 | I '$D(C0XFARY) D INITFARY^C0XF2N("C0XFARY")
|
|---|
| [1349] | 89 | I '$D(ZRTN) S ZRTN=""
|
|---|
| [1343] | 90 | N ZI,ZN S ZI=""
|
|---|
| [1349] | 91 | F S ZI=$O(@C0XTN@("GSPO",ZG,ZI)) Q:ZI="" D ;
|
|---|
| 92 | . S ZRTN($$NXT(.ZRTN),"S")=$$STR(ZI)
|
|---|
| [1343] | 93 | Q
|
|---|
| [1349] | 94 | ;
|
|---|
| [1350] | 95 | qparse(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 | ;
|
|---|
| [1368] | 110 | getGraph(zrtn,zgrf,form) ; get all triples in graph zgrf
|
|---|
| [1391] | 111 | ; forms planned: "rdf" "json" "array" "turtle" "triples" "raw"
|
|---|
| 112 | ; forms supported: "rdf" "json" "array" "raw"
|
|---|
| [1368] | 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 ;
|
|---|
| [1391] | 121 | i form="raw" d rawout^C0XGET1(.zrtn,.ZTRIP) q ;
|
|---|
| [1368] | 122 | W !,"Form not supported: ",form
|
|---|
| 123 | Q
|
|---|
| 124 | ;
|
|---|
| [1350] | 125 | rpctrip(rtn,query,limit,offset) ; rpc to access triples with a query
|
|---|
| 126 | ;
|
|---|
| 127 | n zoff,zlim,zcount,zq
|
|---|
| [1351] | 128 | k rtn
|
|---|
| [1350] | 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 | ;
|
|---|
| [1368] | 142 | triples(triplertn,sub,pred,obj,graph,form,fary) ; returns triples
|
|---|
| [1349] | 143 | I '$D(fary) D ;
|
|---|
| 144 | . D INITFARY^C0XF2N("C0XFARY")
|
|---|
| 145 | . S fary="C0XFARY"
|
|---|
| 146 | D USEFARY^C0XF2N(fary)
|
|---|
| [1368] | 147 | I '$D(form) S form="json"
|
|---|
| [1349] | 148 | k triplertn ; start with a clean return
|
|---|
| 149 | n zsub,zpred,zobj,zgraph,tmprtn
|
|---|
| [1376] | 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
|
|---|
| [1388] | 154 | I $G(DEBUG) W !,"s:",zsub," p:",zpred," o:",zobj
|
|---|
| [1349] | 155 | d trip(.tmprtn,zsub,zpred,zobj,zgraph,fary)
|
|---|
| [1367] | 156 | d ien2tary(.zrary,"tmprtn") ; convert to triples
|
|---|
| [1354] | 157 | ;
|
|---|
| [1368] | 158 | i form="json" d jsonout(.triplertn,.zrary) q ; what follows is 'else'
|
|---|
| 159 | i form="rdf" d rdfout^C0XRDF(.triplertn,.zrary) q ;
|
|---|
| [1391] | 160 | i form="array" d arrayout(.triplertn,.zrary) q ;
|
|---|
| 161 | i form="raw" d rawout(.triplertn,.zrary) q ;
|
|---|
| [1368] | 162 | w !,"form not supported: ",form
|
|---|
| 163 | q
|
|---|
| [1354] | 164 | ;
|
|---|
| [1377] | 165 | subjects(listrtn,pred,obj,graph,form,fary) ; return list of subjects
|
|---|
| 166 | d onelist("S",,$g(pred),$g(obj),$g(fary)) ;subjects
|
|---|
| [1373] | 167 | q
|
|---|
| 168 | ;
|
|---|
| [1381] | 169 | subject(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 | ;
|
|---|
| [1377] | 179 | preds(listrtn,sub,obj,graph,form,fary) ; return list of subjects
|
|---|
| 180 | d onelist("P",$g(sub),,$g(obj),$g(fary)) ;subjects
|
|---|
| [1373] | 181 | q
|
|---|
| 182 | ;
|
|---|
| [1377] | 183 | objects(listrtn,sub,pred,graph,form,fary) ; return list of subjects
|
|---|
| [1376] | 184 | d onelist("O",$g(sub),$g(pred),"",$g(fary)) ;subjects
|
|---|
| [1373] | 185 | q
|
|---|
| 186 | ;
|
|---|
| [1381] | 187 | object(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 | ;
|
|---|
| [1376] | 197 | onelist(zw,sub,pred,obj,fary) ; returns list
|
|---|
| [1373] | 198 | ; zw is S P or O depending on what should be returned
|
|---|
| [1376] | 199 | I $g(fary)="" D ;
|
|---|
| [1373] | 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
|
|---|
| [1376] | 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
|
|---|
| [1388] | 210 | I $G(DEBUG) W !,"s:",zsub," p:",zpred," o:",zobj
|
|---|
| [1373] | 211 | n c0xflag,zi,zx,zt
|
|---|
| 212 | s zt=$na(^C0X(101)) ;
|
|---|
| [1376] | 213 | s c0xflag=$$mask(zsub,zpred,zobj) ; get mask flags
|
|---|
| [1373] | 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
|
|---|
| [1374] | 219 | s ix=$s(zw="O":"d just(zobj)",1:"d zip1(.tmprtn,zt,zi,zobj)")
|
|---|
| [1373] | 220 | s itbl("I001",ii)=ix
|
|---|
| [1376] | 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
|
|---|
| [1374] | 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)")
|
|---|
| [1376] | 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
|
|---|
| [1373] | 242 | s zx=itbl(c0xflag,zi) ; executable instruction to run
|
|---|
| [1376] | 243 | ;i $g(ngraph)'="" s zi="G"_zi ; this is wrong.. don't do graphs yet
|
|---|
| [1388] | 244 | i $g(DEBUG) w !,c0xflag," ",zw," ",zt," ",zi," ",zx,!
|
|---|
| [1376] | 245 | ;zwr itbl
|
|---|
| [1373] | 246 | x zx
|
|---|
| 247 | k listrtn
|
|---|
| 248 | d strings(.listrtn,"tmprtn") ; convert pointer to strings
|
|---|
| 249 | q
|
|---|
| 250 | ;
|
|---|
| [1374] | 251 | just(zin) ; add one element to tmprtn
|
|---|
| 252 | s tmprtn(zin)=""
|
|---|
| 253 | q
|
|---|
| 254 | ;
|
|---|
| [1373] | 255 | zip(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 | ;
|
|---|
| 262 | zip1(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 | ;
|
|---|
| 269 | zip2(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 | ;
|
|---|
| [1368] | 276 | arrayout(rtn,zary) ; output an array of triples
|
|---|
| [1354] | 277 | ;
|
|---|
| 278 | s zrsub=""
|
|---|
| 279 | s zcnt=1
|
|---|
| [1368] | 280 | f s zrsub=$o(zary(zrsub)) q:zrsub="" d ; organized by subject
|
|---|
| [1354] | 281 | . s zzz=""
|
|---|
| [1368] | 282 | . f s zzz=$o(zary(zrsub,zzz)) q:zzz="" d ; pred and obj
|
|---|
| 283 | . . s rtn(zcnt)=zrsub_"^"_zzz
|
|---|
| [1354] | 284 | . . s zcnt=zcnt+1
|
|---|
| [1349] | 285 | q
|
|---|
| 286 | ;
|
|---|
| [1391] | 287 | rawout(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 | ;
|
|---|
| [1373] | 298 | strings(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
|
|---|
| [1382] | 304 | . ;s zs=$$GET1^DIQ(C0XSFN,zzz_",",.01)
|
|---|
| 305 | . s zs=$$NSP^C0XUTIL(zzz) ; get namespaced string
|
|---|
| [1373] | 306 | . q:zs=""
|
|---|
| [1382] | 307 | . s zrary(zs)="" ;
|
|---|
| [1373] | 308 | q
|
|---|
| 309 | ;
|
|---|
| [1367] | 310 | ien2tary(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 | ;
|
|---|
| [1372] | 314 | k zrary ; start out clean
|
|---|
| [1367] | 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 | ;
|
|---|
| [1354] | 325 | jsonout(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 | ;
|
|---|
| [1376] | 339 | mask(zsub,zpred,zobj) ; function to return mask information
|
|---|
| [1373] | 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 | ;
|
|---|
| [1349] | 348 | trip(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)) ;
|
|---|
| [1376] | 354 | s c0xflag=$$mask(nsub,npred,nobj) ; get mask flags
|
|---|
| [1349] | 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
|
|---|
| [1388] | 367 | i $g(DEBUG) w !,zx
|
|---|
| [1349] | 368 | x zx
|
|---|
| 369 | q
|
|---|
| 370 | ;
|
|---|
| 371 | do0(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 | ;
|
|---|
| 378 | do1(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 | ;
|
|---|
| 386 | do2(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 | ;
|
|---|
| 395 | do3(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 | ;
|
|---|
| [1376] | 405 | IENOF(ZSTRING,FARY) ; EXTRINSIC WHICH RETURNS THE IEN OF ZS IN THE STRINGS FILE
|
|---|
| 406 | I '$D(FARY) D ;
|
|---|
| 407 | . D INITFARY^C0XF2N("C0XFARY")
|
|---|
| 408 | . S FARY="C0XFARY"
|
|---|
| 409 | N ZIEN
|
|---|
| 410 | I $G(ZSTRING)="" Q "" ; NO STRING
|
|---|
| [1387] | 411 | S ZIEN=$O(@C0XSN@("B",$$EXT^C0XUTIL(ZSTRING),""))
|
|---|
| [1376] | 412 | Q ZIEN
|
|---|
| 413 | ;
|
|---|
| 414 | IENOFA(ZOUTARY,INARY,FARY) ; RESOLVE STRINGS TO IEN IN STRINGS FILE
|
|---|
| 415 | ; RETURNS IN ZOUTARY OF THE FORM ZOUTARY("IEN","VAR",IEN)=""
|
|---|
| 416 | I '$D(FARY) D ;
|
|---|
| 417 | . D INITFARY^C0XF2N("C0XFARY")
|
|---|
| 418 | . S FARY="C0XFARY"
|
|---|
| 419 | K ZOUTARY ; START WITH CLEAN RESULTS
|
|---|
| 420 | K C0XFDA2 ; USE A SEPARATE FDA FOR THIS
|
|---|
| 421 | I '$D(C0XVOC) D VOCINIT^C0XUTIL
|
|---|
| 422 | N ZINARY
|
|---|
| 423 | N ZI S ZI=""
|
|---|
| 424 | F S ZI=$O(INARY(ZI)) Q:ZI="" D ;
|
|---|
| 425 | . N ZK
|
|---|
| 426 | . S ZK=$O(INARY(ZI,""))
|
|---|
| 427 | . S ZINARY($$EXT^C0XUTIL(ZI),$$EXT^C0XUTIL(ZK))=""
|
|---|
| 428 | N ZV,ZIEN
|
|---|
| 429 | N ZCNT S ZCNT=0
|
|---|
| 430 | F S ZI=$O(ZINARY(ZI)) Q:ZI="" D ; LOOK FOR MISSING STRINGS
|
|---|
| 431 | . S ZV=$O(ZINARY(ZI,""))
|
|---|
| 432 | . I ZV["^" S ZV=$TR(ZV,"^","|")
|
|---|
| 433 | F S ZI=$O(ZINARY(ZI)) Q:ZI="" D ; NOW GET ALL IENS
|
|---|
| 434 | . S ZV=$O(ZINARY(ZI,""))
|
|---|
| 435 | . I ZV["^" S ZV=$TR(ZV,"^","|")
|
|---|
| 436 | . S ZIEN=$O(@C0XSN@("B",ZV,"")) ; THEY SHOULD BE THERE NOW
|
|---|
| 437 | . I ZIEN="" S ZOUTARY("IEN",ZI)=""
|
|---|
| 438 | . E S ZOUTARY("IEN",ZI,ZIEN)=""
|
|---|
| 439 | Q
|
|---|
| 440 | ;
|
|---|
| [1371] | 441 | output(zwhat,zfname,zdir) ; function to write an array to a host file
|
|---|
| 442 | ; if zdir is ommitted, will output to the CCR directory
|
|---|
| 443 | ; ^TMP("C0CCCR","ODIR")
|
|---|
| 444 | ; if fname is ommitted, will output yyyy-mm-dd-hh-mm-ss-C0XOUT.out
|
|---|
| 445 | ; zwhat is passed by name
|
|---|
| 446 | ;
|
|---|
| 447 | i '$d(zdir) s zdir=$G(^TMP("C0CCCR","ODIR"))
|
|---|
| 448 | i '$d(zfname) d ;
|
|---|
| 449 | . s zfname=$$FMTE^XLFDT($$NOW^XLFDT,7)
|
|---|
| 450 | . s zfname=$tr(zfname,"/","-")
|
|---|
| 451 | . s zfname=$tr(zfname,"@","-")
|
|---|
| 452 | . s zfname=$tr(zfname,":","-")
|
|---|
| 453 | . s zfname=zfname_".out"
|
|---|
| 454 | i $e(zwhat,1,1)'="^" d ; not a global
|
|---|
| 455 | . k ^TMP("C0XOUT",$J)
|
|---|
| 456 | . m ^TMP("C0XOUT",$J)=@zwhat
|
|---|
| 457 | . s zwhat=$na(^TMP("C0XOUT",$J,1))
|
|---|
| 458 | n zout s zout=""
|
|---|
| 459 | s zout=$$OUTPUT^C0CXPATH(zwhat,zfname,zdir)
|
|---|
| 460 | K ^TMP("C0XOUT",$J)
|
|---|
| 461 | Q zout
|
|---|
| [1382] | 462 | ;
|
|---|
| 463 | tagText(ztag) ; extrinsic which returns the location of the text
|
|---|
| 464 | ; associated with ztag
|
|---|
| 465 | n zs,zo
|
|---|
| [1383] | 466 | s zs=$$subject("fmts:fileTag",ztag)
|
|---|
| [1386] | 467 | i zs="" d q "" ;
|
|---|
| [1382] | 468 | . w !,"error, tag is either missing or there are more than one ",ztag
|
|---|
| [1383] | 469 | s zo=$$object(zs,"fmts:fileSource")
|
|---|
| [1386] | 470 | i zo="" d q "" ;
|
|---|
| [1382] | 471 | . w !,"error, tag source not found ",zs
|
|---|
| 472 | w !,zo
|
|---|
| 473 | q $$WHERETXT^C0XF2N(zo)
|
|---|
| [1388] | 474 | ;
|
|---|
| 475 | tagRoot(ztag) ; extrinsic which returns the root for graphs and subjects
|
|---|
| 476 | ; associated with ztag
|
|---|
| 477 | n zs,zo
|
|---|
| 478 | s zs=$$subject("fmts:fileTag",ztag)
|
|---|
| 479 | i zs="" d q "" ;
|
|---|
| 480 | . w !,"error, tag is either missing or there are more than one ",ztag
|
|---|
| 481 | s zo=$$object(zs,"fmts:root")
|
|---|
| 482 | i zo="" d q "" ;
|
|---|
| 483 | . w !,"error, root not found ",zs
|
|---|
| 484 | ;w !,zo
|
|---|
| 485 | q zo
|
|---|
| [1371] | 486 | ; |
|---|
