TMGXMLT ;TMG/kst/XML Tools ;02/09/08 ;;1.0;TMG-LIB;**1**;02/09/08 ;"TMG XML EXPORT/IMPORT TOOL FUNCTIONS ;"Kevin Toppenberg MD ;"GNU General Public License (GPL) applies ;"2-9-2008 ;"======================================================================= ;" API -- Public Functions. ;"======================================================================= ;"LoadFile^TMGXMLT(Path,Filename,Option) -- Load XML file and parse ;"$$GetDescNode^TMGXMLT(XMLHandle,ParentNode,Name,ChildNode) -- Find a node that matches Name that is a descendant of Node ;"$$GetSibDescNode^TMGXMLT(XMLHandle,Node,Name) -- Find a node that matches Name that is a sibling of Node ;"GetNName^TMGXMLT(XMLHandle,Node) -- Get name of node indicated by Node handle ;"GetNText^TMGXMLT(XMLHandle,Node,TextArray) -- Get text associated with node ;"Get1NText^TMGXMLT(XMLHandle,Node,TextArray) -- Get 1st line of text associated with node ;"GetJNText^TMGXMLT(XMLHandle,Node,TextArray) -- Get all text of node, joined into 1 long string ;"GetAtrVal^TMGXMLT(XMLHandle,Node,Attrib) - Get attrib value for Attrib ;"GetParams^TMGXMLT(XMLHandle,Node,ParamArray,SubsCallback) - Get all the attribs and values into a Parameter array ;"WriteArray^TMGXMLT(Ref,NodeLabel,ID,Flags,IndentS,IncIndent) -- Write out data dictionary file in XML format ;"ReadArray^TMGXMLT(XMLHandle,Node,Array) -- read an Array (as written by WriteArray) from XML file back into Array ;"======================================================================= ;"PRIVATE API FUNCTIONS ;"======================================================================= ;"LoadParam(XMLHandle,dbName,ParamArray,count,SubsCallback) common code to call from GetParams ;"ShowXMLNode(NodeNum) show a parsed node ;"WriteNode(Ref,Node,IndentS,Flags) A reentrant function to write out one node of the data dictionary. ;"ReadNode(XMLHandle,ParentNode,curRef) LoadFile(Path,Filename,Option) ;"Purpose: To load the file and check for XML validity ;"Input: Path -- path of file to load ;" Filename, -- name of file to load ;" Option -- OPTIONAL ;"Returns: 0 if fails, otherwise XML file handle. ;"Note: EN^MXMLDOM can load the file directly... change this code later. new pDestRef set pDestRef=$name(^TMG("TMP","XML_IMPORT",$J)) new FileHandle set XMLHandle=0 new pDRef1 set pDRef1=$name(@pDestRef@(1)) set FileHandle=$$FTG^%ZISH(Path,Filename,pDRef1,$qlength(pDRef1)) if FileHandle=0 do goto QLoad . new PriorErrorFound . do ShowError^TMGDEBUG(.PriorErrorFound,"Error opening file. Path="_Path_", Filename="_Filename) do HandlOVF(pDestRef) write "Parsing XML File. Please wait. Large files can take > 15 minutes . . ." set XMLHandle=$$EN^MXMLDOM(pDestRef,"") write ! if XMLHandle=0 do . new ErrMsg,PriorErrorFound . set ErrMsg="Error parsing XML document.\n\n" . set ErrMsg=ErrMsg_"Now analyzing XML file to determine problem...\n" . do ShowError^TMGDEBUG(.PriorErrorFound,ErrMsg) . do DetailParse^TMGXMLP(pDestRef) QLoad kill @pDestRef quit XMLHandle HandlOVF(pDestRef) ;"Purpose: to try to handle overflow (OVF) nodes after loading file, ;" if line length is too long because of leading (left side) ;" space padding. new line set line="" for set line=$order(@pDestRef@(line)) quit:(line="") do . if $data(@pDestRef@(line,"OVF"))>0 do . . ;"write "OVF on line ",line,! . . ;"do ArrayDump^TMGDEBUG(pDestRef,line) . . new s1,s2 . . set s1=$get(@pDestRef@(line)) . . set s2=$get(@pDestRef@(line,"OVF",1)) ;"NOTE: <--- only handles 1 extra line. Expand later? . . kill @pDestRef@(line,"OVF",1) . . set s1=$$TRIM^XLFSTR(s1)_s2 . . ;"set s1=$$TrimL^TMGSTUTL(s1)_s2 . . if $length(s1)>255 do quit . . . ;"write "Overflow Line Present. LTrim was not enough...",! . . . set s2=$piece(s1,">",2,999) . . . set s1=$piece(s1,">",1)_">" . . . set @pDestRef@(line)=s1 . . . set @pDestRef@(line_".5")=s2 . . . if $length(s2)>255 do . . . . ;"write "Overflow Line Present. LTrim & line split was not enough..." . . . . ;"write "Line ",line,".5 is ",$length(s2)," characters long.",! . . else do . . . set @pDestRef@(line)=s1 quit GetDescNode(XMLHandle,ParentNode,Name,ChildNode) ;"Purpose: Find a node that matches Name that is a descendant of Node ;"Input: XMLHandle -- the handle, as created by $$EN^MXMLDOM ;" ParentNode: a node handle specifying parent ;" Name: the name to search for ;" ChildNode: OPTIONAL. If provided, then result will follow ;" ChildNode (i.e. start search at ChildNode) ;"Note: If node is sought, Name should be 'Yellow', not ''' ;"Note: Name to be searched for is NOT CASE SENSITIVE ;"Results: nodehandle, or 0 if not found. set ChildNode=+$get(ChildNode) GDNLoop set ChildNode=$$CHILD^MXMLDOM(XMLHandle,ParentNode,ChildNode) if ChildNode=0 goto GDNQ if $$GetNName(XMLHandle,ChildNode)=$$UP^XLFSTR(Name) goto GDNQ goto GDNLoop GDNQ quit ChildNode GetSibDescNode(XMLHandle,Node,Name) ;"Purpose: Find a node that matches Name, starting search among siblings with node ;"Input: XMLHandle -- the handle, as created by $$EN^MXMLDOM ;" Node: a node handle specifying the node to start searching from (AFTER) ;" Name: the name to search for ;"Note: If node is sought, Name should be 'Yellow', not ''' ;"Note: Name comparison is NOT CASE SENSITIVE. ;"Results: nodehandle, or 0 if not found. new SibNode set SibNode=Node GSDNL set SibNode=$$SIBLING^MXMLDOM(XMLHandle,SibNode) if $$GetNName(XMLHandle,ChildNode)=$$UP^XLFSTR(Name) goto GSDNQ if SibNode>0 goto GSDNL GSDNQ quit SibNode GetNName(XMLHandle,Node) ;"Purpose: Get name of node indicated by Node handle ;"Input: XMLHandle -- the handle, as created by $$EN^MXMLDOM ;" Node: node handle ;"Output: returns name associated with node (in UPPERCASE) new result set result=$$NAME^MXMLDOM(XMLHandle,Node) set result=$$UP^XLFSTR(result) quit result GetNText(XMLHandle,Node,TextArray) ;"Purpose: Get text associated with node ;"Input: XMLHandle -- the handle, as created by $$EN^MXMLDOM ;" Node: node handle ;" TextArray: a reference to global array to hold text array ;"Output: returns is text in Text is valid ;"Results: 1=value 0=not valid ;"Note: if Text is not valid, Text is set to " " new Valid set Valid=$$TEXT^MXMLDOM(XMLHandle,Node,$name(TextArray)) if 'Valid set TextArray=" " quit Valid Get1NText(XMLHandle,Node,TextArray) ;"Purpose: To get 1st line of text associated with node ;" 2/13/08 -- modified to 'Return 1 line of text' (all ;"Input: XMLHandle -- the handle, as created by $$EN^MXMLDOM ;" Node: node handle ;" TextArray: [OPTIONAL] If given, should be passed by reference ;" Will contain entire array, as passed back from XML functions ;"Output: returns text associated with node, or "" if none found new resultS if $$GetNText(XMLHandle,Node,.TextArray)>0 do . set resultS=$get(TextArray(1)) . set resultS=$$Trim^TMGSTUTL(resultS) else do . set resultS="" quit resultS GetJNText(XMLHandle,Node,TextArray) ;"Purpose: To get all text associated with node, joined into 1 long string ;"Input: XMLHandle -- the handle, as created by $$EN^MXMLDOM ;" Node: node handle ;" TextArray: [OPTIONAL] If given, should be passed by reference ;" Will contain entire array, as passed back from XML functions ;"Output: returns text associated with node, or "" if none found new resultS if $$GetNText(XMLHandle,Node,.TextArray)>0 do . set resultS=$$WPToStr^TMGSTUTL("TextArray","") . ;"set resultS=$$Trim^TMGSTUTL(resultS) else do . set resultS="" quit resultS Get1LText(XMLHandle,Node,TextArray) ;"Purpose: To get 1 line of text associated with node when nodes are in this format: ;" <--- Node points to this ;" 1317 <--- 1317 to be returned. could be ;" ;"Input: XMLHandle -- the handle, as created by $$EN^MXMLDOM ;" Node: node handle ;" TextArray: [OPTIONAL] If given, should be passed by reference ;" Will contain entire array, as passed back from XML functions ;"Output: returns text associated with node, or "" if none found new resultS set resultS="" new nodeLine set nodeLine=$$CHILD^MXMLDOM(XMLHandle,Node) if nodeLine>0 do . new Valid set Valid=$$TEXT^MXMLDOM(XMLHandle,nodeLine,"TextArray") . if 'Valid quit . set resultS=$$TRIM^XLFSTR($get(TextArray(1))) quit resultS GetAtrVal(XMLHandle,Node,Attrib) ;"Purpose: Get attrib value for Attrib ;"Input: XMLHandle -- the handle, as created by $$EN^MXMLDOM ;" Node: node handle ;" Attrib: name of attribute ;"Results: returns value associated with attribute, or " " if not found new result set result=" " new UserAttrib if Attrib=" " goto GAVDone ;"Note: because user-given attrib may be in lower case, I will have to ;" first scan attribs to find right one. Then get value set Attrib=$$UP^XLFSTR(Attrib) set UserAttrib=$$ATTRIB^MXMLDOM(XMLHandle,Node) GAVLoop if Attrib=$$UP^XLFSTR(UserAttrib) goto GAVGet set UserAttrib=$$ATTRIB^MXMLDOM(XMLHandle,Node,UserAttrib) if $data(UserAttrib)=0 goto GAVDone if UserAttrib="" goto GAVDone goto GAVLoop GAVGet set result=$$VALUE^MXMLDOM(XMLHandle,Node,UserAttrib) if $data(result)=0 set result=" " if result="" set result=" " GAVDone quit result GetParams(XMLHandle,Node,ParamArray,SubsCallback) ;"Purpose: To get all the attribs and values into a Parameter array ;"Input: XMLHandle -- the handle, as created by $$EN^MXMLDOM ;" Node -- the node to parse ;" ParamArray -- MUST BE PASSED BY REFERENCE to accept values back ;" When passed back, it will have this structure: ;" ParamArray(1,"Name")= ;" ParamArray(1,"Name","UpperCase")= ;" ParamArray(1,"VALUE")= ;" ParamArray(1,"VALUE","UpperCase")= ;" ParamArray(2,"Name")= ;" ParamArray(2,"Name","UpperCase")= ;" ParamArray(2,"VALUE")= ;" ParamArray(2,"VALUE","UpperCase")= ;" e.g.: ;" ParamArray(1,"Name")="id" ;" ParamArray(1,"Name","UpperCase")="ID" ;" ParamArray(1,"VALUE")="office" ;" ParamArray(1,"VALUE","UpperCase")="OFFICE" ;" ALSO I will additionally put the data in this format: ;" ParamArray("ID")="office" ;" ParamArray("ID","UpperCase")="OFFICE" ;" ALSO I will add the text from the node into ParamArray("TEXT") ;" e.g. ;" Some Text ;" And some more... ;" ;" would result in: ;" ParamArray("TEXT",1)="Some Text" ;" ParamArray("TEXT",2)="And some more" ;" SubsCallback -- name of function, used to call to see if data subsition (i.e. turning ;" a data value into something else). OPTIONAL ;" e.g. "CheckSubstituteData^TMGXINST". Function must be declared ;" in this format: CheckSubstituteData(value) ;"Result: 1=ok to continue, 0=abort new count set count=1 new value new result set result=1 new attrib set attrib=$$ATTRIB^MXMLDOM(XMLHandle,Node) if $data(attrib)=0 goto GParDone if attrib="" goto GParDone set result=$$LoadParam(XMLHandle,attrib,.ParamArray,count,.SubsCallback) set count=count+1 GParL1 set attrib=$$ATTRIB^MXMLDOM(XMLHandle,Node,attrib) if $data(attrib)=0 goto GParDone if attrib="" goto GParDone set result=$$LoadParam(XMLHandle,attrib,.ParamArray,count,.SubsCallback) set count=count+1 goto GParL1 GParDone quit result LoadParam(XMLHandle,dbName,ParamArray,count,SubsCallback) ;"Purpose: Provide common code to call from GetParams ;"Input: XMLHandle -- the handle, as created by $$EN^MXMLDOM ;" Node -- the node to parse ;" ParamArray -- MUST BE PASSED BY REFERENCE to accept values back ;" count -- Current Count ;" SubsCallback -- name of function, used to call to see if data subsition (i.e. turning ;" a data value into something else). OPTIONAL ;" e.g. "CheckSubstituteData^TMGXINST". Function must be declared ;" in this format: CheckSubstituteData(value) ;"result: 1=ok to continue, 0=abort new value new result set result=1 set ParamArray(count,"Name")=dbName set ParamArray(count,"Name","UpperCase")=$$UP^XLFSTR(dbName) set value=$$VALUE^MXMLDOM(XMLHandle,Node,dbName) if $get(SubsCallback)'="" do . new Fn set Fn="set result=$$"_SubsCallback_"(.value)" . xecute Fn . if result=0 do ShowError^TMGDEBUG(.PriorErrorFound,"Error getting parameter substitution: "_dbName) set ParamArray(count,"VALUE")=value set ParamArray(count,"VALUE","UpperCase")=$$UP^XLFSTR(value) set ParamArray($$UP^XLFSTR(dbName))=value set ParamArray($$UP^XLFSTR(dbName),"UpperCase")=$$UP^XLFSTR(value) quit result ShowXMLNode(NodeNum) ;"Purpose: To show a parsed node new lineI if NodeNum'>0 do goto LSNQuit do ArrayDump^TMGDEBUG("^TMP(""MXMLDOM"","_$J_",1,"_NodeNum_")") if $data(^TMP("MXMLDOM",$J,1,NodeNum))=0 do goto LSNQuit . do ArrayDump^TMGDEBUG("^TMP(""MXMLDOM"","_$J_",1,"_NodeNum_")") if $data(^TMP("MXMLDOM",$J,1,NodeNum,"A")) do . set lineI=$Order(^TMP("MXMLDOM",$J,1,NodeNum,"A","")) . for do quit:(lineI="") . . set lineI=$Order(^TMP("MXMLDOM",$J,1,NodeNum,"A",lineI)) LSNQuit quit WriteArray(Ref,NodeLabel,ID,Flags,IndentS,IncIndent,ProgressFn) ;"Scope: PUBLIC ;"Purpose: to write out an array in XML format ;"Input: Ref -- the Ref to write out, e.g. $name(^DD(FileNum)) ;" Nodelabel -- the label of the node, ;" e.g. DataDictionary, --> ;" ID -- An id for