Index: ccr/trunk/p/C0CMXML.m
===================================================================
--- ccr/trunk/p/C0CMXML.m	(revision 575)
+++ ccr/trunk/p/C0CMXML.m	(revision 601)
@@ -34,4 +34,24 @@
 	Q
 	;
+TEST3
+ S C0CXMLIN=$NA(^TMP("C0CMXML",$J))
+ K GARY,GTMP,GIDX
+ K @C0CXMLIN
+ W $$FTG^%ZISH("/home/vademo2/CCR/","SampleCCDDocument.xml",$NA(@C0CXMLIN@(1)),3)
+ D CLEANARY("GTMP",C0CXMLIN) ; REMOVE CONTROL CHARACTERS
+ K @C0CXMLIN
+ M @C0CXMLIN=GTMP
+ K GTMP
+ D STRIPTXT("GTMP",C0CXMLIN)
+ K @C0CXMLIN
+ M @C0CXMLIN=GTMP
+ K GTMP
+ S C0CDOCID=$$PARSCCD(C0CXMLIN,"W") W !,"DocID: ",C0CDOCID
+ S REDUX="//ClinicalDocument/component/structuredBody"
+ D XPATH(1,"/","GIDX","GARY",,REDUX)
+ S C0CDOCID=$$PARSE(C0CXMLIN) W !,"DOCID: ",C0CDOCID  ;CALL REGULAR PARSER
+ D XPATH(1,"/","GIDX2","GARY2",,REDUX)
+ Q
+ ;
 XPATH(ZOID,ZPATH,ZXIDX,ZXPARY,ZNUM,ZREDUX)	; RECURSIVE ROUTINE TO POPULATE
 	; THE XPATH INDEX ZXIDX, PASSED BY NAME
@@ -59,5 +79,9 @@
 	N GNXT S GNXT=$$NXTSIB(ZOID)
 	I GNXT'=0 D  ;
