source: cprs/branches/tmg-cprs/m_files/TMGSIPH3.m@ 1536

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

replacing soft links with actual files

File size: 36.6 KB
Line 
1TMGSIPH3 ;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 ;"Support functions for transferring files from server
6 ;"Kevin Toppenberg MD
7 ;"GNU General Public License (GPL) applies
8 ;"11/27/09
9 ;
10 ;"=======================================================================
11 ;" API -- Public Functions.
12 ;"=======================================================================
13 ;"TRANSFILE(JNUM) -- move a remote file to local machine, overwriting local entries.
14 ;"GET01FLD(JNUM,FILENUM,IEN) -Get .01 field (internal format) from server.
15 ;"TRANS1FIL(JNUM,FILENUM) -move a remote file to local machine, overwriting local entries.
16 ;"QRYSERVER(JNUM) -- display a given reference from the server
17 ;"TRANSREF(JUNUM) -- move an absolute reference from server to local
18 ;"ASKNEEDED(JNUM,OUTARRAY,INOUT,OPTIONS) --review records of needed records, and
19 ;" ask user which file, or
20 ;" which records to get, and return results of selected in array.
21 ;" This can handle either the list of needed pointers IN or OUT.
22 ;"NUMNEEDED(JNUM,INOUT) -- count number of records needed from server.
23 ;"CHCK4SIM(FILENUM,ARRAY,ANIEN,VALUE01,IENS) -- look at an array and see if there is similar record already on the client.
24 ;"XTRACT01FLD(ARRAY) ; --remove .01 Field values from array returned from GET RECORD & XREF, and store
25 ;"GETANDFIXREC(JNUM,FILENUM,IEN,OVERWRITE,TALLY,INOUT) -- request a record from server, and integrate into local vista,
26 ;" resolving pointers locally to point to newly downloaded record.
27 ;"HANDLNEEDED(JNUM,INOUT,AUTOMODE) --Ask user which records to get from server, then get them and update
28 ;" pointer translation table.
29
30 ;"=======================================================================
31 ;"Dependancies
32 ;"=======================================================================
33 ;"TMGUSRIF, XLFSTR
34 ;"=======================================================================
35 ;
36 ;
37TRANSFILE(JNUM)
38 ;"Purpose: to move a remote file to local machine, overwriting local entries.
39 ;"Input: JNUM -- The job number of the background client process
40 ;"Results: none
41 NEW X,Y,DIC,ARRAY,%
42 SET DIC=1,DIC(0)="MAEQ"
43TF1 WRITE "Pick file to transfer COMPLETELY, or to resume transfer from",!
44 DO ^DIC WRITE !
45 IF +Y'>0 DO QUIT:(+Y'>0)!(%=-1)
46 . SET %=1
47 . WRITE "File not found on this client. Do you want to select a file",!
48 . WRITE "to transfer from the server" DO YN^DICN WRITE !
49 . QUIT:(%'=1)
50 . WRITE "Pick file ON SERVER to transfer COMPLETELY: "
51 . READ Y,!
52 . IF Y["^" QUIT
53 . NEW QUERY,REPLY,ERROR,RESULT
54 . SET QUERY="DO DIC|1^"_Y
55 . DO MSGCLIENT^TMGKERN2(JNUM,QUERY,.REPLY,.ERROR,30)
56 . IF $DATA(ERROR) WRITE ERROR,! SET Y=0 QUIT
57 . SET Y=$GET(REPLY(1))
58 . IF +Y>0 SET ^TMG("TMGSIPH","DD",+Y,"DIFF")=0
59 FOR DO QUIT:(DDOK'=0)
60 . SET DDOK=$$PREPDD^TMGSIPH1(JNUM,+Y)
61 . QUIT:(DDOK=1)
62 . WRITE "Before records can be transferred from the server, the local data",!
63 . WRITE "dictionary must be made compatible. Must work on this now.",!
64 . DO PressToCont^TMGUSRIF
65 . SET DDOK=+$GET(^TMG("TMGSIPH","DD",+Y,"DIFF"))
66 GOTO TF1:(DDOK'=1)
67 DO TRANS1FIL(JNUM,+Y)
68 GOTO TF1
69 ;
70 ;
71GET01FLD(JNUM,FILENUM,IEN) ;
72 ;"Purpose: Get .01 field (internal format) from server, or return previously obtained value.
73 ;"Input: JNUM -- The job number of the background client process
74 ;" FILENUM -- The file number to compare.
75 ;" IEN -- the record to query -- Server-side IEN, not client IEN
76 ;"Result: returns the .01 value or "" if problem
77 SET RESULT=$GET(^TMG("TMGSIPH",".01 VALUE",FILENUM,IEN))
78 IF RESULT'="" GOTO G1DN
79 NEW QUERY,REPLY,ERROR,RESULT
80 SET QUERY="GET .01 FLD|"_FILENUM_"^"_IEN
81 DO MSGCLIENT^TMGKERN2(JNUM,QUERY,.REPLY,.ERROR,30)
82 IF $DATA(ERROR) WRITE ERROR,!
83 SET RESULT=$GET(REPLY(1))
84 SET ^TMG("TMGSIPH",".01 VALUE",FILENUM,IEN)=RESULT
85G1DN QUIT RESULT
86 ;
87 ;
88TRANS1FIL(JNUM,FILENUM) ;
89 ;"Purpose: to move a remote file to local machine, overwriting local entries.
90 ;"Input: JNUM -- The job number of the background client process
91 ;" FILENUM -- The file number to transfer. (Not a subfile)
92 ;"Output: Will set output globals:
93 ;" ^TMG("TMGSIPH","PT XLAT",FILENUM,RemoteIEN)=LocalIEN
94 ;" ^TMG("TMGSIPH","NEEDED RECORDS","PTOUT",FILENUM,RemotePointer,ReferToNodeToBeCorrected,Piece#OfNode)=""
95 ;"Results: none
96 ;
97 NEW MAXNUM
98 NEW QUERY,ERROR,RESULT,REPLY
99 SET QUERY="NUMRECS|"_FILENUM
100 DO MSGCLIENT^TMGKERN2(JNUM,QUERY,.REPLY,.ERROR,15)
101 IF $DATA(ERROR) WRITE ERROR,! GOTO T1FD
102 SET MAXNUM=+$GET(REPLY(1))
103 IF MAXNUM'>0 DO GOTO T1FD
104 . WRITE "Error: number of records=",MAXNUM,!
105 NEW STARTTIME SET STARTTIME=$H
106 NEW GLREF SET GLREF=$GET(^DIC(FILENUM,0,"GL"))
107 NEW REF SET REF=$GET(^TMG("TMGSIPH","DOWNLOADED",FILENUM,"#PRIOR RUN#"))
108 NEW % SET %=1 ;"Default=Y
109 IF REF'="" DO
110 . WRITE "Continue transfer of records from point of last run"
111 . DO YN^DICN WRITE !
112 . IF %=2 SET REF=""
113 IF %=-1 GOTO T1FD
114 IF REF="" SET REF=$$CREF^DILF(GLREF_""""",")
115 SET GLREF=$$CREF^DILF(GLREF)
116 NEW QL SET QL=$QLENGTH(REF)
117 WRITE "Press ESC to abort...",!
118 NEW REC SET REC=""
119 NEW TMGABORT
120 FOR DO QUIT:(REF="")!(TMGABORT=1)
121 . SET TMGABORT=$$UserAborted^TMGUSRIF() QUIT:(TMGABORT=1)
122 . SET QUERY="ORDREF|"_REF
123 . DO MSGCLIENT^TMGKERN2(JNUM,QUERY,.REPLY,.ERROR,30)
124 . IF $DATA(ERROR) DO QUIT
125 . . WRITE ERROR,!
126 . . SET REF=""
127 . IF $DATA(REPLY)=0 SET REF="" QUIT
128 . DO STOREDATA^TMGSIPHU(.REPLY)
129 . SET ^TMG("TMGSIPH","DOWNLOADED",FILENUM,"#PRIOR RUN#")=REF
130 . SET REF=$GET(REPLY(1)) QUIT:(REF="")
131 . SET REF=$EXTRACT(REF,1,$LENGTH(REF)-1)
132 . SET REF=$$QSUBS^TMGSIPHU(REF,QL)
133 . IF $QSUBSCRIPT(REF,QL)=REC do
134 . . write "ERROR: Record number didn't increase!",!
135 . SET REC=$QSUBSCRIPT(REF,QL)
136 . IF (+REC=REC) DO
137 . . IF $$REAL1PTOUT^TMGSIPH1(FILENUM,REC) ;"Ignore function result
138 . . SET ^TMG("TMGSIPH","PT XLAT",FILENUM,REC)=REC ;"remote and local IEN's are same
139 . . SET ^TMG("TMGSIPH","DOWNLOADED",FILENUM,REC)=REC
140 . IF (REC#10)=0 DO
141 . . DO ProgressBar^TMGUSRIF(REC,"Progress: "_REC,0,MAXNUM,70,STARTTIME)
142T1FD QUIT
143 ;
144 ;
145QRYSERVER(JNUM) ;
146 ;"Purpose: To display a given reference from the server
147 ;"Input: JNUM -- The job number of the background client process
148 SET JNUM=+$GET(JNUM)
149 QUIT:(+JNUM'>0)
150 NEW QUERY,ERROR,RESULT,REPLY
151 FOR DO quit:(QUERY="^")
152 . READ "Enter reference> ",QUERY,!
153 . IF (QUERY="")!(QUERY="^") SET QUERY="^" QUIT
154 . ELSE SET QUERY="GET|"_QUERY
155 . DO MSGCLIENT^TMGKERN2(JNUM,QUERY,.REPLY,.ERROR,5)
156 . IF $DATA(ERROR) WRITE ERROR,!
157 . IF $DATA(REPLY) do
158 . . WRITE "reply:",!
159 . . ZWR REPLY
160 quit
161 ;
162 ;
163TRANSREF(JNUM) ;
164 ;"Purpose: To move an absolute reference from server to local
165 SET JNUM=+$GET(JNUM)
166 QUIT:(+JNUM'>0)
167 WRITE "This will allow an arbitrary global to be transferred",!
168 write "from the server.",!
169 NEW REF,QUERY,ERROR,RESULT,REPLY,%
170 FOR DO QUIT:(REF="^")
171 . READ "Enter reference (e.g. ""^ABC(123,"" or ^ to quit)> ",REF,!
172 . IF (REF="")!(REF="^") SET REF="^" QUIT
173 . SET REF=$$CREF^DILF(REF)
174 . SET QUERY="GET|"_REF
175 . DO MSGCLIENT^TMGKERN2(JNUM,QUERY,.REPLY,.ERROR,5)
176 . IF $DATA(ERROR) WRITE ERROR,! QUIT
177 . IF $DATA(REPLY) ZWR REPLY WRITE !
178 . SET %=1
179 . IF $DATA(@REF) DO QUIT:(%'=1)
180 . . WRITE "WARNING: There is already data locally at ",REF,!
181 . . WRITE "Do you want to OVERWRITE this local data"
182 . . SET %=2
183 . . DO YN^DICN WRITE !
184 . DO STOREDATA^TMGSIPHU(.REPLY)
185 . WRITE "Data stored locally.",!,!
186 . KILL REPLY
187 quit
188
189
190
191
192ASKNEEDED(JNUM,OUTARRAY,INOUT,OPTIONS) ;
193 ;"Purpose: To review records of needed records, and ask user which file, or
194 ;" which records to get, and return results of selected in array.
195 ;" This can handle either the list of needed pointers IN or OUT.
196 ;"Input: JNUM -- The job number of the background client process
197 ;" OUTARRAY -- PASS BY REFERNCE, an OUT PARAMETER. Filled as follows
198 ;" OUTARRAY(FileNum,RecordNum)=""
199 ;" INOUT -- OPTIONAL -- Default is "PTOUT". Should be "PTIN" or "PTOUT"
200 ;" OPTIONS -- OPTIONAL default is 0. See SELNEEDED for details.
201 ;"Results: None.
202 ;"NOTE: uses ^TMG("TMGSIPH","NEEDED RECORDS","PTOUT",FILENUM,RemotePointer,RefToNodeToBeCorrected,Piece#OfNode)=""
203 ;" ^TMG("TMGSIPH","NEEDED RECORDS","PTIN",FILENUM,IEN)=""
204 ;
205 NEW REF SET REF=$NAME(^TMG("TMGSIPH","NEEDED RECORDS",INOUT))
206 DO SELNEEDED(JNUM,.OUTARRAY,REF,.OPTIONS)
207 QUIT
208 ;
209 ;
210SELNEEDED(JNUM,OUTARRAY,REF,OPTIONS) ;
211 ;"Purpose: To review an array of needed records, and ask user which file, or
212 ;" which records to get, and return results of selected in array.
213 ;"Input: JNUM -- The job number of the background client process
214 ;" OUTARRAY -- PASS BY REFERNCE, an OUT PARAMETER. Filled as follows
215 ;" OUTARRAY(FileNum,RecordNum)=""
216 ;" REF -- PASS BY NAME -- The name of the variable holding the records to ask from. Variable
217 ;" array should have this format:
218 ;" @REF@(FILENUM,RPTR)=""
219 ;" @REF@(FILENUM,RPTR)=""
220 ;" OPTIONS -- OPTIONAL default is 0. If 1, then all records are processed without asking.
221 ;" OPTIONS("MAP MODE")=1 OPTIONAL, if exists, then different header is displayed
222 ;" OPTIONS("NUMNEEDED")=1 OPTIONAL, if exists, will only get up to 200 records
223 ;" OPTIONS("HEADER")=<header text> OPTIONAL. If present, will be used for header display
224 ;"Results: None.
225 NEW TMGARRAY,TMGSEL,TMGSEL2
226 KILL OUTARRAY
227 SET INOUT=$GET(INOUT) IF INOUT'="PTIN" SET INOUT="PTOUT"
228 NEW FILENUM SET FILENUM=""
229 NEW AUTOMODE SET AUTOMODE=(+$GET(OPTIONS)=1)
230 FOR SET FILENUM=$ORDER(@REF@(FILENUM)) QUIT:(+FILENUM'>0) DO
231 . NEW DISPSTR SET DISPSTR="Get records from REMOTE file #"_FILENUM_" ("
232 . SET DISPSTR=DISPSTR_$$FILENAME^TMGFMUT2(FILENUM)_")"
233 . SET TMGARRAY(DISPSTR)=FILENUM
234 NEW STIME SET STIME=$H
235 NEW SHOWPROG SET SHOWPROG=0
236 NEW TMGCT SET TMGCT=0
237 NEW TMGDONE SET TMGDONE=0
238 NEW SHORTLST SET SHORTLST=+$GET(OPTIONS("NUMNEEDED"))
239 NEW HEADER
240 IF $DATA(OPTIONS("HEADER")) DO
241 . SET HEADER=$GET(OPTIONS("HEADER"))
242 ELSE DO
243 . IF $GET(OPTIONS("MAP MODE"))=1 DO
244 . . SET HEADER="Select File(s) to MAP to local records in. Press <ESC><ESC> when Done."
245 . ELSE SET HEADER="Select File(s) to get REMOTE records from. Press <ESC><ESC> when Done."
246 IF AUTOMODE MERGE TMGSEL=TMGARRAY
247 ELSE DO Selector^TMGUSRIF("TMGARRAY","TMGSEL",HEADER)
248 NEW TMGABORT SET TMGABORT=0
249 NEW IDX SET IDX=""
250 FOR SET IDX=$ORDER(TMGSEL(IDX)) QUIT:(IDX="")!TMGABORT!TMGDONE DO
251 . SET FILENUM=$GET(TMGSEL(IDX)) QUIT:FILENUM=""
252 . NEW FNAME SET FNAME=$$FILENAME^TMGFMUT2(FILENUM)
253 . NEW RPTR SET RPTR=""
254 . KILL TMGARRAY,TMGSEL2
255 . NEW RECCT SET RECCT=0
256 . NEW SELALL SET SELALL=0
257 . NEW ASKED SET ASKED=0
258 . IF AUTOMODE=0 WRITE "GETTING NAMES OF RECORDS...",!
259 . FOR SET RPTR=$ORDER(@REF@(FILENUM,RPTR)) QUIT:(RPTR="")!SELALL!TMGABORT!TMGDONE DO
260 . . NEW DISPSTR SET DISPSTR="File: "_FNAME_", record #"_$$RJ^XLFSTR(RPTR,6)
261 . . IF AUTOMODE=0 SET DISPSTR=DISPSTR_" -- "_$$GET01FLD(JNUM,FILENUM,RPTR)
262 . . SET TMGARRAY(DISPSTR)=RPTR
263 . . SET RECCT=RECCT+1
264 . . SET TMGCT=TMGCT+1
265 . . IF (SHOWPROG=0),($$HDIFF^XLFDT($H,STIME,2)>10) DO ;"Turn on progress bar after 10 seconds.
266 . . . SET SHOWPROG=1
267 . . IF (SHOWPROG=1),(TMGCT>500) DO
268 . . . DO ProgressBar^TMGUSRIF(100,"Gathering list of needed records "_RECCT,-1,-1,70,STIME)
269 . . . SET TMGCT=0
270 . . IF (RECCT>200),(ASKED=0) DO
271 . . . IF SHORTLST SET TMGDONE=1,RECCT=0 QUIT
272 . . . SET ASKED=1
273 . . . IF AUTOMODE=1 QUIT
274 . . . NEW MENU,USRSLCT
275 . . . SET MENU(0)="File "_FNAME_" has > 200 records."
276 . . . SET MENU(1)="Automatically Select ALL records"_$char(9)_"AutoSelALL"
277 . . . SET MENU(2)="Show LONG list to allow picking individual records"_$char(9)_"SelectList"
278 . . . NEW DONE SET DONE=0
279 . . . FOR DO QUIT:(DONE=1)!(TMGABORT)
280 . . . . WRITE #
281 . . . . SET USRSLCT=$$MENU^TMGUSRIF(.MENU,"^")
282 . . . . SET DONE=1
283 . . . . IF USRSLCT="^" SET TMGABORT=1 QUIT
284 . . . . IF USRSLCT="AutoSelALL" SET SELALL=1 QUIT
285 . . . . IF USRSLCT="SelectList" QUIT
286 . . . . ELSE SET DONE=0
287 . IF TMGABORT QUIT
288 . IF (RECCT=1)!AUTOMODE!SELALL DO
289 . . NEW TMGSKIP SET TMGSKIP=0
290 . . SET TMGCT=0
291 . . NEW ONEREC SET ONEREC=""
292 . . FOR SET ONEREC=$ORDER(@REF@(FILENUM,ONEREC)) QUIT:(ONEREC="")!TMGSKIP DO
293 . . . SET TMGSEL2(ONEREC)=ONEREC
294 . . . IF SHORTLST,(TMGCT>200) SET TMGSKIP=1,TMGDONE=1 QUIT
295 . . . SET TMGCT=TMGCT+1
296 . . . SET RECCT=RECCT+1
297 . . . IF (SHOWPROG=0),($$HDIFF^XLFDT($H,STIME,2)>10) DO ;"Turn on progress bar after 10 seconds.
298 . . . . SET SHOWPROG=1
299 . . . IF (SHOWPROG=1),(TMGCT>500) DO
300 . . . . DO ProgressBar^TMGUSRIF(100,"Gathering list of needed records "_RECCT,0,100,70,STIME)
301 . . . . SET TMGCT=0
302 . . SET SELALL=1
303 . IF SELALL=0 DO
304 . . IF $GET(OPTIONS("MAP MODE"))=1 DO
305 . . . SET HEADER="Select records to MAP to local records. Press <ESC><ESC> when Done."
306 . . ELSE SET HEADER="Select records to get from Server. Press <ESC><ESC> when Done."
307 . . DO Selector^TMGUSRIF("TMGARRAY","TMGSEL2",HEADER)
308 . NEW I2 SET I2=""
309 . FOR SET I2=$ORDER(TMGSEL2(I2)) QUIT:(I2="") DO
310 . . SET RPTR=$GET(TMGSEL2(I2))
311 . . SET OUTARRAY(FILENUM,RPTR)=""
312 ;
313 QUIT
314 ;
315 ;
316NUMNEEDED(JNUM,INOUT)
317 ;"Purpose: To count number of records needed from server.
318 ;"Input: JNUM -- The job number of the background client process
319 ;" INOUT -- OPTIONAL -- Default is "PTOUT". Should be "PTIN" or "PTOUT"
320 ;"Output: Returns the number of records needed.
321 ;"
322 NEW GETARRAY,FILENUM,RESULT
323 SET INOUT=$GET(INOUT) IF INOUT'="PTIN" SET INOUT="PTOUT"
324 NEW MODE SET MODE=1,MODE("NUMNEEDED")=1 ;"Will limit number counting to 200 mg
325 DO ASKNEEDED(JNUM,.GETARRAY,INOUT,.MODE)
326 SET FILENUM=0
327 SET RESULT=0
328 NEW TMGCT SET TMGCT=0
329 NEW STIME SET STIME=$H
330 NEW SHOWPROG SET SHOWPROG=0
331 FOR SET FILENUM=$ORDER(GETARRAY(FILENUM)) QUIT:(FILENUM="") DO
332 . NEW IEN SET IEN=""
333 . FOR SET IEN=$ORDER(GETARRAY(FILENUM,IEN),-1) QUIT:(IEN="") DO
334 . . SET RESULT=RESULT+1
335 . . SET TMGCT=TMGCT+1
336 . . IF (SHOWPROG=0),($$HDIFF^XLFDT($H,STIME,2)>5) DO ;"Turn on progress bar after 5 seconds.
337 . . . SET SHOWPROG=1
338 . . IF (SHOWPROG=1),(TMGCT>1000) DO
339 . . . DO ProgressBar^TMGUSRIF(100,"Counting records: "_TMGCT,0,100,70)
340 . . . SET TMGCT=0
341 IF TMGCT>200 SET TMGCT=TMGCT_"+"
342 QUIT TMGCT
343 ;
344 ;
345CHCK4SIM(FILENUM,ARRAY,ANIEN,VALUE01,IENS)
346 ;"Purpose: To look at an array, as returned from server, and see if there is
347 ;" a similar record already on the client.
348 ;"Input: FILENUM -- the fileman filenumber of file to get from remote server
349 ;" ARRAY -- The global record array, as returned from server.
350 ;" ANIEN -- PASS BY REFERENCE. Will be filled with IEN match
351 ;" If IENS is passed (i.e. if dealing with a subfile), then ANIEN is passed
352 ;" back in standard IENS format (e.g. '7,1234,')
353 ;" VALUE01 -- OPTIONAL. This allows a .01 value to be passed. If provided, then
354 ;" the ARRAY won't be searched for a .01 value.
355 ;" IENS -- OPTIONAL. If FILENUM is a subfile, then IENS is needed for lookup.
356 ;" IENS is modified, so **DON'T** PASS BY REFERENCE
357 ;"Results: 0 if no similar record already on the local server (i.e. NO MATCH)
358 ;" 1 if a match WAS found.
359 ;"Output: ANIEN is modified.
360 ;"NOTE: If .01 field of passed record array matches to 2 or more records, then NO MATCH resulted
361 ;" Also, if file does not have a "B" cross reference, then NO MATCH resulted.
362 ;" Also, the first 30 characters (only) are tested for match in "B" xref.
363 ;
364 NEW RESULT SET RESULT=0
365 SET ANIEN=0
366 SET FILENUM=+$GET(FILENUM) ;" If in format of 'SubFile{ParentFile', then strip off parent filenum.
367 NEW GREF SET GREF=$$GETGREF^TMGFMUT2(FILENUM,.IENS) ;"IENS not used if not subfile.
368 IF GREF="" GOTO C4SDN
369 NEW BREF SET BREF=GREF_"""B"")"
370 NEW SAVIENS SET SAVIENS=$GET(IENS)
371 SET $PIECE(IENS,",",1)="" ;"e.g. '7,2345,' --> ',2345,' to specify parent, but no particular subfile entry
372 IF $DATA(@BREF)=0 GOTO C4SDN
373 NEW CGREF SET CGREF=$$CREF^DILF(GREF)
374 NEW GREFLEN SET GREFLEN=$QLENGTH(CGREF)
375 NEW VALUE SET VALUE=$GET(VALUE01)
376 NEW TMGI SET TMGI=0
377 FOR SET TMGI=$ORDER(ARRAY(TMGI)) QUIT:(TMGI="")!(VALUE'="") DO ;"Find .01 value
378 . NEW REF SET REF=$GET(ARRAY(TMGI))
379 . SET REF=$EXTRACT(REF,1,$LENGTH(REF)-1)
380 . SET TMGI=TMGI+1
381 . IF REF="" SET TMGI="" QUIT
382 . IF $QSUBSCRIPT(REF,GREFLEN+2)'=0 QUIT ;"Only check 0 node.
383 . IF $QLENGTH(REF)'=(GREFLEN+2) QUIT ;"Only allow ^GREF(xxx,xxx,IEN,0)
384 . SET VALUE=$EXTRACT($GET(ARRAY(TMGI)),2,10000)
385 . SET VALUE=$PIECE(VALUE,"^",1)
386 IF VALUE="" GOTO C4SDN
387 IF (FILENUM'=9999999.27),$GET(^TMG("TMGSIPH","SKIP CHCK4SIM",FILENUM,VALUE))=1 GOTO C4SDN
388 NEW TMGOUT,TMGMSG
389 DO FIND^DIC(FILENUM,IENS,"@;.01I","BOQUX",VALUE,"*","B","","","TMGOUT","TMGMSG")
390 DO ShowIfDIERR^TMGDEBUG(.TMGOUT)
391 NEW CT SET CT=+$GET(TMGOUT("DILIST",0))
392 IF CT=1 DO
393 . ;"Ensure matched local record didn't actually come from server
394 . NEW LPTR SET LPTR=+$GET(TMGOUT("DILIST",2,1))
395 . IF $DATA(^TMG("TMGSIPH","DOWNLOADED",FILENUM,LPTR)) QUIT
396 . IF SAVIENS'="" DO
397 . . SET ANIEN=SAVIENS
398 . . SET $PIECE(ANIEN,",",1)=LPTR
399 . ELSE SET ANIEN=LPTR
400 . SET RESULT=1
401 ELSE IF CT>100 DO
402 . SET ^TMG("TMGSIPH","SKIP CHCK4SIM",FILENUM,VALUE)=1
403 ;
404C4SDN QUIT RESULT
405 ;
406 ;
407XTRACT01FLD(ARRAY) ;
408 ;"Purpose: To remove pointed-to .01 Field values from array returned from GET RECORD & XREF,
409 ;" and store these for future reference. Removes %PTRSOUT%
410 ;"Input: ARRAY -- PASS BY REFERENCE. Results returned from GET RECORD & XREF. Format:
411 ;" ARRAY(1)="<Ref>="
412 ;" ARRAY(2)="=<Value>"
413 ;" ARRAY(3)="<Ref>="
414 ;" ARRAY(4)="=<Value>"
415
416 ;" ...
417 ;" ARRAY(20)="%PTRSOUT%^PointedToFile^IEN^FIELD_VALUE"
418 ;" ARRAY(21)="%PTRSOUT%^PointedToFile^IEN^FIELD_VALUE"
419 ;" ...
420 ;"Results: none
421 NEW RESULT SET RESULT=0 ;Default to error.
422 NEW SHOWPG SET SHOWPG=0
423 NEW TMGCT SET TMGCT=0
424 NEW STIME SET STIME=$H
425 NEW TMGI SET TMGI=""
426 FOR SET TMGI=$ORDER(ARRAY(TMGI)) QUIT:(+TMGI'>0) DO
427 . IF (SHOWPG=0),($$HDIFF^XLFDT($H,STIME,2)>15) DO ;"Turn on progress bar after 15 seconds.
428 . . SET SHOWPG=1
429 . . SET TMGMIN=$ORDER(ARRAY(0))
430 . . SET TMGMAX=$ORDER(ARRAY(""),-1)
431 . IF (SHOWPG=1),(TMGCT>2000) DO
432 . . DO ProgressBar^TMGUSRIF(TMGI,"Extracting pointers from server data",TMGMIN,TMGMAX,70,STIME)
433 . . SET TMGCT=0
434 . SET TMGCT=TMGCT+1
435 . IF $GET(ARRAY(TMGI))'["%PTRSOUT%" QUIT
436 . NEW FILENUM SET FILENUM=$PIECE(ARRAY(TMGI),"^",2)
437 . NEW IEN SET IEN=$PIECE(ARRAY(TMGI),"^",3)
438 . NEW VALUE SET VALUE=$PIECE(ARRAY(TMGI),"^",4)
439 . KILL ARRAY(TMGI)
440 . SET ^TMG("TMGSIPH",".01 VALUE",FILENUM,IEN)=VALUE
441 QUIT
442 ;
443 ;
444GETANDFIXREC(JNUM,FILENUM,RPTR,OVERWRITE,TALLY,INOUT) ;
445 ;"Purpose: To request a record from server, and integrate into local vista,
446 ;" resolving pointers locally to point to newly downloaded record.
447 ;"Input: JNUM -- The job number of the background client process
448 ;" FILENUM -- the fileman filenumber of file to get from remote server
449 ;" Can be in format of SubFileNum{ParentFileNum{GrandParent....
450 ;" RPTR -- The record number on the server to get.
451 ;" Can be in IENS format, e.g. '7,34532,' if FILENUM is a subfile.
452 ;" OVERWRITE -- OPTIONAL. If 1, then prior local records may be overwritten.
453 ;" If '?' then figure out if should overwrite, asking user if needed.
454 ;" TALLY -- OPTIONAL. PASS BY REFERENCE. An array to keep progress stats. Format:
455 ;" TALLY("ALREADY LOCAL FOUND")=#
456 ;" TALLY("DOWNLOADED")=#
457 ;" TALLY(FILENUM,"NEW REC NEEDED")=#
458 ;" TALLY("UNNEEDED RECORDS")=#
459 ;" INOUT -- OPTIONAL -- Default is "PTOUT". Should be "PTIN" or "PTOUT"
460 ;"NOTE: Gobal ^TMG("TMGSIPH","NEEDED RECORDS","PTOUT") used, with format as below:
461 ;" ^TMG("TMGSIPH","NEEDED RECORDS","PTOUT",FILENUM,RemotePointer,RefToNodeToBeCorrected,Piece#OfNode)=""
462 ;" As pointers are resolved, the entries will be KILLED from the above global
463 ;"Results: 1 if OK, -1 if error, -2 if abort
464 ;
465 NEW QUERY,REPLY,ERROR,NEWIEN
466 NEW RESULT SET RESULT=-1 ;"Default to error
467 NEW TMGABORT SET TMGABORT=0
468 SET INOUT=$GET(INOUT) IF INOUT'="PTIN" SET INOUT="PTOUT"
469 SET OVERWRITE=$GET(OVERWRITE)
470 SET FILENUM=$GET(FILENUM)
471 NEW ISSUBFIL SET ISSUBFIL=$$ISSUBFIL^TMGFMUT2(+FILENUM)
472 IF +RPTR'>0 GOTO GAFRD
473 SET NEWIEN=RPTR ;"Default of not changing IEN
474 SET FILENUM=+FILENUM IF FILENUM'>0 GOTO GAFRD ;"If subfile, strip parent file number.
475 NEW LPTR SET LPTR=$GET(^TMG("TMGSIPH","PT XLAT",FILENUM,RPTR))
476 IF (+LPTR>0) DO GOTO GAFR1 ;"Remote records already downloaded, so just link to it.
477 . SET NEWIEN=LPTR
478 . SET TALLY("ALREADY LOCAL FOUND")=+$GET(TALLY("ALREADY LOCAL FOUND"))+1
479 NEW CONHANDL SET CONHANDL=$GET(^TMG("TMGSIPH","CONFLICT HANDL",FILENUM))
480 NEW USELOCAL SET USELOCAL=0
481 IF CONHANDL="UseLocal" DO GOTO:(USELOCAL=1) GAF2
482 . ;"If pointer is to a file specified as ALWAYS LOCAL, Handle here, if .01 value is known.
483 . NEW VALUE SET VALUE=$GET(^TMG("TMGSIPH",".01 VALUE",FILENUM,RPTR))
484 . QUIT:(VALUE="")
485 . NEW ANIEN
486 . IF $$CHCK4SIM(FILENUM,,.ANIEN,VALUE,RPTR)=0 QUIT ;"RPTR (as IENS) not used if not subfile.
487 . IF +ANIEN'>0 QUIT
488 . SET NEWIEN=ANIEN
489 . SET USELOCAL=1
490 NEW GREF SET GREF=$$GETGREF^TMGFMUT2(FILENUM,RPTR) ;"RPTR (as IENS) not used if not subfile.
491 IF GREF="" GOTO GAFRD
492 NEW ZREF SET ZREF=GREF_"0)"
493 NEW CGREF SET CGREF=$$CREF^DILF(GREF)
494 IF ISSUBFIL DO
495 . NEW REF SET REF=GREF_+RPTR
496 . SET QUERY="GET REF & FILE XREF|"_REF_"^"_FILENUM_"^"_RPTR
497 ELSE DO
498 . SET QUERY="GET RECORD & XREF|"_FILENUM_"^"_RPTR
499 DO MSGCLIENT^TMGKERN2(JNUM,QUERY,.REPLY,.ERROR,30)
500 IF $DATA(ERROR) DO GOTO GAFRD
501 . WRITE ERROR,!
502 IF $DATA(REPLY)=0 DO GOTO GAFR0 ;"No data on server for record, so zero pointers
503 . SET NEWIEN=0
504 DO XTRACT01FLD(.REPLY)
505 NEW SIMIEN
506 IF $$CHCK4SIM(FILENUM,.REPLY,.SIMIEN,,RPTR) DO ;"A prior similar record already is on client.
507 . SET NEWIEN=SIMIEN ;"If dealing with subfiles, SIMIEN will be in IENS format.
508 NEW REF SET REF=GREF_+NEWIEN_")"
509 IF $DATA(@REF) DO
510 . NEW TEMP SET TEMP=$$GETTARGETIEN^TMGSIPHU(FILENUM,.REPLY,.NEWIEN)
511 . SET REF=GREF_+NEWIEN_")" ;"NEWIEN might have changed.
512 . IF TEMP="ABORT" SET RESULT=-2,TMGABORT=1 QUIT
513 . IF TEMP="USELOCAL" SET USELOCAL=1 QUIT
514 . IF TEMP="OVERWRITE" DO QUIT ;"OVERWRITE LOCAL RECORD #LPTR (KILL, THEN STORE later)
515 . . KILL @REF
516GAF2 IF ($GET(TMGABORT)=1)!(NEWIEN'>0) GOTO GAFRD
517 IF USELOCAL=1 DO GOTO GAFR0
518 . SET TALLY("ALREADY LOCAL FOUND")=$GET(TALLY("ALREADY LOCAL FOUND"))+1
519 IF $$STOREDAS^TMGSIPHU(FILENUM,NEWIEN,.REPLY)=-1 GOTO GAFRD
520 SET $PIECE(@ZREF,"^",4)=+$PIECE($GET(@ZREF),"^",4)+1 ;"Update File Header to reflect added records
521 IF +NEWIEN>$PIECE(@ZREF,"^",3) SET $PIECE(@ZREF,"^",3)=NEWIEN
522 IF $$REAL1PTOUT^TMGSIPH1(FILENUM,NEWIEN,.TALLY) ;"Scan for pointers out. Ignore function result
523 SET ^TMG("TMGSIPH","DOWNLOADED",FILENUM,NEWIEN)=RPTR
524 SET TALLY("DOWNLOADED")=+$GET(TALLY("DOWNLOADED"))+1
525GAFR0 SET ^TMG("TMGSIPH","PT XLAT",FILENUM,RPTR)=NEWIEN ;"Add entry to Pointer translation table.
526 IF (RPTR'=NEWIEN) SET ^TMG("TMGSIPH","NEED RE-XREF",FILENUM)="" ;"Flag for re-cross referencing again later.
527 IF USELOCAL=1 SET ^TMG("TMGSIPH","PT XLAT",FILENUM,RPTR,"L")=1 ;"Signal that local record was used
528GAFR1 DO UNNEEDPTR^TMGSIPHU(FILENUM,RPTR,NEWIEN,INOUT,.TALLY)
529 IF INOUT="PTIN" KILL ^TMG("TMGSIPH","NEEDED RECORDS","PTIN",FILENUM,RPTR)
530 IF $$NEEDPTIN(FILENUM)!(INOUT="PTIN") DO ;"See if pointers IN are needed
531 . IF LPTR=RPTR QUIT ;"No need for relinking if this record was already local.
532 . DO GETPTIN^TMGSIPH4(JNUM,FILENUM,RPTR)
533 SET RESULT=1
534GAFRD IF (RESULT'=-1)&(TMGABORT=1) SET RESULT=-2
535 QUIT RESULT
536 ;
537 ;
538NEEDPTIN(FILENUM) ;
539 ;"Purpose: To have a centralized location for which files should automatically trigger a request
540 ;" for pointers-IN
541 ;"NOTE:
542 NEW RESULT SET RESULT=0
543 IF FILENUM=2 SET RESULT=1
544 ELSE IF (FILENUM=9000001) SET RESULT=1
545 ELSE IF (FILENUM=8925) SET RESULT=1
546 ELSE IF (FILENUM["8925.") SET RESULT=1
547 QUIT RESULT
548 ;
549 ;
550AUTONEEDED(JNUM) ;
551 ;"Purpose: To automatically get all pointers IN records and also pointers OUT records
552 ;"Input: JNUM -- The job number of the background client process
553 ;"Results: None
554 ;
555 NEW NPTO,NPTI,TALLY
556AN1 SET NPTO=$$NUMNEEDED^TMGSIPH3(JNUM,"PTOUT")
557 IF NPTO>0 IF $$HANDLNEEDED^TMGSIPH3(JNUM,"PTOUT",1,.TALLY)=-1 GOTO ANDN
558 SET NPTI=$$NUMNEEDED^TMGSIPH3(JNUM,"PTIN")
559 IF (NPTO=0)&(NPTI=0) GOTO ANDN
560 IF NPTI>0 IF $$HANDLNEEDED^TMGSIPH3(JNUM,"PTIN",1,.TALLY)=-1 GOTO ANDN
561 GOTO AN1
562ANDN IF $DATA(TALLY) WRITE ! ZWR TALLY
563 ELSE WRITE "No records needed auto-downloading.",!
564 DO PressToCont^TMGUSRIF
565 QUIT
566 ;
567 ;
568HANDLNEEDED(JNUM,INOUT,AUTOMODE,TALLY) ;
569 ;"Purpose: Ask user which records to get from server, then get them and update
570 ;" pointer translation table.
571 ;"Input: JNUM -- The job number of the background client process
572 ;" INOUT -- OPTIONAL -- Default is "PTOUT". Should be "PTIN" or "PTOUT"
573 ;" AUTOMODE -- OPTIONAL default is 0. If 1, then all records are processed without asking.
574 ;" TALLY -- OPTIONAL. PASS BY REFERENCE. An array to show downloads.
575 ;"Results: 1 if OK, -1 if abort.
576 ;
577 NEW GETARRAY,FILENUM,IEN,STIME,TMGCT,SHOWPROG,QUERY,ERROR,TMGMAX
578 SET INOUT=$GET(INOUT) IF INOUT'="PTIN" SET INOUT="PTOUT"
579 NEW TMGABORT SET TMGABORT=0
580 NEW RESULT SET RESULT=1 ;"Default to success
581HN1 DO ASKNEEDED(JNUM,.GETARRAY,INOUT,.AUTOMODE)
582 IF $DATA(GETARRAY)=0 GOTO HNDN
583 ;"Process JUST ONE record from each file to begin with, to try to minimize user interaction after that.
584 SET FILENUM=0
585 FOR SET FILENUM=$ORDER(GETARRAY(FILENUM)) QUIT:(FILENUM="")!(TMGABORT=1) DO
586 . QUIT:($$DDOK^TMGSIPH1(JNUM,FILENUM)'=1)
587 . QUIT:($$PREPXREF^TMGSIPH1(JNUM,FILENUM)'=1)
588 . SET IEN=$ORDER(GETARRAY(FILENUM,""),-1) QUIT:(IEN="")
589 . NEW TMP SET TMP=$$GETANDFIXREC(JNUM,FILENUM,IEN,"?",.TALLY,INOUT)
590 . IF TMP=-2 SET TMGABORT=1 QUIT
591 . IF TMP=-1 DO HNDLGAFE(FILENUM,IEN,.TMGABORT) QUIT
592 . KILL GETARRAY(FILENUM,IEN) ;"Prevent reprocessing below
593 ;"Now loop through ALL the files and records
594 SET FILENUM=0,SHOWPROG=0
595 FOR SET FILENUM=$ORDER(GETARRAY(FILENUM)) QUIT:(FILENUM="")!(TMGABORT=1) DO
596 . QUIT:($$DDOK^TMGSIPH1(JNUM,FILENUM)'=1)
597 . QUIT:($$PREPXREF^TMGSIPH1(JNUM,FILENUM)'=1)
598 . SET TMGMAX=-1,STIME=$H,TMGCT=1,IEN=""
599 . FOR SET IEN=$ORDER(GETARRAY(FILENUM,IEN),-1) QUIT:(IEN="")!(TMGABORT=1) DO
600 . . IF TMGMAX=-1 SET TMGMAX=IEN
601 . . SET TMGABORT=$$UserAborted^TMGUSRIF() QUIT:(TMGABORT=1)
602 . . SET TMGCT=TMGCT+1
603 . . NEW TMP SET TMP=$$GETANDFIXREC(JNUM,FILENUM,IEN,"?",.TALLY,INOUT)
604 . . IF TMP=-2 SET TMGABORT=1 QUIT
605 . . IF TMP=-1 DO HNDLGAFE(FILENUM,IEN,.TMGABORT) QUIT
606 . . IF (SHOWPROG=0),(($PIECE($H,",",2)-$PIECE(STIME,",",2))>10) SET SHOWPROG=1
607 . . IF SHOWPROG,(TMGCT#10=0) DO
608 . . . WRITE #
609 . . . DO ProgressBar^TMGUSRIF(TMGCT,"Progress: "_TMGCT,0,TMGMAX,70,STIME)
610 . . . IF $DATA(TALLY) WRITE ! ZWR TALLY
611 IF (AUTOMODE=1)&(TMGABORT'=1) GOTO HN1 ;"Loop back and see if more records are now needed.
612 ELSE DO
613 . IF $DATA(TALLY) WRITE ! ZWR TALLY
614 . DO PressToCont^TMGUSRIF
615HNDN IF TMGABORT SET RESULT=-1
616 QUIT RESULT
617 ;
618 ;
619HNDLGAFE(FILENUM,RPTR,TMGABORT) ;" Handle GETANDFIXREC error.
620 ;"Input: FILENUM -- The file containing the bad record
621 ;" RPTR -- the IEN of the bad record, on the server
622 ;" TMGABORT -- PASS BY REFERENCE. An OUT parameter to abort.
623 WRITE !,"Error encountered processing FILE ",$$FILENAME^TMGFMUT2(FILENUM)," (#"_FILENUM_"), REC #"_IEN,!
624 NEW % SET %=2
625 WRITE "Mark REC #",IEN," in FILE #",FILENUM," as an invalid server record"
626 DO YN^DICN WRITE !
627 IF %=-1 SET TMGABORT=1
628 IF %=1 DO BADPTR(FILENUM,IEN)
629HGAFEDN QUIT
630 ;
631 ;
632BADPTR(FILENUM,RPTR) ;
633 ;"Purpose: To handle a pointer to a bad record on the server.
634 ;"Input: FILENUM -- The file containing the bad record
635 ;" RPTR -- the IEN of the bad record, on the server
636 ;"NOTE: globally-scoped variable TMGABORT may be set.
637 ;"Results: None
638 NEW MENU,USRSLCT
639LC2 KILL MENU,USRSLCT
640 SET MENU(0)="Pick Option for Handling INVALID server record"
641 NEW IDX SET IDX=1
642 SET MENU(IDX)="Examine who need this bad record"_$char(9)_"Examine",IDX=IDX+1
643 SET MENU(IDX)="Redirect pointer to a different local record"_$char(9)_"RedirToLocal",IDX=IDX+1
644 SET MENU(IDX)="Change pointer to a NULL pointer"_$char(9)_"MakeNull",IDX=IDX+1
645 SET MENU(IDX)="Backup without making any changes"_$char(9)_"Quit",IDX=IDX+1
646 SET MENU(IDX)="Abort"_$char(9)_"Abort",IDX=IDX+1
647 ;
648 WRITE #
649 SET USRSLCT=$$MENU^TMGUSRIF(.MENU,"^")
650 IF USRSLCT="^" GOTO LC3
651 IF USRSLCT=0 SET USRSLCT=""
652 IF USRSLCT="Examine" DO GOTO:(TMGABORT=1) LC3 GOTO LC2
653 . NEW ARRAY SET ARRAY(FILENUM,RPTR)=""
654 . IF $$SHOWNEED^TMGSIPH5(JNUM,.ARRAY)=-1 SET TMGABORT=1 QUIT
655 IF USRSLCT="RedirToLocal" DO GOTO LC3
656 . NEW DIC,X,Y
657 . SET DIC=FILENUM,DIC(0)="MAEQ"
658 . DO ^DIC WRITE !
659 . IF +Y'>0 QUIT
660 . SET ^TMG("TMGSIPH","PT XLAT",FILENUM,RPTR)=+Y
661 IF USRSLCT="MakeNull" DO GOTO LC3
662 . SET ^TMG("TMGSIPH","PT XLAT",FILENUM,RPTR)=0
663 IF USRSLCT="Quit" GOTO LC3
664 IF USRSLCT="Abort" SET TMGABORT=1 GOTO LC3
665 GOTO LC2
666LC3 QUIT
667 ;
668 ;
669MAP2LOCAL(JNUM,INOUT) ;
670 ;"Purpose: Ask user which records to map to local records
671 ;"Input: JNUM -- The job number of the background client process
672 ;" INOUT -- OPTIONAL -- Default is "PTOUT". Should be "PTIN" or "PTOUT"
673 ;"Results: None
674 ;
675 NEW GETARRAY,FILENUM,IEN,STIME,TMGCT,SHOWPROG,TALLY,QUERY,ERROR,REPLY
676 SET INOUT=$GET(INOUT) IF INOUT'="PTIN" SET INOUT="PTOUT"
677 NEW AUTOMODE SET AUTOMODE=0
678 SET AUTOMODE("MAP MODE")=1
679 DO ASKNEEDED(JNUM,.GETARRAY,INOUT,.AUTOMODE)
680 SET FILENUM=0
681 SET STIME=$H
682 SET TMGCT=1,SHOWPROG=0
683 NEW TMGABORT SET TMGABORT=0
684 FOR SET FILENUM=$ORDER(GETARRAY(FILENUM)) QUIT:(FILENUM="")!(TMGABORT=1) DO
685 . QUIT:($$DDOK^TMGSIPH1(JNUM,FILENUM)'=1)
686 . QUIT:($$PREPXREF^TMGSIPH1(JNUM,FILENUM)'=1)
687 . NEW TMGMAX SET TMGMAX=-1,TMGCT=1,STIME=$H
688 . NEW IEN SET IEN=""
689 . FOR SET IEN=$ORDER(GETARRAY(FILENUM,IEN),-1) QUIT:(IEN="")!(TMGABORT=1) DO
690 . . IF TMGMAX=-1 SET TMGMAX=IEN
691 . . SET TMGABORT=$$UserAborted^TMGUSRIF() QUIT:(TMGABORT=1)
692 . . SET TMGCT=TMGCT+1
693 . . IF (SHOWPROG=0),(($PIECE($H,",",2)-$PIECE(STIME,",",2))>15) SET SHOWPROG=1
694 . . IF SHOWPROG,(TMGCT#2=0) DO
695 . . . WRITE #
696 . . . DO ProgressBar^TMGUSRIF(TMGCT,"Progress in "_FILENUM_": "_TMGCT,0,TMGMAX,70,STIME)
697 . . . IF $DATA(TALLY) WRITE ! ZWR TALLY
698 . . NEW NEWIEN SET NEWIEN=0
699 . . IF $$CHCK4SIM(FILENUM,,.NEWIEN,$$GET01FLD(JNUM,FILENUM,IEN))=0 QUIT ;"Is a prior similar record already is on client?
700 . . SET ^TMG("TMGSIPH","PT XLAT",FILENUM,IEN)=NEWIEN ;"Add entry to Pointer translation table.
701 . . DO UNNEEDPTR^TMGSIPHU(FILENUM,IEN,NEWIEN,INOUT,.TALLY)
702 . . IF INOUT="PTIN" KILL ^TMG("TMGSIPH","NEEDED RECORDS","PTIN",FILENUM,IEN)
703 . . KILL GETARRAY(FILENUM,IEN)
704 SET RESULT=1
705 IF $DATA(GETARRAY) DO
706 . NEW TMGARRAY,TMGSEL,IEN
707 . WRITE #
708 . WRITE "One or more records could not be automatically matched to a local record.",!
709 . WRITE "Select records to manually looked up.",!
710 . DO PRESSTOCONT^TMGUSRIF QUIT:$GET(TMGPTCABORT)=1
711 . FOR SET FILENUM=$ORDER(GETARRAY(FILENUM)) QUIT:(FILENUM="") DO
712 . . NEW FNAME SET FNAME=$PIECE($GET(^DIC(FILENUM,0)),"^",1)
713 . . SET IEN=""
714 . . FOR SET IEN=$ORDER(GETARRAY(FILENUM,IEN),-1) QUIT:(IEN="") DO
715 . . . NEW DISPSTR SET DISPSTR="Get records from REMOTE file #"_FILENUM_" ("
716 . . . SET DISPSTR="File: "_FNAME_"; Record: "_$$GET01FLD(JNUM,FILENUM,IEN)
717 . . . SET TMGARRAY(DISPSTR)=FILENUM_"^"_IEN
718 . NEW HEADER
719 . SET HEADER="Select Record(s) in file "_FILENUM_" to MAP to local records. Press <ESC><ESC> when Done."
720 . DO Selector^TMGUSRIF("TMGARRAY","TMGSEL",HEADER)
721 . IF $DATA(TMGSEL)=0 QUIT
722 . NEW TMGI SET TMGI=""
723 . FOR SET TMGI=$ORDER(TMGSEL(TMGI)) QUIT:(TMGI="")!TMGABORT DO
724 . . NEW ENTRY SET ENTRY=$GET(TMGSEL(TMGI))
725 . . SET FILENUM=+ENTRY QUIT:FILENUM'>0
726 . . SET IEN=$PIECE(ENTRY,"^",2)
727 . . NEW X,Y,DIC
728 . . SET DIC=FILENUM,DIC(0)="MAEQ"
729 . . SET DIC("A")="Lookup a match for ["_$$GET01FLD(JNUM,FILENUM,IEN)_"]: "
730 . . NEW DONE SET DONE=0
731 . . FOR DO QUIT:(+Y>0)!(DONE)!TMGABORT
732 . . . NEW %
733 . . . DO ^DIC WRITE !
734 . . . IF +Y>0 DO QUIT:TMGABORT
735 . . . . SET %=1
736 . . . . WRITE "Use [",$PIECE(Y,"^",2),"]" DO YN^DICN WRITE !
737 . . . . IF %=-1 SET TMGABORT=1 QUIT
738 . . . . IF %=2 SET Y=0 QUIT
739 . . . IF +Y>0 QUIT
740 . . . SET %=1
741 . . . WRITE "Try another lookup" DO YN^DICN WRITE !
742 . . . IF %=-1 SET TMGABORT=1 QUIT
743 . . . IF %=2 SET DONE=1 QUIT
744 . . IF +Y>0 DO
745 . . . SET ^TMG("TMGSIPH","PT XLAT",FILENUM,IEN)=+Y ;"Add entry to Pointer translation table.
746 . . . DO UNNEEDPTR^TMGSIPHU(FILENUM,IEN,+Y,INOUT,.TALLY)
747 . . . IF INOUT="PTIN" KILL ^TMG("TMGSIPH","NEEDED RECORDS","PTIN",FILENUM,IEN)
748 . . . KILL GETARRAY(FILENUM,IEN)
749 . . . SET TALLY("MANUALLY MATCHED TO LOCAL")=+$GET(TALLY("MANUALLY MATCHED TO LOCAL"))+1
750 IF $DATA(TALLY) WRITE ! ZWR TALLY
751 DO PRESSTOCONT^TMGUSRIF
752 QUIT
753 ;
754 ;
755GETFILE
Note: See TracBrowser for help on using the repository browser.