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

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

replacing soft links with actual files

File size: 31.2 KB
RevLine 
[896]1TMGSIPH1 ;TMG/kst/SIPHON PROGRAM, FOR TRANSFERRING VISTA INSTANCES ;11/27/09
2 ;;1.0;TMG-LIB;**1**;11/27/09
3 ;
4 ;"TMG SIPHON PROGRAM, FOR TRANSFERRING VISTA INSTANCE
5 ;"Especially functions for working with the data dictionaries.
6 ;"Kevin Toppenberg MD
7 ;"GNU General Public License (GPL) applies
8 ;"11/27/09
9 ;
10 ;"=======================================================================
11 ;" API -- Public Functions.
12 ;"=======================================================================
13 ;"COMPALLD(JNUM) --ask user for file name and compare data dictionaries.
14 ;"DDOK(JNUM,FILENUM) --check that data dictionary is ready, interacting with user as needed
15 ;"PREPDD(JNUM,FILENUM) --Ensure the data dictonary is ready for the local client
16 ;"COMPDD(JNUM,FILENUM,ARRAY) --compare data dictionary from Remote to local machine.
17 ;"PROCESSDIFF(FILENUM,ARRAY) -- take array of differences (as created by COMPDD) and see if user wants to copy remote changes to local machine.
18 ;"HASFLDMISS(ARRAY) -- determine if file has fields missing in local machine.
19 ;"ADDFLDMISSING(ARRAY) --allow user to pick filed to add to local data dictionary.
20 ;"ADD1FLD(FILENUM,FLD,ARRAY) --add all the nodes for file (or subfile) field to local data dictionary.
21 ;"VFLDMISSING(ARRAY) --display fields missing in local machine.
22 ;"GETMISFLD(ARRAY,MISFLDS) --display fields missing in local machine.
23 ;"VIEW1FLDMISSING(FILENUM,FLD,ARRAY) --show the data for 1 field to be displayed.
24 ;"HASWMISSING(ARRAY) -- determine if there are any Nodes missing in local machine.
25 ;"VIEWMISSING(ARRAY) -- display Nodes missing in local machine.
26 ;"ADDMISSING(ARRAY) -- add remote changes into this machine, if wanted.
27 ;"HASDIFF(ARRAY) -- determine if there are values that differ between remote and local VistA
28 ;"VIEWDIFF(ARRAY) -- display values that differ between remote and local VistA
29 ;"RSLVDIFF(ARRAY) -- allow storing values that differ between remote and local VistA
30 ;"SETPTOUT(FILENUM) --set up an easy to use array of potential pointers out from a file.
31 ;"SETALLPTO -- To cycle through ALL files and call SETPTOUT for each file.
32 ;"REAL1PTOUT(FILENUM,IEN,TALLY) --compare 1 record in the specified file that has been downloaded from the
33 ;" server, but not yet processed, and look for actual pointers out.
34 ;" If pointers out refer to records already gotten from server, then pointer is
35 ;" fixed immediately. Otherwise pointer is added to list of fixes needed.
36 ;"REALPTOUT(FILENUM) -- DEPRECIATED --compare all recorda in the specified file and look for actual pointers out.
37 ;"PREPXREF(JNUM,FILENUM) -- ask the server to pepair organized cross references.
38
39 ;"=======================================================================
40 ;"Dependancies
41 ;"=======================================================================
42 ;"TMGKERN2, TMGUSRIF
43 ;"=======================================================================
44 ;
45COMPALLD(JNUM) ;
46 ;"Purpose: ask user for file name and compare data dictionaries.
47 ;"Input: JNUM -- The job number of the background client process
48 ;"
49 NEW X,Y,DIC,ARRAY
50 SET DIC=1,DIC(0)="MAEQ"
51LCAD DO ^DIC WRITE !
52 IF +Y'>0 QUIT
53 DO COMPDD(JNUM,+Y,.ARRAY)
54 DO PROCESSDIFF(+Y,.ARRAY)
55 ;"GOTO LCAD
56 QUIT
57 ;
58 ;
59DDOK(JNUM,FILENUM) ;
60 ;"Purpose: To check that data dictionary is ready, interacting with user as needed
61 ;"Input: JNUM -- The job number of the background client process
62 ;" FILENUM -- The file number to work on, or subfilenumber{parentfilenumber{grandparent...
63 ;"Results : 1 if DD is ready. -1 if user aborted.
64 ;"NOTE: globally-scoped var TMGABORT may be set to 1 to cause drop back to main menu.
65 NEW DDOK SET DDOK=0
66 SET FILENUM=+$GET(FILENUM) ;"if subfile, strip parent filenumber
67 FOR DO QUIT:(DDOK'=0)!($GET(TMGABORT)=1)
68 . SET DDOK=+$GET(^TMG("TMGSIPH","DD",FILENUM,"DIFF"))
69 . QUIT:(DDOK=1)
70 . ;"WRITE "Before records can be transferred from the server, the local data",!
71 . ;"WRITE "dictionary must be made compatible. Must work on this now.",!
72 . ;"DO PressToCont^TMGUSRIF ;"will set global-scope var TMGPTCABORT if aborted.
73 . IF $GET(TMGPTCABORT)=1 SET DDOK=-1,TMGABORT=1 QUIT
74 . SET DDOK=$$PREPDD(JNUM,FILENUM)
75 QUIT DDOK
76 ;
77 ;
78PREPDD(JNUM,FILENUM) ;
79 ;"Purpose: Ensure the data dictonary is ready for the local client
80 ;"Input: JNUM -- The job number of the background client process
81 ;" FILENUM -- The file number to work on
82 ;"Results : 1 if DD is ready. 0 or -1 if user aborted.
83 ;"NOTE: globally-scoped var TMGABORT may be set to 1 to cause drop back to main menu.
84 NEW ARRAY,RESULT
85 SET RESULT=$GET(^TMG("TMGSIPH","DD",FILENUM,"DIFF"))
86 IF RESULT=1 GOTO PDDN ;"Signal that DD has been resolved
87 DO COMPDD(JNUM,FILENUM,.ARRAY)
88 IF $DATA(ARRAY) DO
89 . DO PROCESSDIFF(FILENUM,.ARRAY)
90 . SET RESULT=+$GET(^TMG("TMGSIPH","DD",FILENUM,"DIFF")) ;"Signal that DD has been looked at
91 ELSE DO
92 . SET ^TMG("TMGSIPH","DD",FILENUM,"DIFF")=1 ;"Signal that DD has been looked at
93 . SET RESULT=1
94PDDN QUIT RESULT
95 ;
96 ;
97COMPDD(JNUM,FILENUM,ARRAY) ;
98 ;"Purpose: To compare data dictionary from Remote to local machine.
99 ;"Input: JNUM -- The job number of the background client process
100 ;" FILENUM -- The file number to compare.
101 ;" ARRAY -- Pass by REFERENCE, an OUT PARAMETER.
102 ;" ARRAY("MISSING NODE",NodeStr)=RemoteValue
103 ;" ARRAY("DIFF VALUE",NodeStr,"L")=LocalValue
104 ;" ARRAY("DIFF VALUE",NodeStr,"R")=RemoteValue
105 ;"Results: none
106 NEW QUERY,ERROR,RESULT,REPLY
107 KILL ARRAY
108 SET FILENUM=+$GET(FILENUM)
109 SET ARRAY("FILE")=FILENUM
110 SET QUERY="GET DD|"_FILENUM
111 DO MSGCLIENT^TMGKERN2(JNUM,QUERY,.REPLY,.ERROR,5)
112 IF $DATA(ERROR) WRITE ERROR,! GOTO CDDD
113 NEW TMGI SET TMGI=1
114 NEW REF,VALUE
115 FOR DO SET TMGI=TMGI+2 QUIT:(REF="")
116 . SET REF=$GET(REPLY(TMGI)) QUIT:(REF="")
117 . SET REF=$EXTRACT(REF,1,$LENGTH(REF)-1) ;"Cleave terminal "="
118 . SET VALUE=$GET(REPLY(TMGI+1))
119 . SET VALUE=$EXTRACT(VALUE,2,$LENGTH(VALUE))
120 . IF $DATA(@REF)=0 DO QUIT
121 . . SET ARRAY("MISSING NODE",REF)=VALUE
122 . IF $GET(@REF)'=VALUE DO QUIT
123 . . SET ARRAY("DIFF VALUE",REF,"L")=$GET(@REF)
124 . . SET ARRAY("DIFF VALUE",REF,"R")=VALUE
125CDDD QUIT
126 ;
127 ;
128PROCESSDIFF(FILENUM,ARRAY) ;
129 ;"Purpose: To take array of differences (as created by COMPDD) and
130 ;" see if user wants to copy remote changes to local machine.
131 ;"Input -- FILENUM -- The Fileman file number
132 ;" ARRAY -- Pass by REFERENCE. As created by COMPDD
133 ;"Result: None
134 ;"NOTE: globally-scoped var TMGABORT may be set to 1 to cause drop back to main menu.
135 ;
136 NEW MENU,USRSLCT,IDX,%
137 NEW FNAME SET FNAME=$PIECE($GET(^DIC(FILENUM,0)),"^",1)
138CD1 KILL MENU
139 SET IDX=1
140 SET MENU(0)="Pick Option for Comparing Differences in File #"_$get(ARRAY("FILE"))_" "_FNAME
141 IF $$HASFLDMISS(.ARRAY) DO
142 . SET MENU(IDX)="View missing local FIELDS"_$char(9)_"ViewFldMissing" SET IDX=IDX+1
143 . SET MENU(IDX)="Add missing local FIELDS"_$char(9)_"AddFldMissing" SET IDX=IDX+1
144 IF $$HASWMISSING(.ARRAY) DO
145 . SET MENU(IDX)="View missing local nodes"_$char(9)_"ViewMissing" SET IDX=IDX+1
146 . SET MENU(IDX)="Add missing local nodes"_$char(9)_"AddMissing" SET IDX=IDX+1
147 IF $$HASDIFF(.ARRAY) DO
148 . SET MENU(IDX)="View conflicts between remote and local VistA"_$char(9)_"ViewDiff" SET IDX=IDX+1
149 . SET MENU(IDX)="Resolve conflicts between remote and local VistA"_$char(9)_"ResolveDiff" SET IDX=IDX+1
150 IF IDX>1 DO
151 . SET MENU(IDX)="Launch local data dictionary browser"_$char(9)_"VPEDD" SET IDX=IDX+1
152 ELSE DO GOTO CDDN2
153 . SET ^TMG("TMGSIPH","DD",FILENUM,"DIFF")=1
154 . ;"WRITE "Local Data Dictionary is OK. Nothing to be done.",!
155 . ;"DO PressToCont^TMGUSRIF
156 SET MENU(IDX)="DONE with fixing differences"_$char(9)_"Done" SET IDX=IDX+1
157 SET MENU(IDX)="ABORT entire process"_$char(9)_"Abort" SET IDX=IDX+1
158 ;
159 WRITE #
160 WRITE "********************************************************************",!
161 WRITE "File name: "_FNAME,!
162 WRITE "Before records can be transferred from the server, the local data",!
163 WRITE "dictionary must be made compatible. Please work on this now.",!
164 WRITE "********************************************************************",!
165 SET USRSLCT=$$MENU^TMGUSRIF(.MENU,"^")
166 IF USRSLCT="^" GOTO CDDONE
167 IF USRSLCT=0 SET USRSLCT=""
168 ;
169 IF USRSLCT="ViewFldMissing" DO VFLDMISSING(.ARRAY) GOTO CD1
170 IF USRSLCT="AddFldMissing" DO ADDFLDMISSING(.ARRAY) GOTO CD1
171 IF USRSLCT="ViewMissing" DO VIEWMISSING(.ARRAY) GOTO CD1
172 IF USRSLCT="AddMissing" DO ADDMISSING(.ARRAY) GOTO CD1
173 IF USRSLCT="ViewDiff" DO VIEWDIFF(.ARRAY) GOTO CD1
174 IF USRSLCT="ResolveDiff" DO RSLVDIFF(.ARRAY) GOTO CD1
175 IF USRSLCT="VPEDD" DO ^%ZVEMD GOTO CD1
176 IF USRSLCT="Done" SET %=1 GOTO CDDN1
177 IF USRSLCT="Abort" SET TMGABORT=1 GOTO CDDN2
178 ;
179CDDONE SET %=2
180 WRITE "Have all conflicts for this file been resolved (^ to abort)"
181 DO YN^DICN WRITE !
182CDDN1 IF %=1 SET ^TMG("TMGSIPH","DD",FILENUM,"DIFF")=1 ;"Signal that DD has been processed
183 ELSE IF %=-1 SET ^TMG("TMGSIPH","DD",FILENUM,"DIFF")=-1 ;"Signal of abort
184 ELSE SET ^TMG("TMGSIPH","DD",FILENUM,"DIFF")=0 ;"Signal that DD needs processing
185CDDN2 QUIT
186 ;
187 ;
188HASFLDMISS(ARRAY) ;
189 ;"Purpose: to determine if file has fields missing in local machine.
190 ;"Input -- ARRAY -- Pass by REFERENCE. As created by COMPDD
191 ;" ARRAY("MISSING NODE",NodeStr)=RemoteValue
192 ;" ARRAY("MISSING NODE",NodeStr)=RemoteValue
193 ;"Results: 1 if has missing fields, 0 if not
194 NEW MISFLDS
195 DO GETMISFLD(.ARRAY,.MISFLDS)
196 NEW FOUND SET FOUND=0
197 NEW FILENUM SET FILENUM=0
198 FOR SET FILENUM=$ORDER(MISFLDS(FILENUM)) QUIT:(FILENUM'>0)!FOUND DO
199 . NEW FLDNAME SET FLDNAME=""
200 . FOR SET FLDNAME=$ORDER(MISFLDS(FILENUM,FLDNAME)) QUIT:(FLDNAME="")!FOUND DO
201 . . SET FOUND=1
202 QUIT (FOUND=1)
203 ;
204 ;
205ADDFLDMISSING(ARRAY) ;
206 ;"Purpose: To allow user to pick filed to add to local data dictionary.
207 ;"Input -- ARRAY -- Pass by REFERENCE. As created by COMPDD
208 ;" ARRAY("MISSING NODE",NodeStr)=RemoteValue
209 ;" ARRAY("MISSING NODE",NodeStr)=RemoteValue
210 NEW MISFLDS
211 DO GETMISFLD(.ARRAY,.MISFLDS)
212 NEW ABORT SET ABORT=0
213 NEW FILENUM SET FILENUM=0
214 FOR SET FILENUM=$ORDER(MISFLDS(FILENUM)) QUIT:(FILENUM'>0)!ABORT DO
215 . NEW MENU,USRSLCT
216 . SET MENU(0)="Pick FIELD to add to local data dictionary, File #"_FILENUM
217 . NEW I SET I=1
218 . NEW FLDNAME SET FLDNAME=""
219 . FOR SET FLDNAME=$ORDER(MISFLDS(FILENUM,FLDNAME)) QUIT:(FLDNAME="") DO
220 . . NEW FLD SET FLD=$GET(MISFLDS(FILENUM,FLDNAME))
221 . . SET MENU(I)="Field "_FLDNAME_" ("_FLD_")"_$char(9)_FLD
222 . . SET I=I+1
223 . NEW DONE SET DONE=0
224 . FOR DO QUIT:DONE
225 . . IF $ORDER(MENU(0))="" SET DONE=1 QUIT
226 . . WRITE #
227 . . SET USRSLCT=$$MENU^TMGUSRIF(.MENU,"^")
228 . . IF USRSLCT="^" SET (DONE,ABORT)=1 QUIT
229 . . IF USRSLCT="" SET DONE=1 QUIT
230 . . IF +USRSLCT>0 IF $$ADD1FLD(FILENUM,+USRSLCT,.ARRAY) DO
231 . . . NEW J SET J=0
232 . . . FOR SET J=$ORDER(MENU(J)) QUIT:(J="") DO
233 . . . . IF MENU(J)[($CHAR(9)_+USRSLCT) KILL MENU(J)
234 QUIT
235 ;
236 ;
237ADD1FLD(FILENUM,FLD,ARRAY) ;
238 ;"Purpose: To add all the nodes for file (or subfile) field to local data dictionary.
239 ;"Input: FILENUM -- The Fileman file
240 ;" FLD -- The fieldman field to add
241 ;" ARRAY -- Pass by REFERENCE. As created by COMPDD
242 ;" ARRAY("MISSING NODE",NodeStr)=RemoteValue
243 ;" ARRAY("MISSING NODE",NodeStr)=RemoteValue
244 ;"Result: 1 if added, 0 if not
245 NEW RESULT SET RESULT=0
246 NEW REF SET REF=""
247 FOR SET REF=$ORDER(ARRAY("MISSING NODE",REF)) QUIT:(REF="") DO
248 . IF $QSUBSCRIPT(REF,0)'="^DD" QUIT
249 . IF $QSUBSCRIPT(REF,1)'=FILENUM QUIT
250 . NEW SUB2 SET SUB2=$QSUBSCRIPT(REF,2)
251 . NEW SUB3 SET SUB3=$QSUBSCRIPT(REF,3)
252 . NEW LASTSUB SET LASTSUB=$QSUBSCRIPT(REF,$QLENGTH(REF))
253 . NEW VALUE SET VALUE=$GET(ARRAY("MISSING NODE",REF))
254 . NEW ADD SET ADD=0
255 . IF (SUB2'=+SUB2),(LASTSUB=FLD) SET ADD=1 ;"Handle xrefs
256 . IF SUB2=FLD SET ADD=1
257 . IF FLD="*" SET ADD=1
258 . IF SUB2=0 DO
259 . . NEW SUB3 SET SUB3=$QSUBSCRIPT(REF,3)
260 . . IF (SUB3="ID"),(LASTSUB=FLD) SET ADD=1 ;"Write identifier nodes
261 . . IF (SUB3="IX"),(LASTSUB=FLD) SET ADD=1 ;"Indexes
262 . . IF (SUB3="PT"),(LASTSUB=FLD) SET ADD=1 ;"Pointers IN to file
263 . . ELSE DO
264 . . . NEW TEMP SET TEMP=1 ;"Breakpoint to see what is NOT being handled.
265 . IF ADD'=1 QUIT
266 . IF SUB3=0,SUB2>0 DO
267 . . NEW PT SET PT=+$PIECE(VALUE,"^",2)
268 . . NEW SUBREF SET SUBREF=$NAME(^DD(PT,0))
269 . . IF $DATA(ARRAY("MISSING NODE",SUBREF)) IF $$ADD1FLD(PT,"*",.ARRAY)
270 . SET @REF=VALUE
271 . WRITE "ADDED ",REF,!
272 . KILL ARRAY("MISSING NODE",REF)
273 . SET RESULT=1
274 WRITE !,"Done.",!
275 DO PressToCont^TMGUSRIF
276 QUIT RESULT
277 ;
278 ;
279VFLDMISSING(ARRAY) ;
280 ;"Purpose: to display fields missing in local machine.
281 ;"Input -- ARRAY -- Pass by REFERENCE. As created by COMPDD
282 ;" ARRAY("MISSING NODE",NodeStr)=RemoteValue
283 ;" ARRAY("MISSING NODE",NodeStr)=RemoteValue
284 NEW NAME,FOUND
285 WRITE "The following FIELDS are present on the remote VistA, but",!
286 WRITE "are missing from the local machine.",!,!
287 NEW MISFLDS
288 DO GETMISFLD(.ARRAY,.MISFLDS)
289 NEW FOUND SET FOUND=0
290 NEW ABORT SET ABORT=0
291 NEW FILENUM SET FILENUM=0
292 FOR SET FILENUM=$ORDER(MISFLDS(FILENUM)) QUIT:(FILENUM'>0)!ABORT DO
293 . NEW MENU,USRSLCT
294 . SET MENU(0)="Pick FIELD to examine in File #"_FILENUM
295 . NEW I SET I=1
296 . NEW FLDNAME SET FLDNAME=""
297 . FOR SET FLDNAME=$ORDER(MISFLDS(FILENUM,FLDNAME)) QUIT:(FLDNAME="") DO
298 . . NEW FLD SET FLD=$GET(MISFLDS(FILENUM,FLDNAME))
299 . . SET MENU(I)="Field "_FLDNAME_" ("_FLD_")"_$char(9)_FLD
300 . . SET I=I+1
301 . IF I>1 SET FOUND=1
302 . ELSE QUIT
303 . NEW DONE SET DONE=0
304 . FOR DO QUIT:DONE
305 . . WRITE #
306 . . SET USRSLCT=$$MENU^TMGUSRIF(.MENU,"^")
307 . . IF USRSLCT="^" SET (DONE,ABORT)=1 QUIT
308 . . IF USRSLCT="" SET DONE=1 QUIT
309 . . IF +USRSLCT>0 DO VIEW1FLDMISSING(FILENUM,+USRSLCT,.ARRAY)
310 IF FOUND=0 DO
311 . WRITE "<<None>>",!
312 . DO PressToCont^TMGUSRIF
313 QUIT
314 ;
315 ;
316GETMISFLD(ARRAY,MISFLDS) ;
317 ;"Purpose: to display fields missing in local machine.
318 ;"Input -- ARRAY -- Pass by REFERENCE. As created by COMPDD
319 ;" ARRAY("MISSING NODE",NodeStr)=RemoteValue
320 ;" ARRAY("MISSING NODE",NodeStr)=RemoteValue
321 ;" MISFLDS -- PASS BY REFERENCE, AN OUT PARAMETER. Format:
322 ;" MISFLDS(FILENUM,FIELDNAME)=FieldNumber
323 NEW REF,VALUE,FOUND
324 NEW FLD,LASTFLD SET LASTFLD=""
325 SET REF=""
326 FOR SET REF=$ORDER(ARRAY("MISSING NODE",REF)) QUIT:(REF="") DO
327 . IF $QSUBSCRIPT(REF,0)'="^DD" QUIT
328 . SET FLD=$QSUBSCRIPT(REF,2)
329 . QUIT:(FLD=LASTFLD)
330 . IF $QSUBSCRIPT(REF,3)'=0 QUIT
331 . SET LASTFLD=FLD
332 . NEW FILENUM SET FILENUM=$QSUBSCRIPT(REF,1)
333 . NEW FLDNAME SET FLDNAME=$PIECE($GET(ARRAY("MISSING NODE",REF)),"^",1)
334 . QUIT:(FLDNAME="")
335 . SET MISFLDS(FILENUM,FLDNAME)=FLD
336 QUIT
337 ;
338 ;
339VIEW1FLDMISSING(FILENUM,FLD,ARRAY) ;
340 ;"Purpose: To show the data for 1 field to be displayed.
341 ;"Input: FILENUM -- The Fileman file
342 ;" FLD -- The fieldman field to add
343 ;" ARRAY -- Pass by REFERENCE. As created by COMPDD
344 ;" ARRAY("MISSING NODE",NodeStr)=RemoteValue
345 ;" ARRAY("MISSING NODE",NodeStr)=RemoteValue
346 NEW LINECT SET LINECT=0
347 SET NAME="",FOUND=0
348 NEW REF SET REF=""
349 FOR SET REF=$ORDER(ARRAY("MISSING NODE",REF)) QUIT:(REF="") DO
350 . IF $QSUBSCRIPT(REF,0)'="^DD" QUIT
351 . IF $QSUBSCRIPT(REF,1)'=FILENUM QUIT
352 . NEW SUB2 SET SUB2=$QSUBSCRIPT(REF,2)
353 . NEW LASTSUB SET LASTSUB=$QSUBSCRIPT(REF,$QLENGTH(REF))
354 . NEW ADD SET ADD=0
355 . IF (SUB2'=+SUB2),(LASTSUB=FLD) SET ADD=1 ;"Handle xrefs
356 . IF SUB2=0 DO
357 . . NEW SUB3 SET SUB3=$QSUBSCRIPT(REF,3)
358 . . IF (SUB3="ID"),(LASTSUB=FLD) SET ADD=1 ;"Write identifier nodes
359 . . IF (SUB3="IX"),(LASTSUB=FLD) SET ADD=1 ;"Indexes
360 . . IF (SUB3="PT"),(LASTSUB=FLD) SET ADD=1 ;"Pointers IN to file
361 . IF SUB2=FLD SET ADD=1
362 . IF ADD'=1 QUIT
363 . WRITE REF,"=",$GET(ARRAY("MISSING NODE",REF)),!
364 . SET FOUND=1
365 . SET LINECT=LINECT+1
366 . IF LINECT=23 SET LINECT=0 DO PressToCont^TMGUSRIF
367 WRITE !,"Done.",!
368 IF FOUND=0 WRITE "<<NONE>>",!
369 DO PressToCont^TMGUSRIF
370 QUIT
371 ;
372 ;
373HASWMISSING(ARRAY) ;
374 ;"Purpose: to determine if there are any Nodes missing in local machine.
375 ;"Input -- ARRAY -- Pass by REFERENCE. As created by COMPDD
376 ;" ARRAY("MISSING NODE",NodeStr)=RemoteValue
377 ;" ARRAY("MISSING NODE",NodeStr)=RemoteValue
378 ;"Results: 1 if has data, 0 if not
379 NEW REF,VALUE,FOUND
380 NEW LINECT SET LINECT=0
381 SET REF="",FOUND=0
382 FOR SET REF=$ORDER(ARRAY("MISSING NODE",REF)) QUIT:(REF="") DO
383 . SET FOUND=1
384 QUIT (FOUND=1)
385 ;
386 ;
387VIEWMISSING(ARRAY) ;
388 ;"Purpose: to display Nodes missing in local machine.
389 ;"Input -- ARRAY -- Pass by REFERENCE. As created by COMPDD
390 ;" ARRAY("MISSING NODE",NodeStr)=RemoteValue
391 ;" ARRAY("MISSING NODE",NodeStr)=RemoteValue
392 NEW REF,VALUE,FOUND
393 WRITE "The following nodes are present on the remote VistA, but",!
394 WRITE "are missing from the local machine.",!,!
395 NEW LINECT SET LINECT=0
396 SET REF="",FOUND=0
397 FOR SET REF=$ORDER(ARRAY("MISSING NODE",REF)) QUIT:(REF="")!($GET(TMGPTCABORT)=1) DO
398 . SET FOUND=1
399 . WRITE REF,"=",$GET(ARRAY("MISSING NODE",REF)),!
400 . SET LINECT=LINECT+1
401 . IF LINECT=23 SET LINECT=0 DO PressToCont^TMGUSRIF
402 IF FOUND=0 WRITE "<<NONE>>",!
403 IF $GET(TMGPTCABORT)'=1 DO PressToCont^TMGUSRIF
404 QUIT
405 ;
406ADDMISSING(ARRAY) ;
407 ;"Purpose: To add remote changes into this machine, if wanted.
408 ;"Input -- ARRAY -- Pass by REFERENCE. As created by COMPDD
409 NEW ASKARRAY,SELARRAY
410 NEW REF SET REF=""
411 FOR SET REF=$ORDER(ARRAY("MISSING NODE",REF)) QUIT:(REF="") DO
412 . NEW VALUE SET VALUE=$GET(ARRAY("MISSING NODE",REF))
413 . SET VALUE=$EXTRACT(VALUE,1,70-$LENGTH(REF))
414 . SET ASKARRAY(REF_"="_VALUE)=REF
415 NEW HDR SET HDR="Pick Nodes to be added to local data dictionary. <ESC><ESC> when done."
416 DO Selector^TMGUSRIF("ASKARRAY","SELARRAY",HDR)
417 NEW TMGI SET TMGI=""
418 FOR SET TMGI=$ORDER(SELARRAY(TMGI)) QUIT:(TMGI="") DO
419 . SET REF=$GET(SELARRAY(TMGI))
420 . NEW VALUE SET VALUE=$GET(ARRAY("MISSING NODE",REF))
421 . SET @REF=VALUE
422 . WRITE "ADDED ",REF,!
423 . KILL ARRAY("MISSING NODE",REF)
424 WRITE !,"Done.",!
425 DO PressToCont^TMGUSRIF
426 QUIT
427 ;
428HASDIFF(ARRAY) ;
429 ;"Purpose: to determine if there are values that differ between remote and local VistA
430 ;"Input -- ARRAY -- Pass by REFERENCE. As created by COMPDD
431 ;" ARRAY("DIFF VALUE",NodeStr,"L")=LocalValue
432 ;" ARRAY("DIFF VALUE",NodeStr,"R")=RemoteValue
433 NEW REF,FOUND
434 SET REF="",FOUND=0
435 FOR SET REF=$ORDER(ARRAY("DIFF VALUE",REF)) QUIT:(REF="")!(FOUND) DO
436 . SET FOUND=1
437 QUIT (FOUND=1)
438 ;
439VIEWDIFF(ARRAY) ;
440 ;"Purpose: to display values that differ between remote and local VistA
441 ;"Input -- ARRAY -- Pass by REFERENCE. As created by COMPDD
442 ;" ARRAY("DIFF VALUE",NodeStr,"L")=LocalValue
443 ;" ARRAY("DIFF VALUE",NodeStr,"R")=RemoteValue
444 NEW REF,VALUE,FOUND
445 WRITE "The following nodes DIFFER between remote and local VistAs",!,!
446 SET REF="",FOUND=0
447 FOR SET REF=$ORDER(ARRAY("DIFF VALUE",REF)) QUIT:(REF="") DO
448 . SET FOUND=1
449 . WRITE REF,!
450 . WRITE " Local: ",$GET(ARRAY("DIFF VALUE",REF,"L")),!
451 . WRITE " Remote:",$GET(ARRAY("DIFF VALUE",REF,"R")),!
452 IF FOUND=0 WRITE "<<NONE>>",!
453 DO PressToCont^TMGUSRIF
454 QUIT
455 ;
456RSLVDIFF(ARRAY) ;
457 ;"Purpose: To allow storing values that differ between remote and local VistA
458 ;"Input -- ARRAY -- Pass by REFERENCE. As created by COMPDD
459 ;" ARRAY("DIFF VALUE",NodeStr,"L")=LocalValue
460 ;" ARRAY("DIFF VALUE",NodeStr,"R")=RemoteValue
461 NEW REF,VALUE,FOUND,%
462 WRITE "The following nodes DIFFER between remote and local VistAs",!,!
463 SET REF="",FOUND=0,%=2
464 FOR SET REF=$ORDER(ARRAY("DIFF VALUE",REF)) QUIT:(REF="")!(%=-1) DO
465 . SET FOUND=1
466 . WRITE REF,!
467 . WRITE " Local: ",$GET(ARRAY("DIFF VALUE",REF,"L")),!
468 . WRITE " Remote:",$GET(ARRAY("DIFF VALUE",REF,"R")),!
469 . SET %=2
470 . WRITE "Overwrite LOCAL value with REMOTE" DO YN^DICN WRITE !
471 . IF %=2 KILL ARRAY("DIFF VALUE",REF)
472 . IF %'=1 QUIT
473 . SET @REF=$GET(ARRAY("DIFF VALUE",REF,"R"))
474 . WRITE " OVERWRITTEN",!
475 . KILL ARRAY("DIFF VALUE",REF)
476 IF FOUND=0 WRITE "<<NONE>>",!
477 DO PressToCont^TMGUSRIF
478 QUIT
479 ;
480 ;
481SETPTOUT(FILENUM) ;
482 ;"Purpose: To set up an easy to use array of potential pointers out from a file.
483 ;"Input: FILENUM-- the filenumber to evaluate
484 ;"Output: Data will be stored in ^TMG("TMGSIPH","DD",FILENUM,"PTR OUT",ONEREF,ENTRY)
485 ;" ; Note: ENTRY=DataPiece^PointedToFile^PointedToReference^IENDepth^[V]
486 ;" ; ONEREF will have multipe IEN entries if IENDepth>1, e.g. '^SC(IEN,"S",IEN(2),1,IEN(3),"C")'
487 ;" ; with order of IEN, IEN(2), IEN(3), ... etc.
488 ;"Results: 1= success, -1=error
489 ;
490 NEW RESULT SET RESULT=-1
491 IF +$GET(FILENUM)'=FILENUM GOTO SPODN
492 NEW IENDEPTH SET IENDEPTH=1
493 NEW ISSUBFIL SET ISSUBFIL=0
494 NEW REF SET REF=$GET(^DIC(FILENUM,0,"GL"))
495 IF (REF=""),$DATA(^DD(FILENUM,0,"UP")) DO
496 . SET REF=$$GETGL^TMGFMUT2(FILENUM,.IENDEPTH)
497 . SET ISSUBFIL=1
498 IF REF="" GOTO SPODN
499 KILL ^TMG("TMGSIPH","DD",FILENUM,"PTR OUT") ;"If FILENUM is subfile, nothing to kill...
500 NEW FLD SET FLD=0
501 FOR SET FLD=$ORDER(^DD(FILENUM,FLD)) QUIT:(+FLD'>0) DO
502 . NEW ZNODE SET ZNODE=$GET(^DD(FILENUM,FLD,0))
503 . NEW FLDTYPE SET FLDTYPE=$PIECE(ZNODE,"^",2)
504 . IF (FLDTYPE'["P")&(FLDTYPE'["V")&(+FLDTYPE'>0) QUIT
505 . IF $PIECE($GET(^DD(+FLDTYPE,.01,0)),"^",2)["W" QUIT ;"WP fields look like subfiles, but really aren't
506 . NEW LOC SET LOC=$PIECE(ZNODE,"^",4)
507 . NEW NODE SET NODE=$PIECE(LOC,";",1)
508 . NEW PCE SET PCE=+$PIECE(LOC,";",2)
509 . IF +NODE'=NODE SET NODE=""""_NODE_""""
510 . NEW ONEREF,SUBSCR
511 . SET SUBSCR=$SELECT((IENDEPTH>1):"("_IENDEPTH_")",1:"")
512 . SET ONEREF=REF_"IEN"_SUBSCR_","_NODE_")"
513 . NEW P2FILE
514 . NEW VREC SET VREC=0
515 . NEW DONE SET DONE=0
516 . FOR DO QUIT:(DONE=1)
517 . . NEW ISVIRT SET ISVIRT=""
518 . . NEW P2REF
519 . . SET P2FILE=0
520 . . IF FLDTYPE["V" DO QUIT:(DONE=1)
521 . . . SET VREC=+$ORDER(^DD(FILENUM,FLD,"V",VREC))
522 . . . IF VREC=0 SET DONE=1 QUIT
523 . . . SET P2FILE=+$GET(^DD(FILENUM,FLD,"V",VREC,0))
524 . . . SET ISVIRT="V"
525 . . . SET P2REF=$PIECE($GET(^DIC(P2FILE,0,"GL")),"^",2)
526 . . ELSE DO QUIT:(P2FILE=0)
527 . . . IF +FLDTYPE>0 IF $$SETPTOUT(+FLDTYPE) SET DONE=1 QUIT ;"Handle subfile.
528 . . . SET P2FILE=+$PIECE(FLDTYPE,"P",2)
529 . . . SET P2REF=$PIECE(ZNODE,"^",3)
530 . . . SET DONE=1
531 . . NEW ENTRY SET ENTRY=PCE_"^"_P2FILE_"^"_P2REF_"^"_IENDEPTH_"^"_ISVIRT
532 . . SET ^TMG("TMGSIPH","DD",$$TOPFILEN^TMGFMUT2(FILENUM),"PTR OUT",ONEREF,ENTRY)=""
533 . . SET ^TMG("TMGSIPH","DD",FILENUM,"PTR OUT",ONEREF,ENTRY)="" ;"Not sure which is used throughout, so store both ways.
534 SET RESULT=1
535SPODN QUIT RESULT
536 ;
537SETALLPTO ;" Set All Pointers Out
538 ;"Purpose: To cycle through ALL files and call SETPTOUT for each file.
539 ;"Input: None
540 ;"Output: Data will be stored...
541 ;"Results: None
542 NEW FILENUM SET FILENUM=0
543 NEW STIME SET STIME=$H
544 NEW FILEMAXCT SET FILEMAXCT=0
545 FOR SET FILENUM=$ORDER(^DD(FILENUM)) QUIT:(+FILENUM'>0) SET FILEMAXCT=FILEMAXCT+1
546 NEW FILECT SET FILECT=0
547 SET FILENUM=0
548 FOR SET FILENUM=$ORDER(^DIC(FILENUM)) QUIT:(+FILENUM'>0) DO
549 . SET FILECT=FILECT+1
550 . NEW FILENAME SET FILENAME=$PIECE($GET(^DIC(FILENUM,0)),"^",1)
551 . DO ProgressBar^TMGUSRIF(FILECT,"Progress: "_FILENAME,0,FILEMAXCT,70,STIME)
552 . IF $DATA(^TMG("TMGSIPH","DD",FILENUM,"PTR OUT")) QUIT
553 . IF $$SETPTOUT(FILENUM) ;"ignore result
554 ;"Now handle subfiles.
555 SET FILENUM=0
556 FOR SET FILENUM=$ORDER(^DD(FILENUM)) QUIT:(+FILENUM'>0) DO
557 . SET FILECT=FILECT+1
558 . DO ProgressBar^TMGUSRIF(FILECT,"Progress: "_FILENUM,0,FILEMAXCT,70,STIME)
559 . IF $DATA(^DIC(FILENUM)) QUIT
560 . IF $$SETPTOUT(FILENUM) ;"ignore result
561 WRITE !,FILECT," Files processed.",!
562 DO PressToCont^TMGUSRIF
563 QUIT
564 ;
565REAL1PTOUT(FILENUM,IEN,TALLY) ;
566 ;"Purpose: to compare 1 record in the specified file that has been downloaded from the
567 ;" server, but not yet processed, and look for actual pointers out.
568 ;" If pointers out refer to records already gotten from server, then pointer is
569 ;" fixed immediately. Otherwise pointer is added to list of fixes needed.
570 ;"Input: FILENUM -- the Fileman file (or subfile) number to look at
571 ;" IEN -- The record number to look at.
572 ;" If FILENUM is a subfile, pass IENS info in IEN (e.g. '3,2345,')
573 ;" TALLY -- OPTIONAL. PASS BY REFERENCE. An array to keep progress stats. Format:
574 ;" TALLY("ALREADY LOCAL FOUND")=#
575 ;" TALLY("FIXED LINK TO ALREADY-DOWNLOADED RECORD")=#
576 ;" TALLY(FILENUM,"NEW REC NEEDED")=#
577 ;"Output: Sets global records to show unresolved pointers:
578 ;" ^TMG("TMGSIPH","NEEDED RECORDS","PTOUT",FILENUM,RemotePointer,ReferToNodeToBeCorrected,INFO)=""
579 ;" INFO=DataPiece^PointedToFile^PointedToReference^IENDepth^[V]
580 ;"Result: 1 = OK, -1 = error
581 ;"NOTE:
582 ;" Uses data from ^TMG("TMGSIPH","DD",FILENUM,"PTR OUT",ONEREF,ENTRY)
583 ;" ENTRY=DataPiece^PointedToFile^PointedToReference^IENDepth^[V]
584 ;" ONEREF will have multipe IEN entries if IENDepth>1, e.g. '^SC(IEN,"S",IEN(2),1,IEN(3),"C")'
585 ;" with order of IEN, IEN(2), IEN(3), ... etc.
586 ;
587 NEW RESULT SET RESULT=-1
588 SET FILENUM=+$GET(FILENUM)
589 IF FILENUM'>0 GOTO RP1ODN
590 IF $DATA(^TMG("TMGSIPH","DOWNLOADED",FILENUM,IEN)) DO GOTO RP1ODN ;"Already processed
591 . SET RESULT=1
592 . SET TALLY("ALREADY LOCAL FOUND")=+$GET(TALLY("ALREADY LOCAL FOUND"))+1
593 IF +$GET(^TMG("TMGSIPH","DD",FILENUM))=0 DO
594 . IF $$SETPTOUT(FILENUM) SET ^TMG("TMGSIPH","DD",FILENUM)=1
595 NEW SAVIENS SET SAVIENS=IEN
596 NEW REF SET REF=""
597 FOR SET REF=$ORDER(^TMG("TMGSIPH","DD",FILENUM,"PTR OUT",REF)) QUIT:(REF="") DO
598 . NEW INFO SET INFO=""
599 . FOR SET INFO=$ORDER(^TMG("TMGSIPH","DD",FILENUM,"PTR OUT",REF,INFO)) QUIT:(INFO="") DO
600 . . NEW PCE SET PCE=+INFO
601 . . NEW P2FILE SET P2FILE=$PIECE(INFO,"^",2)
602 . . NEW P2REF SET P2REF=$PIECE(INFO,"^",3)
603 . . NEW IENDEPTH SET IENDEPTH=$PIECE(INFO,"^",4)
604 . . NEW ISVIRT SET ISVIRT=($PIECE(INFO,"^",5)="V")
605 . . NEW TEMP SET TEMP=+IEN KILL IEN SET IEN=TEMP ;"kill subnodes. Prob won't work with sub-sub files.
606 . . NEW OKCOMBO
607 . . FOR DO QUIT:(OKCOMBO=0)
608 . . . SET OKCOMBO=$$IENCOMBO^TMGFMUT2(REF,IENDEPTH,.IEN) ;"Sets up IEN(n).. needed for @REF
609 . . . QUIT:(OKCOMBO=0)
610 . . . NEW RPTR SET RPTR=$PIECE($GET(@REF),"^",PCE)
611 . . . IF ISVIRT,$PIECE(RPTR,";",2)'=P2REF QUIT ;"Loop to handle PTR with different INFO entry (V-Ptrs stored as IEN;OREF)
612 . . . SET RPTR=+RPTR QUIT:(RPTR'>0)
613 . . . NEW LPTR SET LPTR=+$GET(^TMG("TMGSIPH","PT XLAT",P2FILE,RPTR))
614 . . . IF (LPTR>0) DO QUIT
615 . . . . IF LPTR'=RPTR SET $PIECE(@REF,"^",PCE)=LPTR
616 . . . . SET TALLY("FIXED LINK TO ALREADY-DOWNLOADED RECORD")=1+$GET(TALLY("FIXED LINK TO ALREADY-DOWNLOADED RECORD"))
617 . . . ;"SET ^TMG("TMGSIPH","UNRESOLVED",FILENUM,$NAME(@REF),INFO)=RPTR
618 . . . SET ^TMG("TMGSIPH","NEEDED RECORDS","PTOUT",P2FILE,RPTR,$NAME(@REF),INFO)=""
619 . . . SET TALLY(FILENUM,"NEW REC NEEDED")=+$GET(TALLY(FILENUM,"NEW REC NEEDED"))+1
620 . . KILL IEN("DONE"),IEN("INIT")
621 SET RESULT=1
622RP1ODN QUIT RESULT
623 ;
624 ;
625REALPTOUT(FILENUM) ;" DEPRECIATED
626 ;"Purpose: to compare all records in the specified file and look for actual pointers out.
627 ;"Input: FILENUM -- the Fileman file number to look at
628 ;"Result: 1 = OK, -1 = error
629 ;
630 NEW RESULT SET RESULT=-1
631 IF +$GET(FILENUM)'=FILENUM GOTO RPODN
632 NEW REF SET REF=$GET(^DIC(FILENUM,0,"GL"))
633 NEW CREF SET CREF=$$CREF^DILF(REF)
634 IF REF="" GOTO RPODN
635 ;"KILL ^TMG("TMGSIPH","UNRESOLVED",FILENUM)
636 NEW STARTTIME SET STARTTIME=$H
637 NEW MAXNUM SET MAXNUM=$ORDER(@(REF_"""A"")"),-1)
638 WRITE MAXNUM," records to check for unresolved pointers in file #",FILENUM,!
639 WRITE "Press ESC to abort...",!
640 NEW IEN SET IEN=0
641 NEW TMGABORT SET TMGABORT=0
642 FOR SET IEN=$ORDER(@CREF@(IEN)) QUIT:(+IEN'>0)!(TMGABORT=1) DO
643 . SET TMGABORT=$$UserAborted^TMGUSRIF() QUIT:(TMGABORT=1)
644 . NEW TEMP SET TEMP=$$REAL1PTOUT(FILENUM,IEN)
645 . IF (IEN#10)=0 DO
646 . . DO ProgressBar^TMGUSRIF(IEN,"Progress: "_IEN,0,MAXNUM,70,STARTTIME)
647 SET RESULT=1
648RPODN QUIT RESULT
649 ;
650 ;
651PREPXREF(JNUM,FILENUM) ;
652 ;"Purpose: To ask the server to pepair organized cross references.
653 ;"Input: JNUM -- The job number of the background client process
654 ;" FILENUM -- The Fileman file to transfer
655 ;"Results: 1 if OK, 0 if error.
656 NEW REPLY,ERROR,RESULT
657 SET RESULT=1
658 SET QUERY="PREP XREFS|"_FILENUM_"^1"
659 DO MSGCLIENT^TMGKERN2(JNUM,QUERY,.REPLY,.ERROR,15) ;"ignore REPLY
660 IF $DATA(ERROR) DO
661 . WRITE ERROR,!
662 . SET RESULT=0
663 QUIT RESULT
Note: See TracBrowser for help on using the repository browser.