MDXMLFM1 ; HOIFO/DP/NCA - Data -> XML Utilities ; [01-10-2003 09:14]
;;1.0;CLINICAL PROCEDURES;**6**;Apr 01, 2004;Build 102
; Integration Agreements:
; IA# 10035 [Supported] ^DPT references
;
; Special note: This routine assumes RESULTS contains the closed
; root specification, ^TMP($J) where the output of
; these calls will go.
; i.e. S RESULTS=$NA(^TMP($J))
;
; Calling app needs to call NEWDOC^MDXMLFM *ONCE*
; to clear the global before building an XML document.
;
LOADALL(IENLIST,DD,FLDS) ; Load complete dataset
;
; Loads entire dataset from @IENLIST@(...)
;
N MDIEN S MDIEN=0
D NEWDOC("RESULTS")
D XMLDATA("STATUS","OK")
F S MDIEN=$O(@IENLIST@(MDIEN)) Q:'MDIEN S MDFDAT=$G(@IENLIST@(MDIEN)) D
.D BLDXML(DD,MDIEN,.FLDS,MDFDAT)
D ENDDOC("RESULTS")
Q
;
LOADONE(IEN,DD,FLDS) ; Load single record as dataset
;
; Not to be used recursively
; Assumes complete data set is one record
;
D NEWDOC("RESULTS")
D XMLDATA("STATUS","OK")
D BLDXML(DD,IEN,.FLDS)
D ENDDOC("RESULTS")
Q
;
LOADFILE(MDNUM,MDROOT,MDFLDS) ; Bulk load file MDNUM into XML
;
; Loads all records and all fields in the DD# MDNUM
; Optionally include a closed root of the index to use MDROOT
; Optionally include a list of fields #;#;#;# will default to "*"
;
N MDIEN,MDNODE,MDIDS,MDTEMP,MDHDR,MDNAME
S MDTEMP=$NA(^TMP("MD_TEMP",$J)) K @MDTEMP
S MDNAME=$$GET1^DID(MDNUM,,,"NAME")
I $G(MDROOT)]"" S:'$D(@MDROOT)#2 MDROOT=""
S:$G(MDROOT)="" MDROOT=$$ROOT^DILFD(MDNUM,,1)
S:$G(MDFLDS)="" MDFLDS="*"
;
; Load the records via Fileman GETS^DIQ
;
S MDIEN=0
F S MDIEN=$O(@MDROOT@(MDIEN)) Q:'MDIEN D
.D GETS^DIQ(MDNUM,MDIEN_",",MDFLDS,"I",MDTEMP)
;
; Grab the tags and types if any records were processed
;
S MDIEN=$O(@MDTEMP@(MDNUM,"")) D:MDIEN]""
.F X=0:0 S X=$O(@MDTEMP@(MDNUM,MDIEN,X)) Q:'X D
..S MDTAG=$$GET1^DID(MDNUM,X,,"LABEL")
..S MDTYPE=$$GET1^DID(MDNUM,X,,"TYPE")
..S MDPTR=$$GET1^DID(MDNUM,X,,"POINTER")
..S @MDTEMP@(MDNUM,0,X,"TAG")=$$TAGSAFE(MDTAG)
..S @MDTEMP@(MDNUM,0,X,"TYPE")=MDTYPE
..S @MDTEMP@(MDNUM,0,X,"PTR")=MDPTR
;
; Ok, lets add the file
;
D XMLDATA("TABLENAME",MDNAME)
S MDIENS=$O(@MDTEMP@(MDNUM,0))
F Q:MDIENS="" D
.D XMLHDR("RECORD")
.S MDFLD=$O(@MDTEMP@(MDNUM,MDIENS,0))
.F Q:MDFLD="" D
..S MDTAG=@MDTEMP@(MDNUM,0,MDFLD,"TAG")
..S MDATA=@MDTEMP@(MDNUM,MDIENS,MDFLD,"I")
..S MDTYPE=@MDTEMP@(MDNUM,0,MDFLD,"TYPE") D
...I MDTYPE["WORD" D XMLWP(MDTAG,MDATA) Q
...I MDTYPE["DATE" D XMLDT(MDTAG,MDATA) Q
...D XMLDATA(MDTAG,MDATA)
..S MDFLD=$O(@MDTEMP@(MDNUM,MDIENS,MDFLD))
.D XMLFTR("RECORD")
.S MDIENS=$O(@MDTEMP@(MDNUM,MDIENS))
Q
;
BLDFLD(RESULTS,DD,FLDS) ; Add a field or field^field to the FLDS array
F D Q:FLDS']""
.S Y=$P(FLDS,"^",1),FLDS=$P(FLDS,"^",2,250)
.S MDFLD=$P(Y,";",1) K RESULTS(MDFLD)
.I $P(Y,";",2)]"" S RESULTS(MDFLD,"FORMAT")=$P(Y,";",2)
.E S RESULTS(MDFLD,"FORMAT")="I"
.I $P(Y,";",3)]"" S RESULTS(MDFLD,"TAG")=$P(Y,";",3)
.E S RESULTS(MDFLD,"TAG")=$TR($$GET1^DID(DD,MDFLD,"","LABEL")," ","_")
.I $P(Y,";",4)]"" S RESULTS(MDFLD,"TYPE")=$P(Y,";",4)
.E S RESULTS(MDFLD,"TYPE")=$$GET1^DID(DD,+MDFLD,"","TYPE")
Q
;
BLDXML(DD,IEN,FLDS,MDFDAT) ; Builds an XML Record based on DD, IEN, and FLDS
; Note: this is a standalone module requiring DD and IEN
; so that it can be easily used by the custom query routines
N MDFLD,MDIENS,MDKTR,X,Y
D XMLHDR("RECORD")
S MDIENS=IEN_",",MDFLD="",MDKTR=0
F S MDFLD=$O(FLDS(MDFLD)) Q:MDFLD="" D
.; .001 is always the IEN *IF* it is included in the view
.I +MDFLD=.001 D XMLDATA(FLDS(MDFLD,"TAG"),+MDIENS) S MDKTR=MDKTR+1 Q
.S MDFMT=$G(FLDS(MDFLD,"FORMAT"),"I")
.; Process as a date
.I $G(FLDS(MDFLD,"TYPE"))["DATE" D Q
..S X=$$GET1^DIQ(DD,MDIENS,MDFLD,"I")
..I X]""&(MDFMT'="I") D S X=Y
...S Y=($E(X,1,3)+1700)_"-"_$E(X,4,5)_"-"_$E(X,6,7) Q:X'["."
...S X=X+.0000001 ; Add it in ensure all the time parts
...S Y=Y_" "_$E(X,9,10)_":"_$E(X,11,12)_":"_$E(X,13,14)
..D XMLDATA(FLDS(MDFLD,"TAG"),X)
.; Process as WP
.I $G(FLDS(MDFLD,"TYPE"))["WORD" D Q
..D XMLHDR(FLDS(MDFLD,"TAG"))
..S Y=$O(@RESULTS@(""),-1)+1
..S X=$$GET1^DIQ(DD,MDIENS,MDFLD,"",$NA(@RESULTS@(Y)))
..D XMLFTR(FLDS(MDFLD,"TAG"))
.; Just return with specified data format
.S MDKTR=MDKTR+1
.D XMLDATA(FLDS(MDFLD,"TAG"),$P(MDFDAT,U,MDKTR))
D XMLFTR("RECORD")
Q
;
XMLCMT(COMMENT) ; Add a comment to a document
D XMLADD("")
Q
;
XMLHDR(TAG) ; Add a header tag to the global
S TAG=$$TAGSAFE(TAG)
D XMLADD("<"_TAG_">")
Q
;
XMLFTR(TAG) ; Add a footer tag to the global
D XMLHDR("/"_TAG)
Q
;
XMLDATA(TAG,X) ; Add a data element to the global
S TAG=$$TAGSAFE(TAG)
I $G(X)="" D XMLADD("<"_TAG_" />")
E D XMLADD("<"_TAG_">"_$$XMLSAFE(X)_""_TAG_">")
Q
;
XMLPT(X) ; Add a standard pt identifier node
S X(1,"NAME")=$P(^DPT(X,0),U)
S X(2,"SSN")=$P(^DPT(X,0),U,9)
S X(3,"SEX")=$P(^DPT(X,0),U,2)
S Y=$P(^DPT(X,0),U,3)
S Y(1)=1700+$E(Y,1,3),Y(2)=+$E(Y,4,5),Y(3)=+$E(Y,6,7)
S X(4,"DOB_Y")=Y(1)
S X(5,"DOB_M")=Y(2)
S X(6,"DOB_D")=Y(3)
D XMLIDS("PATIENT",.X,1)
Q
;
XMLWP(TAG,X) ; Add text in array @X to the global
S TAG=$$TAGSAFE(TAG)
I $G(X)="" D XMLADD("<"_TAG_" />") Q ; Empty global ref
D XMLHDR(TAG)
F Y=0:0 S Y=$O(@X@(Y)) Q:'Y D XMLADD(@X@(Y))
D XMLFTR(TAG)
Q
;
XMLDT(TAG,X) ; Add date or date/time to the global
S TAG=$$TAGSAFE(TAG)
I $G(X)="" D XMLADD("<"_TAG_" />") Q ; No data
; Build the ID array
S X(1,"Y")=(1700+$E(X,1,3))
S X(2,"M")=+$E(X,4,5)
S X(3,"D")=+$E(X,6,7)
D:X]"."
.S X=X+.0000001
.S X(4,"hh")=+$E(X,9,10)
.S X(5,"mm")=+$E(X,11,12)
.S X(6,"ss")=+$E(X,13,14)
D XMLIDS(TAG,.X,1)
Q
;
XMLIDS(TAG,IDS,CLOSE) ; Add a data element to the global with ids
S TAG="<"_$$TAGSAFE(TAG)
F X=0:0 S X=$O(IDS(X)) Q:'X D
.S Y="" F S Y=$O(IDS(X,Y)) Q:Y="" D
..S TAG=TAG_" "_Y_"="""_$$XMLSAFE(IDS(X,Y))_""""
S:$G(CLOSE) TAG=TAG_" /" ; Close out the tag element
S TAG=TAG_">"
D XMLADD(TAG)
Q
;
XMLADD(X) ; Add to the global
S @RESULTS@($O(@RESULTS@(""),-1)+1)=$G(X)
Q
;
ADDERR(X) ;
S MDERROR($O(MDERR(""),-1)+1)=X
Q
;
XMLOK(RESULTS) ; Build an XML OK message
K @RESULTS
S @RESULTS@(0)=""
S @RESULTS@(1)="OK"
S @RESULTS@(2)=""
Q
;
XMLERR(ERRMSG) ; Build an XML error Message to return
K @RESULTS
S @RESULTS@(0)=""
S @RESULTS@(1)="ERROR"
I $D(ERRMSG)=1 D ; Simple one liner
.S @RESULTS@(2)=""_$$XMLSAFE(ERRMSG)_""
I $D(ERRMSG)>2 D ; Load the array into the XML message
.S @RESULTS@(2)=""_$G(ERRMSG,"NO DESCRIPTION")
.S X="ERRMSG" F S X=$Q(@X) Q:X=""!(X'?1"ERRMSG(".E) D
..S @RESULTS@($O(@RESULTS@(""),-1)+1)=$$XMLSAFE(@X)
.S @RESULTS@($O(@RESULTS@(""),-1)+1)=""
S @RESULTS@($O(@RESULTS@(""),-1)+1)=""
Q
;
XMLDATE(X) ; Transform Y into XML safe date
N Y
S Y=($E(X,1,3)+1700)_"-"_$E(X,4,5)_"-"_$E(X,6,7)
D:X["."
.S X=X+.0000001
.S Y=Y_" "_$E(X,9,10)_":"_$E(X,11,12)_":"_$E(X,13,14)
Q Y
;
XMLSAFE(X) ; Transform X into XML safe data
S X=$$TRNSLT(X,"&","&")
S X=$$TRNSLT(X,"<","<")
S X=$$TRNSLT(X,">",">")
S X=$$TRNSLT(X,"'","'")
S X=$$TRNSLT(X,"""",""")
Q X
;
TAGSAFE(X) ; Transform X into XML tag
S:X?1N.E X="_"_X ; Remove starting numeric
Q $TR(X," '`()<>*[]","__________")
;
NEWDOC(ROOT,COMMENT) ; Start a new document
K @RESULTS
D XMLADD("")
I $G(COMMENT)]"" D XMLCMT(COMMENT)
D XMLHDR($G(ROOT,"RESULTS"))
Q
;
ENDDOC(ROOT) ; End this document
D XMLFTR($G(ROOT,"RESULTS"))
Q
;
TRNSLT(X,X1,X2) ; Translate every Y to Z in X
N Y
Q:X'[X1 X ; Nothing to translate
S Y="" F Q:X="" D
.I X[X1 S Y=Y_$P(X,X1)_X2,X=$P(X,X1,2,250) Q
.S Y=Y_X,X=""
Q Y
;