EDPXML ;SLC/KCM - XML Array Utilities ;4/25/12 12:51pm
;;2.0;EMERGENCY DEPARTMENT;;May 2, 2012;Build 103
;
Q
TOARR(SRC,DEST,WAITPAST) ; convert XML in global reference to global/local array
; SRC(n) contains the lines of an XML document
; DEST is return array, DEST(ELE,n,ELE,n....ATTR)= attribute value
; DEST(ELE,n,ELE,n,...0)=element text
; WAITPAST is node to wait for before adding nodes to DEST
;
K ^TMP($J,"EDPXMLSRC") M ^TMP($J,"EDPXMLSRC")=SRC
N STACK,CALLBACK,REF,CREF,WAITING
S STACK=0 S WAITING=($G(WAITPAST)'="")
S CALLBACK("STARTELEMENT")="STARTEL^EDPXML"
S CALLBACK("ENDELEMENT")="ENDEL^EDPXML"
S CALLBACK("CHARACTERS")="CHARS^EDPXML"
D EN^MXMLPRSE($NA(^TMP($J,"EDPXMLSRC")),.CALLBACK,"W")
K ^TMP($J,"EDPXMLSRC")
Q
STARTEL(ELEMENT,ATTR) ; start element
I WAITING,ELEMENT=WAITPAST S WAITING=0 Q
Q:WAITING
N I,X
; new stack level, remove former descendants
S STACK=STACK+1 K STACK(STACK+1)
S STACK(STACK,ELEMENT)=$G(STACK(STACK,ELEMENT))+1
S REF(STACK)=""""_ELEMENT_""","_STACK(STACK,ELEMENT)_","
S REF="DEST(" S I=0 F S I=$O(REF(I)) Q:'I Q:I>STACK S REF=REF_REF(I)
I $D(ATTR) S X="" F S X=$O(ATTR(X)) Q:X="" S @(REF_""""_X_""")")=ATTR(X)
S CREF=$E(REF,1,$L(REF)-1)_",0)"
Q
ENDEL(ELEMENT) ; end element
Q:WAITING
S STACK=STACK-1
Q
CHARS(TXT) ; character data
Q:WAITING Q:'$D(CREF) Q:TXT?.C Q:TXT?." "
S @CREF=TXT
Q
;
TOXML(SOURCE,XMLDOC) ; convert array variable to XML document
; SOURCE is array to convert, SOURCE(ELE,n,ELE,n,...,ATTR)=attribuite value
; SOURCE(ELE,n,ELE,n,...,0)=element text
; SOURCE(ELE,n,ELE,n,...,#)=XML
; XMLDOC(n) contains the lines of the output XML document
N LINE,TOP
S LINE=0
S TOP="" F S TOP=$O(SOURCE(TOP)) Q:TOP="" D BLDELEM("SOURCE",TOP)
Q
BLDELEM(REF,ELEMENT) ; Build an XML element (attributes & value)
N SEQ,SUB,VALUE,ATTRIB,LLINE,CHILDREN
S SEQ=0 F S SEQ=$O(@REF@(ELEMENT,SEQ)) Q:'SEQ D
. S LINE=LINE+1,LLINE=LINE,VALUE="",ATTRIB="",CHILDREN=0
. S SUB="" F S SUB=$O(@REF@(ELEMENT,SEQ,SUB)) Q:SUB="" D
. . I $D(@REF@(ELEMENT,SEQ,SUB))=1 D
. . . I +SUB S CHILDREN=1,LINE=LINE+1,XMLDOC(LINE)=@REF@(ELEMENT,SEQ,SUB) Q
. . . I SUB=0 S VALUE=@REF@(ELEMENT,SEQ,SUB) Q
. . . I 'SUB S ATTRIB=ATTRIB_" "_SUB_"="""_@REF@(ELEMENT,SEQ,SUB)_"""" Q
. . I $D(@REF@(ELEMENT,SEQ,SUB))>1 D
. . . S CHILDREN=1
. . . D BLDELEM($NA(@REF@(ELEMENT,SEQ)),SUB)
. S XMLDOC(LLINE)="<"_ELEMENT_ATTRIB_$S(CHILDREN!$L(VALUE):">",1:"/>")_$$ESC^EDPX(VALUE)
. I 'CHILDREN,$L(VALUE) S XMLDOC(LLINE)=XMLDOC(LLINE)_"</"_ELEMENT_">"
. I CHILDREN S LINE=LINE+1,XMLDOC(LINE)="</"_ELEMENT_">"
Q
;
TOXMLG(SOURCE,XMLDOC) ; convert array variable to XML document
; SOURCE is array to convert, SOURCE(ELE,n,ELE,n,...,ATTR)=attribuite value
; SOURCE(ELE,n,ELE,n,...,0)=element text
; SOURCE(ELE,n,ELE,n,...,#)=XML
; XMLDOC(n) contains the lines of the output XML document
N LINE,TOP
S LINE=0
S TOP="" F S TOP=$O(@SOURCE@(TOP)) Q:TOP="" D BLDELEMG(SOURCE,TOP)
Q
BLDELEMG(REF,ELEMENT) ; Build an XML element (attributes & value)
N SEQ,SUB,VALUE,ATTRIB,LLINE,CHILDREN
S SEQ=0 F S SEQ=$O(@REF@(ELEMENT,SEQ)) Q:'SEQ D
. S LINE=LINE+1,LLINE=LINE,VALUE="",ATTRIB="",CHILDREN=0
. S SUB="" F S SUB=$O(@REF@(ELEMENT,SEQ,SUB)) Q:SUB="" D
. . I $D(@REF@(ELEMENT,SEQ,SUB))=1 D
. . . I +SUB S CHILDREN=1,LINE=LINE+1,@XMLDOC@(LINE)=@REF@(ELEMENT,SEQ,SUB) Q
. . . I SUB=0 S VALUE=@REF@(ELEMENT,SEQ,SUB) Q
. . . I 'SUB S ATTRIB=ATTRIB_" "_SUB_"="""_@REF@(ELEMENT,SEQ,SUB)_"""" Q
. . I $D(@REF@(ELEMENT,SEQ,SUB))>1 D
. . . S CHILDREN=1
. . . D BLDELEMG($NA(@REF@(ELEMENT,SEQ)),SUB)
. S @XMLDOC@(LLINE)="<"_ELEMENT_ATTRIB_$S(CHILDREN!$L(VALUE):">",1:"/>")_$$ESC^EDPX(VALUE)
. I 'CHILDREN,$L(VALUE) S @XMLDOC@(LLINE)=@XMLDOC@(LLINE)_"</"_ELEMENT_">"
. I CHILDREN S LINE=LINE+1,@XMLDOC@(LINE)="</"_ELEMENT_">"
Q
;
; bwf: 12/19/2011 - commenting test logic for the time being.
;
;TESTXML ;
;N XMLIN,SKIP
;M XMLIN=^KCM("VitalRead") S SKIP="data"
;D TOARR(.XMLIN,.EDPARR,SKIP) ZW EDPARR
;Q
;TESTGBL ;
;D TOXML(.EDPARR,.XMLOUT) ZW XMLOUT
;Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEDPXML 4271 printed Mar 13, 2025@20:57:18 Page 2
EDPXML ;SLC/KCM - XML Array Utilities ;4/25/12 12:51pm
+1 ;;2.0;EMERGENCY DEPARTMENT;;May 2, 2012;Build 103
+2 ;
+3 QUIT
TOARR(SRC,DEST,WAITPAST) ; convert XML in global reference to global/local array
+1 ; SRC(n) contains the lines of an XML document
+2 ; DEST is return array, DEST(ELE,n,ELE,n....ATTR)= attribute value
+3 ; DEST(ELE,n,ELE,n,...0)=element text
+4 ; WAITPAST is node to wait for before adding nodes to DEST
+5 ;
+6 KILL ^TMP($JOB,"EDPXMLSRC")
MERGE ^TMP($JOB,"EDPXMLSRC")=SRC
+7 NEW STACK,CALLBACK,REF,CREF,WAITING
+8 SET STACK=0
SET WAITING=($GET(WAITPAST)'="")
+9 SET CALLBACK("STARTELEMENT")="STARTEL^EDPXML"
+10 SET CALLBACK("ENDELEMENT")="ENDEL^EDPXML"
+11 SET CALLBACK("CHARACTERS")="CHARS^EDPXML"
+12 DO EN^MXMLPRSE($NAME(^TMP($JOB,"EDPXMLSRC")),.CALLBACK,"W")
+13 KILL ^TMP($JOB,"EDPXMLSRC")
+14 QUIT
STARTEL(ELEMENT,ATTR) ; start element
+1 IF WAITING
IF ELEMENT=WAITPAST
SET WAITING=0
QUIT
+2 if WAITING
QUIT
+3 NEW I,X
+4 ; new stack level, remove former descendants
+5 SET STACK=STACK+1
KILL STACK(STACK+1)
+6 SET STACK(STACK,ELEMENT)=$GET(STACK(STACK,ELEMENT))+1
+7 SET REF(STACK)=""""_ELEMENT_""","_STACK(STACK,ELEMENT)_","
+8 SET REF="DEST("
SET I=0
FOR
SET I=$ORDER(REF(I))
if 'I
QUIT
if I>STACK
QUIT
SET REF=REF_REF(I)
+9 IF $DATA(ATTR)
SET X=""
FOR
SET X=$ORDER(ATTR(X))
if X=""
QUIT
SET @(REF_""""_X_""")")=ATTR(X)
+10 SET CREF=$EXTRACT(REF,1,$LENGTH(REF)-1)_",0)"
+11 QUIT
ENDEL(ELEMENT) ; end element
+1 if WAITING
QUIT
+2 SET STACK=STACK-1
+3 QUIT
CHARS(TXT) ; character data
+1 if WAITING
QUIT
if '$DATA(CREF)
QUIT
if TXT?.C
QUIT
if TXT?." "
QUIT
+2 SET @CREF=TXT
+3 QUIT
+4 ;
TOXML(SOURCE,XMLDOC) ; convert array variable to XML document
+1 ; SOURCE is array to convert, SOURCE(ELE,n,ELE,n,...,ATTR)=attribuite value
+2 ; SOURCE(ELE,n,ELE,n,...,0)=element text
+3 ; SOURCE(ELE,n,ELE,n,...,#)=XML
+4 ; XMLDOC(n) contains the lines of the output XML document
+5 NEW LINE,TOP
+6 SET LINE=0
+7 SET TOP=""
FOR
SET TOP=$ORDER(SOURCE(TOP))
if TOP=""
QUIT
DO BLDELEM("SOURCE",TOP)
+8 QUIT
BLDELEM(REF,ELEMENT) ; Build an XML element (attributes & value)
+1 NEW SEQ,SUB,VALUE,ATTRIB,LLINE,CHILDREN
+2 SET SEQ=0
FOR
SET SEQ=$ORDER(@REF@(ELEMENT,SEQ))
if 'SEQ
QUIT
Begin DoDot:1
+3 SET LINE=LINE+1
SET LLINE=LINE
SET VALUE=""
SET ATTRIB=""
SET CHILDREN=0
+4 SET SUB=""
FOR
SET SUB=$ORDER(@REF@(ELEMENT,SEQ,SUB))
if SUB=""
QUIT
Begin DoDot:2
+5 IF $DATA(@REF@(ELEMENT,SEQ,SUB))=1
Begin DoDot:3
+6 IF +SUB
SET CHILDREN=1
SET LINE=LINE+1
SET XMLDOC(LINE)=@REF@(ELEMENT,SEQ,SUB)
QUIT
+7 IF SUB=0
SET VALUE=@REF@(ELEMENT,SEQ,SUB)
QUIT
+8 IF 'SUB
SET ATTRIB=ATTRIB_" "_SUB_"="""_@REF@(ELEMENT,SEQ,SUB)_""""
QUIT
End DoDot:3
+9 IF $DATA(@REF@(ELEMENT,SEQ,SUB))>1
Begin DoDot:3
+10 SET CHILDREN=1
+11 DO BLDELEM($NAME(@REF@(ELEMENT,SEQ)),SUB)
End DoDot:3
End DoDot:2
+12 SET XMLDOC(LLINE)="<"_ELEMENT_ATTRIB_$SELECT(CHILDREN!$LENGTH(VALUE):">",1:"/>")_$$ESC^EDPX(VALUE)
+13 IF 'CHILDREN
IF $LENGTH(VALUE)
SET XMLDOC(LLINE)=XMLDOC(LLINE)_"</"_ELEMENT_">"
+14 IF CHILDREN
SET LINE=LINE+1
SET XMLDOC(LINE)="</"_ELEMENT_">"
End DoDot:1
+15 QUIT
+16 ;
TOXMLG(SOURCE,XMLDOC) ; convert array variable to XML document
+1 ; SOURCE is array to convert, SOURCE(ELE,n,ELE,n,...,ATTR)=attribuite value
+2 ; SOURCE(ELE,n,ELE,n,...,0)=element text
+3 ; SOURCE(ELE,n,ELE,n,...,#)=XML
+4 ; XMLDOC(n) contains the lines of the output XML document
+5 NEW LINE,TOP
+6 SET LINE=0
+7 SET TOP=""
FOR
SET TOP=$ORDER(@SOURCE@(TOP))
if TOP=""
QUIT
DO BLDELEMG(SOURCE,TOP)
+8 QUIT
BLDELEMG(REF,ELEMENT) ; Build an XML element (attributes & value)
+1 NEW SEQ,SUB,VALUE,ATTRIB,LLINE,CHILDREN
+2 SET SEQ=0
FOR
SET SEQ=$ORDER(@REF@(ELEMENT,SEQ))
if 'SEQ
QUIT
Begin DoDot:1
+3 SET LINE=LINE+1
SET LLINE=LINE
SET VALUE=""
SET ATTRIB=""
SET CHILDREN=0
+4 SET SUB=""
FOR
SET SUB=$ORDER(@REF@(ELEMENT,SEQ,SUB))
if SUB=""
QUIT
Begin DoDot:2
+5 IF $DATA(@REF@(ELEMENT,SEQ,SUB))=1
Begin DoDot:3
+6 IF +SUB
SET CHILDREN=1
SET LINE=LINE+1
SET @XMLDOC@(LINE)=@REF@(ELEMENT,SEQ,SUB)
QUIT
+7 IF SUB=0
SET VALUE=@REF@(ELEMENT,SEQ,SUB)
QUIT
+8 IF 'SUB
SET ATTRIB=ATTRIB_" "_SUB_"="""_@REF@(ELEMENT,SEQ,SUB)_""""
QUIT
End DoDot:3
+9 IF $DATA(@REF@(ELEMENT,SEQ,SUB))>1
Begin DoDot:3
+10 SET CHILDREN=1
+11 DO BLDELEMG($NAME(@REF@(ELEMENT,SEQ)),SUB)
End DoDot:3
End DoDot:2
+12 SET @XMLDOC@(LLINE)="<"_ELEMENT_ATTRIB_$SELECT(CHILDREN!$LENGTH(VALUE):">",1:"/>")_$$ESC^EDPX(VALUE)
+13 IF 'CHILDREN
IF $LENGTH(VALUE)
SET @XMLDOC@(LLINE)=@XMLDOC@(LLINE)_"</"_ELEMENT_">"
+14 IF CHILDREN
SET LINE=LINE+1
SET @XMLDOC@(LINE)="</"_ELEMENT_">"
End DoDot:1
+15 QUIT
+16 ;
+17 ; bwf: 12/19/2011 - commenting test logic for the time being.
+18 ;
+19 ;TESTXML ;
+20 ;N XMLIN,SKIP
+21 ;M XMLIN=^KCM("VitalRead") S SKIP="data"
+22 ;D TOARR(.XMLIN,.EDPARR,SKIP) ZW EDPARR
+23 ;Q
+24 ;TESTGBL ;
+25 ;D TOXML(.EDPARR,.XMLOUT) ZW XMLOUT
+26 ;Q
