Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: MDXMLFM

MDXMLFM.m

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