-	. D XPATH(GNXT,ZPATH,ZXIDX,ZXPARY,$S(ZNUM>0:ZNUM+1,1:""),ZREDUX) ; DO NEXT SIB
+	. N ZMULT S ZMULT=$$ISMULT(GNXT) ; IS THE SIBLING A MULTIPLE?
+	. I (ZNUM="")&(ZMULT) D  ; SIBLING IS FIRST OF MULTIPLES
+	. . S ZNUM=1 ;
+	. . D XPATH(GNXT,ZPATH,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; DO NEXT SIB
+	. E  D XPATH(GNXT,ZPATH,ZXIDX,ZXPARY,$S(ZNUM>0:ZNUM+1,1:""),ZREDUX) ; DO NEXT SIB
 	Q
 	;
@@ -70,4 +94,5 @@
 ISMULT(ZOID)	; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE
 	N ZN
+	;I $$TAG(ZOID)["entry" B
 	S ZN=$$NXTSIB(ZOID)
 	I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG
@@ -77,4 +102,7 @@
 	Q $$CHILD^MXMLDOM(C0CDOCID,ZOID)
 	;
+PARENT(ZOID) ;RETURNS THE OID OF THE PARENT OF ZOID
+ Q $$PARENT^MXMLDOM(C0CDOCID,ZOID)
+ ;
 TAG(ZOID)	; RETURNS THE XML TAG FOR THE NODE
 	Q $$NAME^MXMLDOM(C0CDOCID,ZOID)
@@ -90,2 +118,140 @@
 	Q
 	;
+PARSCCD(DOC,OPTION) ; THIS WAS COPIED FROM EN^MXMLDOM TO CUSTIMIZE FOR 
+ ; PROCESSING CCDS 
+ N CBK,SUCCESS,LEVEL,NODE,HANDLE
+ K ^TMP("MXMLERR",$J)
+ L +^TMP("MXMLDOM",$J):5
+ E  Q 0
+ S HANDLE=$O(^TMP("MXMLDOM",$J,""),-1)+1,^(HANDLE)=""
+ L -^TMP("MXMLDOM",$J)
+ S CBK("STARTELEMENT")="STARTELE^C0CMXML" ; ONLY THIS ONE IS CHANGED ;GPL
+ S CBK("ENDELEMENT")="ENDELE^MXMLDOM"
+ S CBK("COMMENT")="COMMENT^MXMLDOM"
+ S CBK("CHARACTERS")="CHAR^MXMLDOM"
+ S CBK("ENDDOCUMENT")="ENDDOC^MXMLDOM"
+ S CBK("ERROR")="ERROR^MXMLDOM"
+ S (SUCCESS,LEVEL,LEVEL(0),NODE)=0,OPTION=$G(OPTION,"V1")
+ D EN^MXMLPRSE(DOC,.CBK,OPTION)
+ D:'SUCCESS DELETE^MXMLDOM(HANDLE)
+ Q $S(SUCCESS:HANDLE,1:0)
+ ; Start element
+ ; Create new child node and push info on stack
+STARTELE(ELE,ATTR) ; COPIED FROM STARTELE^MXMLDOM AND MODIFIED TO TREAT
+ ; ATTRIBUTES AS SUBELEMENTS TO MAKE CCD XPATH PROCESSING EASIER
+ N PARENT
+ S PARENT=LEVEL(LEVEL),NODE=NODE+1
+ S:PARENT ^TMP("MXMLDOM",$J,HANDLE,PARENT,"C",NODE)=ELE
+ S LEVEL=LEVEL+1,LEVEL(LEVEL)=NODE,LEVEL(LEVEL,0)=ELE
+ S ^TMP("MXMLDOM",$J,HANDLE,NODE)=ELE,^(NODE,"P")=PARENT
+ ;M ^("A")=ATTR
+ N ZI S ZI="" ; INDEX FOR ATTR
+ F  S ZI=$O(ATTR(ZI)) Q:ZI=""  D  ; FOR EACH ATTRIBUTE
+ . N ELE,TXT ; ABOUT TO RECURSE
+ . S ELE=ZI ; TAG
+ . S TXT=ATTR(ZI) ; DATA
+ . D STARTELE(ELE,"") ; CREATE A NEW SUBNODE
+ . D TXT^MXMLDOM("T") ; INSERT DATA TO TAG
+ . D ENDELE^MXMLDOM(ELE) ; POP BACK UP A LEVEL
+ Q
+ ;
+CLEANARY(OUTARY,INARY) ; GOES THROUGH AN ARRAY AND CALLS CLEAN ON EACH NODE
+ ; INARY AND OUTARY PASSED BY NAME
+ N ZI S ZI=""
+ F  S ZI=$O(@INARY@(ZI)) Q:ZI=""  D  ; FOR EACH NODE
+ . S @OUTARY@(ZI)=$$CLEAN(@INARY@(ZI)) ; CLEAN THE NODE
+ Q
+ ;
+CLEAN(STR) ; extrinsic function; returns string
+ ;; Removes all non printable characters from a string.
+ ;; STR by Value
+ N TR,I
+ F I=0:1:31 S TR=$G(TR)_$C(I)
+ S TR=TR_$C(127)
+ QUIT $TR(STR,TR)
+ ;
+STRIPTXT(OUTARY,ZARY) ; STRIPS THE "TEXT" PORTION OUT OF AN XML FILE
+ ; THIS IS USED TO DELETE THE NARATIVE HTML OUT OF THE CCD XML FILES BECAUSE
+ ; THEY DO NOT WORK RIGHT WITH THE PARSER
+ ;N ZWRK,ZBLD,ZI ; WORK ARRAY,BUILD ARRAY, AND COUNTER
+ S ZI=$O(@ZARY@("")) ; GET FIRST LINE NUMBER
+ D C0CBEGIN("ZWRK",ZI) ; INSERT FIRST LINE IN WORK ARRAY
+ F  S ZI=$O(@ZARY@(ZI)) Q:ZI=""  D  ; FOR EACH LINE OF THE ARRAY
+ . I $O(@ZARY@(ZI))="" D  Q  ; AT THE END 
+ . . D C0CEND("ZWRK",ZI) ; INCLUDE LAST LINE IN WORK ARRAY
+ . I ZI=1 D C0CBEGIN("ZWRK",ZI) ; START WITH FIRST LINE
+ . I @ZARY@(ZI)["<text" D C0CEND("ZWRK",ZI-1) ;PREV LINE IS AN END
+ . I @ZARY@(ZI)["</text>" D C0CBEGIN("ZWRK",ZI+1) ;NEXT LINE IS A BEGIN
+ S ZI=""
+ F  S ZI=$O(ZWRK(ZI)) Q:ZI=""  D  ; MAKE A BUILD LIST FROM THE WORK ARRAY
+ . D QUEUE^C0CXPATH("ZBLD",ZARY,$P(ZWRK(ZI),"^",1),$P(ZWRK(ZI),"^",2))
+ D BUILD^C0CXPATH("ZBLD",OUTARY) ; BUILD NEW ARRAY WITHOUT TEXT SECTIONS
+ K @OUTARY@(0) ; GET RID OF THE LINE COUNT
+ Q
+ ;
+C0CBEGIN(ZA,LN) ; INSERTS A BEGIN LINE LN INTO ARRAY ZWRK, PASSED BY NAME
+ N ZI
+ S ZI=$O(@ZA@(""),-1)
+ I ZI="" S ZI=1
+ E  S ZI=ZI+1 ; INCREMENT COUNT IN WORK ARRAY
+ S $P(@ZA@(ZI),"^",1)=LN
+ Q
+ ;
+C0CEND(ZB,LN) ; INSERTS AN END LINE LN INTO ARRAY ZWRK, PASSED BY NAME
+ N ZI
+ S ZI=$O(@ZB@(""),-1)
+ I ZI="" S ZI=1
+ S $P(@ZB@(ZI),"^",2)=LN
+ Q
+ ;
+FINDTID ; FIND TEMPLATE IDS IN DOM 1
+ S C0CDOCID=1
+ S ZD=$NA(^TMP("MXMLDOM",$J,C0CDOCID))
+ S ZN=""
+ S CURSEC=""
+ S TID=""
+ F  S ZN=$O(@ZD@(ZN)) Q:ZN=""  D  ;
+ . I $$TAG(ZN)="root" D  ;
+ . . I $$TAG($$PARENT(ZN))="templateId" D  ; ONLY LOOKING FOR TEMPLATES
+ . . . S ZG=$$PARENT($$PARENT(ZN))
+ . . . S CMT=$G(@ZD@(ZG,"X",1))
+ . . . I $$TAG(ZG)="section" D  ;START OF A SECTION
+ . . . . S CURSEC=ZG
+ . . . . S SECCMT=$G(@ZD@(CURSEC,"X",1))
+ . . . S TID=$G(@ZD@(ZN,"T",1)) ;TEMPLATE ID
+ . . . I CURSEC'="" D  ; IF WE ARE IN A SECTION
+ . . . . S CCDDIR(CURSEC,SECCMT,ZG,$$TAG(ZG),CMT)=TID
+ . . . W !,$$TAG(ZG)," ",$G(@ZD@(ZG,"X",1))
+ . . . W " root ",ZN," ",@ZD@(ZN,"T",1)
+ Q
+ ;
+GENXDS(ZD) ; GENERATE THE XDS PROTOTYPE RECORDS FROM A CCDDIR ARRAY
+ ; ARRAY ELEMENTS LOOK LIKE:
+ ; CCDDIR(1634," Vital signs section template ",1659,"observation"," Result observaion template ")="2.16.840.1.113883.10.20.1.31"
+ ;or CCDDIR(section node,sec name, cur node,cur tag,cur name)=templateId
+ S ZF=178.101 ; FILE NUMBER FOR THE C0C XDS PROTOTYPE FILE
+ S ZI=$Q(@ZD@("")) ;FIRST ARRAY ELEMENT
+ S DONE=0
+ F  Q:DONE  D  ;
+ . W @ZI,!
+ . S ZJ=$QS(ZI,5)
+ . S ZJ=$E(ZJ,2,$L(ZJ)) ;STRIP THE LEADING SPACE
+ . S C0CFDA(ZF,"?+1,",.01)=ZJ
+ . S C0CFDA(ZF,"?+1,",.02)=$QS(ZI,4) ; TAG FOR THIS TEMPLATE
+ . S C0CFDA(ZF,"?+1,",1)=@ZI
+ . D UPDIE
+ . S ZI=$Q(@ZI)
+ . I ZI="" S DONE=1
+ Q
+ ;
+UPDIE	; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
+ K ZERR
+ D CLEAN^DILF
+ D UPDATE^DIE("","C0CFDA","","ZERR")
+ I $D(ZERR) D  ;
+ . W "ERROR",!
+ . ZWR ZERR
+ . B
+ K C0CFDA
+ Q
+ ;
