source: cprs/branches/tmg-cprs/m_files/TMGSIPH5.m@ 1085

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

replacing soft links with actual files

File size: 16.6 KB
Line 
1TMGSIPH5 ;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 ;"Utility functions for working with transfers on client
6 ;"Kevin Toppenberg MD
7 ;"GNU General Public License (GPL) applies
8 ;"11/27/09
9 ;
10 ;"=======================================================================
11 ;" API -- Public Functions.
12 ;"=======================================================================
13 ;"EXAMNEED(JNUM,INOUT) -- User selects records, and then this displays who needs records.
14 ;"SHOWNEED(JNUM,GETARRAY) -- show selected records
15 ;"CHCK1NEED(FILENUM,RPTR,INOUT) --show who is needing one requested record
16 ;"GL2FILE(CREF,FNAME) -- Return filenumber based on global reference.
17 ;"KILLNEED(JNUM,INOUT) --allow user to kill needed needed pointers.
18 ;"PREVIEW(JNUM,INOUT) --allow user view server record before downloading and installing
19 ;"DELREC -- Allow user to del record and remove record that it has been previously downloaded.
20 ;"DEL1REC(FILENUM,LPTR) -- allow deletion of given record and that it has been downloaded.
21 ;"
22 ;"=======================================================================
23 ;"Dependancies
24 ;"=======================================================================
25 ;
26 ;"=======================================================================
27 ;
28EXAMNEED(JNUM,INOUT) ;
29 ;"Purpose:User selects records, and then this displays who needs records.
30 ;"Input: JNUM -- The job number of the background client process
31 ;" INOUT -- OPTIONAL -- Default is "PTOUT". Should be "PTIN" or "PTOUT"
32 ;"Results: None
33 ;
34 NEW GETARRAY
35 SET INOUT=$GET(INOUT) IF INOUT'="PTIN" SET INOUT="PTOUT"
36 NEW OPTIONS
37 SET OPTIONS("HEADER")="Select File(s) to EXAMINE. Press <ESC><ESC> when Done."
38 DO ASKNEEDED^TMGSIPH3(JNUM,.GETARRAY,INOUT,.OPTIONS)
39 IF $DATA(GETARRAY)=0 GOTO WNDN
40 IF $$SHOWNEED(JNUM,.GETARRAY) ;"Ignore aborts
41WNDN QUIT
42 ;
43 ;
44SHOWNEED(JNUM,GETARRAY)
45 ;"Purpose: To show selected records
46 ;"Input: JNUM
47 ;" GETARRAY -- PASS BY REFERENCE. Array as created by ASKNEEDED^TMGSIPH4
48 ;" GETARRAY(FileNum,RecordNum)=""
49 ;"Results: 1 if OK, -1 if abort
50 NEW RESULT SET RESULT=1
51 NEW TMGABORT SET TMGABORT=0
52 NEW FILENUM SET FILENUM=0
53 NEW STIME SET STIME=$H
54 NEW TALLY
55 NEW TMGCT SET TMGCT=1
56 NEW SHOWPROG SET SHOWPROG=0
57 FOR SET FILENUM=$ORDER(GETARRAY(FILENUM)) QUIT:(FILENUM="")!(TMGABORT=1) DO
58 . QUIT:($$DDOK^TMGSIPH1(JNUM,FILENUM)'=1)
59 . QUIT:($$PREPXREF^TMGSIPH1(JNUM,FILENUM)'=1)
60 . NEW TMGMAX SET TMGMAX=-1
61 . NEW IEN SET IEN=""
62 . FOR SET IEN=$ORDER(GETARRAY(FILENUM,IEN),-1) QUIT:(IEN="")!(TMGABORT=1) DO
63 . . IF TMGMAX=-1 SET TMGMAX=IEN
64 . . SET TMGABORT=$$UserAborted^TMGUSRIF() QUIT:(TMGABORT=1)
65 . . SET TMGCT=TMGCT+1
66 . . IF $$CHCK1NEED(FILENUM,IEN,INOUT)=-1 DO QUIT
67 . . . NEW % SET %=1
68 . . . WRITE "ABORT" DO YN^DICN WRITE !
69 . . . IF %'=2 SET TMGABORT=1
70 . . IF (SHOWPROG=0),(($PIECE($H,",",2)-$PIECE(STIME,",",2))>15) SET SHOWPROG=1
71 . . IF SHOWPROG,(TMGCT#10=0) DO
72 . . . WRITE #
73 . . . DO ProgressBar^TMGUSRIF(TMGCT,"Progress: "_TMGCT,0,TMGMAX,70,STIME)
74 . . . IF $DATA(TALLY) WRITE ! ZWR TALLY
75 DO PRESSTOCONT^TMGUSRIF
76 IF ($GET(TMGPTCABORT)=1)!(TMGABORT) SET RESULT=-1
77 QUIT RESULT
78 ;
79 ;
80CHCK1NEED(FILENUM,RPTR,INOUT) ;
81 ;"Purpose: To show who is needing one requested record
82 ;"Input: FILENUM -- The file number to compare.
83 ;" RPTR -- The IEN of the record that was wanted from the server.
84 ;" INOUT -- OPTIONAL -- Default is "PTOUT". Should be "PTIN" or "PTOUT"
85 ;"NOTE: Gobal ^TMG("TMGSIPH","NEEDED RECORDS","PTOUT") used, with format as below:
86 ;" ^TMG("TMGSIPH","NEEDED RECORDS","PTOUT",FILENUM,RemotePointer,RefToNodeToBeCorrected,INFO)=""
87 ;" INFO=DataPiece^PointedToFile^PointedToReference^IENDepth^[V]
88 ;" As pointers are resolved, the entries will be KILLED from the above global
89 ;"
90 ;"Results: 1 for OK, -1 for abort
91 ;"
92 NEW RESULT SET RESULT=1
93 SET FILENUM=+$GET(FILENUM) QUIT:(FILENUM'>0)
94 NEW FNAME SET FNAME=$PIECE($GET(^DIC(FILENUM,0)),"^",1)
95 SET RPTR=+$GET(RPTR)
96 SET LPTR=+$GET(LPTR)
97 NEW REF SET REF=""
98 FOR SET REF=$ORDER(^TMG("TMGSIPH","NEEDED RECORDS","PTOUT",FILENUM,RPTR,REF)) QUIT:(REF="")!(RESULT=-1) DO
99 . NEW INFO SET INFO=""
100 . FOR SET INFO=$ORDER(^TMG("TMGSIPH","NEEDED RECORDS","PTOUT",FILENUM,RPTR,REF,INFO)) QUIT:(INFO="")!(RESULT=-1) DO
101 . . NEW PCE SET PCE=+INFO
102 . . NEW IENDEPTH SET IENDEPTH=$PIECE(INFO,"^",4)
103 . . NEW QNUM SET QNUM=$QLENGTH(REF)-(IENDEPTH*2) ;"e.g. ^TIU(8925,IEN,0), or e.g. ^PS(52.11,IEN,2,IEN2,0), ^PS(52.11,IEN,2,IEN2,0,IEN3,3)
104 . . NEW GL SET GL=$$QSUBS^TMGSIPHU(REF,QNUM)
105 . . NEW FRFNAME SET FRFNAME="??"
106 . . NEW PFROMFIL SET PFROMFIL=$$GL2FILE(GL,.FRFNAME)
107 . . NEW PFROMREC SET PFROMREC=$QSUBSCRIPT(REF,QNUM+1)
108 . . NEW LOC SET LOC=$QSUBSCRIPT(REF,$QLENGTH(REF))
109 . . NEW FLD SET FLD=$$GETFLD^TMGSIPHU(PFROMFIL,LOC,PCE)
110 . . WRITE !,"Needed Record: FILE ",FILENUM," [",FNAME,"]; #",RPTR," [",$$GET01FLD^TMGSIPH3(JNUM,FILENUM,RPTR),"] ",!
111 . . WRITE "Needed by: FILE: ",PFROMFIL," [",FRFNAME,"]; #",PFROMREC,"; FLD: ",+FLD," [",$PIECE(FLD,"^",2),"]",!
112 . . NEW TOSHOW,FLD SET FLD=0
113 . . FOR SET FLD=$ORDER(^DD(PFROMFIL,FLD)) QUIT:(+FLD'>0) DO
114 . . . NEW INFO SET INFO=$PIECE($GET(^DD(PFROMFIL,FLD,0)),"^",2)
115 . . . QUIT:(INFO'["P")
116 . . . NEW AFILE SET AFILE=+$PIECE(INFO,"P",2) QUIT:(AFILE'=2) ;"2 = PATIENT file
117 . . . SET TOSHOW(FLD)=""
118 . . IF $DATA(TOSHOW) DO
119 . . . WRITE "Name of patient in this record as follows:",!
120 . . . DO DumpRec2^TMGDEBUG(PFROMFIL,PFROMREC,0,.TOSHOW)
121 . . NEW % SET %=2
122 . . WRITE "View current local record needing record" DO YN^DICN WRITE !
123 . . IF %=-1 SET RESULT=-1 QUIT
124 . . IF %=1 DO
125 . . . DO DumpRec2^TMGDEBUG(PFROMFIL,PFROMREC)
126 . . . WRITE !
127 . . . DO PRESSTOCONT^TMGUSRIF
128 . . . IF $GET(TMGPTCABORT)=1 SET RESULT=-1
129 ;
130 QUIT RESULT
131 ;
132 ;
133GL2FILE(CREF,FNAME) ;
134 ;"Purpose: Return filenumber based on global reference.
135 ;"Input: CREF -- closed reference of root of file.
136 ;" FNAME -- OPTIONAL. PASS BY REFERENCE. Filled with filename, if found.
137 ;"Results: Filenumber, or 0 if problem
138 NEW RESULT SET RESULT=0
139 NEW NODE0 SET NODE0=$GET(@CREF@(0)) GOTO:(NODE0="") G2FDN
140 SET FNAME=$PIECE(NODE0,"^",1)
141 SET RESULT=+$PIECE(NODE0,"^",2)
142G2FDN QUIT RESULT
143 ;
144 ;
145KILLNEED(JNUM,INOUT) ;
146 ;"Purpose: To allow user to kill needed needed pointers.
147 ;"Input: JNUM -- The job number of the background client process
148 ;" INOUT -- OPTIONAL -- Default is "PTOUT". Should be "PTIN" or "PTOUT"
149 ;"Results: None
150 ;
151 NEW GETARRAY,FILENUM,IEN,STIME,TMGCT,SHOWPROG,TALLY,QUERY,ERROR
152 SET INOUT=$GET(INOUT) IF INOUT'="PTIN" SET INOUT="PTOUT"
153 NEW TMGABORT SET TMGABORT=0
154 NEW OPTIONS
155 SET OPTIONS("HEADER")="Select File(s) to REMOVE NEEDED FROM. Press <ESC><ESC> when Done."
156 DO ASKNEEDED^TMGSIPH3(JNUM,.GETARRAY,INOUT,.OPTIONS)
157 IF $DATA(GETARRAY)=0 GOTO WNDN
158 WRITE !,"NOTE: If the selected records are removed from the needed list,",!
159 WRITE "then all the records pointing to this needed record will be left",!
160 WRITE "with NULL pointers. THIS CAN NOT BE UNDONE.",!
161 WRITE "It is recommended that the individual records be EXAMINED",!
162 WRITE "to better understand the linkages before deletion.",!
163 WRITE "If you don't know what you are doing,then don't proceed.",!,!
164 NEW % SET %=1
165 WRITE "EXAMINE records first" DO YN^DICN WRITE !
166 IF %=-1 GOTO KNDN
167 IF %=1 IF $$SHOWNEED(JNUM,.GETARRAY)=-1 GOTO KNDN
168 SET %=2
169 WRITE "PROCEED WITH DELETION FROM NEEDED LIST" DO YN^DICN WRITE !
170 IF %'=1 GOTO KNDN
171 SET FILENUM=0
172 SET STIME=$H
173 SET TMGCT=1,SHOWPROG=0
174 FOR SET FILENUM=$ORDER(GETARRAY(FILENUM)) QUIT:(FILENUM="")!(TMGABORT=1) DO
175 . NEW TMGMAX SET TMGMAX=-1
176 . NEW IEN SET IEN=""
177 . FOR SET IEN=$ORDER(GETARRAY(FILENUM,IEN),-1) QUIT:(IEN="")!(TMGABORT=1) DO
178 . . IF TMGMAX=-1 SET TMGMAX=IEN
179 . . SET TMGABORT=$$UserAborted^TMGUSRIF() QUIT:(TMGABORT=1)
180 . . SET TMGCT=TMGCT+1
181 . . DO UNNEEDPTR^TMGSIPHU(FILENUM,IEN,0,.TALLY)
182 . . IF (SHOWPROG=0),(($PIECE($H,",",2)-$PIECE(STIME,",",2))>15) SET SHOWPROG=1
183 . . IF SHOWPROG,(TMGCT#10=0) DO
184 . . . WRITE #
185 . . . DO ProgressBar^TMGUSRIF(TMGCT,"Progress: "_TMGCT,0,TMGMAX,70,STIME)
186 . . . IF $DATA(TALLY) WRITE ! ZWR TALLY
187 DO PRESSTOCONT^TMGUSRIF
188KNDN QUIT
189 ;
190 ;
191PREVIEW(JNUM,INOUT) ;
192 ;"Purpose: To allow user view server record before downloading and installing
193 ;"Input: JNUM -- The job number of the background client process
194 ;" INOUT -- OPTIONAL -- Default is "PTOUT". Should be "PTIN" or "PTOUT"
195 ;"Results: None
196 ;
197 NEW GETARRAY,FILENUM,IEN,STIME,TMGCT,SHOWPROG,TALLY,QUERY,ERROR
198 SET INOUT=$GET(INOUT) IF INOUT'="PTIN" SET INOUT="PTOUT"
199 NEW TMGABORT SET TMGABORT=0
200 NEW OPTIONS
201 SET OPTIONS("HEADER")="Select File(s) to PREVIEW. Press <ESC><ESC> when Done."
202 DO ASKNEEDED^TMGSIPH3(JNUM,.GETARRAY,INOUT,.OPTIONS)
203 IF $DATA(GETARRAY)=0 GOTO PVDN
204 NEW SHOWEMPTY
205 NEW % SET %=2
206 WRITE "Display Empty Fields" DO YN^DICN WRITE !
207 IF %=-1 GOTO PVDN
208 SET SHOWEMPTY=(%=1)
209 SET FILENUM=0
210 SET STIME=$H
211 SET TMGCT=1,SHOWPROG=0
212 FOR SET FILENUM=$ORDER(GETARRAY(FILENUM)) QUIT:(FILENUM="")!(TMGABORT=1) DO
213 . NEW TMGMAX SET TMGMAX=-1
214 . NEW IEN SET IEN=""
215 . FOR SET IEN=$ORDER(GETARRAY(FILENUM,IEN),-1) QUIT:(IEN="")!(TMGABORT=1) DO
216 . . IF TMGMAX=-1 SET TMGMAX=IEN
217 . . SET TMGABORT=$$UserAborted^TMGUSRIF() QUIT:(TMGABORT=1)
218 . . SET TMGCT=TMGCT+1
219 . . SET QUERY="DUMP REC|"_FILENUM_"^"_IEN_"^"_SHOWEMPTY
220 . . DO MSGCLIENT^TMGKERN2(JNUM,QUERY,.REPLY,.ERROR,30)
221 . . IF $DATA(ERROR) DO QUIT
222 . . . WRITE ERROR,!
223 . . . SET TMGABORT=1
224 . . NEW TMGI SET TMGI=""
225 . . FOR SET TMGI=$ORDER(REPLY(TMGI)) QUIT:(TMGI="") DO
226 . . . WRITE REPLY(TMGI),!
227 . . IF (SHOWPROG=0),(($PIECE($H,",",2)-$PIECE(STIME,",",2))>15) SET SHOWPROG=1
228 . . IF SHOWPROG,(TMGCT#10=0) DO
229 . . . WRITE #
230 . . . DO ProgressBar^TMGUSRIF(TMGCT,"Progress: "_TMGCT,0,TMGMAX,70,STIME)
231 . . . IF $DATA(TALLY) WRITE ! ZWR TALLY
232 DO PRESSTOCONT^TMGUSRIF
233PVDN QUIT
234 ;
235 ;
236CHKPTIN(JNUM) ;
237 ;"Purpose: to check for pointers in to files/records already downloaded.
238 ;"Input: JNUM -- The job number of the background client process
239 ;"Results: None
240 NEW TMGARRAY,TMGSEL
241 NEW FILENUM SET FILENUM=0
242 FOR SET FILENUM=$ORDER(^TMG("TMGSIPH","DOWNLOADED",FILENUM)) QUIT:(FILENUM'>0) DO
243 . NEW DISPSTR SET DISPSTR="Check for pointers IN to file #"_FILENUM_" ("
244 . SET DISPSTR=DISPSTR_$PIECE($GET(^DIC(FILENUM,0)),"^",1)_")"
245 . SET TMGARRAY(DISPSTR)=FILENUM
246 NEW HEADER SET HEADER="Select File(s) to Check for POINTERS IN. Press <ESC><ESC> when Done."
247 DO Selector^TMGUSRIF("TMGARRAY","TMGSEL",HEADER)
248 ;
249 NEW TMGABORT SET TMGABORT=0
250 NEW IDX SET IDX=""
251 FOR SET IDX=$ORDER(TMGSEL(IDX)) QUIT:(IDX="")!TMGABORT DO
252 . SET FILENUM=$GET(TMGSEL(IDX)) QUIT:FILENUM=""
253 . SET TMGABORT=($$CHK1PTIN(JNUM,FILENUM)'=1)
254 ;
255 WRITE !
256 DO PRESSTOCONT^TMGUSRIF;
257 QUIT
258 ;
259 ;
260CHK1PTIN(JNUM,FILENUM) ;
261 ;"Purpose: To cycle through all local records that have been downloaded and manuall
262 ;" check on server for pointers in, and que checks if needed.
263 ;"Input: JNUM -- The job number of the background client process
264 ;" FILENUM -- The file to process.
265 ;"Results: 1 if OK -1 if error/abort
266 NEW RESULT SET RESULT=1
267 NEW TMGABORT SET TMGABORT=0
268 NEW TMGCT SET TMGCT=999
269 NEW STIME SET STIME=$H
270 NEW TMGMIN SET TMGMIN=$ORDER(^TMG("TMGSIPH","DOWNLOADED",FILENUM,0))
271 NEW TMGMAX SET TMGMAX=$ORDER(^TMG("TMGSIPH","DOWNLOADED",FILENUM,""),-1)
272 NEW LPTR SET LPTR=0
273 FOR SET LPTR=$ORDER(^TMG("TMGSIPH","DOWNLOADED",FILENUM,LPTR)) QUIT:(+LPTR'>0)!TMGABORT DO
274 . SET TMGABORT=$$UserAborted^TMGUSRIF() QUIT:(TMGABORT=1)
275 . NEW RPTR SET RPTR=+$GET(^TMG("TMGSIPH","DOWNLOADED",FILENUM,LPTR))
276 . QUIT:(RPTR'>0)
277 . DO GETPTIN^TMGSIPH4(JNUM,FILENUM,RPTR)
278 . SET TMGCT=TMGCT+1
279 . IF TMGCT>25 DO
280 . . DO ProgressBar^TMGUSRIF(LPTR,"Checking pointers IN to file #"_FILENUM,TMGMIN,TMGMAX,70,STIME)
281 . . SET TMGCT=0
282 IF TMGABORT SET RESULT=-1
283 QUIT RESULT
284 ;
285 ;
286DELREC;
287 ;"Purpose: To allow a user to delete a record on the client, and remove record that it has
288 ;" been previously downloaded. This will allow it to be downloaded again.
289 WRITE !,"Select a downloaded record to delete from this client.",!
290 WRITE "NOTE: All pointer to this record will be deleted.",!
291 NEW X,Y,DIC,FILENUM,RESULT
292 SET DIC=1,DIC(0)="MAEQ"
293 DO ^DIC WRITE !
294 IF +Y>0 DO
295 . SET FILENUM=+Y
296 . NEW % SET %=2
297 . WRITE "DELETE *ALL* RECORDS IN FILE"
298 . DO YN^DICN WRITE !
299 . IF %=1 IF $$DELALL(FILENUM) QUIT
300 . IF %=-1 QUIT
301 . SET DIC=FILENUM
302 . DO ^DIC WRITE !
303 . IF +Y'>0 QUIT
304 . SET RESULT=$$DEL1REC(FILENUM,+Y)
305 . IF +RESULT=-1 DO
306 . . WRITE $PIECE(RESULT,"^",2),!
307 . ELSE DO
308 . . WRITE "Record deleted, and all pointers to record have been removed.",!
309 . DO PRESSTOCONT^TMGUSRIF
310 QUIT
311 ;
312 ;
313DELALL(FILENUM)
314 ;"Purpose: To allow deletion of all records in file on the client, and remove the
315 ;" notation that it has been downloaded.
316 ;"Input: FILENUM -- Filenumber to delete
317 ;"Result: 1 = OK, -1^Message if error
318 SET FILENUM=$GET(FILENUM)
319 NEW RESULT SET RESULT=1
320 NEW % SET %=2
321 WRITE "Are you CERTAIN you want to delete ALL records in file ",FILENUM
322 DO YN^DICN WRITE !
323 IF %'=1 SET RESULT="-1^USER ABORTED" GOTO DADN
324 NEW TMGCT SET TMGCT=0
325 NEW TMGABORT SET TMGABORT=0
326 NEW STIME SET STIME=$H
327 NEW REF SET REF=$GET(^DIC(FILENUM,0,"GL"))
328 IF REF="" DO GOTO DADN
329 . SET RESULT="-1^INVALID FILENUM: "_FILENUM
330 SET REF=$$CREF^DILF(REF)
331 SET TMGMIN=$ORDER(@REF@(0))
332 SET TMGMAX=$ORDER(@REF@("@"),-1)
333 NEW TMGIEN SET TMGIEN=0
334 FOR SET TMGIEN=$ORDER(@REF@(TMGIEN)) QUIT:(+TMGIEN'>0)!TMGABORT DO
335 . SET TMGABORT=$$UserAborted^TMGUSRIF() QUIT:(TMGABORT=1)
336 . IF TMGCT>100 DO
337 . . DO ProgressBar^TMGUSRIF(TMGIEN,"Deleting local records in file "_FILENUM,TMGMIN,TMGMAX,70,STIME)
338 . . SET TMGCT=0
339 . SET TMGCT=TMGCT+1
340 . SET RESULT=$$DEL1REC(FILENUM,TMGIEN,1)
341 . IF +RESULT=-1 SET TMGABORT=1
342 IF 'TMGABORT DO
343 . KILL ^TMG("TMGSIPH","PT XLAT",FILENUM)
344 . KILL ^TMG("TMGSIPH","RECORDS SYNC",FILENUM)
345DADN QUIT RESULT
346 ;
347 ;
348DEL1REC(FILENUM,LPTR,FORCE);
349 ;"Purpose: To allow deletion of a record on the client, and record that it has been downloaded.
350 ;"Input: FILENUM -- Filenumber to delete
351 ;" LPTR -- Record number (IEN) on client to delete
352 ;" FORCE -- OPTIONAL. If 1, then will delete even if not prev downloaded
353 ;"Result: 1 = OK, -1^Message if error
354 NEW RESULT SET RESULT=1
355 IF $GET(FORCE)=1 GOTO D1L1
356 NEW ISDNLOAD SET ISDNLOAD=($DATA(^TMG("TMGSIPH","DOWNLOADED",FILENUM,LPTR))'=0)
357 IF 'ISDNLOAD DO GOTO D1RDONE
358 . SET RESULT="-1^Record doesn't seem to have been downloaded. A local record was probably used instead."
359D1L1 NEW OPTION
360 SET OPTION(FILENUM,LPTR)=0
361 DO QTMVPTR^TMGFMUT(.OPTION)
362 NEW DIE,DR,DA
363 SET DIE=FILENUM
364 SET DR=".01///@"
365 SET DA=LPTR
366 DO ^DIE
367 NEW RPTR SET RPTR=+$GET(^TMG("TMGSIPH","DOWNLOADED",FILENUM,LPTR))
368 KILL ^TMG("TMGSIPH","DOWNLOADED",FILENUM,LPTR)
369 KILL ^TMG("TMGSIPH","PT XLAT",FILENUM,RPTR)
370D1RDONE QUIT RESULT
371 ;
372 ;
Note: See TracBrowser for help on using the repository browser.