source: cprs/branches/tmg-cprs/m_files/TMGXMLIN.m@ 1742

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

Initial upload

File size: 29.4 KB
RevLine 
[796]1TMGXMLIN ;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
18ImportXML
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
42Imp1
43 do ImportFiles(XMLHandle)
44Imp2
45
46ImpDone
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
57GetDDNode(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
69GetSysName(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
82ImportFiles(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
97IFDone quit
98
99
100Import1File(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
126Ip1FDone
127 quit abort
128
129
130CompatFile(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
225CPStore
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
238CPDone
239 quit result
240
241
242HndlDD(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
281HDD1 ;"------ 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
295HDD2 ;" ------- 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
304HDDDone
305 quit
306
307
308HndlDIC(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
346HDIC1 ;"------ 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
358HDIC2 ;" ------- 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
364CPComp3 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
369HDICDone
370 quit
371
372
373
374HandleExtra(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
425HandleDiff(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
450Handle1Diff(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
481H1DDone
482 quit result
483
484
485HdlDICExtra(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
502HdlDICDiff(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
517Imp1Record(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
642I1RDone
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
Note: See TracBrowser for help on using the repository browser.