source: cprs/branches/tmg-cprs/m_files/TMGFIX.m~@ 796

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

Initial upload
File size: 14.5 KB
Line 
1
2
3
4;"=====================================================================
5;"================================================================
6
7ENV ;Establish Routine Environment
8 N DDH,DIR,X,Y,ZTENV,ZTKEY,ZTNAME,ZTSK,XUTMUCI
9 D ENV^XUTMUTL Q:'$D(ZTENV)
10 ;
11 new DIC,X,Y
12 set DIC=.401
13 set DIC(0)="MAEQ"
14 do ^DIC write !
15 if +Y'>0 quit
16 new templIEN set tempLIEN=+Y
17 new IEN set IEN=""
18 for set IEN=$order(^DIBT(tempLIEN,1,IEN)) quit:IEN="" do
19 . do KILLTSK(IEN)
20
21 quit
22
23
24KILLTSK(ZTSK)
25 ;"W !
26 ;"S XUTMT(0)="AL"
27 ;"D ^XUTMT
28 I 'ZTSK K ^TMP($J,"XUTMT") Q
29 ;"I ZTSK["-"!(ZTSK[",") D ^XUTMD1 Q:$D(DTOUT) G SELECT
30 S XUTMT=ZTSK,XUTMT(0)="R3"
31 D ^XUTMT
32 ;
33STATUS ;Report On Status Of Task And Whether User May Delete It
34 I $D(ZTSK(.11))#2,ZTSK(.11)="UNDEFINED",$O(ZTSK(.3))="" W !!?5,"That task is not defined.",$C(7) G SELECT
35 I $D(ZTSK(.11))#2,ZTSK(.11)="UNDEFINED",$O(ZTSK(.3))="TASK",$O(ZTSK("TASK"))="" W !!?5,"That task is running and has no record." G SELECT
36 I $D(ZTSK(.11))#2,ZTSK(.11)="UNDEFINED" W !!?5,"That task is scheduled but has no record." G CONFIRM:ZTKEY G SELECT
37 ;
38S5 I $D(ZTSK(.11))#2,$O(ZTSK(.3))="" W !!?5,"That task's record is incomplete." G CONFIRM:ZTKEY G SELECT
39 I $D(ZTSK(.11))#2,$O(ZTSK(.3))="TASK",$O(ZTSK("TASK"))="" W !!?5,"That task is running and has an incomplete record." G SELECT
40 I $D(ZTSK(.11))#2 W !!?5,"That task is scheduled, but has an incomplete record." G CONFIRM:ZTKEY G SELECT
41 ;
42S9 I $O(ZTSK(.3))="TASK",$O(ZTSK("TASK"))="" W !!?5,"That task is running." G SELECT
43 I 'ZTKEY,$S($P(ZTSK(0),U,11)_","_$P(ZTSK(0),U,12)=XUTMUCI:DUZ'=$P(ZTSK(0),U,3),1:ZTNAME'=$P(ZTSK(0),U,10)) W !!?5,"You may only delete your own tasks." G SELECT
44 ;
45CONFIRM ;Prompt User To Confirm Unscheduling
46 I $S($D(ZTSK(.11))[0:1,1:ZTSK(.11)'="UNDEFINED") W ! D EN^XUTMTP(ZTSK)
47 ;"W !
48 ;"K DIR
49 ;"S DIR(0)="Y"
50 ;"S DIR("A")="Are you sure you want to delete this task"
51 ;"S DIR("B")="NO"
52 ;"S DIR("?")=" Answer YES to delete the task."
53 ;"D ^DIR
54 ;"I 'Y W !!?5,"Tasks NOT deleted!"
55 ;"I $D(DTOUT) W $C(7) Q
56 ;"K DIR,DIRUT,DTOUT,DUOUT
57 ;"I 'Y G SELECT
58 ;
59DELETE ;Delete Task
60 I $D(ZTSK(0))#2,ZTSK(0)["ZTSK^XQ1",$P(ZTSK(0),U,11)_","_$P(ZTSK(0),U,12)=XUTMUCI,$P(ZTSK(0),U,8)]"" D
61 . F DA=0:0 S DA=$O(^DIC(19.2,DA)) Q:DA'>0 I $G(^DIC(19.2,DA,1))=ZTSK D
62 . . N DIE S DIE="^DIC(19.2,",DR="2///@;12///@" D ^DIE Q
63 . Q
64 S XUTMT=ZTSK,XUTMT(0)="D"
65 D ^XUTMT
66 W !!?5,"Deleted!"
67 G SELECT
68 ;
69
70SELECT
71 quit
72
73
74
75FS1
76 NEW X,Y,DIC
77 SET DIC=1,DIC(0)="MAEQ"
78 DO ^DIC WRITE !
79 IF +Y'>0 QUIT
80 NEW I SET I=""
81 FOR SET I=$ORDER(^TMG("TMGSIPH","NEEDED RECORDS",+Y,I)) QUIT:(I'>0) DO
82 . NEW NODE SET NODE=""
83 . FOR SET NODE=$ORDER(^TMG("TMGSIPH","NEEDED RECORDS",+Y,I,NODE)) QUIT:(NODE="") DO
84 . . KILL ^TMG("TMGSIPH","NEEDED RECORDS",+Y,I,NODE)
85 . . SET ^TMG("TMGSIPH","NEEDED RECORDS",+Y,I,NODE,0)=""
86 QUIT
87
88KILLTMPL
89 new X,Y,DIC
90 set DIC=.401
91 set DIC(0)="MAEQ"
92 do ^DIC write !
93 if +Y'>0 write "goodbye.",! quit
94 NEW TMPL SET TMPL=+Y
95 new file set file=$piece($get(^DIBT(TMPL,0)),"^",4)
96 if file'=8925 do quit
97 . write "That file doesn't refer to file 8925. That is all this function can work with!",!
98 new % set %=2
99 write "Delete all the records referred to in this sort template?" do YN^DICN write !
100 if %'=1 write "goodbye.",! quit
101 new MIN,MAX
102 set MIN=$ORDER(^DIBT(TMPL,1,0))
103 set MAX=$ORDER(^DIBT(TMPL,1,""),-1)
104 new TMGCT set TMGCT=0
105 new STIME set STIME=$H
106 new TMGIEN set TMGIEN=0
107 for set TMGIEN=$ORDER(^DIBT(TMPL,1,TMGIEN)) quit:(+TMGIEN'>0) do
108 . ;"write TMGIEN,! quit
109 . new TMGFDA set TMGFDA(8925,TMGIEN_",",.01)="@"
110 . ;"new TMGFDA set TMGFDA(8925,TMGIEN_",",.05)="COMPLETED"
111 . new TMGMSG
112 . do FILE^DIE("E","TMGFDA","TMGMSG")
113 . NEW RPTR SET RPTR=+$GET(^TMG("TMGSIPH","DOWNLOADED",8925,TMGIEN))
114 . KILL ^TMG("TMGSIPH","DOWNLOADED",8925,TMGIEN)
115 . KILL ^TMG("TMGSIPH","PT XLAT",8925,RPTR)
116 . do ShowIfDIERR^TMGDEBUG(.TMGMSG)
117 . set TMGCT=TMGCT+1
118 . if TMGCT>50 do
119 . . do ProgressBar^TMGUSRIF(TMGIEN,"Deleting records",MIN,MAX,70,STIME)
120 . . set TMGCT=0
121 write "goodbye.",!
122 quit
123
124
125FIXXREF ;
126 NEW FILENUM SET FILENUM=0
127 FOR SET FILENUM=$ORDER(^TMG("TMGSIPH","PT XLAT",FILENUM)) QUIT:(+FILENUM'>0) DO
128 . NEW RPTR SET RPTR=0
129 . FOR SET RPTR=$ORDER(^TMG("TMGSIPH","PT XLAT",FILENUM,RPTR)) QUIT:(+RPTR'>0) DO
130 . . NEW LPTR SET LPTR=+$GET(^TMG("TMGSIPH","PT XLAT",FILENUM,RPTR))
131 . . IF LPTR'>0 WRITE "FILE ",FILENUM,", REMOTE IEN=",RPTR," --> ?? LOCAL PTR",! QUIT
132 . . IF $DATA(^TMG("TMGSIPH","DOWNLOADED",FILENUM,LPTR))=0 DO QUIT
133 . . . WRITE "FILE ",FILENUM,", LOCAL IEN=",LPTR," --> Not downloaded??",!
134 . . SET ^TMG("TMGSIPH","DOWNLOADED",FILENUM,LPTR)=RPTR
135 . . WRITE "Set ",$NAME(^TMG("TMGSIPH","DOWNLOADED",FILENUM,LPTR)),"=",RPTR,!
136 quit
137
138
139 ;" ; Note: ENTRY=DataPiece^PointedToFile^PointedToReference^IENDepth^[V]
140 ;" ; ONEREF will have multiple IEN entries if IENDepth>1, e.g. '^SC(IEN,"S",IEN(2),1,IEN(3),"C")'
141 ;" ; with order of IEN, IEN(2), IEN(3), ... etc.
142FIXSUBFILES ;
143 NEW FILENUM SET FILENUM=0
144 NEW ABORT SET ABORT=0
145 FOR SET FILENUM=$ORDER(^TMG("TMGSIPH","DOWNLOADED",FILENUM)) QUIT:(+FILENUM'>0)!ABORT DO
146 . NEW TMP SET TMP=$$HASPTRSF^TMGFMUT2(FILENUM)
147 . IF TMP DO
148 . . WRITE "FILE ",FILENUM," has pointer subfiles.... probably needs fix.",!
149 . . ;"IF $$DDOK^TMGSIPH1(JNUM,FILENUM)
150 . . IF $$SETPTOUT^TMGSIPH1(FILENUM)
151 . . NEW ONEREF SET ONEREF=""
152 . . FOR SET ONEREF=$ORDER(^TMG("TMGSIPH","DD",FILENUM,"PTR OUT",ONEREF)) QUIT:(ONEREF="")!ABORT DO
153 . . . ;"WRITE "ONEREF=",ONEREF,!
154 . . . NEW ENTRY SET ENTRY=""
155 . . . FOR SET ENTRY=$ORDER(^TMG("TMGSIPH","DD",FILENUM,"PTR OUT",ONEREF,ENTRY)) QUIT:(ENTRY="")!ABORT DO
156 . . . . NEW IENDEPTH SET IENDEPTH=$PIECE(ENTRY,"^",4)
157 . . . . IF IENDEPTH=1 QUIT
158 . . . . NEW PCE SET PCE=+ENTRY
159 . . . . ;"WRITE " ENTRY=",ENTRY,!
160 . . . . NEW IEN SET IEN=0
161 . . . . NEW GREF SET GREF=^DIC(FILENUM,0,"GL") QUIT:(GREF="")
162 . . . . NEW CGREF SET CGREF=$$CREF^DILF(GREF)
163 . . . . FOR SET IEN=$ORDER(@CGREF@(IEN)) QUIT:(+IEN'>0)!ABORT DO
164 . . . . . FOR QUIT:($$IENCOMBO^TMGFMUT2(ONEREF,IENDEPTH,.IEN)'=1)!ABORT DO
165 . . . . . . SET ABORT=$$UserAborted^TMGUSRIF QUIT:ABORT
166 . . . . . . NEW TMPREF SET TMPREF=$NAME(@ONEREF) ;"Puts IEN's from IEN array into name.
167 . . . . . . NEW IENS SET IENS=$$GETIENS^TMGFMUT2(.IEN)
168 . . . . . . IF $GET(^TMG("TMGSIPH","FIX",FILENUM,TMPREF))'="" QUIT ;"Already fixed.
169 . . . . . . NEW FROMFILE SET FROMFILE=$PIECE(ENTRY,"^",6)
170 . . . . . . NEW PT SET PT=$PIECE($GET(@TMPREF),"^",PCE) ;"$$IENCOMBO sets up IEN(n).. needed for @REF
171 . . . . . . NEW ISVIRT SET ISVIRT=($PIECE(ENTRY,"^",5)="V")
172 . . . . . . NEW P2REF SET P2REF=$PIECE(ENTRY,"^",3)
173 . . . . . . IF ISVIRT,$PIECE(PT,";",2)'=P2REF QUIT ;"Loop to handle PTR with different ENTRY (V-Ptrs stored as IEN;OREF)
174 . . . . . . SET PT=+PT QUIT:(PT'>0)
175 . . . . . . NEW P2FILE SET P2FILE=$PIECE(ENTRY,"^",2)
176 . . . . . . NEW FROMFLD SET FROMFLD=$PIECE(ENTRY,"^",7)
177 . . . . . . NEW LPTR SET LPTR=$GET(^TMG("TMGSIPH","PT XLAT",P2FILE,PT),"??")
178 . . . . . . WRITE "FILENUM: ",FILENUM," IENS=",IENS," ",TMPREF," --> PTR=",PT," in file: ",P2FILE," LPTR=",LPTR,!
179 . . . . . . IF LPTR'="??" DO
180 . . . . . . . IF (PT'=LPTR) SET $PIECE(@TMPREF,"^",PCE)=LPTR
181 . . . . . . . SET ^TMG("TMGSIPH","FIX",FILENUM,TMPREF)=PT ;"Store old value just in case...
182 . . . . . . ELSE DO
183 . . . . . . . SET ^TMG("TMGSIPH","NEEDED RECORDS","PTOUT",P2FILE,PT,TMPREF,ENTRY)=""
184 . . . . . . . ;"IF $$NEEDPTIN^TMGSIPH3(FILENUM) DO
185 . . . . . . . ;". SET ^TMG("TMGSIPH","NEEDED RECORDS","PTIN",FILENUM,)=""
186 . . . . . NEW TMPIEN SET TMPIEN=IEN KILL IEN SET IEN=TMPIEN ;"delete subnodes in array.
187 do PRESSTOCONT^TMGUSRIF
188 quit
189
190
191 ;" ; Note: ENTRY=DataPiece^PointedToFile^PointedToReference^IENDepth^[V]
192 ;" ; ONEREF will have multiple IEN entries if IENDepth>1, e.g. '^SC(IEN,"S",IEN(2),1,IEN(3),"C")'
193 ;" ; with order of IEN, IEN(2), IEN(3), ... etc.
194FIXDDSUBFILES ;
195 NEW FILENUM SET FILENUM=0
196 NEW ABORT SET ABORT=0
197 FOR SET FILENUM=$ORDER(^TMG("TMGSIPH","DOWNLOADED",FILENUM)) QUIT:(+FILENUM'>0)!ABORT DO
198 . ;"NEW TMP SET TMP=$$HASPTRSF^TMGFMUT2(FILENUM)
199 . ;"IF TMP DO
200 . WRITE "FILE ",FILENUM," has had DD reset.",!
201 . IF $$SETPTOUT^TMGSIPH1(FILENUM)
202 do PRESSTOCONT^TMGUSRIF
203 quit
204
205
206FTIU
207 new IEN set IEN=0
208 for set IEN=$O(^TIU(8925,IEN)) q:(+IEN'>0) if $D(^TIU(8925,IEN,"TEMP")) do
209 . write IEN
210 . if $D(^TIU(8925,IEN,"TEXT"))=0 do quit
211 . . write "NO TEXT"
212 . . merge ^TIU(8925,IEN,"TEXT")=^TIU(8925,IEN,"TEMP")
213 . . kill ^TIU(8925,IEN,"TEMP")
214 . . write " -- FIXED",!
215 . new SAME set SAME=1
216 . new j set j=0
217 . for set j=$o(^TIU(8925,IEN,"TEMP",j)) quit:(+j'>0)!(SAME=0)
218 . . if $G(^TIU(8925,IEN,"TEMP",j,0))'=$G(^TIU(8925,IEN,"TEXT",j,0)) set SAME=0
219 . write " --> SAME=",SAME
220 . if SAME kill ^TIU(8925,IEN,"TEMP") write " FIXED."
221 . write !
222 quit
223
224CKREC
225 ;"^TMG("TMGSIPH","PT XLAT",FILENUM,RemoteIEN)=LocalIEN
226 NEW DIC,X,Y
227 SET DIC(0)="MAEQ"
228 SET DIC=1
229 DO ^DIC WRITE !
230 IF +Y'>0 QUIT
231 NEW ARRAY
232 NEW OVERLAP
233 SET OVERLAP=$$CKREC1F(+Y,.ARRAY)
234 IF OVERLAP DO
235 . WRITE "FILE #",+Y," has ",OVERLAP," overlapping records.",!
236 QUIT
237
238
239CKALLREC
240 NEW FILENUM SET FILENUM=0
241 NEW ARRAY
242 FOR SET FILENUM=$ORDER(^TMG("TMGSIPH","DOWNLOADED",FILENUM)) QUIT:(+FILENUM'>0) DO
243 . NEW OVERLAP
244 . write "Checking file #",FILENUM,"..."
245 . SET OVERLAP=$$CKREC1F(FILENUM,.ARRAY)
246 . WRITE "FILE #",FILENUM," has ",OVERLAP," overlapping records.",!
247 MERGE ^TMG("TMGSIPH","OVERLAP")=ARRAY
248 QUIT
249
250
251CKREC1F(FILENUM,ARRAY)
252 NEW CT SET CT=0
253 NEW RPTR,LPTR
254 SET RPTR=0
255 FOR SET RPTR=$ORDER(^TMG("TMGSIPH","PT XLAT",FILENUM,RPTR)) QUIT:(+RPTR'>0) DO
256 . SET LPTR=$GET(^TMG("TMGSIPH","PT XLAT",FILENUM,RPTR)) QUIT:LPTR=""
257 . SET ARRAY(FILENUM,LPTR,RPTR)=""
258 . SET CT=CT+1
259 . IF CT#100=0 WRITE "." SET CT=0
260 ;"Now delete all entries that are not doubled up.
261 SET LPTR=0
262 FOR SET LPTR=$ORDER(ARRAY(FILENUM,LPTR)) QUIT:(LPTR="") DO
263 . NEW REF SET REF=$NAME(ARRAY(FILENUM,LPTR))
264 . SET CT=$$ListCt^TMGMISC(REF)
265 . IF CT=1 KILL @REF
266 write !
267 QUIT $$ListCt^TMGMISC($NAME(ARRAY(FILENUM)))
268
269
270SUMM
271 NEW FILENUM SET FILENUM=0
272 FOR SET FILENUM=$ORDER(^TMG("TMGSIPH","OVERLAP",FILENUM)) QUIT:FILENUM="" DO
273 . NEW FNAME SET FNAME=$PIECE($GET(^DIC(FILENUM,0)),"^",1)
274 . NEW REF SET REF=$NAME(^TMG("TMGSIPH","OVERLAP",FILENUM))
275 . WRITE "FILE [",FNAME,"] has ",$$ListCt^TMGMISC(REF)," overlapping records",!
276 quit
277
278
279COMPRPC
280 NEW DIC,X,Y
281 NEW OPTION1,OPTION2
282 SET DIC=19,DIC(0)="MAEQ"
283 WRITE "First pick the OLDER entry to compaire",!
284 DO ^DIC WRITE !
285 IF Y=-1 GOTO CPRDN
286 SET OPTION1=+Y
287 WRITE !,"Now, pick the NEWER entry to compare",!
288 DO ^DIC WRITE !
289 IF Y=-1 GOTO CPRDN
290 SET OPTION2=+Y
291 NEW ARRAY1,ARRAY2
292 NEW IEN
293 SET IEN=0
294 FOR SET IEN=$ORDER(^DIC(19,OPTION1,"RPC",IEN)) QUIT:(+IEN'>0) DO
295 . NEW PRPC
296 . SET PRPC=+$GET(^DIC(19,OPTION1,"RPC",IEN,0))
297 . NEW NAME SET NAME=$PIECE($GET(^XWB(8994,PRPC,0)),"^",1)
298 . IF NAME="" WRITE IEN," --> ??",!
299 . ELSE SET ARRAY1(NAME,IEN)=""
300
301 SET IEN=0
302 FOR SET IEN=$ORDER(^DIC(19,OPTION2,"RPC",IEN)) QUIT:(+IEN'>0) DO
303 . NEW PRPC
304 . SET PRPC=+$GET(^DIC(19,OPTION2,"RPC",IEN,0))
305 . NEW NAME SET NAME=$PIECE($GET(^XWB(8994,PRPC,0)),"^",1)
306 . IF NAME="" WRITE IEN," --> ??",!
307 . ELSE SET ARRAY2(NAME,IEN)=""
308
309 NEW NAME SET NAME=""
310 FOR SET NAME=$ORDER(ARRAY1(NAME)) QUIT:(NAME="") DO
311 . IF $DATA(ARRAY2(NAME)) DO
312 . . WRITE "Both have: ",NAME,!
313 . . KILL ARRAY1(NAME),ARRAY2(NAME)
314
315 NEW TEMP
316 WRITE "OK. Here are the entries in the OLDER option, not present in the new one.",!
317 IF $DATA(ARRAY1) ZWR ARRAY1
318 else write "(none)",!
319
320 DO PRESSTOCONT^TMGUSRIF
321
322 WRITE "OK. Here are the entries in the NEWER option, not present in the old one.",!
323 IF $DATA(ARRAY2) ZWR ARRAY2
324 else write "(none)",!
325
326 DO PRESSTOCONT^TMGUSRIF
327
328CPRDN WRITE "GOODBYE",!
329 QUIT
330
331IHS
332 new IEN set IEN=0
333 for set IEN=$order(^DPT(IEN)) quit:(+IEN'>0) do
334 . if $data(^AUPNPAT(IEN))'=0 write "." quit
335 . write "Missing data for IEN=",IEN,!
336 . set ^TMG("TMGSIPH","NEEDED RECORDS","PTIN",9000001,IEN)=""
337 . kill ^TMG("TMGSIPH","PT XLAT",9000001,IEN)
338 quit
339
340IHS2
341 new IEN set IEN=0
342 new Ct set Ct=0
343 new DIK set DIK="^AUPNPAT("
344 new DA
345 new matched set matched=0
346 new ABORT set ABORT=0
347 for set IEN=$order(^AUPNPAT(IEN)) quit:(+IEN'>0)!ABORT do
348 . set ABORT=$$UserAborted^TMGUSRIF
349 . new P2 set P2=$P($G(^AUPNPAT(IEN,0)),"^",1)
350 . if $data(^DPT(IEN))=0 do quit
351 . . write "!"
352 . . set Ct=Ct+1
353 . . set DA=IEN
354 . . do ^DIK
355 . if IEN=P2 write "." set matched=matched+1 quit
356 . write !,IEN," ",P2,!
357 write !,Ct," extra records",!
358 write matched," matched records",!
359 quit
360
361IHS3
362 new IEN set IEN=0
363 for set IEN=$order(^TMG("TMGSIPH","PT XLAT",9000001,IEN)) QUIT:(IEN'>0) DO
364 . NEW PT SET PT=$GET(^TMG("TMGSIPH","PT XLAT",9000001,IEN))
365 . if PT=0 kill ^TMG("TMGSIPH","PT XLAT",9000001,IEN) quit
366 . if PT'=IEN write "MISMATCH IEN ",IEN,"=",PT,!
367 write "goodbye",!
368 quit
Note: See TracBrowser for help on using the repository browser.