source: cprs/branches/tmg-cprs/m_files/TMGSIPH4.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: 16.7 KB
RevLine 
[896]1TMGSIPH4 ;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 pulling 1 record, and all records pointing to it, 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 ;"SRVRDIC(JNUM,REPLY) --get a file and value to lookup on server
14 ;"SRVFDIC(JNUM,FILENUM,REPLY) -- get value to lookup on server, in specified file.
15 ;"GETNEWFL(JNUM) -- get a novel file DD from the server (one not already present on client)
16 ;"GETPTIN(JNUM,FILENUM,IEN) -- as server for all pointers IN to a given record.
17 ;"ASKREC(JNUM,FILENUM,INOUT) --Query user for patient name, and add to ToDo list
18 ;"TRANSPT(JNUM) -- allow user to completely transfer 1 patient
19 ;"TRANSREC(JNUM) -- allow user to completely transfer 1 RECORD
20 ;"GETMSSNG(JNUM,FILENUM,OUTARRAY) ;Return a list of records on server, for given file, that have not been downloaded to client
21 ;"CHKSPUPD(JNUM) --check a pre-determined set of files for records on server that are not on client
22 ;"CHKUPDTE(JNUM) -- check files for records on server that are not on client.
23 ;"CHK1FUPD(JNUM,FILENUM,ALLRECS,TALLY) -- check 1 file for records on server that are not on client.
24 ;"=======================================================================
25 ;"Dependancies
26 ;"=======================================================================
27 ;"TMGKERN2
28 ;"=======================================================================
29 ;
30SRVRDIC(JNUM,REPLY)
31 ;"Purpose: to get a file and value to lookup on server
32 ;"Input: JNUM -- The job number of the background client process
33 ;" REPLY -- PASS BY REFERANCE. An OUT PARAMETER.
34 ;"Output: REPLY is filled with reply from server (if any). Format:
35 ;" REPLY("FILE")=FileNumber that search was from.
36 ;" REPLY(1)= <first line of server reply> <-- could be 'Thinking' type messages...
37 ;" ...
38 ;" REPLY(n)= <Last line of server reply> <-- probably the line to look at if only 1 expected
39 ;"Result: none
40 NEW FILE,DIC,X,Y,VALUE
41 SET DIC=1,DIC(0)="MAEQ"
42 SET DIC("A")="Enter FILE on server to search in: "
43 DO ^DIC WRITE !
44 IF +Y'>0 SET Y=$$GETNEWFL(JNUM)
45 IF +Y'>0 QUIT
46 DO SRVFDIC(JNUM,+Y,.REPLY)
47 QUIT
48 ;
49 ;
50SRVFDIC(JNUM,FILENUM,REPLY)
51 ;"Purpose: to get value to lookup on server, in specified file.
52 ;"Input: JNUM -- The job number of the background client process
53 ;" FILENUM -- The fileman file to search in.
54 ;" REPLY -- PASS BY REFERANCE. An OUT PARAMETER.
55 ;"Output: REPLY is filled with reply from server (if any). Format:
56 ;" REPLY("FILE")=FileNumber that search was from.
57 ;" REPLY(1)= <first line of server reply> <-- could be 'Thinking' type messages...
58 ;" ...
59 ;" REPLY(n)= <Last line of server reply> <-- probably the line to look at if only 1 expected
60 ;"Result: none
61 NEW FILE,DIC,X,Y,VALUE
62 NEW FILENAME SET FILENAME=$$FILENAME^TMGFMUT2(FILENUM)
63 ;"SET FILENAME=$PIECE($GET(^DIC(FILENUM,0)),"^",1)
64 WRITE "Enter value in ",FILENAME," to search on server for: "
65 READ VALUE:$GET(DTIME,3600) WRITE !
66 IF VALUE["^" QUIT
67 NEW QUERY,ERROR
68 KILL REPLY
69 SET QUERY="DO DIC|"_FILENUM_"^"_VALUE
70 DO MSGCLIENT^TMGKERN2(JNUM,QUERY,.REPLY,.ERROR,30)
71 IF $DATA(ERROR) DO QUIT
72 . WRITE ERROR,!
73 SET REPLY("FILE")=FILENUM
74 QUIT
75 ;
76 ;
77GETNEWFL(JNUM) ;
78 ;"Purpose: To get a novel file DD from the server (one not already present on client)
79 ;"Input: JNUM -- The job number of the background client process
80 ;"Output: Data dictionary for novel file my be downloaded and put into local database.
81 ;"Result: Returns file number, or -1 if error or abort.
82 NEW FILENAME,FILENUM,RESULT,I
83 SET RESULT=-1 ;"Default to failure
84 WRITE "Enter name of file to search on server for: "
85 READ FILENAME:$GET(DTIME,3600) WRITE !
86 IF (FILENAME["^")!(FILENAME="") GOTO GNFLDN
87 NEW QUERY,ERROR,REPLY
88 SET QUERY="DO DIC|1^"_FILENAME
89 DO MSGCLIENT^TMGKERN2(JNUM,QUERY,.REPLY,.ERROR,30)
90 IF $DATA(ERROR) DO GOTO GNFLDN
91 . WRITE ERROR,!
92 . DO PRESSTOCONT^TMGUSRIF
93 IF $DATA(REPLY)=0 GOTO GNFLDN
94 SET REPLY("FILE")=1
95 SET I="" FOR SET I=$ORDER(REPLY(I),-1) QUIT:(I="")!(+I=I)
96 SET FILENUM=$GET(REPLY(I))
97 IF +FILENUM'>0 GOTO GNFLDN
98 SET QUERY="GET|^DIC("_+FILENUM_")"
99 DO MSGCLIENT^TMGKERN2(JNUM,QUERY,.REPLY,.ERROR,30)
100 IF $DATA(ERROR) DO GOTO GNFLDN
101 . WRITE ERROR,!
102 . DO PRESSTOCONT^TMGUSRIF
103 DO STOREDATA^TMGSIPHU(.REPLY)
104 ;"---- Get and fix file header ----
105 SET REF=$GET(^DIC(+FILENUM,0,"GL"))
106 IF REF="" DO GOTO GNFLDN
107 . WRITE "UNABLE TO GET GLOBAL REFERENCE IN ^DIC(",FILENUM,",0,""GL"")",!
108 . DO PRESSTOCONT^TMGUSRIF
109 SET REF=REF
110 SET QUERY="GET|"_REF_"0)"
111 DO MSGCLIENT^TMGKERN2(JNUM,QUERY,.REPLY,.ERROR,30)
112 IF $DATA(ERROR) DO GOTO GNFLDN
113 . WRITE ERROR,!
114 . DO PRESSTOCONT^TMGUSRIF
115 DO STOREDATA^TMGSIPHU(.REPLY)
116 SET $PIECE(@(REF_"0)"),"^",3)=$ORDER(@(REF_"""@"")"),-1) ;"most recently added rec #
117 SET $PIECE(@(REF_"0)"),"^",4)=$ORDER(@(REF_"""@"")"),-1) ;"supposed to be total num of recs
118 SET RESULT=$$DDOK^TMGSIPH1(JNUM,FILENUM) ;
119GNFLDN QUIT RESULT
120 ;
121 ;
122GETPTIN(JNUM,FILENUM,IEN)
123 ;"Purpose: as server for all pointers IN to a given record.
124 ;"Input: JNUM -- The job number of the background client process
125 ;" FILENUM -- The fileman file to consider
126 ;" IEN -- The record number in file. Server-side IEN
127 ;"Output: Data us stored in: SET ^TMG("TMGSIPH","NEEDED RECORDS","PTIN",OFILE,NEWIEN)=""
128 ;"Results: none.
129 NEW QUERY,ERROR,REPLY
130 SET QUERY="GET PTRS IN|"_FILENUM_"^"_IEN
131 DO MSGCLIENT^TMGKERN2(JNUM,QUERY,.REPLY,.ERROR,30)
132 ;"REPLY -- PASS BY REFERENCE, an OUT PARAMETER. Format:
133 ;" REPLY(1)=FROMFILE^FROMIENS^FROMFLD
134 ;" REPLY(2)=FROMFILE^FROMIENS^FROMFLD etc.
135 IF $DATA(ERROR) DO QUIT
136 . WRITE ERROR,!
137 NEW LINE,NEWIEN
138 FOR LINE=1:1 QUIT:($DATA(REPLY(LINE))=0) DO
139 . SET NEWIEN=$PIECE(REPLY(LINE),"^",2)
140 . NEW OFILE SET OFILE=+REPLY(LINE)
141 . ;"IF NEWIEN["," QUIT ;"pointers IN from subfiles will be gotten with parent records
142 . IF NEWIEN["," DO
143 . . NEW PFILE SET PFILE=OFILE
144 . . FOR SET PFILE=+$GET(^DD(PFILE,0,"UP")) QUIT:PFILE=0 DO
145 . . . SET OFILE=OFILE_"{"_PFILE
146 . SET ^TMG("TMGSIPH","NEEDED RECORDS","PTIN",OFILE,NEWIEN)=""
147 QUIT
148 ;
149 ;
150ASKREC(JNUM,FILENUM,INOUT) ;
151 ;"Purpose: Query user for patient name, and add to ToDo list
152 ;"Input: JNUM -- The job number of the background client process
153 ;" FILENUM -- OPTIONAL. The fileman file. If not provided, user will be asked for it.
154 ;" INOUT -- OPTIONAL -- Default is "PTOUT". Should be "PTIN" or "PTOUT"
155 ;" ... NOTE: don't use 'PTOUT' ... causes problem because of difference in node numbers...
156 ;"Result: none
157 ;"Records that are needed are stored in ^TMG("TMGSIPH","NEEDED RECORDS","PTIN",FILENUM,IEN)=""
158 SET INOUT=$GET(INOUT) IF INOUT'="PTIN" SET INOUT="PTOUT"
159 NEW ARRAY,IEN,VALUE,I,REPLY
160 SET FILENUM=+$GET(FILENUM)
161 IF FILENUM>0 DO
162 . DO SRVFDIC(JNUM,FILENUM,.ARRAY)
163 ELSE DO
164 . DO SRVRDIC(JNUM,.ARRAY)
165 . SET FILENUM=+$GET(ARRAY("FILE"))
166 IF $DATA(ARRAY)=0 GOTO PRDN
167 SET I="" FOR SET I=$ORDER(ARRAY(I),-1) QUIT:(I="")!(+I=I)
168 SET VALUE=$GET(ARRAY(I))
169 IF +VALUE'>0 GOTO PRDN
170 IF INOUT="PTIN" DO
171 . SET ^TMG("TMGSIPH","NEEDED RECORDS","PTIN",FILENUM,+VALUE)=""
172 ELSE DO ;".... don't use
173 . ;"^TMG("TMGSIPH","NEEDED RECORDS","PTOUT",FILENUM,RemotePointer,ReferToNodeToBeCorrected,Piece#OfNode)=""
174 . ;"SET ^TMG("TMGSIPH","NEEDED RECORDS","PTOUT",FILENUM,+VALUE)=""
175 WRITE $PIECE(VALUE,"^",2),!
176PRDN QUIT
177 ;
178 ;
179TRANSPT(JNUM)
180 ;"Purpose: to allow user to completely transfer 1 patient
181 ;"Input: JNUM -- The job number of the background client process
182 ;"Output: Records are downloaded and put into local database.
183 ;"Result: none
184 DO ASKREC(JNUM,2) ;"2 = PATIENT file.
185 NEW TMGABORT SET TMGABORT=0
186 NEW HASTASKS SET HASTASKS=1
187 FOR QUIT:(HASTASKS=0)!(TMGABORT) DO
188 . IF $$HANDLNEEDED^TMGSIPH3(JNUM,"PTIN",1)=-1 SET TMGABORT=1 QUIT
189 . IF $$HANDLNEEDED^TMGSIPH3(JNUM,"PTOUT",1)=-1 SET TMGABORT=1 QUIT
190 . IF $DATA(^TMG("TMGSIPH","NEEDED RECORDS","PTIN"))>0 QUIT
191 . IF $DATA(^TMG("TMGSIPH","NEEDED RECORDS","PTOUT"))>0 QUIT
192 . SET HASTASKS=0 QUIT
193 QUIT
194 ;
195 ;
196TRANSREC(JNUM) ;
197 ;"Purpose: to allow user to completely transfer 1 RECORD
198 ;"Input: JNUM -- The job number of the background client process
199 ;"Output: Records are downloaded and put into local database.
200 ;"Result: none
201 NEW DIC,X,Y
202 NEW ARRAY,IEN,VALUE,I,REPLY,TALLY
203 SET DIC=1,DIC(0)="MAEQN"
204 DO ^DIC WRITE !
205 IF +Y'>0 SET Y=$$GETNEWFL(JNUM)
206 IF +Y'>0 GOTO TRDN
207 SET FILENUM=+Y
208 DO SRVFDIC(JNUM,FILENUM,.ARRAY)
209 IF $DATA(ARRAY)=0 GOTO TRDN
210 SET I="" FOR SET I=$ORDER(ARRAY(I),-1) QUIT:(I="")!(+I=I)
211 SET VALUE=$GET(ARRAY(I))
212 NEW IEN SET IEN=+VALUE
213 IF IEN'>0 GOTO TRDN
214 WRITE $PIECE(VALUE,"^",2),!
215 IF $$GETANDFIXREC^TMGSIPH3(JNUM,FILENUM,IEN,"?",.TALLY,"PTOUT")
216 IF $DATA(TALLY) ZWR TALLY
217 DO PRESSTOCONT^TMGUSRIF
218 ;
219TRDN QUIT
220 ;
221 ;
222GETMSSNG(JNUM,FILENUM,OUTARRAY) ; GetMissingRecordIENs
223 ;"Purpose: Return a list of records on server, for given file, that have not been downloaded to client
224 ;"Input: JNUM -- The job number of the background client process
225 ;" FILENUM -- The Fileman file number.
226 ;" OUTARRAY -- PASS BY REFERENCE. Prior contents erased. Format:
227 ;" OUTARRAY(FILENUM,RPTR)=""
228 ;" OUTARRAY(FILENUM,RPTR)=""
229 ;"Results: none
230 KILL OUTARRAY
231 NEW CT SET CT=0
232 NEW QUERY,ERROR,REPLY,SVRHEADER
233 SET QUERY="GET IEN HDR|"_FILENUM
234 DO MSGCLIENT^TMGKERN2(JNUM,QUERY,.REPLY,.ERROR,30) ;"Should get LastIEN^TotalNumIENS
235 IF $DATA(ERROR) WRITE ERROR,! GOTO GMDN
236 SET SVRHEADER=$GET(REPLY(1)) IF SVRHEADER="" DO GOTO GMDN
237 . WRITE "Error getting File headers from server.",!
238 NEW DONE SET DONE=0
239 IF $GET(^TMG("TMGSIPH","RECORDS SYNC",FILENUM))=SVRHEADER DO GOTO:DONE GMDN2
240 . WRITE "According to Fileman headers, there are no new records added to file "_FILENUM,!
241 . WRITE "since last check.",!
242 . NEW % SET %=2
243 . WRITE "Do complete and thorough check again anyway" DO YN^DICN WRITE !
244 . SET DONE=(%'=1)
245 NEW FILENAME SET FILENAME=$$FILENAME^TMGFMUT2(FILENUM)
246 WRITE !,"Getting a list of all records on server for file ",FILENAME," (#",FILENUM,")",!
247 SET QUERY="GET IEN LIST|"_FILENUM
248 DO MSGCLIENT^TMGKERN2(JNUM,QUERY,.REPLY,.ERROR,30) ;"Should get list of all IEN's in record on server.
249 IF $DATA(ERROR) WRITE ERROR,! GOTO GMDN
250 SET ^TMG("TMGSIPH","RECORDS SYNC",FILENUM)=SVRHEADER
251 NEW STIME SET STIME=$H
252 NEW TMGCT SET TMGCT=0
253 NEW SHOWPROG SET SHOWPROG=0
254 NEW TMGMIN,TMGMAX
255 NEW TMGABORT SET TMGABORT=0
256 NEW TMGI SET TMGI=0
257 FOR SET TMGI=$ORDER(REPLY(TMGI)) QUIT:(+TMGI'>0)!TMGABORT DO
258 . NEW VALUE SET VALUE=$GET(REPLY(TMGI)) ;"Should be IEN^.01 Value (internal format)
259 . NEW RPTR SET RPTR=+VALUE
260 . IF +$GET(^TMG("TMGSIPH","PT XLAT",FILENUM,RPTR))'>0 DO
261 . . IF $DATA(^TMG("TMGSIPH",".01 VALUE",FILENUM,RPTR))=0 DO
262 . . . SET ^TMG("TMGSIPH",".01 VALUE",FILENUM,RPTR)=$PIECE(VALUE,"^",2)
263 . . SET OUTARRAY(FILENUM,RPTR)=""
264 . . SET CT=CT+1
265 . . KILL REPLY(TMGI)
266 . SET TMGABORT=$$UserAborted^TMGUSRIF() QUIT:(TMGABORT=1)
267 . SET TMGCT=TMGCT+1
268 . IF (SHOWPROG=0),($$HDIFF^XLFDT($H,STIME,2)>5) DO ;"Turn on progress bar after 15 seconds.
269 . . SET SHOWPROG=1
270 . . SET TMGMIN=1
271 . . SET TMGMAX=$ORDER(REPLY(""),-1)
272 . IF (SHOWPROG=1),(TMGCT>200) DO
273 . . DO ProgressBar^TMGUSRIF(TMGI,"Comparing server vs local records in File: "_FILENUM,TMGMIN,TMGMAX,70,STIME)
274 . . SET TMGCT=0
275GMDN WRITE !
276 WRITE CT," records found to be downloaded.",!
277GMDN2 QUIT
278 ;
279 ;
280CHKSPUPD(JNUM) ;" CHECK SPECIAL FILES FOR UPDATE
281 ;"Purpose: To check a pre-determined set of files for records on server that are not on client.
282 ;"Input: JNUM -- The job number of the background client process
283 ;"Output: Records my be downloaded and put into local database.
284 ;"Result: none
285 NEW FILENUM,TALLY,TMGABORT
286 IF $DATA(^TMG("TMGSIPH","TRACKED FILES"))=0 DO
287 . SET ^TMG("TMGSIPH","TRACKED FILES",8925)=1
288 . SET ^TMG("TMGSIPH","TRACKED FILES",120.5)=1
289 . SET ^TMG("TMGSIPH","TRACKED FILES",2005)=1
290 . SET ^TMG("TMGSIPH","TRACKED FILES",22705.5)=1
291 SET TMGABORT=0
292 SET FILENUM=0
293 FOR SET FILENUM=$ORDER(^TMG("TMGSIPH","TRACKED FILES",FILENUM)) QUIT:(+FILENUM'>0)!TMGABORT DO
294 . IF $$CHK1FUPD(JNUM,FILENUM,1,.TALLY)=-1 SET TMGABORT=1
295 DO AUTONEEDED^TMGSIPH3(JNUM)
296 IF $DATA(TALLY) ZWR TALLY
297 DO PRESSTOCONT^TMGUSRIF
298 QUIT
299 ;
300 ;
301CHKUPDTE(JNUM,ALLRECS) ; "CHECK FOR UPDATE
302 ;"Purpose: To check files for records on server that are not on client.
303 ;"Input: JNUM -- The job number of the background client process
304 ;" ALLRECS -- OPTIONAL. Default=0. If 1, then all records are automatically selected
305 ;"Output: Records my be downloaded and put into local database.
306 ;"Result: none
307 NEW DIC,X,Y
308 NEW ARRAY,IEN,TALLY,FILENUM
309 SET DIC=1,DIC(0)="MAEQN"
310 WRITE "Enter FILE on server in which to search for new records.",!
311 WRITE "(If file exists on server, but not on client, enter ^)",!
312 DO ^DIC WRITE !
313 IF +Y'>0 SET Y=$$GETNEWFL(JNUM)
314 IF +Y'>0 GOTO CHDN
315 SET FILENUM=+Y
316 IF $$CHK1FUPD(JNUM,FILENUM,.ALLRECS,.TALLY) ;
317 IF $DATA(TALLY) ZWR TALLY
318 DO PRESSTOCONT^TMGUSRIF
319 ;
320CHDN QUIT
321 ;
322CHK1FUPD(JNUM,FILENUM,ALLRECS,TALLY) ;" CHECK 1 FILE FOR UPDATE
323 ;"Purpose: To check 1 file for records on server that are not on client.
324 ;"Input: JNUM -- The job number of the background client process
325 ;" FILENUM -- the file number to check.
326 ;" ALLRECS -- OPTIONAL. Default=0. If 1, then all records are automatically selected
327 ;" TALLY -- PASS BY REFERENCE. An array to hold progress of downloaded files.
328 ;"Output: Records my be downloaded and put into local database.
329 ;"Result: 1 if OK, -1 if abort
330 NEW ARRAY,IEN
331 NEW RESULT SET RESULT=1
332 SET ALLRECS=+$GET(ALLRECS)
333 DO GETMSSNG(JNUM,FILENUM,.ARRAY)
334 IF ALLRECS'=1 DO PRESSTOCONT^TMGUSRIF
335 IF $DATA(ARRAY)=0 GOTO CH1DN
336 NEW SELARRAY,OPTIONS
337 IF ALLRECS'=1 DO
338 . SET OPTIONS("HEADER")="Select Server Records Missing Locally to Download <Esc><Esc> when done."
339 . DO SELNEEDED^TMGSIPH3(JNUM,.SELARRAY,"ARRAY",.OPTIONS)
340 ELSE DO
341 . MERGE SELARRAY=ARRAY
342 NEW STIME SET STIME=$H
343 NEW TMGCT SET TMGCT=0
344 NEW SHOWPROG SET SHOWPROG=0
345 NEW TMGMIN,TMGMAX
346 NEW TMGABORT SET TMGABORT=0
347 NEW RPTR SET RPTR=""
348 FOR SET RPTR=$ORDER(SELARRAY(FILENUM,RPTR)) QUIT:(+RPTR'>0)!TMGABORT DO
349 . SET TMGABORT=$$UserAborted^TMGUSRIF() QUIT:(TMGABORT=1)
350 . NEW TMP SET TMP=$$GETANDFIXREC^TMGSIPH3(JNUM,FILENUM,RPTR,"?",.TALLY)
351 . IF TMP=-1 DO HNDLGAFE^TMGSIPH3(FILENUM,IEN,.TMGABORT) QUIT
352 . SET TMGCT=TMGCT+1
353 . IF (SHOWPROG=0),($$HDIFF^XLFDT($H,STIME,2)>5) DO ;"Turn on progress bar after 5 seconds.
354 . . SET SHOWPROG=1
355 . . SET TMGMIN=$ORDER(SELARRAY(FILENUM,0))
356 . . SET TMGMAX=$ORDER(SELARRAY(FILENUM,""),-1)
357 . IF (SHOWPROG=1),(TMGCT>50) DO
358 . . DO ProgressBar^TMGUSRIF(RPTR,"Getting Records From File: "_FILENUM,TMGMIN,TMGMAX,70,STIME)
359 . . SET TMGCT=0
360 IF $DATA(TALLY) ZWR TALLY
361 ;
362CH1DN IF TMGABORT SET RESULT=-1
363 QUIT RESULT
Note: See TracBrowser for help on using the repository browser.