XHDLXM ; SLC/JER - XML Library calls for CM ; 25 Jul 2003 9:42 AM
;;1.0;HEALTHEVET DESKTOP;;Jul 15, 2003
XMLHDR(XHDY,ROOTEL,XHDI) ; Create XML Header for Mresult pass root element
; as ROOTEL
S XHDI=+$G(XHDI)+1
S @XHDY@(XHDI)="<?xml version=""1.0"" encoding=""UTF-8"" ?>"
S XHDI=XHDI+1
S @XHDY@(XHDI)="<"_ROOTEL_">"
Q
;
S XHDI=+$G(XHDI)+1,@XHDY@(XHDI)="</"_ROOTEL_">"
Q
;
ESCAPE(DATA) ; Escapes XML special characters in data
N SPEC
S SPEC("<")="<",SPEC(">")=">",SPEC("""")="""
S SPEC("'")="'",SPEC("&")="&"
Q $$REPLACE^XLFSTR(DATA,.SPEC)
;
FILENTRY(XHDY,FILE,IENS,FLDS,INCID,XHDI) ; Produce XML representation of entry
N XHDF,XHDKI,PCATAG S XHDF=0,XHDI=+$G(XHDI)
I +$G(INCID) D
. S XHDI=XHDI+1,@XHDY@("XMLDOC",XHDI)="<id>"_+IENS_"</id>"
D GETS^DIQ(FILE,IENS,$$FLDS(.FLDS),"IE",XHDY)
F S XHDF=$O(@XHDY@(FILE,IENS,XHDF)) Q:XHDF'>0 D
. N TAG,VAL
. S TAG=$TR($$FLDNAME(XHDF,FILE)," /","")
. S VAL=$G(@XHDY@(FILE,IENS,XHDF,$S($L(FLDS(XHDF),U)=2:$P(FLDS(XHDF),U,2),1:"E")))
. S XHDI=XHDI+1,@XHDY@("XMLDOC",XHDI)="<"_TAG_">"_VAL_"</"_TAG_">"
K @XHDY@(FILE)
Q
FLDS(FLDS) ; Iterate through field list, build DR-string
N XHDI,XHDY S XHDI=0,XHDY=""
F S XHDI=$O(FLDS(XHDI)) Q:+XHDI'>0 D
. S XHDY=XHDY_$S(XHDY="":"",1:";")_XHDI
Q XHDY
FLDNAME(XHDFN,FILENUM) ; Resolve field names
Q $$MIXED($P($G(^DD(FILENUM,XHDFN,0)),U))
MIXED(X) ; Return Mixed Case X
N XHDI,WORD,TMP
S TMP="" F XHDI=1:1:$L(X," ") S WORD=$$LOW^XLFSTR($P(X," ",XHDI)),$E(WORD)=$S(XHDI=1:$E(WORD),1:$$UP^XLFSTR($E(WORD))),TMP=$S(TMP="":WORD,1:TMP_WORD)
Q TMP
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXHDLXM 1682 printed Dec 13, 2024@01:57:15 Page 2
XHDLXM ; SLC/JER - XML Library calls for CM ; 25 Jul 2003 9:42 AM
+1 ;;1.0;HEALTHEVET DESKTOP;;Jul 15, 2003
XMLHDR(XHDY,ROOTEL,XHDI) ; Create XML Header for Mresult pass root element
+1 ; as ROOTEL
+2 SET XHDI=+$GET(XHDI)+1
+3 SET @XHDY@(XHDI)="<?xml version=""1.0"" encoding=""UTF-8"" ?>"
+4 SET XHDI=XHDI+1
+5 SET @XHDY@(XHDI)="<"_ROOTEL_">"
+6 QUIT
+7 ;
+1 SET XHDI=+$GET(XHDI)+1
SET @XHDY@(XHDI)="</"_ROOTEL_">"
+2 QUIT
+3 ;
ESCAPE(DATA) ; Escapes XML special characters in data
+1 NEW SPEC
+2 SET SPEC("<")="<"
SET SPEC(">")=">"
SET SPEC("""")="""
+3 SET SPEC("'")="'"
SET SPEC("&")="&"
+4 QUIT $$REPLACE^XLFSTR(DATA,.SPEC)
+5 ;
FILENTRY(XHDY,FILE,IENS,FLDS,INCID,XHDI) ; Produce XML representation of entry
+1 NEW XHDF,XHDKI,PCATAG
SET XHDF=0
SET XHDI=+$GET(XHDI)
+2 IF +$GET(INCID)
Begin DoDot:1
+3 SET XHDI=XHDI+1
SET @XHDY@("XMLDOC",XHDI)="<id>"_+IENS_"</id>"
End DoDot:1
+4 DO GETS^DIQ(FILE,IENS,$$FLDS(.FLDS),"IE",XHDY)
+5 FOR
SET XHDF=$ORDER(@XHDY@(FILE,IENS,XHDF))
if XHDF'>0
QUIT
Begin DoDot:1
+6 NEW TAG,VAL
+7 SET TAG=$TRANSLATE($$FLDNAME(XHDF,FILE)," /","")
+8 SET VAL=$GET(@XHDY@(FILE,IENS,XHDF,$SELECT($LENGTH(FLDS(XHDF),U)=2:$PIECE(FLDS(XHDF),U,2),1:"E")))
+9 SET XHDI=XHDI+1
SET @XHDY@("XMLDOC",XHDI)="<"_TAG_">"_VAL_"</"_TAG_">"
End DoDot:1
+10 KILL @XHDY@(FILE)
+11 QUIT
FLDS(FLDS) ; Iterate through field list, build DR-string
+1 NEW XHDI,XHDY
SET XHDI=0
SET XHDY=""
+2 FOR
SET XHDI=$ORDER(FLDS(XHDI))
if +XHDI'>0
QUIT
Begin DoDot:1
+3 SET XHDY=XHDY_$SELECT(XHDY="":"",1:";")_XHDI
End DoDot:1
+4 QUIT XHDY
FLDNAME(XHDFN,FILENUM) ; Resolve field names
+1 QUIT $$MIXED($PIECE($GET(^DD(FILENUM,XHDFN,0)),U))
MIXED(X) ; Return Mixed Case X
+1 NEW XHDI,WORD,TMP
+2 SET TMP=""
FOR XHDI=1:1:$LENGTH(X," ")
SET WORD=$$LOW^XLFSTR($PIECE(X," ",XHDI))
SET $EXTRACT(WORD)=$SELECT(XHDI=1:$EXTRACT(WORD),1:$$UP^XLFSTR($EXTRACT(WORD)))
SET TMP=$SELECT(TMP="":WORD,1:TMP_WORD)
+3 QUIT TMP
