Routine: EDPXML

EDPXML ;SLC/KCM - XML Array Utilities ;4/25/12 12:51pm

 ;;2.0;EMERGENCY DEPARTMENT;;May 2, 2012;Build 103

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")

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)"

ENDEL(ELEMENT) ; end element

 Q:WAITING

 S STACK=STACK-1

CHARS(TXT) ; character data

 Q:WAITING  Q:'$D(CREF)  Q:TXT?.C  Q:TXT?." "

 S @CREF=TXT

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)

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_">"

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)

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_">"

 ; 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

EDPXML.m