| [613] | 1 | MDXMLFM ; HOIFO/DP - Fileman -> XML Utilities ; [01-10-2003 09:14]
|
|---|
| 2 | ;;1.0;CLINICAL PROCEDURES;**6**;Apr 01, 2004;Build 102
|
|---|
| 3 | ; Integration Agreements:
|
|---|
| 4 | ; IA# 10035 [Supported] ^DPT references
|
|---|
| 5 | ;
|
|---|
| 6 | ; Special note: This routine assumes RESULTS contains the closed
|
|---|
| 7 | ; root specification, ^TMP($J) where the output of
|
|---|
| 8 | ; these calls will go.
|
|---|
| 9 | ; i.e. S RESULTS=$NA(^TMP($J))
|
|---|
| 10 | ;
|
|---|
| 11 | ; Calling app needs to call NEWDOC^MDXMLFM *ONCE*
|
|---|
| 12 | ; to clear the global before building an XML document.
|
|---|
| 13 | ;
|
|---|
| 14 | LOADALL(IENLIST,DD,FLDS) ; Load complete dataset
|
|---|
| 15 | ;
|
|---|
| 16 | ; Loads entire dataset from @IENLIST@(...)
|
|---|
| 17 | ;
|
|---|
| 18 | N MDIEN S MDIEN=0
|
|---|
| 19 | D NEWDOC("RESULTS")
|
|---|
| 20 | D XMLDATA("STATUS","OK")
|
|---|
| 21 | F S MDIEN=$O(@IENLIST@(MDIEN)) Q:'MDIEN D
|
|---|
| 22 | .D BLDXML(DD,MDIEN,.FLDS)
|
|---|
| 23 | D ENDDOC("RESULTS")
|
|---|
| 24 | Q
|
|---|
| 25 | ;
|
|---|
| 26 | LOADONE(IEN,DD,FLDS) ; Load single record as dataset
|
|---|
| 27 | ;
|
|---|
| 28 | ; Not to be used recursively
|
|---|
| 29 | ; Assumes complete data set is one record
|
|---|
| 30 | ;
|
|---|
| 31 | D NEWDOC("RESULTS")
|
|---|
| 32 | D XMLDATA("STATUS","OK")
|
|---|
| 33 | D BLDXML(DD,IEN,.FLDS)
|
|---|
| 34 | D ENDDOC("RESULTS")
|
|---|
| 35 | Q
|
|---|
| 36 | ;
|
|---|
| 37 | LOADFILE(MDNUM,MDROOT,MDFLDS) ; Bulk load file MDNUM into XML
|
|---|
| 38 | ;
|
|---|
| 39 | ; Loads all records and all fields in the DD# MDNUM
|
|---|
| 40 | ; Optionally include a closed root of the index to use MDROOT
|
|---|
| 41 | ; Optionally include a list of fields #;#;#;# will default to "*"
|
|---|
| 42 | ;
|
|---|
| 43 | N MDIEN,MDNODE,MDIDS,MDTEMP,MDHDR,MDNAME
|
|---|
| 44 | S MDTEMP=$NA(^TMP("MD_TEMP",$J)) K @MDTEMP
|
|---|
| 45 | S MDNAME=$$GET1^DID(MDNUM,,,"NAME")
|
|---|
| 46 | I $G(MDROOT)]"" S:'$D(@MDROOT)#2 MDROOT=""
|
|---|
| 47 | S:$G(MDROOT)="" MDROOT=$$ROOT^DILFD(MDNUM,,1)
|
|---|
| 48 | S:$G(MDFLDS)="" MDFLDS="*"
|
|---|
| 49 | ;
|
|---|
| 50 | ; Load the records via Fileman GETS^DIQ
|
|---|
| 51 | ;
|
|---|
| 52 | S MDIEN=0
|
|---|
| 53 | F S MDIEN=$O(@MDROOT@(MDIEN)) Q:'MDIEN D
|
|---|
| 54 | .D GETS^DIQ(MDNUM,MDIEN_",",MDFLDS,"I",MDTEMP)
|
|---|
| 55 | ;
|
|---|
| 56 | ; Grab the tags and types if any records were processed
|
|---|
| 57 | ;
|
|---|
| 58 | S MDIEN=$O(@MDTEMP@(MDNUM,"")) D:MDIEN]""
|
|---|
| 59 | .F X=0:0 S X=$O(@MDTEMP@(MDNUM,MDIEN,X)) Q:'X D
|
|---|
| 60 | ..S MDTAG=$$GET1^DID(MDNUM,X,,"LABEL")
|
|---|
| 61 | ..S MDTYPE=$$GET1^DID(MDNUM,X,,"TYPE")
|
|---|
| 62 | ..S MDPTR=$$GET1^DID(MDNUM,X,,"POINTER")
|
|---|
| 63 | ..S @MDTEMP@(MDNUM,0,X,"TAG")=$$TAGSAFE(MDTAG)
|
|---|
| 64 | ..S @MDTEMP@(MDNUM,0,X,"TYPE")=MDTYPE
|
|---|
| 65 | ..S @MDTEMP@(MDNUM,0,X,"PTR")=MDPTR
|
|---|
| 66 | ;
|
|---|
| 67 | ; Ok, lets add the file
|
|---|
| 68 | ;
|
|---|
| 69 | D XMLDATA("TABLENAME",MDNAME)
|
|---|
| 70 | S MDIENS=$O(@MDTEMP@(MDNUM,0))
|
|---|
| 71 | F Q:MDIENS="" D
|
|---|
| 72 | .D XMLHDR("RECORD")
|
|---|
| 73 | .S MDFLD=$O(@MDTEMP@(MDNUM,MDIENS,0))
|
|---|
| 74 | .F Q:MDFLD="" D
|
|---|
| 75 | ..S MDTAG=@MDTEMP@(MDNUM,0,MDFLD,"TAG")
|
|---|
| 76 | ..S MDATA=@MDTEMP@(MDNUM,MDIENS,MDFLD,"I")
|
|---|
| 77 | ..S MDTYPE=@MDTEMP@(MDNUM,0,MDFLD,"TYPE") D
|
|---|
| 78 | ...I MDTYPE["WORD" D XMLWP(MDTAG,MDATA) Q
|
|---|
| 79 | ...I MDTYPE["DATE" D XMLDT(MDTAG,MDATA) Q
|
|---|
| 80 | ...D XMLDATA(MDTAG,MDATA)
|
|---|
| 81 | ..S MDFLD=$O(@MDTEMP@(MDNUM,MDIENS,MDFLD))
|
|---|
| 82 | .D XMLFTR("RECORD")
|
|---|
| 83 | .S MDIENS=$O(@MDTEMP@(MDNUM,MDIENS))
|
|---|
| 84 | Q
|
|---|
| 85 | ;
|
|---|
| 86 | BLDFLD(RESULTS,DD,FLDS) ; Add a field or field^field to the FLDS array
|
|---|
| 87 | F D Q:FLDS']""
|
|---|
| 88 | .S Y=$P(FLDS,"^",1),FLDS=$P(FLDS,"^",2,250)
|
|---|
| 89 | .S MDFLD=$P(Y,";",1) K RESULTS(MDFLD)
|
|---|
| 90 | .I $P(Y,";",2)]"" S RESULTS(MDFLD,"FORMAT")=$P(Y,";",2)
|
|---|
| 91 | .E S RESULTS(MDFLD,"FORMAT")="I"
|
|---|
| 92 | .I $P(Y,";",3)]"" S RESULTS(MDFLD,"TAG")=$P(Y,";",3)
|
|---|
| 93 | .E S RESULTS(MDFLD,"TAG")=$TR($$GET1^DID(DD,MDFLD,"","LABEL")," ","_")
|
|---|
| 94 | .I $P(Y,";",4)]"" S RESULTS(MDFLD,"TYPE")=$P(Y,";",4)
|
|---|
| 95 | .E S RESULTS(MDFLD,"TYPE")=$$GET1^DID(DD,+MDFLD,"","TYPE")
|
|---|
| 96 | Q
|
|---|
| 97 | ;
|
|---|
| 98 | BLDXML(DD,IEN,FLDS) ; Builds an XML Record based on DD, IEN, and FLDS
|
|---|
| 99 | ; Note: this is a standalone module requiring DD and IEN
|
|---|
| 100 | ; so that it can be easily used by the custom query routines
|
|---|
| 101 | N MDFLD,MDIENS,X,Y
|
|---|
| 102 | D XMLHDR("RECORD")
|
|---|
| 103 | S MDIENS=IEN_",",MDFLD=""
|
|---|
| 104 | F S MDFLD=$O(FLDS(MDFLD)) Q:MDFLD="" D
|
|---|
| 105 | .; .001 is always the IEN *IF* it is included in the view
|
|---|
| 106 | .I +MDFLD=.001 D XMLDATA(FLDS(MDFLD,"TAG"),+MDIENS) Q
|
|---|
| 107 | .S MDFMT=$G(FLDS(MDFLD,"FORMAT"),"I")
|
|---|
| 108 | .; Process as a date
|
|---|
| 109 | .I $G(FLDS(MDFLD,"TYPE"))["DATE" D Q
|
|---|
| 110 | ..S X=$$GET1^DIQ(DD,MDIENS,MDFLD,"I")
|
|---|
| 111 | ..I X]""&(MDFMT'="I") D S X=Y
|
|---|
| 112 | ...S Y=($E(X,1,3)+1700)_"-"_$E(X,4,5)_"-"_$E(X,6,7) Q:X'["."
|
|---|
| 113 | ...S X=X+.0000001 ; Add it in ensure all the time parts
|
|---|
| 114 | ...S Y=Y_" "_$E(X,9,10)_":"_$E(X,11,12)_":"_$E(X,13,14)
|
|---|
| 115 | ..D XMLDATA(FLDS(MDFLD,"TAG"),X)
|
|---|
| 116 | .; Process as WP
|
|---|
| 117 | .I $G(FLDS(MDFLD,"TYPE"))["WORD" D Q
|
|---|
| 118 | ..D XMLHDR(FLDS(MDFLD,"TAG"))
|
|---|
| 119 | ..S Y=$O(@RESULTS@(""),-1)+1
|
|---|
| 120 | ..S X=$$GET1^DIQ(DD,MDIENS,MDFLD,"",$NA(@RESULTS@(Y)))
|
|---|
| 121 | ..D XMLFTR(FLDS(MDFLD,"TAG"))
|
|---|
| 122 | .; Just return with specified data format
|
|---|
| 123 | .I ($G(FLDS(MDFLD,"TYPE"))["SET")&(DD=704.202)&(MDFLD=.09) D Q
|
|---|
| 124 | ..I $$GET1^DIQ(DD,MDIENS,MDFLD,MDFMT)["DISABLED" D XMLDATA(FLDS(MDFLD,"TAG"),$$GET1^DIQ(DD,MDIENS,MDFLD,MDFMT)) Q
|
|---|
| 125 | ..L +^MDK(704.202,+MDIENS):1
|
|---|
| 126 | ..I '$T D XMLDATA(FLDS(MDFLD,"TAG"),"IN_USE") Q
|
|---|
| 127 | ..E L -^MDK(704.202,+MDIENS) D XMLDATA(FLDS(MDFLD,"TAG"),$$GET1^DIQ(DD,MDIENS,MDFLD,MDFMT))
|
|---|
| 128 | ..Q
|
|---|
| 129 | .D XMLDATA(FLDS(MDFLD,"TAG"),$$GET1^DIQ(DD,MDIENS,MDFLD,MDFMT))
|
|---|
| 130 | D XMLFTR("RECORD")
|
|---|
| 131 | Q
|
|---|
| 132 | ;
|
|---|
| 133 | XMLCMT(COMMENT) ; Add a comment to a document
|
|---|
| 134 | D XMLADD("<!-- "_COMMENT_" -->")
|
|---|
| 135 | Q
|
|---|
| 136 | ;
|
|---|
| 137 | XMLHDR(TAG) ; Add a header tag to the global
|
|---|
| 138 | S TAG=$$TAGSAFE(TAG)
|
|---|
| 139 | D XMLADD("<"_TAG_">")
|
|---|
| 140 | Q
|
|---|
| 141 | ;
|
|---|
| 142 | XMLFTR(TAG) ; Add a footer tag to the global
|
|---|
| 143 | D XMLHDR("/"_TAG)
|
|---|
| 144 | Q
|
|---|
| 145 | ;
|
|---|
| 146 | XMLDATA(TAG,X) ; Add a data element to the global
|
|---|
| 147 | S TAG=$$TAGSAFE(TAG)
|
|---|
| 148 | I $G(X)="" D XMLADD("<"_TAG_" />")
|
|---|
| 149 | E D XMLADD("<"_TAG_">"_$$XMLSAFE(X)_"</"_TAG_">")
|
|---|
| 150 | Q
|
|---|
| 151 | ;
|
|---|
| 152 | XMLPT(X) ; Add a standard pt identifier node
|
|---|
| 153 | S X(1,"NAME")=$P(^DPT(X,0),U)
|
|---|
| 154 | S X(2,"SSN")=$P(^DPT(X,0),U,9)
|
|---|
| 155 | S X(3,"SEX")=$P(^DPT(X,0),U,2)
|
|---|
| 156 | S Y=$P(^DPT(X,0),U,3)
|
|---|
| 157 | S Y(1)=1700+$E(Y,1,3),Y(2)=+$E(Y,4,5),Y(3)=+$E(Y,6,7)
|
|---|
| 158 | S X(4,"DOB_Y")=Y(1)
|
|---|
| 159 | S X(5,"DOB_M")=Y(2)
|
|---|
| 160 | S X(6,"DOB_D")=Y(3)
|
|---|
| 161 | D XMLIDS("PATIENT",.X,1)
|
|---|
| 162 | Q
|
|---|
| 163 | ;
|
|---|
| 164 | XMLWP(TAG,X) ; Add text in array @X to the global
|
|---|
| 165 | S TAG=$$TAGSAFE(TAG)
|
|---|
| 166 | I $G(X)="" D XMLADD("<"_TAG_" />") Q ; Empty global ref
|
|---|
| 167 | D XMLHDR(TAG)
|
|---|
| 168 | F Y=0:0 S Y=$O(@X@(Y)) Q:'Y D XMLADD(@X@(Y))
|
|---|
| 169 | D XMLFTR(TAG)
|
|---|
| 170 | Q
|
|---|
| 171 | ;
|
|---|
| 172 | XMLDT(TAG,X) ; Add date or date/time to the global
|
|---|
| 173 | S TAG=$$TAGSAFE(TAG)
|
|---|
| 174 | I $G(X)="" D XMLADD("<"_TAG_" />") Q ; No data
|
|---|
| 175 | ; Build the ID array
|
|---|
| 176 | S X(1,"Y")=(1700+$E(X,1,3))
|
|---|
| 177 | S X(2,"M")=+$E(X,4,5)
|
|---|
| 178 | S X(3,"D")=+$E(X,6,7)
|
|---|
| 179 | D:X]"."
|
|---|
| 180 | .S X=X+.0000001
|
|---|
| 181 | .S X(4,"hh")=+$E(X,9,10)
|
|---|
| 182 | .S X(5,"mm")=+$E(X,11,12)
|
|---|
| 183 | .S X(6,"ss")=+$E(X,13,14)
|
|---|
| 184 | D XMLIDS(TAG,.X,1)
|
|---|
| 185 | Q
|
|---|
| 186 | ;
|
|---|
| 187 | XMLIDS(TAG,IDS,CLOSE) ; Add a data element to the global with ids
|
|---|
| 188 | S TAG="<"_$$TAGSAFE(TAG)
|
|---|
| 189 | F X=0:0 S X=$O(IDS(X)) Q:'X D
|
|---|
| 190 | .S Y="" F S Y=$O(IDS(X,Y)) Q:Y="" D
|
|---|
| 191 | ..S TAG=TAG_" "_Y_"="""_$$XMLSAFE(IDS(X,Y))_""""
|
|---|
| 192 | S:$G(CLOSE) TAG=TAG_" /" ; Close out the tag element
|
|---|
| 193 | S TAG=TAG_">"
|
|---|
| 194 | D XMLADD(TAG)
|
|---|
| 195 | Q
|
|---|
| 196 | ;
|
|---|
| 197 | XMLADD(X) ; Add to the global
|
|---|
| 198 | S @RESULTS@($O(@RESULTS@(""),-1)+1)=$G(X)
|
|---|
| 199 | Q
|
|---|
| 200 | ;
|
|---|
| 201 | ADDERR(X) ;
|
|---|
| 202 | S MDERROR($O(MDERR(""),-1)+1)=X
|
|---|
| 203 | Q
|
|---|
| 204 | ;
|
|---|
| 205 | XMLOK(RESULTS) ; Build an XML OK message
|
|---|
| 206 | K @RESULTS
|
|---|
| 207 | S @RESULTS@(0)="<RESULTS>"
|
|---|
| 208 | S @RESULTS@(1)="<STATUS>OK</STATUS>"
|
|---|
| 209 | S @RESULTS@(2)="</RESULTS>"
|
|---|
| 210 | Q
|
|---|
| 211 | ;
|
|---|
| 212 | XMLERR(ERRMSG) ; Build an XML error Message to return
|
|---|
| 213 | K @RESULTS
|
|---|
| 214 | S @RESULTS@(0)="<RESULTS>"
|
|---|
| 215 | S @RESULTS@(1)="<STATUS>ERROR</STATUS>"
|
|---|
| 216 | I $D(ERRMSG)=1 D ; Simple one liner
|
|---|
| 217 | .S @RESULTS@(2)="<MESSAGE>"_$$XMLSAFE(ERRMSG)_"</MESSAGE>"
|
|---|
| 218 | I $D(ERRMSG)>2 D ; Load the array into the XML message
|
|---|
| 219 | .S @RESULTS@(2)="<MESSAGE>"_$G(ERRMSG,"NO DESCRIPTION")
|
|---|
| 220 | .S X="ERRMSG" F S X=$Q(@X) Q:X=""!(X'?1"ERRMSG(".E) D
|
|---|
| 221 | ..S @RESULTS@($O(@RESULTS@(""),-1)+1)=$$XMLSAFE(@X)
|
|---|
| 222 | .S @RESULTS@($O(@RESULTS@(""),-1)+1)="</MESSAGE>"
|
|---|
| 223 | S @RESULTS@($O(@RESULTS@(""),-1)+1)="</RESULTS>"
|
|---|
| 224 | Q
|
|---|
| 225 | ;
|
|---|
| 226 | XMLDATE(X) ; Transform Y into XML safe date
|
|---|
| 227 | N Y
|
|---|
| 228 | S Y=($E(X,1,3)+1700)_"-"_$E(X,4,5)_"-"_$E(X,6,7)
|
|---|
| 229 | D:X["."
|
|---|
| 230 | .S X=X+.0000001
|
|---|
| 231 | .S Y=Y_" "_$E(X,9,10)_":"_$E(X,11,12)_":"_$E(X,13,14)
|
|---|
| 232 | Q Y
|
|---|
| 233 | ;
|
|---|
| 234 | XMLSAFE(X) ; Transform X into XML safe data
|
|---|
| 235 | S X=$$TRNSLT(X,"&","&")
|
|---|
| 236 | S X=$$TRNSLT(X,"<","<")
|
|---|
| 237 | S X=$$TRNSLT(X,">",">")
|
|---|
| 238 | S X=$$TRNSLT(X,"'","'")
|
|---|
| 239 | S X=$$TRNSLT(X,"""",""")
|
|---|
| 240 | Q X
|
|---|
| 241 | ;
|
|---|
| 242 | TAGSAFE(X) ; Transform X into XML tag
|
|---|
| 243 | S:X?1N.E X="_"_X ; Remove starting numeric
|
|---|
| 244 | Q $TR(X," '`()<>*[]","__________")
|
|---|
| 245 | ;
|
|---|
| 246 | NEWDOC(ROOT,COMMENT) ; Start a new document
|
|---|
| 247 | K @RESULTS
|
|---|
| 248 | D XMLADD("<?xml version=""1.0"" standalone=""yes""?>")
|
|---|
| 249 | I $G(COMMENT)]"" D XMLCMT(COMMENT)
|
|---|
| 250 | D XMLHDR($G(ROOT,"RESULTS"))
|
|---|
| 251 | Q
|
|---|
| 252 | ;
|
|---|
| 253 | ENDDOC(ROOT) ; End this document
|
|---|
| 254 | D XMLFTR($G(ROOT,"RESULTS"))
|
|---|
| 255 | Q
|
|---|
| 256 | ;
|
|---|
| 257 | TRNSLT(X,X1,X2) ; Translate every Y to Z in X
|
|---|
| 258 | N Y
|
|---|
| 259 | Q:X'[X1 X ; Nothing to translate
|
|---|
| 260 | S Y="" F Q:X="" D
|
|---|
| 261 | .I X[X1 S Y=Y_$P(X,X1)_X2,X=$P(X,X1,2,250) Q
|
|---|
| 262 | .S Y=Y_X,X=""
|
|---|
| 263 | Q Y
|
|---|
| 264 | ;
|
|---|
