| [796] | 1 | TMGXMLIN ;TMG/kst/XML Importer ;02/09/08
|
|---|
| 2 | ;;1.0;TMG-LIB;**1**;02/09/08
|
|---|
| 3 |
|
|---|
| 4 | ;"TMG XML IMPORT FUNCTION
|
|---|
| 5 | ;"Kevin Toppenberg MD
|
|---|
| 6 | ;"GNU General Public License (GPL) applies
|
|---|
| 7 | ;"2-9-2008
|
|---|
| 8 |
|
|---|
| 9 | ;"=======================================================================
|
|---|
| 10 | ;" API -- Public Functions.
|
|---|
| 11 | ;"=======================================================================
|
|---|
| 12 |
|
|---|
| 13 | ;"=======================================================================
|
|---|
| 14 | ;"PRIVATE API FUNCTIONS
|
|---|
| 15 | ;"=======================================================================
|
|---|
| 16 |
|
|---|
| 17 |
|
|---|
| 18 | ImportXML
|
|---|
| 19 | ;"Purpose: to Import file records via XML file
|
|---|
| 20 |
|
|---|
| 21 | new UserPath,UserFName,result
|
|---|
| 22 | new XMLHandle set XMLHandle=0
|
|---|
| 23 | set XMLHandle=$order(^TMP("MXMLDOM",$J,""))
|
|---|
| 24 | if XMLHandle>0 goto Imp1
|
|---|
| 25 |
|
|---|
| 26 | new tempArray
|
|---|
| 27 | new tRef
|
|---|
| 28 | set tRef=$name(^TMG("TMP","KILLTHIS","MXMLDOM",777))
|
|---|
| 29 | if $data(@tRef) do goto Imp1
|
|---|
| 30 | . merge ^TMP("MXMLDOM",$J,777)=@tRef
|
|---|
| 31 | . set XMLHandle=777
|
|---|
| 32 |
|
|---|
| 33 | set result=$$GetFName^TMGIOUTL("Select XML Import File","/",,,.UserPath,.UserFName)
|
|---|
| 34 | if result="" goto ImpDone
|
|---|
| 35 |
|
|---|
| 36 | set XMLHandle=$$LoadFile^TMGXMLT(.UserPath,.UserFName)
|
|---|
| 37 | if XMLHandle'>0 goto ImpDone
|
|---|
| 38 |
|
|---|
| 39 | kill @tRef
|
|---|
| 40 | merge @tRef=^TMP("MXMLDOM",$J,XMLHandle)
|
|---|
| 41 |
|
|---|
| 42 | Imp1
|
|---|
| 43 | do ImportFiles(XMLHandle)
|
|---|
| 44 | Imp2
|
|---|
| 45 |
|
|---|
| 46 | ImpDone
|
|---|
| 47 | if XMLHandle>0 do
|
|---|
| 48 | . new % set %=2
|
|---|
| 49 | . write "Delete current XML import (may reload next time)"
|
|---|
| 50 | . do YN^DICN write !
|
|---|
| 51 | . if %'=1 quit
|
|---|
| 52 | . do DELETE^MXMLDOM(XMLHandle)
|
|---|
| 53 | quit
|
|---|
| 54 |
|
|---|
| 55 |
|
|---|
| 56 |
|
|---|
| 57 | GetDDNode(XMLHandle)
|
|---|
| 58 | ;"Purpose: Get the Data Dictionary Node (stored under FILE node)
|
|---|
| 59 | ;"Input: XMLHandle -- The handle created by loading function.
|
|---|
| 60 | ;"Results: 0 if node not found, otherwise node number
|
|---|
| 61 |
|
|---|
| 62 | new result
|
|---|
| 63 | set result=$$GetDescNode^TMGXMLT(XMLHandle,1,"DataDictionary")
|
|---|
| 64 |
|
|---|
| 65 | quit result
|
|---|
| 66 |
|
|---|
| 67 |
|
|---|
| 68 |
|
|---|
| 69 | GetSysName(XMLHandle)
|
|---|
| 70 | ;"Purpose: Get label of the VistA system that exported the data
|
|---|
| 71 | ;" This means that this will only work with data exported by
|
|---|
| 72 | ;" TMGXMLEX code module.
|
|---|
| 73 | ;"Input: XMLHandle -- The handle created by loading function.
|
|---|
| 74 | ;"Results: Returns system name, or "" if not found
|
|---|
| 75 | ;"Note: Expects node 1 to be <EXPORT source="MyName">
|
|---|
| 76 |
|
|---|
| 77 | new result
|
|---|
| 78 | set result=$$GetAtrVal^TMGXMLT(XMLHandle,1,"source")
|
|---|
| 79 | quit result
|
|---|
| 80 |
|
|---|
| 81 |
|
|---|
| 82 | ImportFiles(XMLHandle)
|
|---|
| 83 | ;"Purpose: to import data stored in XML file into local database
|
|---|
| 84 | ;"Input: XMLHandle -- The handle created by loading function.
|
|---|
| 85 | ;"results: none
|
|---|
| 86 |
|
|---|
| 87 | new SrcSysName set SrcSysName=$$GetSysName(XMLHandle)
|
|---|
| 88 | if SrcSysName="" goto IFDone
|
|---|
| 89 |
|
|---|
| 90 | ;"Later put guard to ensure not re-importing to self.
|
|---|
| 91 |
|
|---|
| 92 | new abort set abort=0
|
|---|
| 93 | new nodeFile set nodeFile=0
|
|---|
| 94 | for set nodeFile=$$GetDescNode^TMGXMLT(XMLHandle,1,"FILE",nodeFile) quit:(nodeFile'>0)!abort do
|
|---|
| 95 | . set abort=$$Import1File(XMLHandle,SrcSysName,nodeFile)
|
|---|
| 96 |
|
|---|
| 97 | IFDone quit
|
|---|
| 98 |
|
|---|
| 99 |
|
|---|
| 100 | Import1File(XMLHandle,SrcSysName,nodeFile)
|
|---|
| 101 | ;"Purpose: to Import 1 file from XML data.
|
|---|
| 102 | ;"Input: XMLHandle -- The handle created by loading function.
|
|---|
| 103 | ;" SrcSysName -- The name of the source VistA system
|
|---|
| 104 | ;" ParentNode -- the node containing the <FILE starting data for file
|
|---|
| 105 | ;"Results: 0=OK to continue, 1=abort
|
|---|
| 106 |
|
|---|
| 107 | new abort set abort=0
|
|---|
| 108 |
|
|---|
| 109 | new FileNum set FileNum=+$$GetAtrVal^TMGXMLT(XMLHandle,nodeFile,"id")
|
|---|
| 110 | if FileNum'>0 do goto Ip1FDone
|
|---|
| 111 | . set abort=1
|
|---|
| 112 | . write "Unable to import FILE because no numeric file number in attrib id='xx'",!
|
|---|
| 113 |
|
|---|
| 114 | ;"Later change this so that all the DD's are checked before calling Import1File
|
|---|
| 115 | new temp set temp=$$CompatFile(XMLHandle,SrcSysName,nodeFile)
|
|---|
| 116 | if temp'>0 do goto Ip1FDone
|
|---|
| 117 | . set abort=1
|
|---|
| 118 | . if temp=-1 quit
|
|---|
| 119 | . write "Unable to import FILE #",FileNum," because data dictionaries are incompatible.",!
|
|---|
| 120 |
|
|---|
| 121 | ;"new nodeRecord set nodeRecord=$$CHILD^MXMLDOM(XMLHandle,nodeFile)
|
|---|
| 122 | new nodeRecord set nodeRecord=0
|
|---|
| 123 | for set nodeRecord=$$GetDescNode^TMGXMLT(XMLHandle,nodeFile,"Record",nodeRecord) quit:(nodeRecord'>0)!abort do
|
|---|
| 124 | . set abort=$$Imp1Record(XMLHandle,SrcSysName,FileNum,nodeRecord)
|
|---|
| 125 |
|
|---|
| 126 | Ip1FDone
|
|---|
| 127 | quit abort
|
|---|
| 128 |
|
|---|
| 129 |
|
|---|
| 130 | CompatFile(XMLHandle,SrcSysName,nodeFile)
|
|---|
| 131 | ;"Purpose: to determine if the data dictionary (i.e. File Definition) is
|
|---|
| 132 | ;" compatible between the Src VistA system, and this installation.
|
|---|
| 133 | ;" E.g. Does field #1 mean the same thing on both systems?
|
|---|
| 134 | ;"Note, a table will be maintained to store the compatibility data. (The process
|
|---|
| 135 | ;" of comparing the data dictionaries is slow).
|
|---|
| 136 | ;" Format:
|
|---|
| 137 | ;" ^TMG("XML EXPORTER",SrcSysName,"DD",FileNum,"DATE-TIME")=Time_(H$)_of_last_comparison
|
|---|
| 138 | ;" ^TMG("XML EXPORTER",SrcSysName,"DD",FileNum,"COMPATIBLE")=1 (0=NOT compat, -1=aborted)
|
|---|
| 139 | ;" ^TMG("XML EXPORTER",SrcSysName,"DD",FileNum,"WORKING","^DD","IMPORT-EXTRA")=...
|
|---|
| 140 | ;" ^TMG("XML EXPORTER",SrcSysName,"DD",FileNum,"WORKING","^DD","DIFFERENCE")=...
|
|---|
| 141 | ;" ^TMG("XML EXPORTER",SrcSysName,"DD",FileNum,"WORKING","^DD","TEMP-ARRAY")=...
|
|---|
| 142 | ;" ^TMG("XML EXPORTER",SrcSysName,"DD",FileNum,"WORKING","^DIC","IMPORT-EXTRA")=...
|
|---|
| 143 | ;" ^TMG("XML EXPORTER",SrcSysName,"DD",FileNum,"WORKING","^DIC","DIFFERENCE")=...
|
|---|
| 144 | ;" ^TMG("XML EXPORTER",SrcSysName,"DD",FileNum,"WORKING","^DIC","TEMP-ARRAY")=...
|
|---|
| 145 | ;" ^TMG("XML EXPORTER",SrcSysName,"DD",FileNum,FieldNum,... exceptions information
|
|---|
| 146 | ;"
|
|---|
| 147 | ;"Note: If a prior comparision has not be made, then it will be done here, and
|
|---|
| 148 | ;" user will be asked if they want to add any missing field/files definitions.
|
|---|
| 149 | ;" Also, the user will be asked to review any difference between the to
|
|---|
| 150 | ;" DD's to see if the changes are minor (allowable), or major (not compatible)
|
|---|
| 151 | ;"
|
|---|
| 152 | ;"**I would like to have some way of NOT allowing one single difference between
|
|---|
| 153 | ;" DD's abort the entire process, especially when we don't know if that
|
|---|
| 154 | ;" field will even be used during the upload process. (Perhaps the upload
|
|---|
| 155 | ;" data won't have any instances of that field.) Perhaps I could just store
|
|---|
| 156 | ;" the difference here, and then handle only when an example of data being
|
|---|
| 157 | ;" uploaded for that field arises. Pro's: user could have example of real
|
|---|
| 158 | ;" data to see if it is appropriate to be filed. Con's: during a long process
|
|---|
| 159 | ;" (such as importing might be), it would be annoying to have sit and wait for
|
|---|
| 160 | ;" possible user queries. Better to get that all setteled before starting
|
|---|
| 161 | ;" actual import. Perhaps ask user up front, but allow a "SKIP FOR NOW"
|
|---|
| 162 | ;" option. If so, then only asked when actual data arises.
|
|---|
| 163 | ;"
|
|---|
| 164 | ;"Result: 1=is compatable, or 0 if not, -1=abort
|
|---|
| 165 |
|
|---|
| 166 | new result set result=0 ;"default to not compatable.
|
|---|
| 167 | new FileNum set FileNum=+$$GetAtrVal^TMGXMLT(XMLHandle,nodeFile,"id")
|
|---|
| 168 | new pInfoRef set pInfoRef=$name(^TMG("XML EXPORTER",SrcSysName,"DD",FileNum))
|
|---|
| 169 | new ProgressFn,IncVar
|
|---|
| 170 | new ErrMsg
|
|---|
| 171 |
|
|---|
| 172 | new timeLastCheck set timeLastCheck=+$get(@pInfoRef@("DATE-TIME"))
|
|---|
| 173 | ;"Later check how much time has elapsed since last check and ask user if recheck
|
|---|
| 174 | ;" is needed...
|
|---|
| 175 | set result=$get(@pInfoRef@("COMPATIBLE"))
|
|---|
| 176 | if result=1 goto CPDone
|
|---|
| 177 | if result=0 do goto:(result'="") CPDone
|
|---|
| 178 | . new % set %=1
|
|---|
| 179 | . write "Data dictionary etc. has previously been found to be incompatible.",!
|
|---|
| 180 | . write "Recheck again" do YN^DICN write !
|
|---|
| 181 | . if %=-1 set result=-1 quit
|
|---|
| 182 | . if %=1 set result="" quit
|
|---|
| 183 |
|
|---|
| 184 | do HndlDD(XMLHandle,nodeFile,pInfoRef,.ErrMsg)
|
|---|
| 185 | if $data(ErrMsg) goto CPStore
|
|---|
| 186 |
|
|---|
| 187 | do HndlDIC(XMLHandle,nodeFile,pInfoRef,.ErrMsg)
|
|---|
| 188 | if $data(ErrMsg) goto CPStore
|
|---|
| 189 |
|
|---|
| 190 | ;"==============================================================
|
|---|
| 191 | ;"Compare FileHeader. -------------------------------
|
|---|
| 192 | ;"==============================================================
|
|---|
| 193 |
|
|---|
| 194 | new HdrNode set HdrNode=$$GetDescNode^TMGXMLT(XMLHandle,nodeFile,"FILE_HEADER")
|
|---|
| 195 | if HdrNode=0 do goto CPStore
|
|---|
| 196 | . set ErrMsg(1)="Unable to check compatibility of File header for file "_FileNum
|
|---|
| 197 | . set ErrMsg(2)=" because a FILE_HEADER node could not be found as a child node"
|
|---|
| 198 | . set ErrMsg(3)=" from node "_nodeFile_". Aborting."
|
|---|
| 199 |
|
|---|
| 200 | new srcHeader set srcHeader=$$GetJNText^TMGXMLT(XMLHandle,HdrNode)
|
|---|
| 201 | set srcHeader=$$Trim^TMGSTUTL(srcHeader)
|
|---|
| 202 | if srcHeader="" do goto CPStore
|
|---|
| 203 | . set ErrMsg(1)="Can't find a source Header entry."
|
|---|
| 204 |
|
|---|
| 205 | new gl set gl=$get(^DIC(FileNum,0,"GL"))
|
|---|
| 206 | if gl="" do goto CPStore
|
|---|
| 207 | . set ErrMsg(1)="Unable to find global file reference in ^DIC for file "_FileNum
|
|---|
| 208 | set gl=gl_"0)"
|
|---|
| 209 | new lclHeader set lclHeader=$get(@gl)
|
|---|
| 210 |
|
|---|
| 211 | if $piece(srcHeader,"^",1,2)'=$piece(lclHeader,"^",1,2) do goto:(result=-1) CPStore
|
|---|
| 212 | . set result=1
|
|---|
| 213 | . write "There appears to be a difference in the file headers:",!
|
|---|
| 214 | . write "SOURCE VISTA SYSTEM",!
|
|---|
| 215 | . write " "_$piece(srcHeader,"^",1,2)_"^...",!,!
|
|---|
| 216 | . write "TARGET (LOCAL) VISTA SYSTEM",!
|
|---|
| 217 | . write " "_$piece(lclHeader,"^",1,2)_"^...",!
|
|---|
| 218 | . new % set %=1
|
|---|
| 219 | . write "Abort import" do YN^DICN write !
|
|---|
| 220 | . if %'=2 set result=-1
|
|---|
| 221 |
|
|---|
| 222 | ;"SUCCESS IF WE GOT THIS FAR....
|
|---|
| 223 | set result=1 ;"SUCCESS
|
|---|
| 224 |
|
|---|
| 225 | CPStore
|
|---|
| 226 | if $data(ErrMsg) do
|
|---|
| 227 | . write "ERROR. Message:",!
|
|---|
| 228 | . new i set i=""
|
|---|
| 229 | . for set i=$order(ErrMsg(i)) quit:(i="") write ErrMsg(i),!
|
|---|
| 230 | . do PressToCont^TMGUSRIF
|
|---|
| 231 | . set result=-1
|
|---|
| 232 |
|
|---|
| 233 | set @pInfoRef@("COMPATIBLE")=result
|
|---|
| 234 | set @pInfoRef@("DATE-TIME")=$H
|
|---|
| 235 | if result=1 do
|
|---|
| 236 | . kill @pInfoRef@("WORKING") ;"no longer needed.
|
|---|
| 237 |
|
|---|
| 238 | CPDone
|
|---|
| 239 | quit result
|
|---|
| 240 |
|
|---|
| 241 |
|
|---|
| 242 | HndlDD(XMLHandle,nodeFile,pInfoRef,ErrMsg)
|
|---|
| 243 |
|
|---|
| 244 | ;"==============================================================
|
|---|
| 245 | ;"Handle ^DD -----------------------------
|
|---|
| 246 | ;"==============================================================
|
|---|
| 247 |
|
|---|
| 248 | new tempArray,ExtraB,MissingB,diffArray
|
|---|
| 249 | new tempSize set tempSize=100000
|
|---|
| 250 | new pExtraB set pExtraB="ExtraB"
|
|---|
| 251 | new pDiffArray set pDiffArray="diffArray"
|
|---|
| 252 | new pDDRef set pDDRef=$name(@pInfoRef@("WORKING","DD"))
|
|---|
| 253 |
|
|---|
| 254 | if $data(@pDDRef@("IMPORT-EXTRA"))>0 merge ExtraB=@pDDRef@("IMPORT-EXTRA")
|
|---|
| 255 | if $data(@pDDRef@("DIFFERENCE"))>0 merge diffArray=@pDDRef@("DIFFERENCE")
|
|---|
| 256 | if ($data(@pExtraB)>0)!($data(@pDiffArray)>1) goto HDD2 ;"skip XML read and comparison
|
|---|
| 257 |
|
|---|
| 258 | if $data(@pDDRef@("TEMP-ARRAY"))>0 do goto HDD1 ;"skip XML read
|
|---|
| 259 | . merge tempArray=@pDDRef@("TEMP-ARRAY")
|
|---|
| 260 |
|
|---|
| 261 | new DDNode set DDNode=$$GetDescNode^TMGXMLT(XMLHandle,nodeFile,"DataDictionary")
|
|---|
| 262 | if DDNode=0 do goto HDDDone
|
|---|
| 263 | . set ErrMsg(1)="Unable to check compatibility of data dictionary for file "_FileNum
|
|---|
| 264 | . set ErrMsg(2)=" because a DataDictionary node could not be found as a child node"
|
|---|
| 265 | . set ErrMsg(3)=" from node "_nodeFile_". Aborting."
|
|---|
| 266 |
|
|---|
| 267 | set ProgressFn="use $P do ProgressBar^TMGUSRIF(IncVar,""Reading ^DD(""_FileNum_"")"",0,tempSize,,"""_$H_""") use IO"
|
|---|
| 268 | write "Gathering import data dictionary (DD) information for file "_FileNum_"...",!
|
|---|
| 269 | do ReadArray^TMGXMLT(XMLHandle,DDNode,.tempArray,.ProgressFn,.IncVar)
|
|---|
| 270 | set IncVar=tempSize xecute ProgressFn ;"set progress bar to 100%
|
|---|
| 271 |
|
|---|
| 272 | write !," " do CUU^TMGTERM(1)
|
|---|
| 273 | write !,"Sizing up data read in..."
|
|---|
| 274 | set tempSize=$$NodeCt^TMGMISC("tempArray")
|
|---|
| 275 | write " ",tempSize," nodes.",!
|
|---|
| 276 | kill @pDDRef@("TEMP-ARRAY") merge @pDDRef@("TEMP-ARRAY")=tempArray
|
|---|
| 277 |
|
|---|
| 278 | if $data(tempArray)=0 do goto HDDDone
|
|---|
| 279 | . set ErrMsg(1)="Reading of DD array failed. Aborting."
|
|---|
| 280 |
|
|---|
| 281 | HDD1 ;"------ do actual comparison
|
|---|
| 282 | set IncVar=0
|
|---|
| 283 | set ProgressFn="use $P do ProgressBar^TMGUSRIF(IncVar,""^DD(""_FileNum_"")"",0,tempSize,,"""_$H_""") use IO"
|
|---|
| 284 | write "Comparing imported data dictionary (DD) to installed DD for File ",FileNum,"...",!
|
|---|
| 285 | kill @pExtraB,@pDiffArray
|
|---|
| 286 | if $$CompABArray^TMGMISC("^DD("_FileNum_")","tempArray",pExtraB,,pDiffArray,.ProgressFn,.IncVar)=1 do goto CPDone
|
|---|
| 287 | . set ErrMsg(1)="Error or abort comparing data."
|
|---|
| 288 | write !
|
|---|
| 289 | set IncVar=tempSize xecute ProgressFn ;"set progress bar to 100%
|
|---|
| 290 | do FixArray^TMGMISC(pExtraB)
|
|---|
| 291 | do FixArray^TMGMISC(pDiffArray)
|
|---|
| 292 | kill @pDDRef@("IMPORT-EXTRA") merge @pDDRef@("IMPORT-EXTRA")=ExtraB
|
|---|
| 293 | kill @pDDRef@("DIFFERENCE") merge @pDDRef@("DIFFERENCE")=diffArray
|
|---|
| 294 |
|
|---|
| 295 | HDD2 ;" ------- process found differences
|
|---|
| 296 | if $$HandleExtra(pExtraB)=0 do goto HDDDone
|
|---|
| 297 | . set ErrMsg(1)="Unable to handle extra fields or files found in data from source"
|
|---|
| 298 | . set ErrMsg(2)="VistA system. Aborting..."
|
|---|
| 299 |
|
|---|
| 300 | if $$HandleDiff(pDiffArray)=0 do goto HDDDone
|
|---|
| 301 | . set ErrMsg(1)="Unable to handle differences between source and destination VistA"
|
|---|
| 302 | . set ErrMsg(2)="installations. Aborting."
|
|---|
| 303 |
|
|---|
| 304 | HDDDone
|
|---|
| 305 | quit
|
|---|
| 306 |
|
|---|
| 307 |
|
|---|
| 308 | HndlDIC(XMLHandle,nodeFile,pInfoRef,ErrMsg)
|
|---|
| 309 | ;"==============================================================
|
|---|
| 310 | ;"Handle ^DIC -------------------------------
|
|---|
| 311 | ;"==============================================================
|
|---|
| 312 |
|
|---|
| 313 | new tempArray,ExtraB,MissingB,diffArray
|
|---|
| 314 | new tempSize set tempSize=100000
|
|---|
| 315 | new pExtraB set pExtraB="ExtraB"
|
|---|
| 316 | new pDiffArray set pDiffArray="diffArray"
|
|---|
| 317 | new pDICRef set pDICRef=$name(@pInfoRef@("WORKING","DIC"))
|
|---|
| 318 |
|
|---|
| 319 | if $data(@pDICRef@("IMPORT-EXTRA"))>0 merge ExtraB=@pDICRef@("IMPORT-EXTRA")
|
|---|
| 320 | if $data(@pDICRef@("DIFFERENCE"))>0 merge diffArray=@pDICRef@("DIFFERENCE")
|
|---|
| 321 | if ($data(@pExtraB)>0)!($data(@pDiffArray)>1) goto HDIC2
|
|---|
| 322 |
|
|---|
| 323 | if $data(@pDICRef@("TEMP-ARRAY"))>0 do goto HDIC1
|
|---|
| 324 | . merge tempArray=@pDICRef@("TEMP-ARRAY")
|
|---|
| 325 |
|
|---|
| 326 | ;"---- read XML data into temporary array
|
|---|
| 327 | new DICNode set DICNode=$$GetDescNode^TMGXMLT(XMLHandle,nodeFile,"DIC_File")
|
|---|
| 328 | if DICNode=0 do goto CPStore
|
|---|
| 329 | . set ErrMsg(1)="Unable to check compatibility of ^DIC for file "_FileNum
|
|---|
| 330 | . set ErrMsg(1)=" because a DIC_File node could not be found as a child node"
|
|---|
| 331 | . set ErrMsg(1)=" from node "_nodeFile_". Aborting."
|
|---|
| 332 |
|
|---|
| 333 | set IncVar=0,tempSize=100000
|
|---|
| 334 | set ProgressFn="use $P do ProgressBar^TMGUSRIF(IncVar,""Reading ^DIC(""_FileNum_"")"",0,tempSize,,"""_$H_""") use IO"
|
|---|
| 335 | write "Gathering import DIC information for file "_FileNum_"...",!
|
|---|
| 336 | do ReadArray^TMGXMLT(XMLHandle,DICNode,.tempArray,.ProgressFn,.IncVar)
|
|---|
| 337 | set IncVar=tempSize xecute ProgressFn ;"set progress bar to 100%
|
|---|
| 338 | write !,"Sizing up data read in..."
|
|---|
| 339 | new tempSize set tempSize=$$NodeCt^TMGMISC("tempArray")
|
|---|
| 340 | write " ",tempSize," nodes.",!
|
|---|
| 341 | kill @pDICRef@("TEMP-ARRAY") merge @pDICRef@("TEMP-ARRAY")=tempArray
|
|---|
| 342 |
|
|---|
| 343 | if $data(tempArray)=0 do goto HDICDone
|
|---|
| 344 | . set ErrMsg(1)="Reading of DIC array failed. Aborting."
|
|---|
| 345 |
|
|---|
| 346 | HDIC1 ;"------ do actual comparison
|
|---|
| 347 | set IncVar=0
|
|---|
| 348 | set ProgressFn="use $P do ProgressBar^TMGUSRIF(IncVar,""^DIC(""_FileNum_"")"",0,tempSize,,"""_$H_""") use IO"
|
|---|
| 349 | write "Comparing imported DIC to installed DIC for File ",FileNum,"...",!
|
|---|
| 350 | if $$CompABArray^TMGMISC("^DIC("_FileNum_")","tempArray",pExtraB,,pDiffArray,.ProgressFn,.IncVar)=1 do goto CPStore
|
|---|
| 351 | . set ErrMsg(1)="Error or abort while comparing data."
|
|---|
| 352 | write !,!
|
|---|
| 353 | do FixArray^TMGMISC(pExtraB)
|
|---|
| 354 | kill @pDICRef@("IMPORT-EXTRA") merge @pDICRef@("IMPORT-EXTRA")=@pExtraB
|
|---|
| 355 | do FixArray^TMGMISC(pDiffArray)
|
|---|
| 356 | kill @pDICRef@("DIFFERENCE") merge @pDICRef@("DIFFERENCE")=@pDiffArray
|
|---|
| 357 |
|
|---|
| 358 | HDIC2 ;" ------- process found differences
|
|---|
| 359 | if $$HandleExtra(pExtraB)=0 do goto HDICDone
|
|---|
| 360 | . set ErrMsg(1)="Unable to handle extra fields or files found in data from source"
|
|---|
| 361 | . set ErrMsg(2)="VistA system. Aborting..."
|
|---|
| 362 | kill @pDICRef@("IMPORT-EXTRA") merge @pDICRef@("IMPORT-EXTRA")=@pExtraB
|
|---|
| 363 |
|
|---|
| 364 | CPComp3 if $$HandleDiff(pDiffArray)=0 do goto HDICDone
|
|---|
| 365 | . set ErrMsg(1)="Unable to handle differences between source and destination VistA"
|
|---|
| 366 | . set ErrMsg(2)="installations. Aborting."
|
|---|
| 367 | kill @pDICRef@("DIFFERENCE") merge @pDICRef@("DIFFERENCE")=@pDiffArray
|
|---|
| 368 |
|
|---|
| 369 | HDICDone
|
|---|
| 370 | quit
|
|---|
| 371 |
|
|---|
| 372 |
|
|---|
| 373 |
|
|---|
| 374 | HandleExtra(pSrcExtra)
|
|---|
| 375 | ;"Purpose: to handle addition of extra (non-conflicting) fields / files
|
|---|
| 376 | ;" to destination (local) VistA system based on import data
|
|---|
| 377 | ;"Input: pSrcExtra -- PASS BY NAME. Array of additions in source System.
|
|---|
| 378 | ;" Format as per CompABArray^TMGMISC
|
|---|
| 379 | ;"Result: 1=OK to continue, 0=Failed resolution.
|
|---|
| 380 | ;"Note: this function is assuming input like this:
|
|---|
| 381 | ;" @Array@("^GLBNAME",filenumber,...
|
|---|
| 382 |
|
|---|
| 383 | new result set result=1 ;"default to SUCCESS
|
|---|
| 384 |
|
|---|
| 385 | new UsrPick set UsrPick=""
|
|---|
| 386 | new Menu
|
|---|
| 387 | set Menu(0)="Pick option for handling EXTRA file info from importing VistA"
|
|---|
| 388 | set Menu(1)="MERGE node(s) into the local system."
|
|---|
| 389 | set Menu(2)="Do NOT add this into the local system."
|
|---|
| 390 | set Menu(3)="SKIP for now. Decide if import actually needs these fields."
|
|---|
| 391 | set Menu(4)="Choose for each INDIVIDUAL entry"
|
|---|
| 392 |
|
|---|
| 393 | new gblRef set gblRef=""
|
|---|
| 394 | for set gblRef=$order(@pSrcExtra@(gblRef)) quit:(gblRef="")!(UsrPick="^") do
|
|---|
| 395 | . new fileNum set fileNum=""
|
|---|
| 396 | . for set fileNum=$order(@pSrcExtra@(gblRef,fileNum)) quit:(fileNum="")!(UsrPick="^") do
|
|---|
| 397 | . . write !,"The Remote/Source VistA system File #",fileNum," (",$$GetFName^TMGDBAPI(fileNum),") in ",gblRef," has Extra Information:",!
|
|---|
| 398 | . . new fieldNum set fieldNum=""
|
|---|
| 399 | . . for set fieldNum=$order(@pSrcExtra@(gblRef,fileNum,fieldNum)) quit:(fieldNum="")!(UsrPick="^") do
|
|---|
| 400 | . . . new subRef set subRef=$name(@pSrcExtra@(gblRef,fileNum,fieldNum))
|
|---|
| 401 | . . . write #,!
|
|---|
| 402 | . . . write "File# ",fileNum,", Field# ",fieldNum," has the following:",!
|
|---|
| 403 | . . . do ArrayDump^TMGDEBUG($name(@pSrcExtra@(gblRef,fileNum,fieldNum)),,,"F")
|
|---|
| 404 | . . . set UsrPick=$$Menu^TMGUSRIF(.Menu,3)
|
|---|
| 405 | . . . if UsrPick="^" set result=0 quit
|
|---|
| 406 | . . . if UsrPick=3 quit
|
|---|
| 407 | . . . if UsrPick=2 do quit
|
|---|
| 408 | . . . . kill @subRef
|
|---|
| 409 | . . . if UsrPick=1 do quit
|
|---|
| 410 | . . . . new writeRef set writeRef=$qsubscript(subRef,1)
|
|---|
| 411 | . . . . new i for i=2:1:$qlength(subRef) do
|
|---|
| 412 | . . . . . set writeRef=$name(@writeRef@($qsubscript(subRef,i)))
|
|---|
| 413 | . . . . if $data(@writeRef)>0 do quit
|
|---|
| 414 | . . . . . write "Aborting merge because "_writeRef_" already has data!",!
|
|---|
| 415 | . . . . merge @writeRef=@subRef
|
|---|
| 416 | . . . . kill @subRef
|
|---|
| 417 | . . . if UsrPick=4 do quit
|
|---|
| 418 | . . . . new subNode set subNode=""
|
|---|
| 419 | . . . . for set subNode=$order(@subRef@(subNode)) quit:(subNode="")!(UsrPick="^") do
|
|---|
| 420 | . . . . . set UsrPick=$$HandleExtra($name(@subRef@(subNode)))
|
|---|
| 421 |
|
|---|
| 422 | quit result
|
|---|
| 423 |
|
|---|
| 424 |
|
|---|
| 425 | HandleDiff(pDiffArray)
|
|---|
| 426 | ;"Purpose: To handle difference between source and local installations.
|
|---|
| 427 | ;"Input: pDiffArray -- PASS BY NAME. Array of differences. Format as
|
|---|
| 428 | ;" per CompABArray^TMGMISC
|
|---|
| 429 | ;"Result: 1=OK to continue, 0=Failed resolution.
|
|---|
| 430 |
|
|---|
| 431 | ;"Note: this function probably needs to be changed to handle reformatted diffArray
|
|---|
| 432 |
|
|---|
| 433 | new result set result=1 ;"default to SUCCESS
|
|---|
| 434 |
|
|---|
| 435 | new ref set ref=""
|
|---|
| 436 | for set ref=$order(@pDiffArray@("A",ref)) quit:(ref="")!(result=0) do
|
|---|
| 437 | . new idx set idx=""
|
|---|
| 438 | . for set idx=$order(@pDiffArray@("A",ref,idx)) quit:(idx="")!(result=0)!(result=2) do
|
|---|
| 439 | . . new local,import
|
|---|
| 440 | . . merge local=@pDiffArray@("A",ref,idx)
|
|---|
| 441 | . . merge import=@pDiffArray@("B",ref,idx)
|
|---|
| 442 | . . ;"new name set name=$name(@ref@(idx))
|
|---|
| 443 | . . new name set name=ref
|
|---|
| 444 | . . set result=$$Handle1Diff(name,.local,.import)
|
|---|
| 445 |
|
|---|
| 446 | write !!
|
|---|
| 447 | quit result
|
|---|
| 448 |
|
|---|
| 449 |
|
|---|
| 450 | Handle1Diff(name,local,import)
|
|---|
| 451 | ;"Scope: private
|
|---|
| 452 | ;"Purpose: to handle 1 difference.
|
|---|
| 453 | ;"Input: local PASS BY REFERENCE
|
|---|
| 454 | ;" import PASS BY REFERENCE
|
|---|
| 455 | ;"Results: 1=OK to continue, 0=cancel import
|
|---|
| 456 |
|
|---|
| 457 | new result set result=1
|
|---|
| 458 | write #
|
|---|
| 459 | write "For node: ",name,!
|
|---|
| 460 | write "================================",!
|
|---|
| 461 | write "LOCAL VistA has this:",!
|
|---|
| 462 | write $get(local),!
|
|---|
| 463 | write !
|
|---|
| 464 | write "IMPORTING VistA has this:",!
|
|---|
| 465 | write $get(import),!
|
|---|
| 466 |
|
|---|
| 467 | new Menu,UsrInput
|
|---|
| 468 | set Menu(1)="Cancel Import"
|
|---|
| 469 | set Menu(2)="Ignore difference"
|
|---|
| 470 | set Menu(3)="Ignore ALL for this field"
|
|---|
| 471 | set Menu(4)="Overwrite LOCAL with IMPORTING"
|
|---|
| 472 | set UsrInput=$$Menu^TMGUSRIF(.Menu,2)
|
|---|
| 473 |
|
|---|
| 474 | if (UsrInput="^")!(UsrInput=1) set result=0 goto H1DDone
|
|---|
| 475 | if UsrInput=2 goto H1DDone
|
|---|
| 476 | if UsrInput=3 set result=2 goto H1DDone
|
|---|
| 477 | if UsrInput=4 do
|
|---|
| 478 | . write "IMPLEMENT THIS FEATURE LATER... (Handle1Diff^TMGXMLIN)",!
|
|---|
| 479 | . set result=1
|
|---|
| 480 |
|
|---|
| 481 | H1DDone
|
|---|
| 482 | quit result
|
|---|
| 483 |
|
|---|
| 484 |
|
|---|
| 485 | HdlDICExtra(pSrcExtra)
|
|---|
| 486 | ;"Purpose: to handle addition of extra (non-conflicting) fields / files
|
|---|
| 487 | ;" to destination (local) VistA system based on import data
|
|---|
| 488 | ;"Input: pSrcExtra -- PASS BY NAME. Array of additions in source System.
|
|---|
| 489 | ;" Format as per CompABArray^TMGMISC
|
|---|
| 490 | ;"Result: 1=OK to continue, 0=Failed resolution.
|
|---|
| 491 |
|
|---|
| 492 | new result set result=1 ;"default to SUCCESS
|
|---|
| 493 |
|
|---|
| 494 | if $data(@pSrcExtra)>0 do
|
|---|
| 495 | . write "Please modify HdleDICExtra^TMGXMLIN to handle extra info from import.",!
|
|---|
| 496 | . zwr @pSrcExtra
|
|---|
| 497 | . set result=-1
|
|---|
| 498 |
|
|---|
| 499 | quit result
|
|---|
| 500 |
|
|---|
| 501 |
|
|---|
| 502 | HdlDICDiff(pDiffArray)
|
|---|
| 503 | ;"Purpose: To handle difference between source and local installations.
|
|---|
| 504 | ;"Input: pDiffArray -- PASS BY NAME. Array of differences. Format as
|
|---|
| 505 | ;" per CompABArray^TMGMISC
|
|---|
| 506 | ;"Result: 1=OK to continue, 0=Failed resolution.
|
|---|
| 507 |
|
|---|
| 508 | new result set result=1 ;"default to SUCCESS
|
|---|
| 509 |
|
|---|
| 510 | if $data(@pDiffArray)>0 do
|
|---|
| 511 | . write "Please modify HdleDICDiff^TMGXMLIN to handle differences from import.",!
|
|---|
| 512 | . set result=-1
|
|---|
| 513 |
|
|---|
| 514 | quit result
|
|---|
| 515 |
|
|---|
| 516 |
|
|---|
| 517 | Imp1Record(XMLHandle,SrcSysName,FileNum,nodeRecord)
|
|---|
| 518 | ;"Purpose: to import 1 record
|
|---|
| 519 | ;"Input: XMLHandle -- The handle created by loading function.
|
|---|
| 520 | ;" SrcSysName -- The name of the source VistA system
|
|---|
| 521 | ;" FileNum -- file number of target file to up uploaded into
|
|---|
| 522 | ;" nodeRecord -- the XML node pointing the the record to upload.
|
|---|
| 523 | ;"Assumption: The target VistA system has already been checked and is
|
|---|
| 524 | ;" compatible with upload data.
|
|---|
| 525 | ;" ALSO, data exported should have been in INTERNAL format.
|
|---|
| 526 | ;" This is because the upload will be INTERNAL values (to try
|
|---|
| 527 | ;" to bypass import transforms.)
|
|---|
| 528 | ;"Note: if the XML entry for the record contains the tag="POINTED_TO_RECORD",
|
|---|
| 529 | ;" Then this record is recognized as a supporting record, rather than
|
|---|
| 530 | ;" primary import information. In this case, a check will be made to
|
|---|
| 531 | ;" see if the record has already been uploaded. If so, then it will not
|
|---|
| 532 | ;" be uploaded again.
|
|---|
| 533 | ;"Note: A translation table for IEN's in the source system, and the target
|
|---|
| 534 | ;" system will be maintained as follows:
|
|---|
| 535 | ;" ^TMG("XML EXPORTER",SrcSysName,FileNum,SrcIEN)=TargetIEN
|
|---|
| 536 | ;" ^TMG("XML EXPORTER",SrcSysName,FileNum,SrcIEN)=TargetIEN
|
|---|
| 537 | ;" ^TMG("XML EXPORTER",SrcSysName,FileNum,SrcIEN)=TargetIEN
|
|---|
| 538 | ;"Note: This does not current support or hand DIFROM records, or records
|
|---|
| 539 | ;" with an expectation of IEN's to match IEN's in other files etc.
|
|---|
| 540 | ;" I will have to handle these problems as they come up.
|
|---|
| 541 | ;"Output
|
|---|
| 542 | ;" ^TMG("XML EXPORTER",SrcSysName,FileNum,"NEEDS RETRY",nodeRecord,.01)=oldTargetIEN
|
|---|
| 543 | ;" ^TMG("XML EXPORTER",SrcSysName,FileNum,"NEEDS RESOLUTION",localIEN,fieldNum)=oldTargetIEN
|
|---|
| 544 | ;" ^TMG("XML EXPORTER",SrcSysName,FileNum,remoteIEN)=localIEN
|
|---|
| 545 | ;"Results: 0=OK to continue, 1=abort, 2=try again later
|
|---|
| 546 |
|
|---|
| 547 | new result set result=0
|
|---|
| 548 | new ErrMsg
|
|---|
| 549 | new remoteIEN ;"aka SrcIEN
|
|---|
| 550 | new localIEN ;"aka TargetIEN
|
|---|
| 551 | new mode
|
|---|
| 552 | set remoteIEN=+$$GetAtrVal^TMGXMLT(XMLHandle,nodeRecord,"id")
|
|---|
| 553 | if remoteIEN'>0 do goto I1RDone
|
|---|
| 554 | . set ErrMsg(1)="Can't find import IEN in XML node# "_nodeRecord
|
|---|
| 555 | set localIEN=+$get(^TMG("XML EXPORTER",SrcSysName,FileNum,remoteIEN))
|
|---|
| 556 | if localIEN>0 goto I1RDone ;"Already uploaded or found. Done here...
|
|---|
| 557 |
|
|---|
| 558 | ;"Handle usual case of importing 1 record here.
|
|---|
| 559 |
|
|---|
| 560 | new TMGFDA,TMGIEN,TMGMSG
|
|---|
| 561 | new tempArray,ptrToArray
|
|---|
| 562 | new refFDA set refFDA=$name(TMGFDA(FileNum,"+1,"))
|
|---|
| 563 | new abort set abort=0
|
|---|
| 564 | new nodeField set nodeField=0
|
|---|
| 565 |
|
|---|
| 566 | for set nodeField=$$GetDescNode^TMGXMLT(XMLHandle,nodeRecord,"FIELD",nodeField) quit:(nodeField'>0)!abort do
|
|---|
| 567 | . new fieldNum set fieldNum=$$GetAtrVal^TMGXMLT(XMLHandle,nodeField,"id")
|
|---|
| 568 | . new fieldType set fieldType=$$GetAtrVal^TMGXMLT(XMLHandle,nodeField,"TYPE")
|
|---|
| 569 | . if fieldType="WORD-PROCESSING" quit ;"handle later... **FINISH**
|
|---|
| 570 | . new value set value=$$Get1LText^TMGXMLT(XMLHandle,nodeField)
|
|---|
| 571 | . if value'="" set tempArray(fieldNum)=value
|
|---|
| 572 | . new P2 set P2=$piece($get(^DD(FileNum,fieldNum,0)),"^",2)
|
|---|
| 573 | . if P2["P" set ptrToArray(fieldNum)=+$piece(P2,"P",2)
|
|---|
| 574 |
|
|---|
| 575 | set mode=$$GetAtrVal^TMGXMLT(XMLHandle,nodeRecord,"tag")
|
|---|
| 576 | if mode="POINTED_TO_RECORD" do
|
|---|
| 577 | . ;"See if similar record already exists in the system. (matching)
|
|---|
| 578 | . new Data
|
|---|
| 579 | . set Data(0,"FILE")=FileNum
|
|---|
| 580 | . merge Data(1)=tempArray
|
|---|
| 581 | . set Data(1,.01,"MATCHTHIS")=1 ;" <--- Only require .01 field to match. Enough?
|
|---|
| 582 | . new priorIEN
|
|---|
| 583 | . if $$GetRecMatch^TMGDBAPI(.Data,.priorIEN)=0 do quit
|
|---|
| 584 | . . set ErrMsg(1)="Error during search for prior records."
|
|---|
| 585 | . if priorIEN'>0 quit ;"no pre-existing records exist on system.
|
|---|
| 586 | . set localIEN=priorIEN
|
|---|
| 587 | . set ^TMG("XML EXPORTER",SrcSysName,FileNum,remoteIEN)=localIEN
|
|---|
| 588 | if $data(ErrMsg)!(localIEN>0) goto I1RDone
|
|---|
| 589 |
|
|---|
| 590 | new mandIEN set mandIEN=0 ;"manditory IEN for storage of this record (if any)
|
|---|
| 591 |
|
|---|
| 592 | if $P($get(^DD(FileNum,.01,0)),"^",5,99)["DINUM" do
|
|---|
| 593 | . new targetFile set targetFile=+$get(ptrToArray(.01))
|
|---|
| 594 | . if targetFile>0 do
|
|---|
| 595 | . . new oldTargetIEN set oldTargetIEN=+$get(tempArray(.01))
|
|---|
| 596 | . . new localTargetIEN
|
|---|
| 597 | . . set localTargetIEN=+$get(^TMG("XML EXPORTER",SrcSysName,FileNum,oldTargetIEN))
|
|---|
| 598 | . . ;"At this point, we know that this record is DINUM'd, meaning that it must
|
|---|
| 599 | . . ;"be filed at a specific IEN. In this case it's IEN must match the pointer
|
|---|
| 600 | . . ;"stored in the .01 field. NOTE, however, that this pointer must be resolved
|
|---|
| 601 | . . ;"the corresponding record on the new system. So oldTargetIEN is resolved
|
|---|
| 602 | . . ;"to localTargetIEN. If localTargetIEN=0, then this means that the other record
|
|---|
| 603 | . . ;"that this one is tied to has not yet been imported. So this record should
|
|---|
| 604 | . . ;"be tried again after other files from import have been processed.
|
|---|
| 605 | . . if localTargetIEN=0 do quit
|
|---|
| 606 | . . . set ^TMG("XML EXPORTER",SrcSysName,FileNum,"NEEDS RETRY",nodeRecord,.01)=oldTargetIEN
|
|---|
| 607 | . . . set result=2 ;"2=try again later.
|
|---|
| 608 | . . set mandIEN=localTargetIEN
|
|---|
| 609 | . else do
|
|---|
| 610 | . . ;"this is a DINUM based on something that is not a pointer
|
|---|
| 611 | . . set mandIEN=$get(tempArray(.01))
|
|---|
| 612 | . . ;"Not sure of examples of above, but shouldn't need resolving in new system.
|
|---|
| 613 | if result=2 goto I1RDone
|
|---|
| 614 |
|
|---|
| 615 | ;"Resolve any pointers out if possible prior to storage.
|
|---|
| 616 | ;"Make note of pointer in record that will need resolving later.
|
|---|
| 617 | new resolveLater
|
|---|
| 618 | set fieldNum=""
|
|---|
| 619 | for set fieldNum=$order(ptrToArray(fieldNum)) quit:(+fieldNum'>0) do
|
|---|
| 620 | . new targetFile set targetFile=+$get(ptrToArray(fieldNum))
|
|---|
| 621 | . new oldTargetIEN set oldTargetIEN=$get(tempArray(fieldNum))
|
|---|
| 622 | . new localTargetIEN set localTargetIEN=+$get(^TMG("XML EXPORTER",SrcSysName,FileNum,oldTargetIEN))
|
|---|
| 623 | . if localTargetIEN>0 do
|
|---|
| 624 | . . set tempArray(fieldNum)=localTargetIEN ;"<-- pointer now resolved.
|
|---|
| 625 | . else do
|
|---|
| 626 | . . set resolveLater(fieldNum)=oldTargetIEN ;"<-- remember to resolve later.
|
|---|
| 627 |
|
|---|
| 628 | merge @refFDA=tempArray ;" set up TMGFDA
|
|---|
| 629 | if mandIEN>0 set TMGIEN(1)=mandIEN ;"specify mandated IEN to store record in.
|
|---|
| 630 | do UPDATE^DIE("S","TMGFDA","TMGIEN","TMGMSG") ;" do actual storage.
|
|---|
| 631 | if $data(TMGMSG("DIERR")) do
|
|---|
| 632 | . do ShowDIERR^TMGDEBUG(.TMGMSG)
|
|---|
| 633 | . set result=1
|
|---|
| 634 | else do ;"make notes of newly stored record
|
|---|
| 635 | . set localIEN=+$get(TMGIEN(1))
|
|---|
| 636 | . set ^TMG("XML EXPORTER",SrcSysName,FileNum,remoteIEN)=localIEN
|
|---|
| 637 | . set fieldNum="" ;"some pointers out might not have been resolvable. Remember this.
|
|---|
| 638 | . for set fieldNum=$order(resolveLater(fieldNum)) quit:(fieldNum="") do
|
|---|
| 639 | . . set oldTargetIEN=$get(resolveLater(fieldNum))
|
|---|
| 640 | . . set ^TMG("XML EXPORTER",SrcSysName,FileNum,"NEEDS RESOLUTION",localIEN,fieldNum)=oldTargetIEN
|
|---|
| 641 |
|
|---|
| 642 | I1RDone
|
|---|
| 643 | if $data(ErrMsg) do
|
|---|
| 644 | . write "ERROR. Message:",!
|
|---|
| 645 | . new i set i=""
|
|---|
| 646 | . for set i=$order(ErrMsg(i)) quit:(i="") write ErrMsg(i),!
|
|---|
| 647 | . do PressToCont^TMGUSRIF
|
|---|
| 648 | . set result=1 ;" abort
|
|---|
| 649 |
|
|---|
| 650 | quit result
|
|---|
| 651 |
|
|---|
| 652 |
|
|---|
