source: FOIAVistA/trunk/r/CLINICAL_PROCEDURES-MD/MDXMLFM1.m@ 1757

Last change on this file since 1757 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 7.6 KB
Line 
1MDXMLFM1 ; HOIFO/DP/NCA - Data -> 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 ;
14LOADALL(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 S MDFDAT=$G(@IENLIST@(MDIEN)) D
22 .D BLDXML(DD,MDIEN,.FLDS,MDFDAT)
23 D ENDDOC("RESULTS")
24 Q
25 ;
26LOADONE(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 ;
37LOADFILE(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 ;
86BLDFLD(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 ;
98BLDXML(DD,IEN,FLDS,MDFDAT) ; 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,MDKTR,X,Y
102 D XMLHDR("RECORD")
103 S MDIENS=IEN_",",MDFLD="",MDKTR=0
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) S MDKTR=MDKTR+1 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 .S MDKTR=MDKTR+1
124 .D XMLDATA(FLDS(MDFLD,"TAG"),$P(MDFDAT,U,MDKTR))
125 D XMLFTR("RECORD")
126 Q
127 ;
128XMLCMT(COMMENT) ; Add a comment to a document
129 D XMLADD("<!-- "_COMMENT_" -->")
130 Q
131 ;
132XMLHDR(TAG) ; Add a header tag to the global
133 S TAG=$$TAGSAFE(TAG)
134 D XMLADD("<"_TAG_">")
135 Q
136 ;
137XMLFTR(TAG) ; Add a footer tag to the global
138 D XMLHDR("/"_TAG)
139 Q
140 ;
141XMLDATA(TAG,X) ; Add a data element to the global
142 S TAG=$$TAGSAFE(TAG)
143 I $G(X)="" D XMLADD("<"_TAG_" />")
144 E D XMLADD("<"_TAG_">"_$$XMLSAFE(X)_"</"_TAG_">")
145 Q
146 ;
147XMLPT(X) ; Add a standard pt identifier node
148 S X(1,"NAME")=$P(^DPT(X,0),U)
149 S X(2,"SSN")=$P(^DPT(X,0),U,9)
150 S X(3,"SEX")=$P(^DPT(X,0),U,2)
151 S Y=$P(^DPT(X,0),U,3)
152 S Y(1)=1700+$E(Y,1,3),Y(2)=+$E(Y,4,5),Y(3)=+$E(Y,6,7)
153 S X(4,"DOB_Y")=Y(1)
154 S X(5,"DOB_M")=Y(2)
155 S X(6,"DOB_D")=Y(3)
156 D XMLIDS("PATIENT",.X,1)
157 Q
158 ;
159XMLWP(TAG,X) ; Add text in array @X to the global
160 S TAG=$$TAGSAFE(TAG)
161 I $G(X)="" D XMLADD("<"_TAG_" />") Q ; Empty global ref
162 D XMLHDR(TAG)
163 F Y=0:0 S Y=$O(@X@(Y)) Q:'Y D XMLADD(@X@(Y))
164 D XMLFTR(TAG)
165 Q
166 ;
167XMLDT(TAG,X) ; Add date or date/time to the global
168 S TAG=$$TAGSAFE(TAG)
169 I $G(X)="" D XMLADD("<"_TAG_" />") Q ; No data
170 ; Build the ID array
171 S X(1,"Y")=(1700+$E(X,1,3))
172 S X(2,"M")=+$E(X,4,5)
173 S X(3,"D")=+$E(X,6,7)
174 D:X]"."
175 .S X=X+.0000001
176 .S X(4,"hh")=+$E(X,9,10)
177 .S X(5,"mm")=+$E(X,11,12)
178 .S X(6,"ss")=+$E(X,13,14)
179 D XMLIDS(TAG,.X,1)
180 Q
181 ;
182XMLIDS(TAG,IDS,CLOSE) ; Add a data element to the global with ids
183 S TAG="<"_$$TAGSAFE(TAG)
184 F X=0:0 S X=$O(IDS(X)) Q:'X D
185 .S Y="" F S Y=$O(IDS(X,Y)) Q:Y="" D
186 ..S TAG=TAG_" "_Y_"="""_$$XMLSAFE(IDS(X,Y))_""""
187 S:$G(CLOSE) TAG=TAG_" /" ; Close out the tag element
188 S TAG=TAG_">"
189 D XMLADD(TAG)
190 Q
191 ;
192XMLADD(X) ; Add to the global
193 S @RESULTS@($O(@RESULTS@(""),-1)+1)=$G(X)
194 Q
195 ;
196ADDERR(X) ;
197 S MDERROR($O(MDERR(""),-1)+1)=X
198 Q
199 ;
200XMLOK(RESULTS) ; Build an XML OK message
201 K @RESULTS
202 S @RESULTS@(0)="<RESULTS>"
203 S @RESULTS@(1)="<STATUS>OK</STATUS>"
204 S @RESULTS@(2)="</RESULTS>"
205 Q
206 ;
207XMLERR(ERRMSG) ; Build an XML error Message to return
208 K @RESULTS
209 S @RESULTS@(0)="<RESULTS>"
210 S @RESULTS@(1)="<STATUS>ERROR</STATUS>"
211 I $D(ERRMSG)=1 D ; Simple one liner
212 .S @RESULTS@(2)="<MESSAGE>"_$$XMLSAFE(ERRMSG)_"</MESSAGE>"
213 I $D(ERRMSG)>2 D ; Load the array into the XML message
214 .S @RESULTS@(2)="<MESSAGE>"_$G(ERRMSG,"NO DESCRIPTION")
215 .S X="ERRMSG" F S X=$Q(@X) Q:X=""!(X'?1"ERRMSG(".E) D
216 ..S @RESULTS@($O(@RESULTS@(""),-1)+1)=$$XMLSAFE(@X)
217 .S @RESULTS@($O(@RESULTS@(""),-1)+1)="</MESSAGE>"
218 S @RESULTS@($O(@RESULTS@(""),-1)+1)="</RESULTS>"
219 Q
220 ;
221XMLDATE(X) ; Transform Y into XML safe date
222 N Y
223 S Y=($E(X,1,3)+1700)_"-"_$E(X,4,5)_"-"_$E(X,6,7)
224 D:X["."
225 .S X=X+.0000001
226 .S Y=Y_" "_$E(X,9,10)_":"_$E(X,11,12)_":"_$E(X,13,14)
227 Q Y
228 ;
229XMLSAFE(X) ; Transform X into XML safe data
230 S X=$$TRNSLT(X,"&","&amp;")
231 S X=$$TRNSLT(X,"<","&lt;")
232 S X=$$TRNSLT(X,">","&gt;")
233 S X=$$TRNSLT(X,"'","&apos;")
234 S X=$$TRNSLT(X,"""","&quot;")
235 Q X
236 ;
237TAGSAFE(X) ; Transform X into XML tag
238 S:X?1N.E X="_"_X ; Remove starting numeric
239 Q $TR(X," '`()<>*[]","__________")
240 ;
241NEWDOC(ROOT,COMMENT) ; Start a new document
242 K @RESULTS
243 D XMLADD("<?xml version=""1.0"" standalone=""yes""?>")
244 I $G(COMMENT)]"" D XMLCMT(COMMENT)
245 D XMLHDR($G(ROOT,"RESULTS"))
246 Q
247 ;
248ENDDOC(ROOT) ; End this document
249 D XMLFTR($G(ROOT,"RESULTS"))
250 Q
251 ;
252TRNSLT(X,X1,X2) ; Translate every Y to Z in X
253 N Y
254 Q:X'[X1 X ; Nothing to translate
255 S Y="" F Q:X="" D
256 .I X[X1 S Y=Y_$P(X,X1)_X2,X=$P(X,X1,2,250) Q
257 .S Y=Y_X,X=""
258 Q Y
259 ;
Note: See TracBrowser for help on using the repository browser.