source: cprs/branches/tmg-cprs/m_files/TMGXMLT.m@ 820

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

Initial upload
File size: 20.4 KB
RevLine 
[796]1TMGXMLT ;TMG/kst/XML Tools ;02/09/08
2 ;;1.0;TMG-LIB;**1**;02/09/08
3
4 ;"TMG XML EXPORT/IMPORT TOOL FUNCTIONS
5 ;"Kevin Toppenberg MD
6 ;"GNU General Public License (GPL) applies
7 ;"2-9-2008
8
9 ;"=======================================================================
10 ;" API -- Public Functions.
11 ;"=======================================================================
12 ;"LoadFile^TMGXMLT(Path,Filename,Option) -- Load XML file and parse
13 ;"$$GetDescNode^TMGXMLT(XMLHandle,ParentNode,Name,ChildNode) -- Find a node that matches Name that is a descendant of Node
14 ;"$$GetSibDescNode^TMGXMLT(XMLHandle,Node,Name) -- Find a node that matches Name that is a sibling of Node
15 ;"GetNName^TMGXMLT(XMLHandle,Node) -- Get name of node indicated by Node handle
16 ;"GetNText^TMGXMLT(XMLHandle,Node,TextArray) -- Get text associated with node
17 ;"Get1NText^TMGXMLT(XMLHandle,Node,TextArray) -- Get 1st line of text associated with node
18 ;"GetJNText^TMGXMLT(XMLHandle,Node,TextArray) -- Get all text of node, joined into 1 long string
19 ;"GetAtrVal^TMGXMLT(XMLHandle,Node,Attrib) - Get attrib value for Attrib
20 ;"GetParams^TMGXMLT(XMLHandle,Node,ParamArray,SubsCallback) - Get all the attribs and values into a Parameter array
21 ;"WriteArray^TMGXMLT(Ref,NodeLabel,ID,Flags,IndentS,IncIndent) -- Write out data dictionary file in XML format
22 ;"ReadArray^TMGXMLT(XMLHandle,Node,Array) -- read an Array (as written by WriteArray) from XML file back into Array
23
24 ;"=======================================================================
25 ;"PRIVATE API FUNCTIONS
26 ;"=======================================================================
27 ;"LoadParam(XMLHandle,dbName,ParamArray,count,SubsCallback) common code to call from GetParams
28 ;"ShowXMLNode(NodeNum) show a parsed node
29 ;"WriteNode(Ref,Node,IndentS,Flags) A reentrant function to write out one node of the data dictionary.
30 ;"ReadNode(XMLHandle,ParentNode,curRef)
31
32LoadFile(Path,Filename,Option)
33 ;"Purpose: To load the file and check for XML validity
34 ;"Input: Path -- path of file to load
35 ;" Filename, -- name of file to load
36 ;" Option -- OPTIONAL
37 ;"Returns: 0 if fails, otherwise XML file handle.
38
39 ;"Note: EN^MXMLDOM can load the file directly... change this code later.
40
41 new pDestRef set pDestRef=$name(^TMG("TMP","XML_IMPORT",$J))
42
43 new FileHandle
44 set XMLHandle=0
45 new pDRef1 set pDRef1=$name(@pDestRef@(1))
46
47 set FileHandle=$$FTG^%ZISH(Path,Filename,pDRef1,$qlength(pDRef1))
48 if FileHandle=0 do goto QLoad
49 . new PriorErrorFound
50 . do ShowError^TMGDEBUG(.PriorErrorFound,"Error opening file. Path="_Path_", Filename="_Filename)
51 do HandlOVF(pDestRef)
52
53 write "Parsing XML File. Please wait. Large files can take > 15 minutes . . ."
54 set XMLHandle=$$EN^MXMLDOM(pDestRef,"")
55 write !
56 if XMLHandle=0 do
57 . new ErrMsg,PriorErrorFound
58 . set ErrMsg="Error parsing XML document.\n\n"
59 . set ErrMsg=ErrMsg_"Now analyzing XML file to determine problem...\n"
60 . do ShowError^TMGDEBUG(.PriorErrorFound,ErrMsg)
61 . do DetailParse^TMGXMLP(pDestRef)
62
63QLoad
64 kill @pDestRef
65 quit XMLHandle
66
67
68HandlOVF(pDestRef)
69 ;"Purpose: to try to handle overflow (OVF) nodes after loading file,
70 ;" if line length is too long because of leading (left side)
71 ;" space padding.
72
73 new line set line=""
74 for set line=$order(@pDestRef@(line)) quit:(line="") do
75 . if $data(@pDestRef@(line,"OVF"))>0 do
76 . . ;"write "OVF on line ",line,!
77 . . ;"do ArrayDump^TMGDEBUG(pDestRef,line)
78 . . new s1,s2
79 . . set s1=$get(@pDestRef@(line))
80 . . set s2=$get(@pDestRef@(line,"OVF",1)) ;"NOTE: <--- only handles 1 extra line. Expand later?
81 . . kill @pDestRef@(line,"OVF",1)
82 . . set s1=$$TRIM^XLFSTR(s1)_s2
83 . . ;"set s1=$$TrimL^TMGSTUTL(s1)_s2
84 . . if $length(s1)>255 do quit
85 . . . ;"write "Overflow Line Present. LTrim was not enough...",!
86 . . . set s2=$piece(s1,">",2,999)
87 . . . set s1=$piece(s1,">",1)_">"
88 . . . set @pDestRef@(line)=s1
89 . . . set @pDestRef@(line_".5")=s2
90 . . . if $length(s2)>255 do
91 . . . . ;"write "Overflow Line Present. LTrim & line split was not enough..."
92 . . . . ;"write "Line ",line,".5 is ",$length(s2)," characters long.",!
93 . . else do
94 . . . set @pDestRef@(line)=s1
95
96 quit
97
98
99
100GetDescNode(XMLHandle,ParentNode,Name,ChildNode)
101 ;"Purpose: Find a node that matches Name that is a descendant of Node
102 ;"Input: XMLHandle -- the handle, as created by $$EN^MXMLDOM
103 ;" ParentNode: a node handle specifying parent
104 ;" Name: the name to search for
105 ;" ChildNode: OPTIONAL. If provided, then result will follow
106 ;" ChildNode (i.e. start search at ChildNode)
107 ;"Note: If <Yellow> node is sought, Name should be 'Yellow', not '<Yellow>''
108 ;"Note: Name to be searched for is NOT CASE SENSITIVE
109 ;"Results: nodehandle, or 0 if not found.
110
111 set ChildNode=+$get(ChildNode)
112GDNLoop set ChildNode=$$CHILD^MXMLDOM(XMLHandle,ParentNode,ChildNode)
113 if ChildNode=0 goto GDNQ
114 if $$GetNName(XMLHandle,ChildNode)=$$UP^XLFSTR(Name) goto GDNQ
115 goto GDNLoop
116
117GDNQ
118 quit ChildNode
119
120
121
122GetSibDescNode(XMLHandle,Node,Name)
123 ;"Purpose: Find a node that matches Name, starting search among siblings with node
124 ;"Input: XMLHandle -- the handle, as created by $$EN^MXMLDOM
125 ;" Node: a node handle specifying the node to start searching from (AFTER)
126 ;" Name: the name to search for
127 ;"Note: If <Yellow> node is sought, Name should be 'Yellow', not '<Yellow>''
128 ;"Note: Name comparison is NOT CASE SENSITIVE.
129 ;"Results: nodehandle, or 0 if not found.
130
131 new SibNode set SibNode=Node
132GSDNL set SibNode=$$SIBLING^MXMLDOM(XMLHandle,SibNode)
133 if $$GetNName(XMLHandle,ChildNode)=$$UP^XLFSTR(Name) goto GSDNQ
134 if SibNode>0 goto GSDNL
135
136GSDNQ quit SibNode
137
138
139
140GetNName(XMLHandle,Node)
141 ;"Purpose: Get name of node indicated by Node handle
142 ;"Input: XMLHandle -- the handle, as created by $$EN^MXMLDOM
143 ;" Node: node handle
144 ;"Output: returns name associated with node (in UPPERCASE)
145
146 new result
147 set result=$$NAME^MXMLDOM(XMLHandle,Node)
148 set result=$$UP^XLFSTR(result)
149 quit result
150
151
152
153GetNText(XMLHandle,Node,TextArray)
154 ;"Purpose: Get text associated with node
155 ;"Input: XMLHandle -- the handle, as created by $$EN^MXMLDOM
156 ;" Node: node handle
157 ;" TextArray: a reference to global array to hold text array
158 ;"Output: returns is text in Text is valid
159 ;"Results: 1=value 0=not valid
160 ;"Note: if Text is not valid, Text is set to " "
161
162 new Valid
163 set Valid=$$TEXT^MXMLDOM(XMLHandle,Node,$name(TextArray))
164 if 'Valid set TextArray=" "
165 quit Valid
166
167
168
169Get1NText(XMLHandle,Node,TextArray)
170 ;"Purpose: To get 1st line of text associated with node
171 ;" 2/13/08 -- modified to 'Return 1 line of text' (all
172 ;"Input: XMLHandle -- the handle, as created by $$EN^MXMLDOM
173 ;" Node: node handle
174 ;" TextArray: [OPTIONAL] If given, should be passed by reference
175 ;" Will contain entire array, as passed back from XML functions
176 ;"Output: returns text associated with node, or "" if none found
177
178 new resultS
179 if $$GetNText(XMLHandle,Node,.TextArray)>0 do
180 . set resultS=$get(TextArray(1))
181 . set resultS=$$Trim^TMGSTUTL(resultS)
182 else do
183 . set resultS=""
184
185 quit resultS
186
187
188GetJNText(XMLHandle,Node,TextArray)
189 ;"Purpose: To get all text associated with node, joined into 1 long string
190 ;"Input: XMLHandle -- the handle, as created by $$EN^MXMLDOM
191 ;" Node: node handle
192 ;" TextArray: [OPTIONAL] If given, should be passed by reference
193 ;" Will contain entire array, as passed back from XML functions
194 ;"Output: returns text associated with node, or "" if none found
195
196 new resultS
197 if $$GetNText(XMLHandle,Node,.TextArray)>0 do
198 . set resultS=$$WPToStr^TMGSTUTL("TextArray","")
199 . ;"set resultS=$$Trim^TMGSTUTL(resultS)
200 else do
201 . set resultS=""
202
203 quit resultS
204
205
206Get1LText(XMLHandle,Node,TextArray)
207 ;"Purpose: To get 1 line of text associated with node when nodes are in this format:
208 ;" <Rec label="xyz" > <--- Node points to this
209 ;" <LINE>1317</LINE> <--- 1317 to be returned. <LINE> could be <AnyName>
210 ;" </Rec>
211 ;"Input: XMLHandle -- the handle, as created by $$EN^MXMLDOM
212 ;" Node: node handle
213 ;" TextArray: [OPTIONAL] If given, should be passed by reference
214 ;" Will contain entire array, as passed back from XML functions
215 ;"Output: returns text associated with node, or "" if none found
216
217 new resultS set resultS=""
218 new nodeLine set nodeLine=$$CHILD^MXMLDOM(XMLHandle,Node)
219 if nodeLine>0 do
220 . new Valid set Valid=$$TEXT^MXMLDOM(XMLHandle,nodeLine,"TextArray")
221 . if 'Valid quit
222 . set resultS=$$TRIM^XLFSTR($get(TextArray(1)))
223
224 quit resultS
225
226
227GetAtrVal(XMLHandle,Node,Attrib)
228 ;"Purpose: Get attrib value for Attrib
229 ;"Input: XMLHandle -- the handle, as created by $$EN^MXMLDOM
230 ;" Node: node handle
231 ;" Attrib: name of attribute
232 ;"Results: returns value associated with attribute, or " " if not found
233
234 new result set result=" "
235 new UserAttrib
236 if Attrib=" " goto GAVDone
237
238 ;"Note: because user-given attrib may be in lower case, I will have to
239 ;" first scan attribs to find right one. Then get value
240 set Attrib=$$UP^XLFSTR(Attrib)
241 set UserAttrib=$$ATTRIB^MXMLDOM(XMLHandle,Node)
242GAVLoop
243 if Attrib=$$UP^XLFSTR(UserAttrib) goto GAVGet
244
245 set UserAttrib=$$ATTRIB^MXMLDOM(XMLHandle,Node,UserAttrib)
246 if $data(UserAttrib)=0 goto GAVDone
247 if UserAttrib="" goto GAVDone
248 goto GAVLoop
249
250GAVGet
251 set result=$$VALUE^MXMLDOM(XMLHandle,Node,UserAttrib)
252 if $data(result)=0 set result=" "
253 if result="" set result=" "
254
255GAVDone
256 quit result
257
258
259
260GetParams(XMLHandle,Node,ParamArray,SubsCallback)
261 ;"Purpose: To get all the attribs and values into a Parameter array
262 ;"Input: XMLHandle -- the handle, as created by $$EN^MXMLDOM
263 ;" Node -- the node to parse
264 ;" ParamArray -- MUST BE PASSED BY REFERENCE to accept values back
265 ;" When passed back, it will have this structure:
266 ;" ParamArray(1,"Name")=<attrib name>
267 ;" ParamArray(1,"Name","UpperCase")=<UPPER CASE OF attrib name>
268 ;" ParamArray(1,"VALUE")=<value of attrib>
269 ;" ParamArray(1,"VALUE","UpperCase")=<UPPER CASE OF value of attrib>
270 ;" ParamArray(2,"Name")=<attrib name>
271 ;" ParamArray(2,"Name","UpperCase")=<UPPER CASE OF attrib name>
272 ;" ParamArray(2,"VALUE")=<value of attrib>
273 ;" ParamArray(2,"VALUE","UpperCase")=<UPPER CASE OF value of attrib>
274 ;" e.g.:
275 ;" ParamArray(1,"Name")="id"
276 ;" ParamArray(1,"Name","UpperCase")="ID"
277 ;" ParamArray(1,"VALUE")="office"
278 ;" ParamArray(1,"VALUE","UpperCase")="OFFICE"
279 ;" ALSO I will additionally put the data in this format:
280 ;" ParamArray("ID")="office"
281 ;" ParamArray("ID","UpperCase")="OFFICE"
282 ;" ALSO I will add the text from the node into ParamArray("TEXT")
283 ;" e.g. <Comment>
284 ;" Some Text
285 ;" And some more...
286 ;" </Comment>
287 ;" would result in:
288 ;" ParamArray("TEXT",1)="Some Text"
289 ;" ParamArray("TEXT",2)="And some more"
290 ;" SubsCallback -- name of function, used to call to see if data subsition (i.e. turning
291 ;" a data value into something else). OPTIONAL
292 ;" e.g. "CheckSubstituteData^TMGXINST". Function must be declared
293 ;" in this format: CheckSubstituteData(value)
294 ;"Result: 1=ok to continue, 0=abort
295
296 new count set count=1
297 new value
298 new result set result=1
299 new attrib
300
301 set attrib=$$ATTRIB^MXMLDOM(XMLHandle,Node)
302 if $data(attrib)=0 goto GParDone
303 if attrib="" goto GParDone
304 set result=$$LoadParam(XMLHandle,attrib,.ParamArray,count,.SubsCallback)
305 set count=count+1
306GParL1
307 set attrib=$$ATTRIB^MXMLDOM(XMLHandle,Node,attrib)
308 if $data(attrib)=0 goto GParDone
309 if attrib="" goto GParDone
310 set result=$$LoadParam(XMLHandle,attrib,.ParamArray,count,.SubsCallback)
311 set count=count+1
312 goto GParL1
313GParDone
314 quit result
315
316
317LoadParam(XMLHandle,dbName,ParamArray,count,SubsCallback)
318 ;"Purpose: Provide common code to call from GetParams
319 ;"Input: XMLHandle -- the handle, as created by $$EN^MXMLDOM
320 ;" Node -- the node to parse
321 ;" ParamArray -- MUST BE PASSED BY REFERENCE to accept values back
322 ;" count -- Current Count
323 ;" SubsCallback -- name of function, used to call to see if data subsition (i.e. turning
324 ;" a data value into something else). OPTIONAL
325 ;" e.g. "CheckSubstituteData^TMGXINST". Function must be declared
326 ;" in this format: CheckSubstituteData(value)
327
328 ;"result: 1=ok to continue, 0=abort
329 new value
330 new result set result=1
331
332 set ParamArray(count,"Name")=dbName
333 set ParamArray(count,"Name","UpperCase")=$$UP^XLFSTR(dbName)
334 set value=$$VALUE^MXMLDOM(XMLHandle,Node,dbName)
335 if $get(SubsCallback)'="" do
336 . new Fn set Fn="set result=$$"_SubsCallback_"(.value)"
337 . xecute Fn
338 . if result=0 do ShowError^TMGDEBUG(.PriorErrorFound,"Error getting parameter substitution: "_dbName)
339 set ParamArray(count,"VALUE")=value
340 set ParamArray(count,"VALUE","UpperCase")=$$UP^XLFSTR(value)
341 set ParamArray($$UP^XLFSTR(dbName))=value
342 set ParamArray($$UP^XLFSTR(dbName),"UpperCase")=$$UP^XLFSTR(value)
343
344 quit result
345
346
347
348ShowXMLNode(NodeNum)
349 ;"Purpose: To show a parsed node
350 new lineI
351 if NodeNum'>0 do goto LSNQuit
352 do ArrayDump^TMGDEBUG("^TMP(""MXMLDOM"","_$J_",1,"_NodeNum_")")
353 if $data(^TMP("MXMLDOM",$J,1,NodeNum))=0 do goto LSNQuit
354 . do ArrayDump^TMGDEBUG("^TMP(""MXMLDOM"","_$J_",1,"_NodeNum_")")
355 if $data(^TMP("MXMLDOM",$J,1,NodeNum,"A")) do
356 . set lineI=$Order(^TMP("MXMLDOM",$J,1,NodeNum,"A",""))
357 . for do quit:(lineI="")
358 . . set lineI=$Order(^TMP("MXMLDOM",$J,1,NodeNum,"A",lineI))
359
360LSNQuit quit
361
362
363
364WriteArray(Ref,NodeLabel,ID,Flags,IndentS,IncIndent,ProgressFn)
365 ;"Scope: PUBLIC
366 ;"Purpose: to write out an array in XML format
367 ;"Input: Ref -- the Ref to write out, e.g. $name(^DD(FileNum))
368 ;" Nodelabel -- the label of the node,
369 ;" e.g. DataDictionary, --> <DataDictionary>
370 ;" ID -- An id for <Label id=xxx>
371 ;" Flags -- OPTIONAL -- flags as declared above. Only "i" used here
372 ;" IndentS -- OPTIONAL -- current string to write to indent line.
373 ;" IncIndent -- OPTIONAL -- the amount of space to indent by, e.g. " "
374 ;" ProgressFn -- OPTIONAL -- M code to exec as a progress indicator
375 ;"Results: none
376
377 set IncIndent=$get(IncIndent," ")
378 set IndentS=$get(IndentS)
379
380 if $get(Flags)["i" write IndentS
381 write "<",NodeLabel," id=""",$$SYMENC^MXMLUTL(ID),""">",!
382 do WriteNode(Ref,Ref,IndentS_IncIndent,.Flags,.ProgressFn)
383 if $get(Flags)["i" write IndentS
384 write "</",NodeLabel,">",!
385 quit
386
387
388
389WriteNode(Ref,Node,IndentS,Flags,ProgressFn,IncVar)
390 ;"SCOPE: PRIVATE
391 ;"Purpose: A reentrant function to write out one node of the data dictionary.
392 ;"Input: Ref -- the NAME OF the full referenct to the current node to export (includes Node below)
393 ;" Node -- the name of just the node to export
394 ;" IndentS -- The OPTIONAL string to print to indent the text.
395 ;" Flags -- Flags as declared above. Only "i" used here.
396 ;" ProgressFn -- OPTIONAL -- M code to exec as a progress indicator
397 ;" IncVar -- OPTIONAL -- a counter that can be referenced by ProgressFn
398 ;"NOTE: Uses GLOBAL SCOPED IncIndent variable. But setting this is OPTIONAL.
399 ;"Results: none
400
401 new result set result=0
402 set IncIndent=$get(IncIndent," ")
403 set IndentS=$get(IndentS)
404 set IncVar=+$get(IncVar)+1
405 if (IncVar#10=1),($get(ProgressFn)'="") do
406 . new $etrap set $etrap="set $etrap="""",$ecode="""""
407 . xecute ProgressFn
408
409 new outS
410 if $get(Flags)["i" write IndentS
411 write "<N id=""",$$SYMENC^MXMLUTL(Node),""">"
412 set outS=$$SYMENC^MXMLUTL($get(@Ref))
413
414 if outS'="" write outS
415 else if $data(@Ref)#10=1 write """"""
416
417 ;"write !
418 new NewLnWriten set NewLnWriten=0
419
420 new sub set sub=""
421 for set sub=$order(@Ref@(sub)) quit:(sub="") do
422 . if NewLnWriten=0 write ! set NewLnWriten=1
423 . do WriteNode($name(@Ref@(sub)),sub,IndentS_IncIndent,.Flags,.ProgressFn,.IncVar)
424
425 if NewLnWriten,$get(Flags)["i" write IndentS
426 write "</N>",!
427 quit
428
429
430
431ReadArray(XMLHandle,Node,Array,ProgressFn,IncVar)
432 ;"Purpose: to read an Array (as written by WriteArray) from XML file back into Array
433 ;"Input: XMLHandle
434 ;" Node -- the node number (as used by MXMLDOM code)
435 ;" Array -- PASS BY REFERENCE, the array to get results back into. Old values Killed
436 ;" ProgressFn -- OPTIONAL -- M code to exec as a progress indicator
437 ;" IncVar -- OPTIONAL -- a counter that can be referenced by ProgressFn
438 ;"Result: None
439
440 kill Array
441 new refNode set refNode=$$CHILD^MXMLDOM(XMLHandle,Node)
442 if refNode=0 goto RADone
443 new origRef set origRef=$$GetAtrVal(XMLHandle,refNode,"id")
444 new temp set temp=$$ReadNode(XMLHandle,refNode,"Array",.ProgressFn,.IncVar)
445
446RADone quit
447
448
449
450ReadNode(XMLHandle,ParentNode,curRef,ProgressFn,IncVar)
451 ;"Input: XMLHandle
452 ;" ParentNode -- the node number (as used by MXMLDOM code)
453 ;" curRef -- PASS BY NAME. Reference to array to get results back into. Old values Killed
454 ;" ProgressFn -- OPTIONAL -- M code to exec as a progress indicator
455 ;" IncVar -- OPTIONAL -- a counter that can be referenced by ProgressFn
456 ;"Result: 1=Data found, 0=no data found
457
458 set IncVar=+$get(IncVar)+1
459 if IncVar#10=1 do
460 . if $get(ProgressFn)'="" do
461 . . new $etrap set $etrap="set $etrap="""",$ecode="""""
462 . . xecute ProgressFn
463 . . write !,ParentNode,"(",curRef,") ",! do CUU^TMGTERM(2) ;"temp
464 . . if $$UserAborted^TMGUSRIF() set abort=1 quit
465
466 new result set result=0
467 new curNode set curNode=0
468 new origRef set origRef=curRef
469 for set curNode=$$CHILD^MXMLDOM(XMLHandle,ParentNode,curNode) quit:(curNode=0) do
470 . set result=1
471 . new ArrayNode set ArrayNode=$$GetAtrVal(XMLHandle,curNode,"id")
472 . set curRef=$name(@origRef@(ArrayNode))
473 . new data
474 . ;"BELOW ONLY READS 1 LINE PER NODE.. I THINK THIS IS OK...
475 . if $$TEXT^MXMLDOM(XMLHandle,curNode,"data") set data=$get(data(1))
476 . set data=$$TRIM^XLFSTR(data,"R") ;"I am afraid a L trim of WP docs would mess them up...
477 . new temp set temp=data if temp=" " set temp=""
478 . if data="""""" set @curRef=""
479 . else if (data'="")&(temp'="") set @curRef=data
480 . ;"if temp'="" write curRef,"=[",data,"]",! ;"temp
481 . new subData set subData=$$ReadNode(XMLHandle,curNode,curRef,.ProgressFn,.IncVar)
482 . if (subData=0)&(data="") do
483 . . set @curRef=""
484 . . ;"write curRef,"=[""""]",! ;"temp
485
486 quit result
487
Note: See TracBrowser for help on using the repository browser.