TMGXMLIN ;TMG/kst/XML Importer ;02/09/08 ;;1.0;TMG-LIB;**1**;02/09/08 ;"TMG XML IMPORT FUNCTION ;"Kevin Toppenberg MD ;"GNU General Public License (GPL) applies ;"2-9-2008 ;"======================================================================= ;" API -- Public Functions. ;"======================================================================= ;"======================================================================= ;"PRIVATE API FUNCTIONS ;"======================================================================= ImportXML ;"Purpose: to Import file records via XML file new UserPath,UserFName,result new XMLHandle set XMLHandle=0 set XMLHandle=$order(^TMP("MXMLDOM",$J,"")) if XMLHandle>0 goto Imp1 new tempArray new tRef set tRef=$name(^TMG("TMP","KILLTHIS","MXMLDOM",777)) if $data(@tRef) do goto Imp1 . merge ^TMP("MXMLDOM",$J,777)=@tRef . set XMLHandle=777 set result=$$GetFName^TMGIOUTL("Select XML Import File","/",,,.UserPath,.UserFName) if result="" goto ImpDone set XMLHandle=$$LoadFile^TMGXMLT(.UserPath,.UserFName) if XMLHandle'>0 goto ImpDone kill @tRef merge @tRef=^TMP("MXMLDOM",$J,XMLHandle) Imp1 do ImportFiles(XMLHandle) Imp2 ImpDone if XMLHandle>0 do . new % set %=2 . write "Delete current XML import (may reload next time)" . do YN^DICN write ! . if %'=1 quit . do DELETE^MXMLDOM(XMLHandle) quit GetDDNode(XMLHandle) ;"Purpose: Get the Data Dictionary Node (stored under FILE node) ;"Input: XMLHandle -- The handle created by loading function. ;"Results: 0 if node not found, otherwise node number new result set result=$$GetDescNode^TMGXMLT(XMLHandle,1,"DataDictionary") quit result GetSysName(XMLHandle) ;"Purpose: Get label of the VistA system that exported the data ;" This means that this will only work with data exported by ;" TMGXMLEX code module. ;"Input: XMLHandle -- The handle created by loading function. ;"Results: Returns system name, or "" if not found ;"Note: Expects node 1 to be new result set result=$$GetAtrVal^TMGXMLT(XMLHandle,1,"source") quit result ImportFiles(XMLHandle) ;"Purpose: to import data stored in XML file into local database ;"Input: XMLHandle -- The handle created by loading function. ;"results: none new SrcSysName set SrcSysName=$$GetSysName(XMLHandle) if SrcSysName="" goto IFDone ;"Later put guard to ensure not re-importing to self. new abort set abort=0 new nodeFile set nodeFile=0 for set nodeFile=$$GetDescNode^TMGXMLT(XMLHandle,1,"FILE",nodeFile) quit:(nodeFile'>0)!abort do . set abort=$$Import1File(XMLHandle,SrcSysName,nodeFile) IFDone quit Import1File(XMLHandle,SrcSysName,nodeFile) ;"Purpose: to Import 1 file from XML data. ;"Input: XMLHandle -- The handle created by loading function. ;" SrcSysName -- The name of the source VistA system ;" ParentNode -- the node containing the 0 do goto Ip1FDone . set abort=1 . write "Unable to import FILE because no numeric file number in attrib id='xx'",! ;"Later change this so that all the DD's are checked before calling Import1File new temp set temp=$$CompatFile(XMLHandle,SrcSysName,nodeFile) if temp'>0 do goto Ip1FDone . set abort=1 . if temp=-1 quit . write "Unable to import FILE #",FileNum," because data dictionaries are incompatible.",! ;"new nodeRecord set nodeRecord=$$CHILD^MXMLDOM(XMLHandle,nodeFile) new nodeRecord set nodeRecord=0 for set nodeRecord=$$GetDescNode^TMGXMLT(XMLHandle,nodeFile,"Record",nodeRecord) quit:(nodeRecord'>0)!abort do . set abort=$$Imp1Record(XMLHandle,SrcSysName,FileNum,nodeRecord) Ip1FDone quit abort CompatFile(XMLHandle,SrcSysName,nodeFile) ;"Purpose: to determine if the data dictionary (i.e. File Definition) is ;" compatible between the Src VistA system, and this installation. ;" E.g. Does field #1 mean the same thing on both systems? ;"Note, a table will be maintained to store the compatibility data. (The process ;" of comparing the data dictionaries is slow). ;" Format: ;" ^TMG("XML EXPORTER",SrcSysName,"DD",FileNum,"DATE-TIME")=Time_(H$)_of_last_comparison ;" ^TMG("XML EXPORTER",SrcSysName,"DD",FileNum,"COMPATIBLE")=1 (0=NOT compat, -1=aborted) ;" ^TMG("XML EXPORTER",SrcSysName,"DD",FileNum,"WORKING","^DD","IMPORT-EXTRA")=... ;" ^TMG("XML EXPORTER",SrcSysName,"DD",FileNum,"WORKING","^DD","DIFFERENCE")=... ;" ^TMG("XML EXPORTER",SrcSysName,"DD",FileNum,"WORKING","^DD","TEMP-ARRAY")=... ;" ^TMG("XML EXPORTER",SrcSysName,"DD",FileNum,"WORKING","^DIC","IMPORT-EXTRA")=... ;" ^TMG("XML EXPORTER",SrcSysName,"DD",FileNum,"WORKING","^DIC","DIFFERENCE")=... ;" ^TMG("XML EXPORTER",SrcSysName,"DD",FileNum,"WORKING","^DIC","TEMP-ARRAY")=... ;" ^TMG("XML EXPORTER",SrcSysName,"DD",FileNum,FieldNum,... exceptions information ;" ;"Note: If a prior comparision has not be made, then it will be done here, and ;" user will be asked if they want to add any missing field/files definitions. ;" Also, the user will be asked to review any difference between the to ;" DD's to see if the changes are minor (allowable), or major (not compatible) ;" ;"**I would like to have some way of NOT allowing one single difference between ;" DD's abort the entire process, especially when we don't know if that ;" field will even be used during the upload process. (Perhaps the upload ;" data won't have any instances of that field.) Perhaps I could just store ;" the difference here, and then handle only when an example of data being ;" uploaded for that field arises. Pro's: user could have example of real ;" data to see if it is appropriate to be filed. Con's: during a long process ;" (such as importing might be), it would be annoying to have sit and wait for ;" possible user queries. Better to get that all setteled before starting ;" actual import. Perhaps ask user up front, but allow a "SKIP FOR NOW" ;" option. If so, then only asked when actual data arises. ;" ;"Result: 1=is compatable, or 0 if not, -1=abort new result set result=0 ;"default to not compatable. new FileNum set FileNum=+$$GetAtrVal^TMGXMLT(XMLHandle,nodeFile,"id") new pInfoRef set pInfoRef=$name(^TMG("XML EXPORTER",SrcSysName,"DD",FileNum)) new ProgressFn,IncVar new ErrMsg new timeLastCheck set timeLastCheck=+$get(@pInfoRef@("DATE-TIME")) ;"Later check how much time has elapsed since last check and ask user if recheck ;" is needed... set result=$get(@pInfoRef@("COMPATIBLE")) if result=1 goto CPDone if result=0 do goto:(result'="") CPDone . new % set %=1 . write "Data dictionary etc. has previously been found to be incompatible.",! . write "Recheck again" do YN^DICN write ! . if %=-1 set result=-1 quit . if %=1 set result="" quit do HndlDD(XMLHandle,nodeFile,pInfoRef,.ErrMsg) if $data(ErrMsg) goto CPStore do HndlDIC(XMLHandle,nodeFile,pInfoRef,.ErrMsg) if $data(ErrMsg) goto CPStore ;"============================================================== ;"Compare FileHeader. ------------------------------- ;"============================================================== new HdrNode set HdrNode=$$GetDescNode^TMGXMLT(XMLHandle,nodeFile,"FILE_HEADER") if HdrNode=0 do goto CPStore . set ErrMsg(1)="Unable to check compatibility of File header for file "_FileNum . set ErrMsg(2)=" because a FILE_HEADER node could not be found as a child node" . set ErrMsg(3)=" from node "_nodeFile_". Aborting." new srcHeader set srcHeader=$$GetJNText^TMGXMLT(XMLHandle,HdrNode) set srcHeader=$$Trim^TMGSTUTL(srcHeader) if srcHeader="" do goto CPStore . set ErrMsg(1)="Can't find a source Header entry." new gl set gl=$get(^DIC(FileNum,0,"GL")) if gl="" do goto CPStore . set ErrMsg(1)="Unable to find global file reference in ^DIC for file "_FileNum set gl=gl_"0)" new lclHeader set lclHeader=$get(@gl) if $piece(srcHeader,"^",1,2)'=$piece(lclHeader,"^",1,2) do goto:(result=-1) CPStore . set result=1 . write "There appears to be a difference in the file headers:",! . write "SOURCE VISTA SYSTEM",! . write " "_$piece(srcHeader,"^",1,2)_"^...",!,! . write "TARGET (LOCAL) VISTA SYSTEM",! . write " "_$piece(lclHeader,"^",1,2)_"^...",! . new % set %=1 . write "Abort import" do YN^DICN write ! . if %'=2 set result=-1 ;"SUCCESS IF WE GOT THIS FAR.... set result=1 ;"SUCCESS CPStore if $data(ErrMsg) do . write "ERROR. Message:",! . new i set i="" . for set i=$order(ErrMsg(i)) quit:(i="") write ErrMsg(i),! . do PressToCont^TMGUSRIF . set result=-1 set @pInfoRef@("COMPATIBLE")=result set @pInfoRef@("DATE-TIME")=$H if result=1 do . kill @pInfoRef@("WORKING") ;"no longer needed. CPDone quit result HndlDD(XMLHandle,nodeFile,pInfoRef,ErrMsg) ;"============================================================== ;"Handle ^DD ----------------------------- ;"============================================================== new tempArray,ExtraB,MissingB,diffArray new tempSize set tempSize=100000 new pExtraB set pExtraB="ExtraB" new pDiffArray set pDiffArray="diffArray" new pDDRef set pDDRef=$name(@pInfoRef@("WORKING","DD")) if $data(@pDDRef@("IMPORT-EXTRA"))>0 merge ExtraB=@pDDRef@("IMPORT-EXTRA") if $data(@pDDRef@("DIFFERENCE"))>0 merge diffArray=@pDDRef@("DIFFERENCE") if ($data(@pExtraB)>0)!($data(@pDiffArray)>1) goto HDD2 ;"skip XML read and comparison if $data(@pDDRef@("TEMP-ARRAY"))>0 do goto HDD1 ;"skip XML read . merge tempArray=@pDDRef@("TEMP-ARRAY") new DDNode set DDNode=$$GetDescNode^TMGXMLT(XMLHandle,nodeFile,"DataDictionary") if DDNode=0 do goto HDDDone . set ErrMsg(1)="Unable to check compatibility of data dictionary for file "_FileNum . set ErrMsg(2)=" because a DataDictionary node could not be found as a child node" . set ErrMsg(3)=" from node "_nodeFile_". Aborting." set ProgressFn="use $P do ProgressBar^TMGUSRIF(IncVar,""Reading ^DD(""_FileNum_"")"",0,tempSize,,"""_$H_""") use IO" write "Gathering import data dictionary (DD) information for file "_FileNum_"...",! do ReadArray^TMGXMLT(XMLHandle,DDNode,.tempArray,.ProgressFn,.IncVar) set IncVar=tempSize xecute ProgressFn ;"set progress bar to 100% write !," " do CUU^TMGTERM(1) write !,"Sizing up data read in..." set tempSize=$$NodeCt^TMGMISC("tempArray") write " ",tempSize," nodes.",! kill @pDDRef@("TEMP-ARRAY") merge @pDDRef@("TEMP-ARRAY")=tempArray if $data(tempArray)=0 do goto HDDDone . set ErrMsg(1)="Reading of DD array failed. Aborting." HDD1 ;"------ do actual comparison set IncVar=0 set ProgressFn="use $P do ProgressBar^TMGUSRIF(IncVar,""^DD(""_FileNum_"")"",0,tempSize,,"""_$H_""") use IO" write "Comparing imported data dictionary (DD) to installed DD for File ",FileNum,"...",! kill @pExtraB,@pDiffArray if $$CompABArray^TMGMISC("^DD("_FileNum_")","tempArray",pExtraB,,pDiffArray,.ProgressFn,.IncVar)=1 do goto CPDone . set ErrMsg(1)="Error or abort comparing data." write ! set IncVar=tempSize xecute ProgressFn ;"set progress bar to 100% do FixArray^TMGMISC(pExtraB) do FixArray^TMGMISC(pDiffArray) kill @pDDRef@("IMPORT-EXTRA") merge @pDDRef@("IMPORT-EXTRA")=ExtraB kill @pDDRef@("DIFFERENCE") merge @pDDRef@("DIFFERENCE")=diffArray HDD2 ;" ------- process found differences if $$HandleExtra(pExtraB)=0 do goto HDDDone . set ErrMsg(1)="Unable to handle extra fields or files found in data from source" . set ErrMsg(2)="VistA system. Aborting..." if $$HandleDiff(pDiffArray)=0 do goto HDDDone . set ErrMsg(1)="Unable to handle differences between source and destination VistA" . set ErrMsg(2)="installations. Aborting." HDDDone quit HndlDIC(XMLHandle,nodeFile,pInfoRef,ErrMsg) ;"============================================================== ;"Handle ^DIC ------------------------------- ;"============================================================== new tempArray,ExtraB,MissingB,diffArray new tempSize set tempSize=100000 new pExtraB set pExtraB="ExtraB" new pDiffArray set pDiffArray="diffArray" new pDICRef set pDICRef=$name(@pInfoRef@("WORKING","DIC")) if $data(@pDICRef@("IMPORT-EXTRA"))>0 merge ExtraB=@pDICRef@("IMPORT-EXTRA") if $data(@pDICRef@("DIFFERENCE"))>0 merge diffArray=@pDICRef@("DIFFERENCE") if ($data(@pExtraB)>0)!($data(@pDiffArray)>1) goto HDIC2 if $data(@pDICRef@("TEMP-ARRAY"))>0 do goto HDIC1 . merge tempArray=@pDICRef@("TEMP-ARRAY") ;"---- read XML data into temporary array new DICNode set DICNode=$$GetDescNode^TMGXMLT(XMLHandle,nodeFile,"DIC_File") if DICNode=0 do goto CPStore . set ErrMsg(1)="Unable to check compatibility of ^DIC for file "_FileNum . set ErrMsg(1)=" because a DIC_File node could not be found as a child node" . set ErrMsg(1)=" from node "_nodeFile_". Aborting." set IncVar=0,tempSize=100000 set ProgressFn="use $P do ProgressBar^TMGUSRIF(IncVar,""Reading ^DIC(""_FileNum_"")"",0,tempSize,,"""_$H_""") use IO" write "Gathering import DIC information for file "_FileNum_"...",! do ReadArray^TMGXMLT(XMLHandle,DICNode,.tempArray,.ProgressFn,.IncVar) set IncVar=tempSize xecute ProgressFn ;"set progress bar to 100% write !,"Sizing up data read in..." new tempSize set tempSize=$$NodeCt^TMGMISC("tempArray") write " ",tempSize," nodes.",! kill @pDICRef@("TEMP-ARRAY") merge @pDICRef@("TEMP-ARRAY")=tempArray if $data(tempArray)=0 do goto HDICDone . set ErrMsg(1)="Reading of DIC array failed. Aborting." HDIC1 ;"------ do actual comparison set IncVar=0 set ProgressFn="use $P do ProgressBar^TMGUSRIF(IncVar,""^DIC(""_FileNum_"")"",0,tempSize,,"""_$H_""") use IO" write "Comparing imported DIC to installed DIC for File ",FileNum,"...",! if $$CompABArray^TMGMISC("^DIC("_FileNum_")","tempArray",pExtraB,,pDiffArray,.ProgressFn,.IncVar)=1 do goto CPStore . set ErrMsg(1)="Error or abort while comparing data." write !,! do FixArray^TMGMISC(pExtraB) kill @pDICRef@("IMPORT-EXTRA") merge @pDICRef@("IMPORT-EXTRA")=@pExtraB do FixArray^TMGMISC(pDiffArray) kill @pDICRef@("DIFFERENCE") merge @pDICRef@("DIFFERENCE")=@pDiffArray HDIC2 ;" ------- process found differences if $$HandleExtra(pExtraB)=0 do goto HDICDone . set ErrMsg(1)="Unable to handle extra fields or files found in data from source" . set ErrMsg(2)="VistA system. Aborting..." kill @pDICRef@("IMPORT-EXTRA") merge @pDICRef@("IMPORT-EXTRA")=@pExtraB CPComp3 if $$HandleDiff(pDiffArray)=0 do goto HDICDone . set ErrMsg(1)="Unable to handle differences between source and destination VistA" . set ErrMsg(2)="installations. Aborting." kill @pDICRef@("DIFFERENCE") merge @pDICRef@("DIFFERENCE")=@pDiffArray HDICDone quit HandleExtra(pSrcExtra) ;"Purpose: to handle addition of extra (non-conflicting) fields / files ;" to destination (local) VistA system based on import data ;"Input: pSrcExtra -- PASS BY NAME. Array of additions in source System. ;" Format as per CompABArray^TMGMISC ;"Result: 1=OK to continue, 0=Failed resolution. ;"Note: this function is assuming input like this: ;" @Array@("^GLBNAME",filenumber,... new result set result=1 ;"default to SUCCESS new UsrPick set UsrPick="" new Menu set Menu(0)="Pick option for handling EXTRA file info from importing VistA" set Menu(1)="MERGE node(s) into the local system." set Menu(2)="Do NOT add this into the local system." set Menu(3)="SKIP for now. Decide if import actually needs these fields." set Menu(4)="Choose for each INDIVIDUAL entry" new gblRef set gblRef="" for set gblRef=$order(@pSrcExtra@(gblRef)) quit:(gblRef="")!(UsrPick="^") do . new fileNum set fileNum="" . for set fileNum=$order(@pSrcExtra@(gblRef,fileNum)) quit:(fileNum="")!(UsrPick="^") do . . write !,"The Remote/Source VistA system File #",fileNum," (",$$GetFName^TMGDBAPI(fileNum),") in ",gblRef," has Extra Information:",! . . new fieldNum set fieldNum="" . . for set fieldNum=$order(@pSrcExtra@(gblRef,fileNum,fieldNum)) quit:(fieldNum="")!(UsrPick="^") do . . . new subRef set subRef=$name(@pSrcExtra@(gblRef,fileNum,fieldNum)) . . . write #,! . . . write "File# ",fileNum,", Field# ",fieldNum," has the following:",! . . . do ArrayDump^TMGDEBUG($name(@pSrcExtra@(gblRef,fileNum,fieldNum)),,,"F") . . . set UsrPick=$$Menu^TMGUSRIF(.Menu,3) . . . if UsrPick="^" set result=0 quit . . . if UsrPick=3 quit . . . if UsrPick=2 do quit . . . . kill @subRef . . . if UsrPick=1 do quit . . . . new writeRef set writeRef=$qsubscript(subRef,1) . . . . new i for i=2:1:$qlength(subRef) do . . . . . set writeRef=$name(@writeRef@($qsubscript(subRef,i))) . . . . if $data(@writeRef)>0 do quit . . . . . write "Aborting merge because "_writeRef_" already has data!",! . . . . merge @writeRef=@subRef . . . . kill @subRef . . . if UsrPick=4 do quit . . . . new subNode set subNode="" . . . . for set subNode=$order(@subRef@(subNode)) quit:(subNode="")!(UsrPick="^") do . . . . . set UsrPick=$$HandleExtra($name(@subRef@(subNode))) quit result HandleDiff(pDiffArray) ;"Purpose: To handle difference between source and local installations. ;"Input: pDiffArray -- PASS BY NAME. Array of differences. Format as ;" per CompABArray^TMGMISC ;"Result: 1=OK to continue, 0=Failed resolution. ;"Note: this function probably needs to be changed to handle reformatted diffArray new result set result=1 ;"default to SUCCESS new ref set ref="" for set ref=$order(@pDiffArray@("A",ref)) quit:(ref="")!(result=0) do . new idx set idx="" . for set idx=$order(@pDiffArray@("A",ref,idx)) quit:(idx="")!(result=0)!(result=2) do . . new local,import . . merge local=@pDiffArray@("A",ref,idx) . . merge import=@pDiffArray@("B",ref,idx) . . ;"new name set name=$name(@ref@(idx)) . . new name set name=ref . . set result=$$Handle1Diff(name,.local,.import) write !! quit result Handle1Diff(name,local,import) ;"Scope: private ;"Purpose: to handle 1 difference. ;"Input: local PASS BY REFERENCE ;" import PASS BY REFERENCE ;"Results: 1=OK to continue, 0=cancel import new result set result=1 write # write "For node: ",name,! write "================================",! write "LOCAL VistA has this:",! write $get(local),! write ! write "IMPORTING VistA has this:",! write $get(import),! new Menu,UsrInput set Menu(1)="Cancel Import" set Menu(2)="Ignore difference" set Menu(3)="Ignore ALL for this field" set Menu(4)="Overwrite LOCAL with IMPORTING" set UsrInput=$$Menu^TMGUSRIF(.Menu,2) if (UsrInput="^")!(UsrInput=1) set result=0 goto H1DDone if UsrInput=2 goto H1DDone if UsrInput=3 set result=2 goto H1DDone if UsrInput=4 do . write "IMPLEMENT THIS FEATURE LATER... (Handle1Diff^TMGXMLIN)",! . set result=1 H1DDone quit result HdlDICExtra(pSrcExtra) ;"Purpose: to handle addition of extra (non-conflicting) fields / files ;" to destination (local) VistA system based on import data ;"Input: pSrcExtra -- PASS BY NAME. Array of additions in source System. ;" Format as per CompABArray^TMGMISC ;"Result: 1=OK to continue, 0=Failed resolution. new result set result=1 ;"default to SUCCESS if $data(@pSrcExtra)>0 do . write "Please modify HdleDICExtra^TMGXMLIN to handle extra info from import.",! . zwr @pSrcExtra . set result=-1 quit result HdlDICDiff(pDiffArray) ;"Purpose: To handle difference between source and local installations. ;"Input: pDiffArray -- PASS BY NAME. Array of differences. Format as ;" per CompABArray^TMGMISC ;"Result: 1=OK to continue, 0=Failed resolution. new result set result=1 ;"default to SUCCESS if $data(@pDiffArray)>0 do . write "Please modify HdleDICDiff^TMGXMLIN to handle differences from import.",! . set result=-1 quit result Imp1Record(XMLHandle,SrcSysName,FileNum,nodeRecord) ;"Purpose: to import 1 record ;"Input: XMLHandle -- The handle created by loading function. ;" SrcSysName -- The name of the source VistA system ;" FileNum -- file number of target file to up uploaded into ;" nodeRecord -- the XML node pointing the the record to upload. ;"Assumption: The target VistA system has already been checked and is ;" compatible with upload data. ;" ALSO, data exported should have been in INTERNAL format. ;" This is because the upload will be INTERNAL values (to try ;" to bypass import transforms.) ;"Note: if the XML entry for the record contains the tag="POINTED_TO_RECORD", ;" Then this record is recognized as a supporting record, rather than ;" primary import information. In this case, a check will be made to ;" see if the record has already been uploaded. If so, then it will not ;" be uploaded again. ;"Note: A translation table for IEN's in the source system, and the target ;" system will be maintained as follows: ;" ^TMG("XML EXPORTER",SrcSysName,FileNum,SrcIEN)=TargetIEN ;" ^TMG("XML EXPORTER",SrcSysName,FileNum,SrcIEN)=TargetIEN ;" ^TMG("XML EXPORTER",SrcSysName,FileNum,SrcIEN)=TargetIEN ;"Note: This does not current support or hand DIFROM records, or records ;" with an expectation of IEN's to match IEN's in other files etc. ;" I will have to handle these problems as they come up. ;"Output ;" ^TMG("XML EXPORTER",SrcSysName,FileNum,"NEEDS RETRY",nodeRecord,.01)=oldTargetIEN ;" ^TMG("XML EXPORTER",SrcSysName,FileNum,"NEEDS RESOLUTION",localIEN,fieldNum)=oldTargetIEN ;" ^TMG("XML EXPORTER",SrcSysName,FileNum,remoteIEN)=localIEN ;"Results: 0=OK to continue, 1=abort, 2=try again later new result set result=0 new ErrMsg new remoteIEN ;"aka SrcIEN new localIEN ;"aka TargetIEN new mode set remoteIEN=+$$GetAtrVal^TMGXMLT(XMLHandle,nodeRecord,"id") if remoteIEN'>0 do goto I1RDone . set ErrMsg(1)="Can't find import IEN in XML node# "_nodeRecord set localIEN=+$get(^TMG("XML EXPORTER",SrcSysName,FileNum,remoteIEN)) if localIEN>0 goto I1RDone ;"Already uploaded or found. Done here... ;"Handle usual case of importing 1 record here. new TMGFDA,TMGIEN,TMGMSG new tempArray,ptrToArray new refFDA set refFDA=$name(TMGFDA(FileNum,"+1,")) new abort set abort=0 new nodeField set nodeField=0 for set nodeField=$$GetDescNode^TMGXMLT(XMLHandle,nodeRecord,"FIELD",nodeField) quit:(nodeField'>0)!abort do . new fieldNum set fieldNum=$$GetAtrVal^TMGXMLT(XMLHandle,nodeField,"id") . new fieldType set fieldType=$$GetAtrVal^TMGXMLT(XMLHandle,nodeField,"TYPE") . if fieldType="WORD-PROCESSING" quit ;"handle later... **FINISH** . new value set value=$$Get1LText^TMGXMLT(XMLHandle,nodeField) . if value'="" set tempArray(fieldNum)=value . new P2 set P2=$piece($get(^DD(FileNum,fieldNum,0)),"^",2) . if P2["P" set ptrToArray(fieldNum)=+$piece(P2,"P",2) set mode=$$GetAtrVal^TMGXMLT(XMLHandle,nodeRecord,"tag") if mode="POINTED_TO_RECORD" do . ;"See if similar record already exists in the system. (matching) . new Data . set Data(0,"FILE")=FileNum . merge Data(1)=tempArray . set Data(1,.01,"MATCHTHIS")=1 ;" <--- Only require .01 field to match. Enough? . new priorIEN . if $$GetRecMatch^TMGDBAPI(.Data,.priorIEN)=0 do quit . . set ErrMsg(1)="Error during search for prior records." . if priorIEN'>0 quit ;"no pre-existing records exist on system. . set localIEN=priorIEN . set ^TMG("XML EXPORTER",SrcSysName,FileNum,remoteIEN)=localIEN if $data(ErrMsg)!(localIEN>0) goto I1RDone new mandIEN set mandIEN=0 ;"manditory IEN for storage of this record (if any) if $P($get(^DD(FileNum,.01,0)),"^",5,99)["DINUM" do . new targetFile set targetFile=+$get(ptrToArray(.01)) . if targetFile>0 do . . new oldTargetIEN set oldTargetIEN=+$get(tempArray(.01)) . . new localTargetIEN . . set localTargetIEN=+$get(^TMG("XML EXPORTER",SrcSysName,FileNum,oldTargetIEN)) . . ;"At this point, we know that this record is DINUM'd, meaning that it must . . ;"be filed at a specific IEN. In this case it's IEN must match the pointer . . ;"stored in the .01 field. NOTE, however, that this pointer must be resolved . . ;"the corresponding record on the new system. So oldTargetIEN is resolved . . ;"to localTargetIEN. If localTargetIEN=0, then this means that the other record . . ;"that this one is tied to has not yet been imported. So this record should . . ;"be tried again after other files from import have been processed. . . if localTargetIEN=0 do quit . . . set ^TMG("XML EXPORTER",SrcSysName,FileNum,"NEEDS RETRY",nodeRecord,.01)=oldTargetIEN . . . set result=2 ;"2=try again later. . . set mandIEN=localTargetIEN . else do . . ;"this is a DINUM based on something that is not a pointer . . set mandIEN=$get(tempArray(.01)) . . ;"Not sure of examples of above, but shouldn't need resolving in new system. if result=2 goto I1RDone ;"Resolve any pointers out if possible prior to storage. ;"Make note of pointer in record that will need resolving later. new resolveLater set fieldNum="" for set fieldNum=$order(ptrToArray(fieldNum)) quit:(+fieldNum'>0) do . new targetFile set targetFile=+$get(ptrToArray(fieldNum)) . new oldTargetIEN set oldTargetIEN=$get(tempArray(fieldNum)) . new localTargetIEN set localTargetIEN=+$get(^TMG("XML EXPORTER",SrcSysName,FileNum,oldTargetIEN)) . if localTargetIEN>0 do . . set tempArray(fieldNum)=localTargetIEN ;"<-- pointer now resolved. . else do . . set resolveLater(fieldNum)=oldTargetIEN ;"<-- remember to resolve later. merge @refFDA=tempArray ;" set up TMGFDA if mandIEN>0 set TMGIEN(1)=mandIEN ;"specify mandated IEN to store record in. do UPDATE^DIE("S","TMGFDA","TMGIEN","TMGMSG") ;" do actual storage. if $data(TMGMSG("DIERR")) do . do ShowDIERR^TMGDEBUG(.TMGMSG) . set result=1 else do ;"make notes of newly stored record . set localIEN=+$get(TMGIEN(1)) . set ^TMG("XML EXPORTER",SrcSysName,FileNum,remoteIEN)=localIEN . set fieldNum="" ;"some pointers out might not have been resolvable. Remember this. . for set fieldNum=$order(resolveLater(fieldNum)) quit:(fieldNum="") do . . set oldTargetIEN=$get(resolveLater(fieldNum)) . . set ^TMG("XML EXPORTER",SrcSysName,FileNum,"NEEDS RESOLUTION",localIEN,fieldNum)=oldTargetIEN I1RDone if $data(ErrMsg) do . write "ERROR. Message:",! . new i set i="" . for set i=$order(ErrMsg(i)) quit:(i="") write ErrMsg(i),! . do PressToCont^TMGUSRIF . set result=1 ;" abort quit result