- MDXMLFM ; HOIFO/DP - Fileman -> 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 D
- .D BLDXML(DD,MDIEN,.FLDS)
- 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) ; 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,X,Y
- D XMLHDR("RECORD")
- S MDIENS=IEN_",",MDFLD=""
- 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) 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
- .I ($G(FLDS(MDFLD,"TYPE"))["SET")&(DD=704.202)&(MDFLD=.09) D Q
- ..I $$GET1^DIQ(DD,MDIENS,MDFLD,MDFMT)["DISABLED" D XMLDATA(FLDS(MDFLD,"TAG"),$$GET1^DIQ(DD,MDIENS,MDFLD,MDFMT)) Q
- ..L +^MDK(704.202,+MDIENS):1
- ..I '$T D XMLDATA(FLDS(MDFLD,"TAG"),"IN_USE") Q
- ..E L -^MDK(704.202,+MDIENS) D XMLDATA(FLDS(MDFLD,"TAG"),$$GET1^DIQ(DD,MDIENS,MDFLD,MDFMT))
- ..Q
- .D XMLDATA(FLDS(MDFLD,"TAG"),$$GET1^DIQ(DD,MDIENS,MDFLD,MDFMT))
- D XMLFTR("RECORD")
- Q
- ;
- XMLCMT(COMMENT) ; Add a comment to a document
- D XMLADD("<!-- "_COMMENT_" -->")
- 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)="<RESULTS>"
- S @RESULTS@(1)="<STATUS>OK</STATUS>"
- S @RESULTS@(2)="</RESULTS>"
- Q
- ;
- XMLERR(ERRMSG) ; Build an XML error Message to return
- K @RESULTS
- S @RESULTS@(0)="<RESULTS>"
- S @RESULTS@(1)="<STATUS>ERROR</STATUS>"
- I $D(ERRMSG)=1 D ; Simple one liner
- .S @RESULTS@(2)="<MESSAGE>"_$$XMLSAFE(ERRMSG)_"</MESSAGE>"
- I $D(ERRMSG)>2 D ; Load the array into the XML message
- .S @RESULTS@(2)="<MESSAGE>"_$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)="</MESSAGE>"
- S @RESULTS@($O(@RESULTS@(""),-1)+1)="</RESULTS>"
- 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("<?xml version=""1.0"" standalone=""yes""?>")
- 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
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMDXMLFM 8287 printed Jan 18, 2025@02:45:47 Page 2
- MDXMLFM ; HOIFO/DP - Fileman -> XML Utilities ; [01-10-2003 09:14]
- +1 ;;1.0;CLINICAL PROCEDURES;**6**;Apr 01, 2004;Build 102
- +2 ; Integration Agreements:
- +3 ; IA# 10035 [Supported] ^DPT references
- +4 ;
- +5 ; Special note: This routine assumes RESULTS contains the closed
- +6 ; root specification, ^TMP($J) where the output of
- +7 ; these calls will go.
- +8 ; i.e. S RESULTS=$NA(^TMP($J))
- +9 ;
- +10 ; Calling app needs to call NEWDOC^MDXMLFM *ONCE*
- +11 ; to clear the global before building an XML document.
- +12 ;
- LOADALL(IENLIST,DD,FLDS) ; Load complete dataset
- +1 ;
- +2 ; Loads entire dataset from @IENLIST@(...)
- +3 ;
- +4 NEW MDIEN
- SET MDIEN=0
- +5 DO NEWDOC("RESULTS")
- +6 DO XMLDATA("STATUS","OK")
- +7 FOR
- SET MDIEN=$ORDER(@IENLIST@(MDIEN))
- if 'MDIEN
- QUIT
- Begin DoDot:1
- +8 DO BLDXML(DD,MDIEN,.FLDS)
- End DoDot:1
- +9 DO ENDDOC("RESULTS")
- +10 QUIT
- +11 ;
- LOADONE(IEN,DD,FLDS) ; Load single record as dataset
- +1 ;
- +2 ; Not to be used recursively
- +3 ; Assumes complete data set is one record
- +4 ;
- +5 DO NEWDOC("RESULTS")
- +6 DO XMLDATA("STATUS","OK")
- +7 DO BLDXML(DD,IEN,.FLDS)
- +8 DO ENDDOC("RESULTS")
- +9 QUIT
- +10 ;
- LOADFILE(MDNUM,MDROOT,MDFLDS) ; Bulk load file MDNUM into XML
- +1 ;
- +2 ; Loads all records and all fields in the DD# MDNUM
- +3 ; Optionally include a closed root of the index to use MDROOT
- +4 ; Optionally include a list of fields #;#;#;# will default to "*"
- +5 ;
- +6 NEW MDIEN,MDNODE,MDIDS,MDTEMP,MDHDR,MDNAME
- +7 SET MDTEMP=$NAME(^TMP("MD_TEMP",$JOB))
- KILL @MDTEMP
- +8 SET MDNAME=$$GET1^DID(MDNUM,,,"NAME")
- +9 IF $GET(MDROOT)]""
- if '$DATA(@MDROOT)#2
- SET MDROOT=""
- +10 if $GET(MDROOT)=""
- SET MDROOT=$$ROOT^DILFD(MDNUM,,1)
- +11 if $GET(MDFLDS)=""
- SET MDFLDS="*"
- +12 ;
- +13 ; Load the records via Fileman GETS^DIQ
- +14 ;
- +15 SET MDIEN=0
- +16 FOR
- SET MDIEN=$ORDER(@MDROOT@(MDIEN))
- if 'MDIEN
- QUIT
- Begin DoDot:1
- +17 DO GETS^DIQ(MDNUM,MDIEN_",",MDFLDS,"I",MDTEMP)
- End DoDot:1
- +18 ;
- +19 ; Grab the tags and types if any records were processed
- +20 ;
- +21 SET MDIEN=$ORDER(@MDTEMP@(MDNUM,""))
- if MDIEN]""
- Begin DoDot:1
- +22 FOR X=0:0
- SET X=$ORDER(@MDTEMP@(MDNUM,MDIEN,X))
- if 'X
- QUIT
- Begin DoDot:2
- +23 SET MDTAG=$$GET1^DID(MDNUM,X,,"LABEL")
- +24 SET MDTYPE=$$GET1^DID(MDNUM,X,,"TYPE")
- +25 SET MDPTR=$$GET1^DID(MDNUM,X,,"POINTER")
- +26 SET @MDTEMP@(MDNUM,0,X,"TAG")=$$TAGSAFE(MDTAG)
- +27 SET @MDTEMP@(MDNUM,0,X,"TYPE")=MDTYPE
- +28 SET @MDTEMP@(MDNUM,0,X,"PTR")=MDPTR
- End DoDot:2
- End DoDot:1
- +29 ;
- +30 ; Ok, lets add the file
- +31 ;
- +32 DO XMLDATA("TABLENAME",MDNAME)
- +33 SET MDIENS=$ORDER(@MDTEMP@(MDNUM,0))
- +34 FOR
- if MDIENS=""
- QUIT
- Begin DoDot:1
- +35 DO XMLHDR("RECORD")
- +36 SET MDFLD=$ORDER(@MDTEMP@(MDNUM,MDIENS,0))
- +37 FOR
- if MDFLD=""
- QUIT
- Begin DoDot:2
- +38 SET MDTAG=@MDTEMP@(MDNUM,0,MDFLD,"TAG")
- +39 SET MDATA=@MDTEMP@(MDNUM,MDIENS,MDFLD,"I")
- +40 SET MDTYPE=@MDTEMP@(MDNUM,0,MDFLD,"TYPE")
- Begin DoDot:3
- +41 IF MDTYPE["WORD"
- DO XMLWP(MDTAG,MDATA)
- QUIT
- +42 IF MDTYPE["DATE"
- DO XMLDT(MDTAG,MDATA)
- QUIT
- +43 DO XMLDATA(MDTAG,MDATA)
- End DoDot:3
- +44 SET MDFLD=$ORDER(@MDTEMP@(MDNUM,MDIENS,MDFLD))
- End DoDot:2
- +45 DO XMLFTR("RECORD")
- +46 SET MDIENS=$ORDER(@MDTEMP@(MDNUM,MDIENS))
- End DoDot:1
- +47 QUIT
- +48 ;
- BLDFLD(RESULTS,DD,FLDS) ; Add a field or field^field to the FLDS array
- +1 FOR
- Begin DoDot:1
- +2 SET Y=$PIECE(FLDS,"^",1)
- SET FLDS=$PIECE(FLDS,"^",2,250)
- +3 SET MDFLD=$PIECE(Y,";",1)
- KILL RESULTS(MDFLD)
- +4 IF $PIECE(Y,";",2)]""
- SET RESULTS(MDFLD,"FORMAT")=$PIECE(Y,";",2)
- +5 IF '$TEST
- SET RESULTS(MDFLD,"FORMAT")="I"
- +6 IF $PIECE(Y,";",3)]""
- SET RESULTS(MDFLD,"TAG")=$PIECE(Y,";",3)
- +7 IF '$TEST
- SET RESULTS(MDFLD,"TAG")=$TRANSLATE($$GET1^DID(DD,MDFLD,"","LABEL")," ","_")
- +8 IF $PIECE(Y,";",4)]""
- SET RESULTS(MDFLD,"TYPE")=$PIECE(Y,";",4)
- +9 IF '$TEST
- SET RESULTS(MDFLD,"TYPE")=$$GET1^DID(DD,+MDFLD,"","TYPE")
- End DoDot:1
- if FLDS']""
- QUIT
- +10 QUIT
- +11 ;
- BLDXML(DD,IEN,FLDS) ; Builds an XML Record based on DD, IEN, and FLDS
- +1 ; Note: this is a standalone module requiring DD and IEN
- +2 ; so that it can be easily used by the custom query routines
- +3 NEW MDFLD,MDIENS,X,Y
- +4 DO XMLHDR("RECORD")
- +5 SET MDIENS=IEN_","
- SET MDFLD=""
- +6 FOR
- SET MDFLD=$ORDER(FLDS(MDFLD))
- if MDFLD=""
- QUIT
- Begin DoDot:1
- +7 ; .001 is always the IEN *IF* it is included in the view
- +8 IF +MDFLD=.001
- DO XMLDATA(FLDS(MDFLD,"TAG"),+MDIENS)
- QUIT
- +9 SET MDFMT=$GET(FLDS(MDFLD,"FORMAT"),"I")
- +10 ; Process as a date
- +11 IF $GET(FLDS(MDFLD,"TYPE"))["DATE"
- Begin DoDot:2
- +12 SET X=$$GET1^DIQ(DD,MDIENS,MDFLD,"I")
- +13 IF X]""&(MDFMT'="I")
- Begin DoDot:3
- +14 SET Y=($EXTRACT(X,1,3)+1700)_"-"_$EXTRACT(X,4,5)_"-"_$EXTRACT(X,6,7)
- if X'["."
- QUIT
- +15 ; Add it in ensure all the time parts
- SET X=X+.0000001
- +16 SET Y=Y_" "_$EXTRACT(X,9,10)_":"_$EXTRACT(X,11,12)_":"_$EXTRACT(X,13,14)
- End DoDot:3
- SET X=Y
- +17 DO XMLDATA(FLDS(MDFLD,"TAG"),X)
- End DoDot:2
- QUIT
- +18 ; Process as WP
- +19 IF $GET(FLDS(MDFLD,"TYPE"))["WORD"
- Begin DoDot:2
- +20 DO XMLHDR(FLDS(MDFLD,"TAG"))
- +21 SET Y=$ORDER(@RESULTS@(""),-1)+1
- +22 SET X=$$GET1^DIQ(DD,MDIENS,MDFLD,"",$NAME(@RESULTS@(Y)))
- +23 DO XMLFTR(FLDS(MDFLD,"TAG"))
- End DoDot:2
- QUIT
- +24 ; Just return with specified data format
- +25 IF ($GET(FLDS(MDFLD,"TYPE"))["SET")&(DD=704.202)&(MDFLD=.09)
- Begin DoDot:2
- +26 IF $$GET1^DIQ(DD,MDIENS,MDFLD,MDFMT)["DISABLED"
- DO XMLDATA(FLDS(MDFLD,"TAG"),$$GET1^DIQ(DD,MDIENS,MDFLD,MDFMT))
- QUIT
- +27 LOCK +^MDK(704.202,+MDIENS):1
- +28 IF '$TEST
- DO XMLDATA(FLDS(MDFLD,"TAG"),"IN_USE")
- QUIT
- +29 IF '$TEST
- LOCK -^MDK(704.202,+MDIENS)
- DO XMLDATA(FLDS(MDFLD,"TAG"),$$GET1^DIQ(DD,MDIENS,MDFLD,MDFMT))
- +30 QUIT
- End DoDot:2
- QUIT
- +31 DO XMLDATA(FLDS(MDFLD,"TAG"),$$GET1^DIQ(DD,MDIENS,MDFLD,MDFMT))
- End DoDot:1
- +32 DO XMLFTR("RECORD")
- +33 QUIT
- +34 ;
- XMLCMT(COMMENT) ; Add a comment to a document
- +1 DO XMLADD("<!-- "_COMMENT_" -->")
- +2 QUIT
- +3 ;
- XMLHDR(TAG) ; Add a header tag to the global
- +1 SET TAG=$$TAGSAFE(TAG)
- +2 DO XMLADD("<"_TAG_">")
- +3 QUIT
- +4 ;
- XMLFTR(TAG) ; Add a footer tag to the global
- +1 DO XMLHDR("/"_TAG)
- +2 QUIT
- +3 ;
- XMLDATA(TAG,X) ; Add a data element to the global
- +1 SET TAG=$$TAGSAFE(TAG)
- +2 IF $GET(X)=""
- DO XMLADD("<"_TAG_" />")
- +3 IF '$TEST
- DO XMLADD("<"_TAG_">"_$$XMLSAFE(X)_"</"_TAG_">")
- +4 QUIT
- +5 ;
- XMLPT(X) ; Add a standard pt identifier node
- +1 SET X(1,"NAME")=$PIECE(^DPT(X,0),U)
- +2 SET X(2,"SSN")=$PIECE(^DPT(X,0),U,9)
- +3 SET X(3,"SEX")=$PIECE(^DPT(X,0),U,2)
- +4 SET Y=$PIECE(^DPT(X,0),U,3)
- +5 SET Y(1)=1700+$EXTRACT(Y,1,3)
- SET Y(2)=+$EXTRACT(Y,4,5)
- SET Y(3)=+$EXTRACT(Y,6,7)
- +6 SET X(4,"DOB_Y")=Y(1)
- +7 SET X(5,"DOB_M")=Y(2)
- +8 SET X(6,"DOB_D")=Y(3)
- +9 DO XMLIDS("PATIENT",.X,1)
- +10 QUIT
- +11 ;
- XMLWP(TAG,X) ; Add text in array @X to the global
- +1 SET TAG=$$TAGSAFE(TAG)
- +2 ; Empty global ref
- IF $GET(X)=""
- DO XMLADD("<"_TAG_" />")
- QUIT
- +3 DO XMLHDR(TAG)
- +4 FOR Y=0:0
- SET Y=$ORDER(@X@(Y))
- if 'Y
- QUIT
- DO XMLADD(@X@(Y))
- +5 DO XMLFTR(TAG)
- +6 QUIT
- +7 ;
- XMLDT(TAG,X) ; Add date or date/time to the global
- +1 SET TAG=$$TAGSAFE(TAG)
- +2 ; No data
- IF $GET(X)=""
- DO XMLADD("<"_TAG_" />")
- QUIT
- +3 ; Build the ID array
- +4 SET X(1,"Y")=(1700+$EXTRACT(X,1,3))
- +5 SET X(2,"M")=+$EXTRACT(X,4,5)
- +6 SET X(3,"D")=+$EXTRACT(X,6,7)
- +7 if X]"."
- Begin DoDot:1
- +8 SET X=X+.0000001
- +9 SET X(4,"hh")=+$EXTRACT(X,9,10)
- +10 SET X(5,"mm")=+$EXTRACT(X,11,12)
- +11 SET X(6,"ss")=+$EXTRACT(X,13,14)
- End DoDot:1
- +12 DO XMLIDS(TAG,.X,1)
- +13 QUIT
- +14 ;
- XMLIDS(TAG,IDS,CLOSE) ; Add a data element to the global with ids
- +1 SET TAG="<"_$$TAGSAFE(TAG)
- +2 FOR X=0:0
- SET X=$ORDER(IDS(X))
- if 'X
- QUIT
- Begin DoDot:1
- +3 SET Y=""
- FOR
- SET Y=$ORDER(IDS(X,Y))
- if Y=""
- QUIT
- Begin DoDot:2
- +4 SET TAG=TAG_" "_Y_"="""_$$XMLSAFE(IDS(X,Y))_""""
- End DoDot:2
- End DoDot:1
- +5 ; Close out the tag element
- if $GET(CLOSE)
- SET TAG=TAG_" /"
- +6 SET TAG=TAG_">"
- +7 DO XMLADD(TAG)
- +8 QUIT
- +9 ;
- XMLADD(X) ; Add to the global
- +1 SET @RESULTS@($ORDER(@RESULTS@(""),-1)+1)=$GET(X)
- +2 QUIT
- +3 ;
- ADDERR(X) ;
- +1 SET MDERROR($ORDER(MDERR(""),-1)+1)=X
- +2 QUIT
- +3 ;
- XMLOK(RESULTS) ; Build an XML OK message
- +1 KILL @RESULTS
- +2 SET @RESULTS@(0)="<RESULTS>"
- +3 SET @RESULTS@(1)="<STATUS>OK</STATUS>"
- +4 SET @RESULTS@(2)="</RESULTS>"
- +5 QUIT
- +6 ;
- XMLERR(ERRMSG) ; Build an XML error Message to return
- +1 KILL @RESULTS
- +2 SET @RESULTS@(0)="<RESULTS>"
- +3 SET @RESULTS@(1)="<STATUS>ERROR</STATUS>"
- +4 ; Simple one liner
- IF $DATA(ERRMSG)=1
- Begin DoDot:1
- +5 SET @RESULTS@(2)="<MESSAGE>"_$$XMLSAFE(ERRMSG)_"</MESSAGE>"
- End DoDot:1
- +6 ; Load the array into the XML message
- IF $DATA(ERRMSG)>2
- Begin DoDot:1
- +7 SET @RESULTS@(2)="<MESSAGE>"_$GET(ERRMSG,"NO DESCRIPTION")
- +8 SET X="ERRMSG"
- FOR
- SET X=$QUERY(@X)
- if X=""!(X'?1"ERRMSG(".E)
- QUIT
- Begin DoDot:2
- +9 SET @RESULTS@($ORDER(@RESULTS@(""),-1)+1)=$$XMLSAFE(@X)
- End DoDot:2
- +10 SET @RESULTS@($ORDER(@RESULTS@(""),-1)+1)="</MESSAGE>"
- End DoDot:1
- +11 SET @RESULTS@($ORDER(@RESULTS@(""),-1)+1)="</RESULTS>"
- +12 QUIT
- +13 ;
- XMLDATE(X) ; Transform Y into XML safe date
- +1 NEW Y
- +2 SET Y=($EXTRACT(X,1,3)+1700)_"-"_$EXTRACT(X,4,5)_"-"_$EXTRACT(X,6,7)
- +3 if X["."
- Begin DoDot:1
- +4 SET X=X+.0000001
- +5 SET Y=Y_" "_$EXTRACT(X,9,10)_":"_$EXTRACT(X,11,12)_":"_$EXTRACT(X,13,14)
- End DoDot:1
- +6 QUIT Y
- +7 ;
- XMLSAFE(X) ; Transform X into XML safe data
- +1 SET X=$$TRNSLT(X,"&","&")
- +2 SET X=$$TRNSLT(X,"<","<")
- +3 SET X=$$TRNSLT(X,">",">")
- +4 SET X=$$TRNSLT(X,"'","'")
- +5 SET X=$$TRNSLT(X,"""",""")
- +6 QUIT X
- +7 ;
- TAGSAFE(X) ; Transform X into XML tag
- +1 ; Remove starting numeric
- if X?1N.E
- SET X="_"_X
- +2 QUIT $TRANSLATE(X," '`()<>*[]","__________")
- +3 ;
- NEWDOC(ROOT,COMMENT) ; Start a new document
- +1 KILL @RESULTS
- +2 DO XMLADD("<?xml version=""1.0"" standalone=""yes""?>")
- +3 IF $GET(COMMENT)]""
- DO XMLCMT(COMMENT)
- +4 DO XMLHDR($GET(ROOT,"RESULTS"))
- +5 QUIT
- +6 ;
- ENDDOC(ROOT) ; End this document
- +1 DO XMLFTR($GET(ROOT,"RESULTS"))
- +2 QUIT
- +3 ;
- TRNSLT(X,X1,X2) ; Translate every Y to Z in X
- +1 NEW Y
- +2 ; Nothing to translate
- if X'[X1
- QUIT X
- +3 SET Y=""
- FOR
- if X=""
- QUIT
- Begin DoDot:1
- +4 IF X[X1
- SET Y=Y_$PIECE(X,X1)_X2
- SET X=$PIECE(X,X1,2,250)
- QUIT
- +5 SET Y=Y_X
- SET X=""
- End DoDot:1
- +6 QUIT Y
- +7 ;