source: cprs/branches/tmg-cprs/m_files/TMGXMLE2.m@ 1381

Last change on this file since 1381 was 796, checked in by Kevin Toppenberg, 14 years ago

Initial upload
File size: 51.0 KB
Line 
1TMGXMLE2 ;TMG/kst/XML Exporter -- Core functionality ;03/25/06
2 ;;1.0;TMG-LIB;**1**;07/12/05
3
4 ;"TMG XML EXPORT FUNCTIONS (CORE FUNCTIONALITY)
5 ;"Kevin Toppenberg MD
6 ;"GNU General Public License (GPL) applies
7 ;"7-12-2005
8 ;"=======================================================================
9 ;" API -- Public Functions.
10 ;"=======================================================================
11 ;"WriteXMLData(pArray,Flags,IndentS)
12 ;"Write1File(File,Recs,Flags,IndentS,SavFieldInfo)
13 ;"Write1Rec(File,IEN,Fields,Flags,SRef,IENS,IndentS,RWriter,FWriter,LWriter,WPLWriter,SavFieldInfo)
14 ;"Write1Fld(FileNum,IEN,Field,Fields,Flags,SRef,IENS,IndentS,RWriter,FWriter,LWriter,WPLWriter,SavFieldInfo)
15
16 ;"=======================================================================
17 ;"PRIVATE API FUNCTIONS
18 ;"=======================================================================
19
20
21 ;"=======================================================================
22 ;"DEPENDENCIES
23 ;" TMGDBAPI,TMGDEBUG,TMGMISC,TMGUSRIF
24 ;"=======================================================================
25 ;"=======================================================================
26
27 ;"The basic format is to be as follows:
28
29 ;"Array(File,Record,Field,subRec,SubField...)="" <--- means export this entry to XML
30 ;"Array(File,"TEMPLATE",Field)
31 ;"Array(File,"TEMPLATE","ORDER",OrderNum)=Field
32 ;"Array(File,"TEMPLATE","TAG NAME",FieldNumber)="Custom field name to put in XML file"
33 ;"Array("FLAGS","b")="" b -- show tags for ALL fields, even if field has no data
34 ;"Array("FLAGS","i")="" i -- indent tags for pretty, but technically useless, file formating.
35 ;"Array("FLAGS","I")="" I -- output INTERNAL values
36 ;"Array("FLAGS","D")="" D -- output the data dictionary
37 ;"Array("!DOCTYPE")=MyLabel
38 ;"Array("EXPORT_SYSTEM_NAME")=LabelForExportingSystem -- OPTIONAL
39 ;"
40 ;"-----------------------------------------------------------------------------------------------
41 ;"Note: File numbers can be replaces with full FILE NAMES, e.g.
42 ;" Array("NEW PERSON",1234,.01)=""
43 ;"
44 ;"Example: For ALL records, output ALL fields, and ALL subfields
45 ;" Array(8925,"*")="" <--- this is default if Recs is not specified/passed
46 ;"
47 ;"Example: to print from:
48 ;" file 8925, records 1234,1235,1236,1237
49 ;" file 200, ALL records
50 ;" file 22705, records 3,5
51 ;" file 2, ALL records
52 ;"
53 ;" Array(8925,1234)=""
54 ;" Array(8925,1235)=""
55 ;" Array(8925,1236)=""
56 ;" Array(8925,1237)=""
57 ;" Array(200,"*")=""
58 ;" Array(22705,3)=""
59 ;" Array(22705,5)=""
60 ;" Array(2,"*")=""
61 ;"
62 ;"Example: Output extra info in record node
63 ;" Array(8925,1232)="tag=value^tag2=value2" <-- optional extra info for record
64 ;" e.g. --> <Record id=1232 tag="value" tag2="value2">
65 ;"
66 ;"Example: For record 1231, output fields .01 and .02
67 ;" For record 1232, output field .01 only
68 ;" For record 1234, output field "NAME" only
69 ;" For record 1235, output ALL fields
70 ;" Array(8925,1231,.01)=""
71 ;" Array(8925,1231,.02)=""
72 ;" Array(8925,1232,.01)=""
73 ;" Array(8925,1234,"NAME")=""
74 ;" Array(8925,1235,"*")=""
75 ;"
76 ;"Example:
77 ;" Array(8925,"TEMPLATE",.01)="" <-- define a template for file 8925, with fields .01,.02,.03
78 ;" Array(8925,"TEMPLATE",.02)=""
79 ;" Array(8925,"TEMPLATE",.03)=""
80 ;" Array(8925,1234) <-- print record 1234 (will use the template)
81 ;" Array(8925,1235) <-- print record 1235
82 ;"
83 ;"Example:
84 ;" Array(8925,"TEMPLATE","*"))="" <-- include all fields in template
85 ;" Array(8925,"TEMPLATE","Field Exclude",.04)="" <-- but exclude field .04
86 ;" Array(8925,1235) <-- print record 1235, all fields but .04
87 ;"
88 ;"Example: For all records, output fields .01 and .02 and "NAME"
89 ;" Array(8925,"*",.01)=""
90 ;" Array(8925,"*",.02)=""
91 ;" Array(8925,"*","NAME")=""
92 ;"
93 ;"Example:
94 ;" Array(8925,1231,"*")="" <--- indicates that ALL fields, ALL subrecs,and ALL subfields are wanted
95 ;"
96 ;"Example: For all records, output field "ENTRY", which is a multiple. In
97 ;" subfile, output all records, fields .01, and .02
98 ;" Array(8925,"*","ENTRY","*",.01)=""
99 ;" Array(8925,"*","ENTRY","*",.02)=""
100 ;"
101 ;"Example: For ALL records, output ALL fields, and ALL subfields, with 2 exceptions
102 ;" Array(8925,"Rec Exclude",1234)="" <-- All records except 1234 & 1235 will be output
103 ;" Array(8925,"Rec Exclude",1235)=""
104 ;" Array(8925,"*")=""
105 ;"
106 ;"Example:
107 ;" Array(8925,"TEMPLATE","Field Exclude",.04)="" <-- don't show field .04
108 ;" Array(8925,"TEMPLATE","Field Exclude","STATE")="" <-- don't show field "STATE"
109 ;" Array(8925,1231,"*")="" <-- in record 1231, show all fields but .04 and "STATE"
110 ;"
111 ;"Example: Field .04 is multiple. ALL sub records and ALL subfields to be written
112 ;" Array(8925,1231,.04,"*","*")=""
113 ;" Array(8925,1231,.04,"*")="" <--- "*" assumed for subfields
114 ;" Array(8925,1231,.04)="" <-- "*" assumed for subrecords and subfields.
115 ;"
116 ;"Example: Field .03 is multiple. All sub records to be written (except for #5) , and .01 and .02 fields to be written
117 ;" Array(8925,1231,.03,"*",.01)="" <-- In all sub recs, sub field .01 is to be written
118 ;" Array(8925,1231,.03,"*",.02)="" <-- In all sub recs, sub field .02 is to be written
119 ;" Array(8925,1231,.03,"Rec Exclude",5)="" <-- Exclude subrec 5
120 ;"
121 ;"Example: Field .03 is multiple. All sub records to be written, and .01 and .02 fields to be written
122 ;" Array(8925,1231,"TEMPLATE",.03,"*","TEMPLATE",.01)="" <-- In all sub recs, sub field .01 is to be written
123 ;" Array(8925,1231,"TEMPLATE",.03,"*","TEMPLATE",.02)="" <-- In all sub recs, sub field .02 is to be written
124
125 ;"Example: Field .03 is multiple. Sub records 1,2,3 to be written, fields as below
126 ;" Array(8925,1231,.03,1,.01)="" <-- In sub rec 1, sub field .01 is to be written
127 ;" Array(8925,1231,.03,1,.02)="" <-- In sub rec 1, sub field .02 is to be written
128 ;" Array(8925,1231,.03,2,.01)="" <-- In sub rec 2, sub field .01 is to be written
129 ;" Array(8925,1231,.03,3,"*")="" <-- In sub rec 3, all sub fields are to be written
130 ;" Array(8925,1231,.03,4)="" <-- In sub rec 4, all sub fields are to be written (defalt)
131 ;" Array(8925,1231,.03,5,"*")="" <-- In sub rec 5, all sub fields are to be written, with one exception
132 ;" Array(8925,1231,.03,5,"Field Exclude",.01)="" <-- In sub rec 5, sub fields .01 is not to be written.
133 ;"
134 ;"Example: Shows optional substitution of a new tag name for a given field
135 ;" Array(8925,"TEMPLATE","TAG NAME",.01)="Patent Name" <-- use "Patient Name" instead of field name for .01 field
136 ;" Array(8925,"TEMPLATE","TAG NAME",.02)="City" <-- use "City" instead of field name for .02 field
137 ;"
138 ;"Note: pattern continues for sub-sub-multiples etc.
139 ;"
140 ;"Example:
141 ;" Array(8925,1231,.01)=""
142 ;" Array(8925,1231,.02)=""
143 ;" Array(8925,1231,"NAME")="" <--- note that field name is allowed in place of number
144 ;" Array(8925,1231,.03,1,.01)="" <-- In sub rec 1, sub field .01 is to be written
145 ;" Array(8925,1231,.03,1,.02)="" <-- In sub rec 1, sub field .02 is to be written
146 ;" Array(8925,1231,.03,2,.01)="" <-- In sub rec 2, sub field .01 is to be written
147 ;" Array(8925,1231,.03,3,"*")="" <-- In sub rec 3, all sub fields are to be written
148 ;" Array(8925,1231,.03,4)="" <-- In sub rec 4, all sub fields are to be written (defalt)
149 ;"
150 ;"Example: Field .03 is a multiple
151 ;" Array(8925,1231,.03,"TEMPLATE",.01)=""
152 ;" Array(8925,1231,.03,"TEMPLATE",.02)=""
153 ;" Array(8925,1231,.03,1)="" <-- In sub rec 1, export fields .01,.02 from template
154 ;" Array(8925,1231,.03,2)="" <-- In sub rec 2, export fields .01,.02 from template
155 ;" Array(8925,1231,.03,4)="" <-- In sub rec 4, export fields .01,.02 from template
156 ;"
157 ;"Example:
158 ;" Array(8925,"TEMPLATE","ORDER",1)=.03 <-- 1st field to output
159 ;" Array(8925,"TEMPLATE","ORDER",2)=.02 <-- 2nd field to output
160 ;" Array(8925,"TEMPLATE","ORDER",3)="NAME" <-- 3rd field to output
161 ;" Array(8925,"TEMPLATE","ORDER",4)=.01 <-- 4th field to output
162 ;" Note: Specifying an 'ORDER' is not compatible with specifying "*" fields
163 ;" If "ORDER" is specified, only fields with a given order will be output
164 ;" Both Field("ORDER",x)=FieldNum *AND* Field(FieldNum)="" should be defined
165 ;" This will be primarily important for fields that are multiples, with sub recs.
166 ;"
167 ;"Example:
168 ;" Array(8925,"TEMPLATE","TRANSFORM",.01)="write ""Custom .01 output transform M code here..."""
169 ;" Array(8925,"TEMPLATE","TRANSFORM",.02)="write ""Custom .02 output transform M code here..."""
170
171
172
173WriteXMLData(pArray,Flags,IndentS,ShowProgress)
174 ;"Scope: PUBLIC
175 ;"Purpose: to dump out a specified set of files and records in XML Format
176 ;"Input: pArray -- pointer to (i.e. name of) array containting formatting/output info.
177 ;" REQUIRED An array specifying which files and records to display
178 ;" Format as follows:
179 ;" ;"-----------------------------------------
180 ;" Array(File,IEN,FieldInfo) ; For FieldInfo, see Write1File, and Write1Rec
181 ;" Array(File,["TEMPLATE"],...) ;For Template info see function Write1File
182 ;" Array("FLAGS","b")="" b -- show tags for ALL fields, even if field has no data
183 ;" Array("FLAGS","i")="" i -- indent tags for pretty, but technically useless, file formating.
184 ;" Array("FLAGS","I")="" I -- output INTERNAL values
185 ;" Array("FLAGS","D")="" D -- output the data dictionary
186 ;" Array("FLAGS","S")="" S -- output export settings.
187 ;" Array("!DOCTYPE")=MyLabel
188 ;" Array("EXPORT_SYSTEM_NAME")=LabelForExportingSystem -- OPTIONAL
189 ;" ;"-----------------------------------------
190 ;"
191 ;" e.g. Array(8925,1234)=""
192 ;" Array(8925,1235)=""
193 ;" Array(8925,1236)=""
194 ;" Array(8925,1237)=""
195 ;" Array(8925,1232)="tag=value^tag2=value2" <-- optional extra info for record
196 ;" e.g. --> <Record id=1232 tag="value" tag2="value2">
197 ;" Array(200,"*")=""
198 ;" Array(22705,3)=""
199 ;" Array(22705,5)=""
200 ;" Array(2,"*")=""
201 ;"
202 ;" This would print from:
203 ;" file 8925, records 1234,1235,1236,1237
204 ;" file 200, ALL records
205 ;" file 22705, records 3,5
206 ;" file 2, ALL records
207 ;"
208 ;" Example:
209 ;" Array(8925,"TEMPLATE",.01)="" <-- define a template for file 8925
210 ;" Array(8925,"TEMPLATE",.02)=""
211 ;" Array(8925,"TEMPLATE",.02)=""
212 ;" Array(8925,1234) <-- print record 1234
213 ;" Array(8925,1235) <-- print record 1235
214 ;"
215 ;" Example:
216 ;" Array(8925,1234) <-- print record 1234
217 ;" Array(8925,1235) <-- print record 1235
218 ;"
219 ;" Example:
220 ;" Array(8925,1234,.01) <-- print record 1234, only field .01
221 ;" Array(8925,1235,.04) <-- print record 1235, only field .04
222 ;"
223 ;" Note: File numbers can be replaces with full FILE NAMES, e.g.
224 ;" Array("NEW PERSON","*")=""
225 ;"
226 ;" Note: All File numbers and field numbers can be replaced with NAMES
227 ;"
228 ;" Flags -- OPTIONAL (Note Flags can also be specified with a "FLAGS" node)
229 ;" b -- show tags for ALL fields, even if field has no data
230 ;" i -- indent tags for pretty, but technically useless, file formating.
231 ;" I -- output INTERNAL values
232 ;" D -- output Data dictionary
233 ;" e.g. Flags="b" or "bi" or "ib" or "iI" etc.
234 ;" IndentS -- OPTIONAL -- current string to write to indent line.
235 ;" IndentS("IncIndent")=IncIndent
236 ;" ShowProgress -- OPTIONAL -- if =1, then a progress bar will be shown.
237 ;"Output: results are written to the current device.
238 ;"result : none
239
240 new File,tArray,SavFieldInfo
241 merge tArray=@pArray
242 set Flags=$get(Flags)
243 new IncIndent set IncIndent=$get(IndentS("IncIndent")," ")
244
245 if ($data(tArray("FLAGS","b"))>0)&(Flags'["b") set Flags=Flags_"b"
246 if ($data(tArray("FLAGS","i"))>0)&(Flags'["i") set Flags=Flags_"i"
247 if ($data(tArray("FLAGS","I"))>0)&(Flags'["I") set Flags=Flags_"I"
248 if ($data(tArray("FLAGS","D"))>0)&(Flags'["D") set Flags=Flags_"D"
249 if ($data(tArray("FLAGS","S"))>0)&(Flags'["S") set Flags=Flags_"S"
250
251 do WriteHeader
252 write "<!DOCTYPE "_$get(tArray("!DOCTYPE"),"UNDEFINED"),">",!
253 new SrcName set SrcName=$get(tArray("EXPORT_SYSTEM_NAME"),"?Unnamed?")
254 write "<EXPORT source=""",$$SYMENC^MXMLUTL(SrcName),""">",!
255 set IndentS=$get(IndentS)_IncIndent
256 if Flags["S" do WriteSettings(.Flags,.IndentS) ;"output writing settings
257
258 set File=""
259 for set File=$order(tArray(File)) quit:(+File'>0) do
260 . new IEN,Template,Recs
261 . merge Template=tArray(File,"TEMPLATE")
262 . kill tArray(File,"TEMPLATE")
263 . merge Recs=tArray(File)
264 . set IEN=$order(tArray(File,""))
265 . if IEN'="" do
266 . . if $data(TMGXDEBUG) do
267 . . . use $P write "Writing file: ",File,! use IO
268 . . if IEN="*" do
269 . . . do Write1File(File,.Recs,.Flags,.IndentS,.Template,.ShowProgress,,,,,.SavFieldInfo)
270 . . else do
271 . . . new Recs merge Recs=tArray(File)
272 . . . do Write1File(File,.Recs,.Flags,.IndentS,,.ShowProgress,,,,,.SavFieldInfo)
273
274 write "</EXPORT>",!
275
276 quit
277
278
279WriteHeader
280 ;"Scope: PUBLIC
281 ;"Purpose: A shell to write out a proper XML header. This should be done prior
282 ;" to writing out XML formatted data to a device
283 ;"Output: Header is output to current device
284 ;"Results: none
285
286 new s
287 set s=$$XMLHDR^MXMLUTL
288 write s,!
289 quit
290
291
292Write1File(File,Recs,Flags,IndentS,Template,ShowProgress,RWriter,FWriter,LWriter,WPLWriter,SavFieldInfo)
293 ;"Scope: PUBLIC
294 ;"Purpose: to dump out (in XML) one file, for specified records
295 ;"Input: File -- name or number of file to dump
296 ;" Recs -- OPTIONAL. PASS BY REFERENCE (default is to write ALL records)
297 ;" To specify records to write out, use Recs array with following format:
298 ;" -------------------------------------------------------------------
299 ;" Recs(IEN,Field,FieldInfo); (Default for all is "*")
300 ;" For format of FieldInfo, see function Write1Rec
301 ;" Recs("Rec Exclude",IEN) <-- exclude IEN from output
302 ;" -------------------------------------------------------------------
303 ;" Example:
304 ;" Recs(1231)=""
305 ;" Recs(1232)=""
306 ;" Recs(1234)="" this would be used to print records 1231,1232,1234
307 ;" Recs(1232)="tag=value^tag2=value2" <-- optional extra info for record
308 ;" e.g. <Record id=1232 tag="value" tag2="value2">
309 ;"
310 ;" Example: For ALL records, output ALL fields, and ALL subfields
311 ;" Recs("*")="" <--- this is default if Recs is not specified/passed
312 ;" Example: For all records, output fields .01 and .02 and "NAME"
313 ;" Recs("*",.01)=""
314 ;" Recs("*",.02)=""
315 ;" Recs("*","NAME")=""
316 ;" Example: For record 1231, output fields .01 and .02
317 ;" For record 1232, output field .01 only
318 ;" For record 1234, output field "NAME" only
319 ;" For record 1235, output ALL fields
320 ;" Recs(1231,.01)=""
321 ;" Recs(1231,.02)=""
322 ;" Recs(1232,.01)=""
323 ;" Recs(1234,"NAME")=""
324 ;" Recs(1235,"*")=""
325 ;" Example: For all records, output field "ENTRY", which is a multiple. In
326 ;" subfile, output records .01, and .02
327 ;" Recs("*","ENTRY",.01)=""
328 ;" Recs("*","ENTRY",.02)=""
329 ;" Example: For ALL records, output ALL fields, and ALL subfields, with 2 exceptions
330 ;" Recs("*")=""
331 ;" Recs("Rec Exclude",1234)="" <-- All records except 1234 & 1235 will be output
332 ;" Recs("Rec Exclude",1235)=""
333 ;" Flags -- OPTIONAL
334 ;" b -- show tags for ALL fields, even if field has no data
335 ;" i -- indent tags for pretty, but technically useless, file formating.
336 ;" I -- output INTERNAL values
337 ;" D -- include data dictionary for file.
338 ;" S -- output export settings
339 ;" IndentS -- OPTIONAL -- current string to write to indent line.
340 ;" IndentS("IncIndent")=IncIndent
341 ;" Template -- OPTIONAL. PASS BY REFERENCE
342 ;" This can be used for instances where the same set of fields are desired for
343 ;" multiple records.
344 ;" Example:
345 ;" Recs(1231)=""
346 ;" Recs(1232)=""
347 ;" Recs(1234)=""
348 ;" with Template(.01)=""
349 ;" Template(.02)=""
350 ;" Is the same as specifying:
351 ;" Recs(1231,.01)=""
352 ;" Recs(1231,.02)=""
353 ;" Recs(1232,.01)=""
354 ;" Recs(1232,.02)=""
355 ;" Recs(1234,.01)=""
356 ;" Recs(1234,.02)=""
357 ;" ShowProgress -- OPTIONAL -- if >0, then a progress bar will be shown.
358 ;" RWriter -- OPTIONAL -- the name of a custom function to use for writing
359 ;" actual starting and ending <record> </record>. e.g.
360 ;" "MyCustomFn". Note do NOT include parameters. Function named
361 ;" as custom function must accept same parameters as WriteRLabel
362 ;" FWriter -- OPTIONAL -- the name of a custom function to use for writing
363 ;" actual line of text out. e.g. "WriteFLabel" or
364 ;" "MyCustomFn". Note do NOT include parameters. Function named
365 ;" LWriter -- OPTIONAL -- the name of a custom function to use for writing
366 ;" actual line of text out for WP fields. e.g. "WriteLine" or
367 ;" "MyCustomFn". Note do NOT include parameters. Function named
368 ;" as custom function must accept same parameters as WriteLine
369 ;" as custom function must accept same parameters as WriteFLabel
370 ;" WPLWriter -- OPTIONAL -- the name of a custom function to use for writing
371 ;" actual line of text out for WP fields. If not provided, then
372 ;" LWriter will be used instead.
373 ;" e.g. "WriteWPLine" or "MyWPCustomFn". Note do NOT include parameters.
374 ;" Function named as custom function must accept same parameters as WriteLine
375 ;" SavFieldInfo -- OPTIONAL -- PASS BY REFERENCE. An array to hold lookup values about
376 ;" fields, so it doesn't have to be done each time (faster)
377 ;"Output: results are written to the current device.
378 ;"result : none
379
380 new ORoot,GRef
381 new FileNum,FName
382 new prgsCt set prgsCt=0
383 new prgsMax
384
385 new IncIndent set IncIndent=$get(IndentS("IncIndent")," ")
386 if $data(Template)=0 set Template("*")=""
387 new RecsSpecified set RecsSpecified=(($data(Recs)>1)&($data(Recs("*"))=0))
388 new keyin set keyin=32
389 new startTime set startTime=$H
390 set RWriter=$get(RWriter,"WriteRLabel")
391 set IndentS=$get(IndentS)
392
393 set FileNum=+$get(File)
394 if FileNum=0 do
395 . set FileNum=$$GetFileNum^TMGDBAPI(.File)
396 . set FName=File
397 else do
398 . set FName=$order(^DD(FileNum,0,"NM",""))
399 if FileNum=0 do goto WFDone
400 . do ShowError^TMGDEBUG(.PriorErrorFound,"Can't convert file '"_$get(File)_", to a number.")
401
402 set ORoot=$$GET1^DID(FileNum,"","","GLOBAL NAME") ;" Get global root (Thanks, Don Donati...)
403 set GRef=$$CREF^DILF(ORoot) ;" Convert open to closed root
404
405 if $get(ShowProgress) do
406 . if RecsSpecified do
407 . . set prgsMax=$$ListCt^TMGMISC("Recs")
408 . else do
409 . . set prgsMax=0
410 . . set IEN=$order(@GRef@("")) ;"count ALL records in file.
411 . . for do quit:(IEN'>0)
412 . . . set IEN=$order(@GRef@(IEN))
413 . . . if +IEN>0 set prgsMax=prgsMax+1
414
415 set Flags=$get(Flags)
416 if Flags["i" write IndentS
417 write "<FILE id=""",FileNum,""" label=""",$$SYMENC^MXMLUTL(FName),""">",!
418
419 if Flags["D" do WriteDD(FileNum,Flags,IndentS_IncIndent) ;"write out data dictionary file
420
421 new IndS2 set IndS2=IndentS_IncIndent
422 new IEN set IEN=0
423 for do quit:(IEN'>0)
424 . if $data(Fields)'>1 set Fields("*")=""
425 . if RecsSpecified do
426 . . set IEN=$order(Recs(IEN)) ;"Cycle through specified records
427 . . new Extra set Extra=$get(Recs(IEN))
428 . . if Extra'="" do ;"parse extra info into IEN array for output
429 . . . new s,n,tag,value
430 . . . for n=1:1:$length(Extra,"^") do
431 . . . . set s=$piece(Extra,"^",n)
432 . . . . if s'["=" quit
433 . . . . set tag=$piece(s,"=",1)
434 . . . . set value=$piece(s,"=",2)
435 . . . . set IEN(tag)=value
436 . else do
437 . . set IEN=$order(@GRef@(IEN)) ;"Cycle through ALL records in file.
438 . if (IEN'>0) quit
439 . if $data(Recs("Rec Exclude",IEN)) quit ;"skip excluded records
440 . new Fields merge Fields=Recs(IEN)
441 . if $data(Fields)'>1 merge Fields=Template
442 . if $get(Flags)["i" write $get(IndS2)
443 . new exFn set exFn="do "_RWriter_"(.IEN,0)"
444 . xecute exFn
445 . if $data(TMGXDEBUG) do
446 . . use $P
447 . . write "Writing record: ",IEN," prgsCt=",prgsCt," prgsMax=",prgsMax,!
448 . . use IO
449 . do Write1Rec(FileNum,IEN,.Fields,.Flags,"","",IndS2_IncIndent,.RWriter,.FWriter,.LWriter,.WPLWriter,.SavFieldInfo)
450 . if $get(Flags)["i" write $get(IndS2)
451 . set exFn="do "_RWriter_"(.IEN,1)"
452 . xecute exFn
453 . set prgsCt=prgsCt+1
454 . if $get(ShowProgress)&(prgsCt#2=1) do
455 . . use $P
456 . . do ProgressBar^TMGUSRIF(prgsCt,"Writing "_FName,1,prgsMax,,startTime)
457 . . use IO
458 . ;"use $P read *keyin use IO
459 . if keyin=27 do
460 . . new Abort
461 . . use $P
462 . . write prgsCt," records written so far...",!
463 . . write !,"Do you want to abort XML export? NO// "
464 . . read Abort:$get(DTIME,3600),!
465 . . if Abort="" set Abort="NO"
466 . . if "YESyesYes"[Abort set IEN=0 ;"abort signal
467 . . write "OK. Continuing...",!
468 . . use IO
469
470 if $get(Flags)["i" write IndentS
471 write "</FILE>",!
472
473 if $get(ShowProgress) do
474 . use $P
475 . do ProgressBar^TMGUSRIF(100,"Writing "_FName,1,100)
476 . use IO
477
478WFDone
479 quit
480
481WriteSettings(Flags,IndentS)
482 ;"Scope: PRIVATE
483 ;"Purpose: to output XML output settings.
484 ;"Input: Flags -- flags as declared above. Only "i" used here
485 ;" IndentS -- OPTIONAL -- current string to write to indent line.
486 ;" IndentS("IncIndent")=IncIndent
487
488 ;"NOTE: Uses GLOBAL SCOPED IncIndent variable. But setting this is OPTIONAL.
489 ;"Results: none
490
491 set IndentS=$get(IndentS)
492 set Flags=$get(Flags)
493 new IncIndent set IncIndent=$get(IndentS("IncIndent")," ")
494
495 if Flags["i" write IndentS
496 write "<ExportSettings>",!
497
498 new fArray,fl
499 set fArray("i")="Indent_Output"
500 set fArray("b")="Output_Blanks"
501 set fArray("I")="Output_Internal_Values"
502 set fArray("D")="Output_Data_Dictionary"
503
504 set fl=""
505 for set fl=$order(fArray(fl)) quit:(fl="") do
506 . if Flags["i" write IndentS_IncIndent
507 . write "<Setting id=""",$$SYMENC^MXMLUTL($get(fArray(fl))),""">"
508 . write $select((Flags[fl):"TRUE",1:"FALSE")
509 . write "</Setting>",!
510
511 if Flags["i" write IndentS
512 write "</ExportSettings>",!
513
514 quit
515
516WriteDD(FileNum,Flags,IndentS)
517 ;"Scope: PRIVATE
518 ;"Purpose: to write out data dictionary file, ^DIC,and file Header in XML format
519 ;"Input: FileNum -- the file number (not name) of the data dictionary to export
520 ;" Flags -- flags as declared above. Only "i" used here
521 ;" IndentS -- OPTIONAL -- current string to write to indent line.
522 ;"NOTE: Uses GLOBAL SCOPED IncIndent variable. But setting this is OPTIONAL.
523 ;"Results: none
524
525 new ProgressFn
526 use $P write ! use IO
527 set IncIndent=$get(IncIndent," ")
528
529 set ProgressFn="use $P do ProgressBar^TMGUSRIF(IncVar,""^DD("_FileNum_")"",0,100000,,"""_$H_""") use IO"
530 do WriteArray^TMGXMLT($name(^DD(FileNum)),"DataDictionary",FileNum,.Flags,.IndentS,.IncIndent,.ProgressFn)
531
532 set ProgressFn="use $P do ProgressBar^TMGUSRIF(IncVar,""^(DIC("_FileNum_")"",0,1000000,,"""_$H_""") use IO"
533 new DIC ;"Pull just the fileman nodes. ^DIC also contains some full files...
534 merge DIC(FileNum,0)=^DIC(FileNum,0)
535 merge DIC(FileNum,"%")=^DIC(FileNum,"%")
536 merge DIC(FileNum,"%A")=^DIC(FileNum,"%A")
537 merge DIC(FileNum,"%D")=^DIC(FileNum,"%D")
538 do WriteArray^TMGXMLT("DIC("_FileNum_")","DIC_File",FileNum,.Flags,.IndentS,.IncIndent,.ProgressFn)
539
540 do
541 . new Ref set Ref=$get(^DIC(FileNum,0,"GL"))
542 . set Ref=$$CREF^DILF(Ref) ;" Convert open to closed root
543 . if $get(Flags)["i" write IndentS
544 . write "<FILE_HEADER id=""",FileNum,""">",!
545 . if $get(Flags)["i" write IndentS
546 . write $get(@Ref@(0)),!
547 . if $get(Flags)["i" write IndentS
548 . write "</FILE_HEADER>",!
549
550 ;"use $P write ! use IO
551 quit
552
553
554Write1Rec(File,IEN,Fields,Flags,SRef,IENS,IndentS,RWriter,FWriter,LWriter,WPLWriter,SavFieldInfo)
555 ;"Scope: PUBLIC
556 ;"Purpose: To dump one record out in XML format
557 ;"Input: File -- name or number of file to dump
558 ;" IEN -- Record number (IEN) to dump (see also IENS below)
559 ;" Fields -- OPTIONAL. PASS BY REFERENCE. Array of fields to write, format at follows
560 ;" Fields(Field,[SubRecNums,[SubFields,...]])=""
561 ;" Fields(Field,["Rec Exclude",Excluded IEN])=""
562 ;" Fields("Field Exclude",ExcludedField)="" <-- OPTIONAL
563 ;" Fields("ORDER",OrderNum)=Field <-- OPTIONAL
564 ;" Fields("TAG NAME",FieldNumber)="Custom field name to put in XML file" <-- OPTIONAL
565 ;"
566 ;" Example:
567 ;" Fields(.01)=""
568 ;" Fields(.02)=""
569 ;" Fields("NAME")="" <--- note that field name is allowed in place of number
570 ;" Fields(.03)=""
571 ;"
572 ;" Example:
573 ;" Fields("*")="" <--- indicates that ALL fields, ALL subrecs,and ALL subfields are wanted
574 ;"
575 ;" Example:
576 ;" Fields("*")=""
577 ;" Fields("Field Exclude",.04)="" <-- don't show field .04
578 ;" Fields("Field Exclude","STATE")="" <-- don't show field "STATE"
579 ;"
580 ;" Example: Field .04 is multiple. ALL sub records and ALL subfields to be written
581 ;" Fields(.04,"*","*")=""
582 ;" Fields(.04,"*")="" <--- "*" assumed for subfields
583 ;" Fields(.04)="" <-- "*" assumed for subrecords and subfields.
584 ;"
585 ;" Example: Field .03 is multiple. All sub records to be written, and .01 and .02 fields to be written
586 ;" Fields(.03,"*",.01)="" <-- In all sub recs, sub field .01 is to be written
587 ;" Fields(.03,"*",.02)="" <-- In all sub recs, sub field .02 is to be written
588 ;" Fields(.03,"Rec Exclude",5)="" <-- Exclude subrec 5
589 ;"
590 ;" Example: Field .03 is multiple. Sub records 1,2,3 to be written, fields as below
591 ;" Fields(.03,1,.01)="" <-- In sub rec 1, sub field .01 is to be written
592 ;" Fields(.03,1,.02)="" <-- In sub rec 1, sub field .02 is to be written
593 ;" Fields(.03,2,.01)="" <-- In sub rec 2, sub field .01 is to be written
594 ;" Fields(.03,3,"*")="" <-- In sub rec 3, all sub fields are to be written
595 ;" Fields(.03,4)="" <-- In sub rec 4, all sub fields are to be written (defalt)
596 ;" Fields(.03,5,"*")="" <-- In sub rec 5, all sub fields are to be written, with one exception
597 ;" Fields(.03,5,"Field Exclude",.01)="" <-- In sub rec 5, sub fields .01 is not to be written.
598 ;"
599 ;" Example: Shows optional substitution of a new tag name for a given field
600 ;" Fields("TAG NAME",.01)="Patent Name" <-- use "Patient Name" instead of field name for .01 field
601 ;" Fields("TAG NAME",.02)="City" <-- use "City" instead of field name for .02 field
602 ;"
603 ;" Example:
604 ;" Array("TRANSFORM",.01)="write ""Custom .01 output transform M code here..."""
605 ;" Array("TRANSFORM",.02)="write ""Custom .02 output transform M code here..."""
606 ;"
607 ;" Note: pattern continues for sub-sub-multiples etc.
608 ;"
609 ;" Example:
610 ;" Fields(.01)=""
611 ;" Fields(.02)=""
612 ;" Fields("NAME")="" <--- note that field name is allowed in place of number
613 ;" Fields(.03,1,.01)="" <-- In sub rec 1, sub field .01 is to be written
614 ;" Fields(.03,1,.02)="" <-- In sub rec 1, sub field .02 is to be written
615 ;" Fields(.03,2,.01)="" <-- In sub rec 2, sub field .01 is to be written
616 ;" Fields(.03,3,"*")="" <-- In sub rec 3, all sub fields are to be written
617 ;" Fields(.03,4)="" <-- In sub rec 4, all sub fields are to be written (defalt)
618 ;" Fields("ORDER",1)=.03 <-- 1st field to output
619 ;" Fields("ORDER",2)=.02 <-- 2nd field to output
620 ;" Fields("ORDER",3)="NAME" <-- 3rd field to output
621 ;" Fields("ORDER",4)=.01 <-- 4th field to output
622 ;" Note: Specifying an 'ORDER' is not compatible with specifying "*" fields
623 ;" If "ORDER" is specified, only fields with a given order will be output
624 ;" Both Field("ORDER",x)=FieldNum *AND* Field(FieldNum)="" should be defined
625 ;" This will be primarily important for fields that are multiples, with sub recs.
626 ;"
627 ;" Flags -- OPTIONAL
628 ;" b -- show tags for fields, even if field has no data
629 ;" i -- indent tags for pretty, but technically useless, file formating.
630 ;" I -- output INTERNAL values
631 ;" SRef -- OPTIONAL (Used only when calling self recursively)
632 ;" IENS -- OPTIONAL a standard IENS string
633 ;" e.g. "IEN,parent-IEN,grandparent-IEN," etc.
634 ;" This is used when calling self recursively, to handle subfiles
635 ;" IndentS -- OPTIONAL -- current string to write to indent line.
636 ;" RWriter -- OPTIONAL -- the name of a custom function to use for writing
637 ;" actual starting and ending <record> </record>. e.g.
638 ;" "MyCustomFn". Note do NOT include parameters. Function named
639 ;" as custom function must accept same parameters as WriteRLabel
640 ;" FWriter -- OPTIONAL -- the name of a custom function to use for writing
641 ;" actual line of text out. e.g. "WriteFLabel" or
642 ;" "MyCustomFn". Note do NOT include parameters. Function named
643 ;" as custom function must accept same parameters as WriteFLabel
644 ;" LWriter -- OPTIONAL -- the name of a custom function to use for writing
645 ;" actual line of text out for fields. e.g. "WriteLine" or
646 ;" "MyCustomFn". Note do NOT include parameters. Function named
647 ;" as custom function must accept same parameters as WriteLine
648 ;" WPLWriter -- OPTIONAL -- the name of a custom function to use for writing
649 ;" actual line of text out for WP fields. If not provided, then
650 ;" LWriter will be used instead.
651 ;" e.g. "WriteWPLine" or "MyWPCustomFn". Note do NOT include parameters.
652 ;" Function named as custom function must accept same parameters as WriteLine
653 ;" SavFieldInfo -- OPTIONAL -- PASS BY REFERENCE. An array to hold lookup values about
654 ;" fields, so it doesn't have to be done each time (faster)
655
656 ;"Output: Values are written to the current device
657 ;"Results: None
658 ;"Note: this code began its life as a function written by Greg Woodhouse (thanks Greg!)
659
660 new Field,FldType,FieldInfo
661 new StoreLoc,Node,Pos
662 new IntValue,ORoot,GRef
663 new Range,FIRST,LAST
664 new SubFile,SRoot,CRoot
665 new SubRec,VAL2,Label
666 new FileNum
667 new IncIndent set IncIndent=" "
668 if $data(Fields)<10 set Fields("*")=""
669 new AllFields set AllFields=($data(Fields("*"))>0)
670 new OrdFields,OrdIndex set OrdFields=0,OrdIndex=0
671 if $order(Fields("ORDER"))>1 set AllFields=0,OrdFields=1
672
673 new LastFileName
674
675 set FileNum=+$get(File)
676 if FileNum=0 set FileNum=$$GetFileNum^TMGDBAPI(.File)
677 if FileNum=0 do goto WRDone
678 . do ShowError^TMGDEBUG(.PriorErrorFound,"Can't convert file '"_$get(File)_", to a number.")
679
680 if $get(IENS)="" set IENS=IEN_","
681
682 set Field=0
683 set LastFileName=Field
684
685 ;"Ensure all text exclusion fields are converted to numeric ones.
686 if $data(Fields("Field Exclude"))>0 do
687 . new field
688 . set field=$order(Fields("Field Exclude",""))
689 . if field'="" for do quit:(field="")
690 . . if +field'=field do
691 . . . new tempField
692 . . . set tempField=$$GetNumField^TMGDBAPI(FileNum,field)
693 . . . set Fields("Field Exclude",tempField)=""
694 . . set field=$order(Fields("Field Exclude",field))
695
696 ;"Ensure all custom tag field names are converted to numeric ones.
697 if $data(Fields("TAG NAME"))>0 do
698 . new field
699 . set field=$order(Fields("TAG NAME",""))
700 . if field'="" for do quit:(field="")
701 . . if +field'=field do
702 . . . new tempField
703 . . . set tempField=$$GetNumField^TMGDBAPI(FileNum,field)
704 . . . set Fields("TAG NAME",tempField)=Fields("TAG NAME",field)
705 . . set field=$order(Fields("TAG NAME",field))
706
707 ;"Ensure all custom TRANSFORM field names are converted to numeric ones.
708 if $data(Fields("TRANSFORM"))>0 do
709 . new field
710 . set field=$order(Fields("TRANSFORM",""))
711 . if field'="" for do quit:(field="")
712 . . if +field'=field do
713 . . . new tempField
714 . . . set tempField=$$GetNumField^TMGDBAPI(FileNum,field)
715 . . . set Fields("TRANSFORM",tempField)=Fields("TRANSFORM",field)
716 . . set field=$order(Fields("TRANSFORM",field))
717
718 ;"NOTE: It is ineffecient to call a function for each field. That requires
719 ;" the field function to call $$GET1^DIQ. A more effecient way would
720 ;" be to call GETS^DIQ to get ALL the field's values at once, and then
721 ;" pass the value to the field function. FIX LATER...
722
723 for do quit:(+Field'>0)
724 . if AllFields do
725 . . set Field=$order(^DD(FileNum,Field))
726 . else if OrdFields do quit:(Field="")
727 . . set OrdIndex=$order(Fields("ORDER",OrdIndex))
728 . . set Field=$get(Fields("ORDER",OrdIndex))
729 . else do quit:(+Field'>0)
730 . . set Field=$order(Fields(LastFileName))
731 . set LastFileName=Field
732 . if +Field=0 set Field=$$GetNumField^TMGDBAPI(FileNum,Field)
733 . if $data(Fields("Field Exclude",Field))>0 quit
734 . if +Field=0 quit
735 . do Write1Fld(FileNum,IEN,Field,.Fields,.Flags,.SRef,.IENS,.IndentS,.RWriter,.FWriter,.LWriter,.WPLWriter,.SavFieldInfo)
736
737WRDone
738 quit
739
740
741Write1Fld(FileNum,IEN,Field,Fields,Flags,SRef,IENS,IndentS,RWriter,FWriter,LWriter,WPLWriter,SavFieldInfo)
742 ;"Scope: PUBLIC
743 ;"Purpose: To dump one field out in XML format
744 ;"Input: FileNum -- number of file containing field
745 ;" IEN -- Record number (IEN) to dump (see also IENS below). Ignored if IENS supplied
746 ;" Field -- The field number to write from array below.
747 ;" Fields -- The field to write.
748 ;" Flags -- OPTIONAL
749 ;" b -- show tags for fields, even if field has no data
750 ;" i -- indent tags for pretty, but technically useless, file formating.
751 ;" I -- output INTERNAL values
752 ;" SRef -- OPTIONAL (Used only when calling self recursively)
753 ;" IENS -- OPTIONAL a standard IENS string
754 ;" e.g. "IEN,parent-IEN,grandparent-IEN," etc.
755 ;" This is used when calling self recursively, to handle subfiles
756 ;" Late Note: if IENS is supplied, then IEN is ignored
757 ;" IndentS -- OPTIONAL -- current string to write to indent line.
758 ;" RWriter -- OPTIONAL -- the name of a custom function to use for writing
759 ;" actual starting and ending <record> </record>. e.g.
760 ;" "MyCustomFn". Note do NOT include parameters. Function named
761 ;" as custom function must accept same parameters as WriteRLabel
762 ;" FWriter -- OPTIONAL -- the name of a custom function to use for writing
763 ;" actual line of text out. e.g. "WriteFLabel" or
764 ;" "MyCustomFn". Note do NOT include parameters. Function named
765 ;" as custom function must accept same parameters as WriteFLabel
766 ;" LWriter -- OPTIONAL -- the name of a custom function to use for writing
767 ;" actual line of text out for WP fields. e.g. "WriteLine" or
768 ;" "MyCustomFn". Note do NOT include parameters. Function named
769 ;" as custom function must accept same parameters as WriteLine
770 ;" WPLWriter -- OPTIONAL -- the name of a custom function to use for writing
771 ;" actual line of text out for WP fields. If not provided, then
772 ;" LWriter will be used instead.
773 ;" e.g. "WriteWPLine" or "MyWPCustomFn". Note do NOT include parameters.
774 ;" Function named as custom function must accept same parameters as WriteLine
775 ;" SavFieldInfo -- OPTIONAL -- PASS BY REFERENCE. An array to hold lookup values about
776 ;" fields, so it doesn't have to be done each time (faster)
777 ;"Output: Values are written to the current device
778 ;"Results: None
779 ;"Note: this code began its life as a function written by Greg Woodhouse (thanks Greg!)
780
781 new FldType,Label
782 new FieldInfo
783
784 if $get(IENS)="" set IENS=IEN_","
785 if +$get(Field)=0 goto W1FDone
786 set FWriter=$get(FWriter,"WriteFLabel")
787 set RWriter=$get(RWriter,"WriteRLabel")
788 set LWriter=$get(LWriter,"WriteLine")
789 set WPLWriter=$get(WPLWriter,LWriter)
790 set Flags=$get(Flags)
791
792 if 1=1 do
793 . if $data(SavFieldInfo(FileNum,Field))>0 do
794 . . merge FieldInfo=SavFieldInfo(FileNum,Field)
795 . else do
796 . . do GetFieldInfo^TMGDBAPI(FileNum,Field,"FieldInfo","LABEL")
797 . . merge SavFieldInfo(FileNum,Field)=FieldInfo
798 else if 1=0 do
799 . ;"try to get info directly to speed things up.... FINISH LATER
800 . new node set node=$get(^DD(FileNum,Field,0))
801 . set FieldInfo("SPECIFIER")=$piece(node,"^",2)
802 . set FieldInfo("LABEL")=$piece(node,"^",1)
803 . set FieldInfo("MULTIPLE-VALUED")=(+FieldInfo("SPECIFIER")>0)
804 . if FieldInfo("SPECIFIER")["W" set FieldInfo("TYPE")="WORD-PROCESSING"
805 . else if FieldInfo("SPECIFIER")["D" set FieldInfo("TYPE")="DATE"
806 . else if FieldInfo("SPECIFIER")["F" set FieldInfo("TYPE")="FREE TEXT"
807 . else if FieldInfo("SPECIFIER")["P" set FieldInfo("TYPE")="POINTER"
808 . else if FieldInfo("SPECIFIER")["N" set FieldInfo("TYPE")="NUMERIC"
809 . else if FieldInfo("SPECIFIER")["S" set FieldInfo("TYPE")="SET"
810 . else set FieldInfo("TYPE")=FieldInfo("SPECIFIER")
811
812 set FldType=FieldInfo("SPECIFIER")
813 if $data(Fields("TAG NAME",Field))#10>1 set Label=Fields("TAG NAME",Field)
814 else set Label=FieldInfo("LABEL")
815
816 if $get(FieldInfo("MULTIPLE-VALUED"))=1 do
817 . if $get(FieldInfo("TYPE"))="WORD-PROCESSING" do
818 . . new TMGWP,TMGMsg,result
819 . . set result=$$ReadWP^TMGDBAPI(FileNum,IENS,Field,.TMGWP)
820 . . if result=1 do
821 . . . new i set i=$order(TMGWP(""))
822 . . . if i="" quit
823 . . . if Flags["i" write $get(IndentS)
824 . . . new exFn set exFn="do "_FWriter_"(Label,"""_$$QtProtect^TMGSTUTL(Field)_""","""_FieldInfo("TYPE")_""",0)"
825 . . . xecute exFn
826 . . . write ! ;"so first <LINE> will be on a separate line
827 . . . for do quit:(i="")
828 . . . . new line set line=$get(TMGWP(i))
829 . . . . set line=$$CmdChStrip^TMGSTUTL(line) ;"shouldn't be needed!!! ??GT.M bug??
830 . . . . if Flags["i" write $get(IndentS)_IncIndent
831 . . . . set exFn="do "_WPLWriter_"("""_$$QtProtect^TMGSTUTL(line)_""")"
832 . . . . ;"WRITE exFn,!
833 . . . . xecute exFn
834 . . . . set i=$order(TMGWP(i))
835 . . . if Flags["i" write $get(IndentS)
836 . . . set exFn="do "_FWriter_"(Label,"""_$$QtProtect^TMGSTUTL(Field)_""","""_FieldInfo("TYPE")_""",1)"
837 . . . xecute exFn
838 . else do ;"Other multiple (subfile)
839 . . set SubFile=+FldType
840 . . new AllSubRecs,tempField
841 . . new ORoot,Node
842 . . if $get(SRef)'="" set ORoot=SRef
843 . . else set ORoot=$get(^DIC(FileNum,0,"GL"))
844 . . if ORoot="" quit
845 . . if AllFields set tempField="*"
846 . . else set tempField=LastFileName
847 . . set AllSubRecs=($data(Fields(tempField,"*"))>0)!($order(Fields(tempField,""))="")
848 . . set Node=$piece($get(FieldInfo("StoreLoc")),";",1)
849 . . if Node="" quit ;"skip computed fields
850 . . if (+Node'=Node) set Node=""""_Node_"""" ;" enclose text indices with quotes
851 . . set SRoot=ORoot_IEN_","_Node_"," ;"open root
852 . . set CRoot=ORoot_IEN_","_Node_")" ;"closed root
853 . . set SubRec=$order(@CRoot@(0))
854 . . if (SubRec'="")!(Flags["b") do
855 . . . if Flags["i" write $get(IndentS)
856 . . . new exFn set exFn="do "_FWriter_"("""_$$QtProtect^TMGSTUTL(Label)_""","""_$$QtProtect^TMGSTUTL(Field)_""","""_FieldInfo("TYPE")_""",0)"
857 . . . xecute exFn
858 . . . write !
859 . . . new IndS2 set IndS2=$get(IndentS)_IncIndent
860 . . . if +SubRec>0 for do quit:+SubRec'>0
861 . . . . ;"descend into subfile (if allowed subrecord #)
862 . . . . if (AllSubRecs)!($data(Fields(tempField,SubRec))>0) do
863 . . . . . if $data(Fields(tempField,"Rec Exclude",SubRec))>0 quit
864 . . . . . new SubIENS,SubFields,tempSR
865 . . . . . if AllSubRecs set tempSR="*"
866 . . . . . else set tempSR=SubRec
867 . . . . . set SubIENS=SubRec_","_IENS
868 . . . . . merge SubFields=Fields(tempField,tempSR)
869 . . . . . if (AllFields)!($data(SubFields)=0) set SubFields("*")=""
870 . . . . . if Flags["i" write $get(IndS2)
871 . . . . . new exFn set exFn="do "_RWriter_"("_$$QtProtect^TMGSTUTL(SubRec)_",0)"
872 . . . . . xecute exFn
873 . . . . . do Write1Rec(SubFile,SubRec,.SubFields,Flags,SRoot,SubIENS,IndS2_IncIndent,.RWriter,.FWriter,.LWriter,.WPLWriter,.SavFieldInfo)
874 . . . . . if Flags["i" write $get(IndS2)
875 . . . . . new exFn set exFn="do "_RWriter_"("_$$QtProtect^TMGSTUTL(SubRec)_",1)"
876 . . . . . xecute exFn
877 . . . . set SubRec=$order(@CRoot@(SubRec))
878 . . . if Flags["i" write $get(IndentS)
879 . . . set exFn="do "_FWriter_"("""_$$QtProtect^TMGSTUTL(Label)_""","""_$$QtProtect^TMGSTUTL(Field)_""","""_FieldInfo("TYPE")_""",1)"
880 . . . xecute exFn
881 else do ;"the usual case here...
882 . new line set line=""
883 . new CustXForm set CustXForm=$get(Fields("TRANSFORM",Field))
884 . if CustXForm'="" do
885 . . new Pos,GRef,Node
886 . . new FILE,FIELD,X,Y
887 . . new IntValue set IntValue=""
888 . . if $get(SRef)'="" set ORoot=SRef
889 . . else set ORoot=$get(^DIC(FileNum,0,"GL"))
890 . . if ORoot="" quit
891 . . set Node=$piece($get(FieldInfo("StoreLoc")),";",1)
892 . . if Node="" quit ;"skip computed fields
893 . . if (+Node'=Node) set Node=""""_Node_"""" ;" enclose text indices with quotes
894 . . set Pos=$piece($get(FieldInfo("StoreLoc")),";",2)
895 . . set GRef=ORoot_IEN_","_Node_")"
896 . . if +Pos>0 set IntValue=$piece($get(@GRef),"^",Pos)
897 . . ;"Set up variables for use by transform code
898 . . set FILE=FileNum
899 . . set FIELD=+Field
900 . . set X=IntValue
901 . . set Y=""
902 . . new $etrap set $etrap="set Y=""(Invalid custom transform M code!. Error Trapped.)"" set $etrap="""",$ecode="""""
903 . . xecute CustXForm
904 . . set line=Y
905 . else do
906 . . new GetFlag set GetFlag=""
907 . . if Flags["I" set GetFlag="I"
908 . . set line=$$GET1^DIQ(FileNum,IENS,Field,GetFlag)
909 . if (line="")&(Flags'["b") quit
910 . if Flags["i" write $get(IndentS)
911 . new exFn set exFn="do "_FWriter_"("""_$$QtProtect^TMGSTUTL(Label)_""","""_$$QtProtect^TMGSTUTL(Field)_""","""_FieldInfo("TYPE")_""",0)"
912 . xecute exFn
913 . set exFn="do "_LWriter_"(.line)"
914 . xecute exFn ;"write line
915 . if Flags["i" write $get(IndentS)
916 . set exFn="do "_FWriter_"("""_$$QtProtect^TMGSTUTL(Label)_""","""_$$QtProtect^TMGSTUTL(Field)_""","""_FieldInfo("TYPE")_""",1)"
917 . xecute exFn
918
919W1FDone
920 quit
921
922
923
924WriteRLabel(IEN,Ender)
925 ;"Purpose: To actually write out labels for record starting and ending.
926 ;" IEN -- the IEN (record number) of the record
927 ;" Optional extra informat:
928 ;" IEN(tag)=value
929 ;" IEN(tag2)=value2
930 ;" If provided, will be added to output as follows:
931 ;" <Record id="IEN" tag="value" tag2="value2">
932 ;" Ender -- OPTIONAL if 1, then ends field.
933 ;"Results: none.
934 ;"Note: This is a separate function so that a different callback function can replace it
935
936 if +$get(Ender)>0 write "</Record>",!
937 else do
938 . write "<Record id=""",IEN,""" "
939 . new tag set tag=""
940 . for set tag=$order(IEN(tag)) quit:(tag="") do
941 . . write tag,"=""",$get(IEN(tag)),""" "
942 . write ">",!
943
944 quit
945
946WriteFLabel(Label,Field,Type,Ender)
947 ;"Purpose: This is the code that actually does writing of labels etc for output
948 ;"Input: Label -- OPTIONAL -- Name of label, to write after 'label='
949 ;" Field -- OPTIONAL -- Name of field, to write after 'id='
950 ;" Type -- OPTIONAL -- Typeof field, to write after 'type='
951 ;" Ender -- OPTIONAL if 1, then ends field.
952 ;"Results: none.
953 ;"Note: This is a separate function so that a different callback function can replace it
954
955 ;"To write out <Field label="NAME" id=".01" type="FREE TEXT"> or </Field>
956
957 if +$get(Ender)>0 do
958 . write "</Field>",!
959 else do
960 . write "<Field "
961 . if $get(Field)'="" write "id=""",$$SYMENC^MXMLUTL(Field),""" "
962 . if $get(Label)'="" write "label=""",$$SYMENC^MXMLUTL(Label),""" "
963 . if $get(Type)'="" write "type=""",$$SYMENC^MXMLUTL(Type),""" "
964 . write ">"
965
966 quit
967
968WriteLine(Line)
969 ;"Purpose: This is the code that actually does writing of labels etc for output
970 ;"Input: Line -- the line of text to write out.
971 ;"Results: none
972 ;"Note: This is a separate function so that a different callback function can replace it
973
974 set Line=$$SYMENC^MXMLUTL(Line)
975 write "<LINE>",Line,"</LINE>",!
976 quit
977
978
979ConvertLabel(Label)
980 ;"Note: This function is no longer being used...
981
982 ;"To convert the XML tag into an acceptible format for XML
983 ;"
984 new i
985 new result set result=""
986
987 for i=1:1:$length(Label) do
988 . new ch set ch=$ascii($extract(Label,i))
989 . if ((ch>64)&(ch<91))!((ch>96)&(ch<123)) do quit
990 . . set result=result_$char(ch)
991 . if (ch=32) set result=result_"_"
992 . else do
993 . . set result=result_"x"
994
995 quit result
996
Note: See TracBrowser for help on using the repository browser.