Changeset 630 for ccr/trunk/p/C0CMXML.m
- Timestamp:
- Dec 4, 2009, 4:00:21 PM (14 years ago)
- File:
-
- 1 edited
-
ccr/trunk/p/C0CMXML.m (modified) (4 diffs)
Legend:
- Unmodified
- Added
- Removed
-
ccr/trunk/p/C0CMXML.m
r621 r630 1 C0CMXML ; ERX/GPL - MXML based XPath utilities;10/13/09 17:05 2 ;;0.1;C0P;nopatch;noreleasedate 3 ;Copyright 2009 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 TEST ; 23 S C0CXMLIN=$NA(^TMP("C0CMXML",$J)) 24 K GARY 25 W $$FTG^%ZISH("/home/vademo2/EHR/p/","mxml-test.xml",$NA(@C0CXMLIN@(1)),3) 26 S C0CDOCID=$$PARSE(C0CXMLIN) W !,"DocID: ",C0CDOCID 27 S REDUX="//ContinuityOfCareRecord/Body" 28 D XPATH(1,"/","GIDX","GARY",,REDUX) 29 Q 30 ; 31 TEST2 ; 32 S REDUX="//soap:Envelope/soap:Body/GetPatientFullMedicationHistory5Response/GetPatientFullMedicationHistory5Result/patientDrugDetail" 33 D XPATH(1,"/","GIDX","GARY","",REDUX) 34 Q 35 ; 1 C0CMXML ; GPL - MXML based XPath utilities;10/13/09 17:05 2 ;;0.1;C0C;nopatch;noreleasedate 3 ;Copyright 2009 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 ; THIS FILE CONTAINS THE XPATH CREATOR, THE PARSE CALL TO THE MXML PARSER 22 ; AND THE OUTXML XML GENERATOR THAT OUTPUTS XML FROM AN MXML DOM 23 ; FOR CCD SPECIFIC ROUTINES, SEE C0CMCCD 24 ; FOR TEMPLATE FILE RELATED ROUTINES, SEE C0CMXP 25 ; 26 TEST ; 27 S C0CXMLIN=$NA(^TMP("C0CMXML",$J)) 28 K GARY 29 W $$FTG^%ZISH("/home/vademo2/EHR/p/","mxml-test.xml",$NA(@C0CXMLIN@(1)),3) 30 S C0CDOCID=$$PARSE(C0CXMLIN) W !,"DocID: ",C0CDOCID 31 S REDUX="//ContinuityOfCareRecord/Body" 32 D XPATH(1,"/","GIDX","GARY",,REDUX) 33 Q 34 ; 35 TEST2 ; 36 S REDUX="//soap:Envelope/soap:Body/GetPatientFullMedicationHistory5Response/GetPatientFullMedicationHistory5Result/patientDrugDetail" 37 D XPATH(1,"/","GIDX","GARY","",REDUX) 38 Q 39 ; 36 40 TEST3 37 41 S C0CXMLIN=$NA(^TMP("C0CMXML",$J)) … … 92 96 Q 93 97 ; 94 XPATH(ZOID,ZPATH,ZXIDX,ZXPARY,ZNUM,ZREDUX) 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 PARSE(INXML,INDOC) 129 130 131 132 133 134 ISMULT(ZOID) 135 136 137 138 139 140 141 FIRST(ZOID) 142 143 98 XPATH(ZOID,ZPATH,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE 99 ; THE XPATH INDEX ZXIDX, PASSED BY NAME 100 ; THE XPATH ARRAY XPARY, PASSED BY NAME 101 ; ZOID IS THE STARTING OID 102 ; ZPATH IS THE STARTING XPATH, USUALLY "/" 103 ; ZNUM IS THE MULTIPLE NUMBER [x], USUALLY NULL WHEN ON THE TOP NODE 104 ; ZREDUX IS THE XPATH REDUCTION STRING, TAKEN OUT OF EACH XPATH IF PRESENT 105 I $G(ZREDUX)="" S ZREDUX="" 106 N NEWPATH 107 N NEWNUM S NEWNUM="" 108 I $G(ZNUM)>0 S NEWNUM="["_ZNUM_"]" 109 S NEWPATH=ZPATH_"/"_$$TAG(ZOID)_NEWNUM ; CREATE THE XPATH FOR THIS NODE 110 I $G(ZREDUX)'="" D ; REDUX PROVIDED? 111 . N GT S GT=$P(NEWPATH,ZREDUX,2) 112 . I GT'="" S NEWPATH=GT 113 S @ZXIDX@(NEWPATH)=ZOID ; ADD THE XPATH FOR THIS NODE TO THE XPATH INDEX 114 N GD D DATA("GD",ZOID) ; SEE IF THERE IS DATA FOR THIS NODE 115 I $D(GD(2)) M @ZXPARY@(NEWPATH)=GD ; IF MULITPLE DATA MERGE TO THE ARRAY 116 E I $D(GD(1)) S @ZXPARY@(NEWPATH)=GD(1) ; IF SINGLE VALUE, ADD TO ARRAY 117 N ZFRST S ZFRST=$$FIRST(ZOID) ; SET FIRST CHILD 118 I ZFRST'=0 D ; THERE IS A CHILD 119 . N ZNUM 120 . N ZMULT S ZMULT=$$ISMULT(ZFRST) ; IS FIRST CHILD A MULTIPLE 121 . D XPATH(ZFRST,NEWPATH,ZXIDX,ZXPARY,$S(ZMULT:1,1:""),ZREDUX) ; DO THE CHILD 122 N GNXT S GNXT=$$NXTSIB(ZOID) 123 I $$TAG(GNXT)'=$$TAG(ZOID) S ZNUM="" ; RESET COUNTING AFTER MULTIPLES 124 I GNXT'=0 D ; 125 . N ZMULT S ZMULT=$$ISMULT(GNXT) ; IS THE SIBLING A MULTIPLE? 126 . I (ZNUM="")&(ZMULT) D ; SIBLING IS FIRST OF MULTIPLES 127 . . N ZNUM S ZNUM=1 ; 128 . . D XPATH(GNXT,ZPATH,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; DO NEXT SIB 129 . E D XPATH(GNXT,ZPATH,ZXIDX,ZXPARY,$S(ZNUM>0:ZNUM+1,1:""),ZREDUX) ; DO NEXT SIB 130 Q 131 ; 132 PARSE(INXML,INDOC) ;CALL THE MXML PARSER ON INXML, PASSED BY NAME 133 ; INDOC IS PASSED AS THE DOCUMENT NAME - DON'T KNOW WHERE TO STORE THIS NOW 134 ; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY MXML 135 ;Q $$EN^MXMLDOM(INXML) 136 Q $$EN^MXMLDOM(INXML,"W") 137 ; 138 ISMULT(ZOID) ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE 139 N ZN 140 ;I $$TAG(ZOID)["entry" B 141 S ZN=$$NXTSIB(ZOID) 142 I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG 143 Q 0 144 ; 145 FIRST(ZOID) ;RETURNS THE OID OF THE FIRST CHILD OF ZOID 146 Q $$CHILD^MXMLDOM(C0CDOCID,ZOID) 147 ; 144 148 PARENT(ZOID) ;RETURNS THE OID OF THE PARENT OF ZOID 145 149 Q $$PARENT^MXMLDOM(C0CDOCID,ZOID) … … 151 155 Q 152 156 ; 153 TAG(ZOID) 154 155 156 157 158 159 160 161 162 NXTSIB(ZOID) 163 164 165 DATA(ZT,ZOID) 166 167 168 169 170 171 157 TAG(ZOID) ; RETURNS THE XML TAG FOR THE NODE 158 ;I ZOID=149 B ;GPLTEST 159 N X,Y 160 S Y="" 161 S X=$G(C0CCBK("TAG")) ;IS THERE A CALLBACK FOR THIS ROUTINE 162 I X'="" X X ; EXECUTE THE CALLBACK, SHOULD SET Y 163 I Y="" S Y=$$NAME^MXMLDOM(C0CDOCID,ZOID) 164 Q Y 165 ; 166 NXTSIB(ZOID) ; RETURNS THE NEXT SIBLING 167 Q $$SIBLING^MXMLDOM(C0CDOCID,ZOID) 168 ; 169 DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE 170 ;N ZT,ZN S ZT="" 171 ;S C0CDOM=$NA(^TMP("MXMLDOM",$J,C0CDOCID)) 172 ;Q $G(@C0CDOM@(ZOID,"T",1)) 173 S ZN=$$TEXT^MXMLDOM(C0CDOCID,ZOID,ZT) 174 Q 175 ; 172 176 OUTXML(ZRTN,INID) ; USES C0CMXMLB (MXMLBLD) TO OUTPUT XML FROM AN MXMLDOM 173 177 ; … … 194 198 Q 195 199 ; 196 PARSCCD(DOC,OPTION) ; THIS WAS COPIED FROM EN^MXMLDOM TO CUSTIMIZE FOR 197 ; PROCESSING CCDS 198 N CBK,SUCCESS,LEVEL,NODE,HANDLE 199 K ^TMP("MXMLERR",$J) 200 L +^TMP("MXMLDOM",$J):5 201 E Q 0 202 S HANDLE=$O(^TMP("MXMLDOM",$J,""),-1)+1,^(HANDLE)="" 203 L -^TMP("MXMLDOM",$J) 204 S CBK("STARTELEMENT")="STARTELE^C0CMXML" ; ONLY THIS ONE IS CHANGED ;GPL 205 S CBK("ENDELEMENT")="ENDELE^MXMLDOM" 206 S CBK("COMMENT")="COMMENT^MXMLDOM" 207 S CBK("CHARACTERS")="CHAR^MXMLDOM" 208 S CBK("ENDDOCUMENT")="ENDDOC^MXMLDOM" 209 S CBK("ERROR")="ERROR^MXMLDOM" 210 S (SUCCESS,LEVEL,LEVEL(0),NODE)=0,OPTION=$G(OPTION,"V1") 211 D EN^MXMLPRSE(DOC,.CBK,OPTION) 212 D:'SUCCESS DELETE^MXMLDOM(HANDLE) 213 Q $S(SUCCESS:HANDLE,1:0) 214 ; Start element 215 ; Create new child node and push info on stack 216 STARTELE(ELE,ATTR) ; COPIED FROM STARTELE^MXMLDOM AND MODIFIED TO TREAT 217 ; ATTRIBUTES AS SUBELEMENTS TO MAKE CCD XPATH PROCESSING EASIER 218 N PARENT 219 S PARENT=LEVEL(LEVEL),NODE=NODE+1 220 S:PARENT ^TMP("MXMLDOM",$J,HANDLE,PARENT,"C",NODE)=ELE 221 S LEVEL=LEVEL+1,LEVEL(LEVEL)=NODE,LEVEL(LEVEL,0)=ELE 222 S ^TMP("MXMLDOM",$J,HANDLE,NODE)=ELE,^(NODE,"P")=PARENT 223 ;M ^("A")=ATTR 224 N ZI S ZI="" ; INDEX FOR ATTR 225 F S ZI=$O(ATTR(ZI)) Q:ZI="" D ; FOR EACH ATTRIBUTE 226 . N ELE,TXT ; ABOUT TO RECURSE 227 . S ELE=ZI ; TAG 228 . S TXT=ATTR(ZI) ; DATA 229 . D STARTELE(ELE,"") ; CREATE A NEW SUBNODE 230 . D TXT^MXMLDOM("T") ; INSERT DATA TO TAG 231 . D ENDELE^MXMLDOM(ELE) ; POP BACK UP A LEVEL 232 Q 233 ; 234 CLEANARY(OUTARY,INARY) ; GOES THROUGH AN ARRAY AND CALLS CLEAN ON EACH NODE 235 ; INARY AND OUTARY PASSED BY NAME 236 N ZI S ZI="" 237 F S ZI=$O(@INARY@(ZI)) Q:ZI="" D ; FOR EACH NODE 238 . S @OUTARY@(ZI)=$$CLEAN(@INARY@(ZI)) ; CLEAN THE NODE 239 Q 240 ; 241 CLEAN(STR) ; extrinsic function; returns string 242 ;; Removes all non printable characters from a string. 243 ;; STR by Value 244 N TR,I 245 F I=0:1:31 S TR=$G(TR)_$C(I) 246 S TR=TR_$C(127) 247 QUIT $TR(STR,TR) 248 ; 249 STRIPTXT(OUTARY,ZARY) ; STRIPS THE "TEXT" PORTION OUT OF AN XML FILE 250 ; THIS IS USED TO DELETE THE NARATIVE HTML OUT OF THE CCD XML FILES BECAUSE 251 ; THEY DO NOT WORK RIGHT WITH THE PARSER 252 ;N ZWRK,ZBLD,ZI ; WORK ARRAY,BUILD ARRAY, AND COUNTER 253 S ZI=$O(@ZARY@("")) ; GET FIRST LINE NUMBER 254 D C0CBEGIN("ZWRK",ZI) ; INSERT FIRST LINE IN WORK ARRAY 255 F S ZI=$O(@ZARY@(ZI)) Q:ZI="" D ; FOR EACH LINE OF THE ARRAY 256 . I $O(@ZARY@(ZI))="" D Q ; AT THE END 257 . . D C0CEND("ZWRK",ZI) ; INCLUDE LAST LINE IN WORK ARRAY 258 . I ZI=1 D C0CBEGIN("ZWRK",ZI) ; START WITH FIRST LINE 259 . I @ZARY@(ZI)["<text" D C0CEND("ZWRK",ZI-1) ;PREV LINE IS AN END 260 . I @ZARY@(ZI)["</text>" D C0CBEGIN("ZWRK",ZI+1) ;NEXT LINE IS A BEGIN 261 S ZI="" 262 F S ZI=$O(ZWRK(ZI)) Q:ZI="" D ; MAKE A BUILD LIST FROM THE WORK ARRAY 263 . D QUEUE^C0CXPATH("ZBLD",ZARY,$P(ZWRK(ZI),"^",1),$P(ZWRK(ZI),"^",2)) 264 D BUILD^C0CXPATH("ZBLD",OUTARY) ; BUILD NEW ARRAY WITHOUT TEXT SECTIONS 265 K @OUTARY@(0) ; GET RID OF THE LINE COUNT 266 Q 267 ; 268 C0CBEGIN(ZA,LN) ; INSERTS A BEGIN LINE LN INTO ARRAY ZWRK, PASSED BY NAME 269 N ZI 270 S ZI=$O(@ZA@(""),-1) 271 I ZI="" S ZI=1 272 E S ZI=ZI+1 ; INCREMENT COUNT IN WORK ARRAY 273 S $P(@ZA@(ZI),"^",1)=LN 274 Q 275 ; 276 C0CEND(ZB,LN) ; INSERTS AN END LINE LN INTO ARRAY ZWRK, PASSED BY NAME 277 N ZI 278 S ZI=$O(@ZB@(""),-1) 279 I ZI="" S ZI=1 280 S $P(@ZB@(ZI),"^",2)=LN 281 Q 282 ; 283 SEPARATE(OUTARY,INARY) ; SEPARATES XPATH VARIABLES ACCORDING TO THEIR 284 ; ROOT ; /Problems/etc/etc goes to @OUTARY@("Problems","/Problems/etc/etc") 285 S ZI="" 286 F S ZI=$O(@INARY@(ZI)) Q:ZI="" D ; FOR EACH ELEMENT OF THE ARRAY 287 . S ZJ=$P(ZI,"/",2) ; 288 . I ZJ="" S ZJ=$P(ZI,"/",3) ; 289 . S @OUTARY@(ZJ,ZI)=@INARY@(ZI) 290 Q 291 ; 292 FINDTID ; FIND TEMPLATE IDS IN DOM 1 293 S C0CDOCID=1 294 S ZD=$NA(^TMP("MXMLDOM",$J,C0CDOCID)) 295 S ZN="" 296 S CURSEC="" 297 S TID="" 298 F S ZN=$O(@ZD@(ZN)) Q:ZN="" D ; 299 . I $$TAG(ZN)="root" D ; 300 . . I $$TAG($$PARENT(ZN))="templateId" D ; ONLY LOOKING FOR TEMPLATES 301 . . . S ZG=$$PARENT($$PARENT(ZN)) 302 . . . S ZG2=$$PARENT(ZG) ;COMPONENT THAT HOLDS THIS SECTION 303 . . . S CMT=$G(@ZD@(ZG,"X",1)) 304 . . . I CMT="" S CMT="?" 305 . . . I $$TAG(ZG)="section" D ;START OF A SECTION 306 . . . . S CURSEC=$$PARENT(ZG) 307 . . . . S SECCMT=$G(@ZD@(CURSEC,"X",1)) 308 . . . . I SECCMT="" S SECCMT="?" 309 . . . . S SECTID=$G(@ZD@(ZN,"T",1)) ;SECTION TEMPLATE ID 310 . . . S TID=$G(@ZD@(ZN,"T",1)) ;TEMPLATE ID 311 . . . I CURSEC'="" D ; IF WE ARE IN A SECTION 312 . . . . S CCDDIR(ZG2,CURSEC,$$TAG(ZG2),CMT,SECCMT)=TID 313 . . . . S DOMMAP(ZG2)=CURSEC_U_$$TAG(ZG2)_U_TID_U_SECTID 314 . . . W !,$$TAG(ZG2)," ",$G(@ZD@(ZG,"X",1)) 315 . . . W " root ",ZN," ",@ZD@(ZN,"T",1) 316 Q 317 ; 318 FINDALT ; PROCESS THE DOMMAP AND FIND THE ALT TAGS FOR COMPONENTS 319 ; 320 S ZI="" 321 F S ZI=$O(DOMMAP(ZI)) Q:ZI="" D ; FOR EACH NODE IN THE MAP 322 . S ZJ=DOMMAP(ZI) ; 323 . S PARNODE=$P(ZJ,U,1) ;PARENT NODE 324 . S TAG=$P(ZJ,U,2) ;THIS TAG 325 . S TID=$P(ZJ,U,3) ;THIS TEMPLATE ID 326 . S PARTID=$P(ZJ,U,4) ;PARENT TEMPLATE ID 327 . S ZIEN=$O(^C0CXDS(178.101,"TID",TID,"")) ;THIS NODE IEN 328 . S PARIEN=$O(^C0CXDS(178.101,"TID",PARTID,"")) ;PARENT NODE IEN 329 . I ZI=PARNODE D ; IF THIS IS A SECTION NODE 330 . . S ALTTAG=$$GET1^DIQ(178.101,PARIEN_",",.03) ;ALT TAG FIELD FOR PARENT 331 . . S NAME=$$GET1^DIQ(178.101,ZIEN_",",.01) ;NAME OF THIS NODE'S TEMPLATE 332 . . W ZI," ",TAG," ",ALTTAG," ",NAME,! 333 . . S C0CTAGS(ZI)=ALTTAG 334 . E D ; NOT A SECTION NODE 335 . . N ZJ S ZJ="" 336 . . S ZJ=$O(^C0CXDS(178.101,"D",PARIEN,ZIEN,"")) ;A WHEREUSED POINTER? 337 . . I ZJ'="" D ; THERE IS A NEW LABEL FOR THIS NODE 338 . . . N ZK 339 . . . S ZK=$$GET1^DIQ(178.111,ZJ_","_ZIEN_",",2) 340 . . . I ZK'="" D ; 341 . . . . W "FOUND ",ZK,! 342 . . . . S C0CTAGS(ZI)=ZK ; NEW TAG FOR INTERSECTION 343 Q 344 ; 345 ALTTAG(NODE) ; SET Y EQUAL TO THE ALT TAG FOUND IN C0CTAGS IF NODE IF FOUND 346 ; 347 S Y=$G(C0CTAGS(NODE)) 348 Q 349 ; 350 SETCBK ; SET THE TAG CALLBACK FOR XPATH PROCESSSING OF THE CCD 351 S C0CCBK("TAG")="D ALTTAG(ZOID)" 352 Q 353 ; 354 OUTCCD ; OUTPUT THE PARSED CCD TO A TEXT FILE 355 D TEST3 356 N ZT S ZT=$NA(^TMP("CCDOUT",$J)) 357 N ZI,ZJ 358 S ZI=1 S ZJ="" 359 K @ZT 360 F S ZJ=$O(GARY(ZJ)) Q:ZJ="" D ; 361 . S @ZT@(ZI)=ZJ_"^"_GARY(ZJ) 362 . S ZI=ZI+1 363 S ONAME=$NA(@ZT@(1)) 364 W $$OUTPUT^C0CXPATH(ONAME,"CCDOUT.txt","/home/vademo2/CCR") 365 K @ZT 366 Q 367 ; 368 GENXDS(ZD) ; GENERATE THE XDS PROTOTYPE RECORDS FROM A CCDDIR ARRAY 369 ; ARRAY ELEMENTS LOOK LIKE: 370 ; CCDDIR(1659,1634,"observation"," Result observaion template "," Vital signs section template ")="2.16.840.1.113883.10.20.1.31" 371 ;or CCDDIR(cur node,section node,cur tag,cur name,sec name)=templateId 372 S ZF=178.101 ; FILE NUMBER FOR THE C0C XDS PROTOTYPE FILE 373 S ZI=$Q(@ZD@("")) ;FIRST ARRAY ELEMENT 374 S DONE=0 375 F Q:DONE D ; 376 . W @ZI,! 377 . S ZJ=$QS(ZI,5) 378 . S ZJ=$E(ZJ,2,$L(ZJ)) ;STRIP THE LEADING SPACE 379 . S C0CFDA(ZF,"?+1,",.01)=ZJ 380 . S C0CFDA(ZF,"?+1,",.02)=$QS(ZI,4) ; TAG FOR THIS TEMPLATE 381 . S C0CFDA(ZF,"?+1,",1)=@ZI 382 . D UPDIE 383 . S ZI=$Q(@ZI) 384 . I ZI="" S DONE=1 385 Q 386 ; 387 WHRUSD(ZD) ; UPDATE THE C0C XDS FILE WITH WHERE USED DATA FROM 388 ; CCDDIR PASS BY NAME 389 ; ARRAY ELEMENTS LOOK LIKE: 390 ; CCDDIR(1634," Vital signs section template ",1659,"observation"," Result observaion template ")="2.16.840.1.113883.10.20.1.31" 391 ;or CCDDIR(section node,sec name, cur node,cur tag,cur name)=templateId 392 S ZF=178.101 ; FILE NUMBER FOR THE C0C XDS PROTOTYPE FILE 393 S ZSF=178.111 ; WHERE USED SUBFILE OF C0C XDS PROTOTYPE FILE 394 S ZI=$Q(@ZD@("")) ;FIRST ARRAY ELEMENT 395 S DONE=0 396 F Q:DONE D ; 397 . W @ZI 398 . S ZIEN=$O(^C0CXDS(178.101,"TID",@ZI,"")) ; IEN FOR THIS NODE'S TEMPLATE 399 . W " IEN:",ZIEN 400 . S ZJ=$QS(ZI,2) 401 . S ZJ=$E(ZJ,2,$L(ZJ)) ;STRIP THE LEADING SPACE 402 . S ZPIEN=$O(^C0CXDS(178.101,"B",ZJ,"")) ; PARENT IEN 403 . W " PARENT IEN:",ZPIEN 404 . S ZTAG=$QS(ZI,4) ; TAG FOR THIS TEMPLATE 405 . W " TAG:",ZTAG,! 406 . I ZIEN'=ZPIEN D ; ONLY FOR CHILD TEMPLATES 407 . . S C0CFDA(ZSF,"?+1,"_ZIEN_",",.01)=ZPIEN ; NEW SUBFILE ENTRY WITH PAR PTR 408 . . S C0CFDA(ZSF,"?+1,"_ZIEN_",",1)=ZTAG ; TAG FOR NEW ENTRY 409 . . D UPDIE 410 . ;S C0CFDA(ZF,"?+1,",1)=@ZI 411 . ;D UPDIE 412 . S ZI=$Q(@ZI) 413 . I ZI="" S DONE=1 414 Q 415 ; 416 MKTPLATE(INXML,OUTT) ;MAKE A TEMPLATE FROM INXML, RETURNED IN OUTT 417 ; BOTH PASSED BY NAME 418 ; 419 S C0CDOCID=$$PARSE(INXML,"C0CMKT") 420 S C0CDOM=$NA(^TMP("MXMLDOM",$J,C0CDOCID)) 421 N ZI S ZI="" 422 F S ZI=$O(@C0CDOM@(ZI)) Q:ZI="" D ; FOR EACH NODE IN THE DOM 423 . W !,ZI,$$TAG(ZI) 424 Q 425 ; 426 UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS 200 UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS 427 201 K ZERR 428 202 D CLEAN^DILF
Note:
See TracChangeset
for help on using the changeset viewer.
