source: cprs/branches/tmg-cprs/m_files/TMGNDF4B.m

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

Initial upload
File size: 28.2 KB
Line 
1TMGNDF4B ;TMG/kst/FDA Import: Activation of POI's ;03/25/06
2 ;;1.0;TMG-LIB;**1**;11/21/06
3
4 ;" FDA - NATIONAL DRUG FILES COMPILING FUNCTIONS
5 ;" Activation of records in PHARMACY ORDERABLE ITEM file
6 ;"Kevin Toppenberg MD
7 ;"GNU General Public License (GPL) applies
8 ;"11-21-2006
9
10 ;"=======================================================================
11 ;" API -- Public Functions.
12 ;"=======================================================================
13 ;"Menu
14
15 ;"ActivAll -- remove the inactive date for all records in 50.7
16 ;"Activ1TMG(IEN) -- activate records linked from 22706.9 in 50.7
17 ;"Activ1Rx(IEN50) -- activate records linked from 50 in 50.7
18
19 ;"=======================================================================
20 ;" Private Functions.
21 ;"=======================================================================
22 ;"ActivDate(DateAfter) -- remove inactive date if inactive date on/after DateAfter
23 ;"XFormOff -- remove restrinction in input transform that prevents deletion.
24 ;"XFormOn -- restore the input transform to field .04 in file 50.7
25 ;"SetXForm(code) -- remove the old input transform, and replace with code
26
27
28 ;"=======================================================================
29
30Menu
31
32 new Menu,UsrSlct
33 set Menu(0)="Pick Option to Activate PHARMACY ORDERABLE ITEMS (4B)"
34 set Menu(1)="Activate import PHARMACY ORDERABLE ITEMS."_$char(9)_"ActivateImports"
35 set Menu(2)="Inactivate POI's NOT from an active FDA import."_$char(9)_"InactivateNonImports"
36 set Menu(3)="Check for duplicate entries in POI file"_$char(9)_"Check4Dups"
37 set Menu(4)="Check for dangling entries in POI file"_$char(9)_"Check4Dangle"
38 set Menu("P")="Prev Stage"_$char(9)_"Prev"
39 set Menu("N")="Next Stage"_$char(9)_"Next"
40
41M1 write #
42 set UsrSlct=$$Menu^TMGUSRIF(.Menu,"^")
43
44 if UsrSlct="ActivateImports" do ActivRecs(1) goto M1
45 if UsrSlct="InactivateNonImports" do InactivateNonImports("NOW") goto M1
46 if UsrSlct="Check4Dups" do Check4Dups goto M1
47 if UsrSlct="Check4Dangle" do Check4Dangle goto M1
48 if UsrSlct="Prev" goto Menu^TMGNDF4A ;"quit can occur from there...
49 if UsrSlct="Next" goto Menu^TMGNDF4C ;"quit can occur from there...
50 if UsrSlct="^" goto MenuDone
51 goto M1
52
53MenuDone
54 quit
55
56 ;"=============================================================================
57
58ActivRecs(OnlyImports)
59 ;"Purpose: To activate records in 50.7 by removing the inactivation date
60 ;"Input: OnlyImports: if 1 then only records linked to a FDA import will be modified.
61 ;" if 0 then ALL records will be modified.
62 ;"Results: none
63
64 new date,%T,X,Y
65 set X="1/1/1960"
66 do ^%DT
67 if Y'>0 goto AvADone
68 set date=Y
69
70 do ActivateImports(date,OnlyImports)
71AvADone
72 quit
73
74
75Activ1TMG(IEN,Option)
76 ;"Purpose: To activate records linked from 22706.9 in 50.7 by removing the inactivation date
77 ;"Input: IEN -- IEN in 22706.9
78 ;"Get 22706.9 --> 50 --> 50.7
79 ;" --> 50 --> 50.7
80 new gIEN50,tIEN50
81 set tIEN50=+$piece($get(^TMG(22706.9,IEN,7)),"^",1)
82 set gIEN50=+$piece($get(^TMG(22706.9,IEN,7)),"^",2)
83 do Activ1Rx(tIEN50)
84 do Activ1Rx(gIEN50)
85
86 quit
87
88
89Activ1Rx(IEN50)
90 ;"Purpose: To activate records linked from 50 in 50.7 by removing the inactivation date
91 ;"Input: IEN -- IEN in 22706.9
92 ;"Result: none
93
94 new date,%T,X,Y
95 set X="1/1/1960"
96 do ^%DT
97 if Y'>0 goto AvADone
98 set date=Y
99
100 do XFormOff
101
102 ;"Get 50 --> 50.7
103 if +$get(IEN50)'>0 goto A1RxDone
104 new IEN50d7
105 set IEN50d7=+$piece($get(^PSDRUG(IEN50,2)),"^",1)
106 if IEN50d7=0 quit
107 new temp set temp=$$Active1(IEN50d7,date)
108
109 do XFormOn
110
111A1RxDone
112 quit
113
114
115ActivateImports(DateAfter,OnlyImports)
116 ;"Purpose: To remove inactive date for all records in PHARMACY ORDERABLE ITEM
117 ;" having an inactive date on/after DateAfter
118 ;"Input: DateAfter -- the date to compare the inactive date with. If the
119 ;" inactive date is on/after DateAfter, then inactive date
120 ;" will be deleted.
121 ;" ** Must be in Fileman Date format
122 ;" OnlyImports: if 1 then only records linked to a FDA import will be modified.
123 ;" if 0 then ALL records will be modified.
124
125 do XFormOff
126
127 new Itr,IEN,Date,Y,X
128 new count set count=0
129 new abort set abort=0
130
131 write !,!,"Scanning all PHARMACY ORDERABLE ITEMS to activate those",!
132 write " records linked to an active (non-skipped) FDA import...",!
133 set IEN=$$ItrInit^TMGITR(50.7,.Itr)
134 do PrepProgress^TMGITR(.Itr,20,0,"IEN")
135 if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0)!(abort>0)
136 . if $$UserAborted^TMGUSRIF set abort=1 quit
137 . if (OnlyImports=1),($$IsImport^TMGNDFUT(IEN)=0) quit
138 . new temp set temp=$$Active1(IEN,DateAfter)
139 . if temp=2 set count=count+1
140 do ProgressDone^TMGITR(.Itr)
141
142 do XFormOn
143 kill TMGXFORM
144
145 write count," records modified.",!
146 do PressToCont^TMGUSRIF
147
148 quit
149
150
151Active1(IEN,DateAfter)
152 ;"Purpose: To remove inactive date for one records in PHARMACY ORDERABLE ITEM
153 ;" having an inactive date on/after DateAfter
154 ;"Input: IEN -- the IEN from file 50.7 to affect
155 ;" DateAfter -- the date to compare the inactive date with. If the
156 ;" inactive date is on/after DateAfter, then inactive date
157 ;" will be deleted.
158 ;" ** Must be in Fileman Date format
159 ;"Results: 1=OK, 0 error occurred, 2 if modification made
160 ;"NOTE: The XFormOff should be called before this is called, and XFormON called after
161
162
163 new Date,Y,X
164 new abort set abort=-5
165 new TMGFDA,TMGMSG
166 new X1,X2
167 new result set result=1
168
169 set X2=$piece($get(^PS(50.7,IEN,0)),"^",4) ;"0;4 --> inactive date
170 if X2="" goto A1Done
171 ;"set X1=DateAfter
172 ;"do ^%DTC
173 set TMGFDA(50.7,IEN_",",.04)="" ;"kill inactive date
174 new $etrap set $etrap="W ""??ERROR TRAPPED??"",! Q"
175 do FILE^DIE("K","TMGFDA","TMGMSG")
176 new PriorErrorFound
177 if $$ShowIfError^TMGDBAPI(.TMGMSG,.PriorErrorFound) set result=0 goto A1Done
178 set X2=$piece($get(^PS(50.7,IEN,0)),"^",4) ;"0;4 --> inactive date
179 if X2'="" do goto A1Done
180 . write "Deletion of 50.7 inactivation date (",X2,") FAILED in record: ",IEN,!
181 . set result=0
182
183 set result=2
184A1Done
185 quit result
186
187
188InactivateNonImports(Date)
189 ;"Purpose: To inactive records in PHARMACY ORDERABLE ITEM not linked to a FDA import
190 ;"Input: DateAfter -- OPTIONAL. Default is "NOW"
191 ;" The date to to use for the inactivation
192 ;" ** Must be in EXTERNAL format
193 ;"Results: none
194
195 do XFormOff
196
197 new Itr,IEN,Date,Y,X
198 set Date=$get(Date,"NOW")
199 new abort set abort=0
200 new count set count=0
201
202 write !,!,"Scanning all PHARMACY ORDERABLE ITEMS to inactivate those NOT",!
203 write " linked to an active (i.e. non-skipped) FDA import...",!
204 set IEN=$$ItrInit^TMGITR(50.7,.Itr)
205 do PrepProgress^TMGITR(.Itr,20,0,"IEN")
206 if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0)!(abort>0)
207 . if $$UserAborted^TMGUSRIF set abort=1 quit
208 . if $$IsImport^TMGNDFUT(IEN)=1 quit
209 . new temp set temp=$$InActv1(IEN,Date)
210 . if temp=2 set count=count+1
211 do ProgressDone^TMGITR(.Itr)
212
213 do XFormOn
214 kill TMGXFORM
215
216 ;"Now check that all skipped imports don't point to POI records.
217 ;"And that pointers point to valid records.
218 new ChangeCt set ChangeCt=0
219 new Itr,IEN22706d9
220 new abort set abort=0
221 write !,"Checking Imports for links to bad POI records",!
222 set IEN22706d9=$$ItrInit^TMGITR(22706.9,.Itr)
223 do PrepProgress^TMGITR(.Itr,20,0,"IEN22706d9")
224 if IEN22706d9'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN22706d9)'>0)!abort
225 . if $$UserAborted^TMGUSRIF set abort=1 quit
226 . new tIEN50d7 set tIEN50d7=$piece($get(^TMG(22706.9,IEN22706d9,8)),"^",3)
227 . set count=count+$$Verify1(IEN22706d9,tIEN50d7,"TRADE")
228 . new gIEN50d7 set gIEN50d7=$piece($get(^TMG(22706.9,IEN22706d9,8)),"^",4)
229 . set count=count+$$Verify1(IEN22706d9,gIEN50d7,"GENERIC")
230 do ProgressDone^TMGITR(.Itr)
231
232 write count," records modified.",!
233 do PressToCont^TMGUSRIF
234
235 quit
236
237
238Verify1(IEN22706d9,IEN50d7,mode)
239 ;"To Verify one
240 ;"Input: IEN22706d9
241 ;" IEN50 -- link to PHARMACY ORDERABLE ITEM file (either for Generic Drug, or Trade Drug)
242 ;" mode - "GENERIC" or "TRADE"
243 ;"Result: 0 -- no change, 1= change made
244
245 new result set result=0
246 new field50d7 set field50d7=""
247 new fieldName set fieldName=""
248 new node,pce set (node,pce)=""
249 if mode="GENERIC" do
250 . set field50d7=5.71
251 . set fieldName=.075
252 . set node=7,pce=4
253 else if mode="TRADE" do
254 . set field50d7=5.61
255 . set fieldName=.055
256 . set node=7,pce=3
257 if (field50d7="") goto V1Done
258 if (IEN50d7="") goto V1Done
259
260 new drugName set drugName=$piece($get(^PS(50.7,IEN50d7,0)),"^",1)
261 new TMGName set TMGName=$piece($get(^TMG(22706.9,IEN22706d9,node)),"^",pce)
262 set TMGName=$translate(TMGName,";",":")
263
264 if $data(^PS(50.7,+$get(IEN50d7)))=0 do
265 . write "Bad pointer: ",IEN50d7
266 . set IEN50d7=0
267
268 if drugName'=TMGName do
269 . write IEN22706d9," (",$extract(mode,1),"): Name mismatch: ",drugName," vs ",TMGName,!
270 . if TMGName="" set IEN50d7=0
271
272 if $get(IEN50d7)=0 do goto V1Done
273 . new TMGFDA,TMGMSG
274 . set TMGFDA(22706.9,IEN22706d9_",",field50d7)="@"
275 . do UPDATE^DIE("","TMGFDA","TMGMSG")
276 . do ShowIfDIERR^TMGDEBUG(.TMGMSG)
277 . write " ... fixed.",!
278 . set result=1
279V1Done
280 quit result
281
282
283InActv1(IEN,Date)
284 ;"Purpose: To set inactive date for one records in PHARMACY ORDERABLE ITEM
285 ;" having no inactive date
286 ;"Input: IEN -- the IEN from file 50.7 to affect
287 ;" Date -- the date to set inactive date to. Should be EXTERNAL FORMAT
288 ;"Results: 1=OK, 0 error occurred, 2 if record modified
289 ;"NOTE: The XFormOff should be called before this is called, and XFormON called after
290
291 new abort set abort=-5
292 new TMGFDA,TMGMSG
293 new X1,X2
294 new result set result=1
295
296 set X2=$piece($get(^PS(50.7,IEN,0)),"^",4) ;"0;4 --> inactive date
297 if X2'="" goto IA1Done
298 set TMGFDA(50.7,IEN_",",.04)=Date ;"new inactive date
299 new $etrap set $etrap="W ""??ERROR TRAPPED??"",! Q"
300 do FILE^DIE("EK","TMGFDA","TMGMSG")
301 new PriorErrorFound
302 if $$ShowIfError^TMGDBAPI(.TMGMSG,.PriorErrorFound) set result=0 goto IA1Done
303 set result=2
304IA1Done
305 quit result
306
307
308XFormOff
309 ;"Purpose: to remove restrinction in input transform that prevents deletion.
310
311 ;"new TMGXFORM ;NOTE: NO new -- will be killed later
312 set TMGXFORM=$piece($get(^DD(50.7,.04,0)),"^",5,99)
313 merge ^TMG("TMP","XREF",50.7,.04,1)=^DD(50.7,.04,1)
314 kill ^DD(50.7,.04,1) ;"kill off the screening xref code
315 do SetXForm("W !,X,! S %DT=""E"" D ^%DT S X=Y S:Y<1 X=""""")
316
317 quit
318
319
320XFormOn
321 ;"Purpose: to restore the input transform to field .04 in file 50.7
322
323 set TMGXFORM=$get(TMGXFORM,"S %DT=""EX"" D ^%DT S X=Y K:Y<1 X")
324 do SetXForm(TMGXFORM)
325 kill ^DD(50.7,.04,1)
326 merge ^DD(50.7,.04,1)=^TMG("TMP","XREF",50.7,.04,1) ;"restore screening xref code
327 quit
328
329
330SetXForm(code)
331 ;"Purpose: to remove the old input transform, and replace with code
332
333 set $piece(^DD(50.7,.04,0),"^",5,99)="" ;"clear out old stuff
334 set $piece(^DD(50.7,.04,0),"^",5)=code
335 ;"zwr ^DD(50.7,.04,0)
336 quit
337
338
339Check4Dups
340 ;"Purpose: to ensure that there are not two entries in the PHARMACY ORDERABLE ITEM
341 ;" file with the same name.
342
343 new array,dupArray
344
345 new Itr,IEN
346 new abort set abort=0
347 set IEN=$$ItrInit^TMGITR(50.7,.Itr)
348 do PrepProgress^TMGITR(.Itr,20,0,"IEN")
349 if IEN'="" for do quit:(+$$ItrNext^TMGITR(.Itr,.IEN)'>0)!abort
350 . if $$UserAborted^TMGUSRIF set abort=1 quit
351 . new name set name=$piece($get(^PS(50.7,IEN,0)),"^",1)
352 . new priorIEN set priorIEN=+$order(array(name,""))
353 . if priorIEN'=0 do
354 . . write !,name," previously found...",!
355 . . set dupArray(name,priorIEN)=""
356 . . set dupArray(name,IEN)=""
357 . set array(name,IEN)=""
358 do ProgressDone^TMGITR(.Itr)
359
360 new count set count=0
361 new fixName set fixName=""
362 for set fixName=$order(dupArray(fixName)) quit:(fixName="") do
363 . new keepIEN set keepIEN=$order(dupArray(fixName,""))
364 . new IEN50d7 set IEN50d7=keepIEN
365 . for set IEN50d7=$order(dupArray(fixName,IEN50d7)) quit:(IEN50d7="") do
366 . . new IEN50Array
367 . . do GetpDRUGs^TMGNDFUT(IEN50d7,.IEN50Array)
368 . . new IEN50 set IEN50=""
369 . . for set IEN50=+$order(IEN50Array(IEN50)) quit:(IEN50=0) do
370 . . . new TMGFDA,TMGMSG
371 . . . set TMGFDA(50,IEN50_",",2.1)=keepIEN ;"redirect to ONE kept record
372 . . . do FILE^DIE("S","TMGFDA","TMGMSG")
373 . . . do ShowIfDIERR^TMGDEBUG(.TMGMSG)
374 . . kill TMGFDA,TMGMSG
375 . . set TMGFDA(50.7,IEN50d7_",",.01)="@" ;"kill duplicate record
376 . . do FILE^DIE("S","TMGFDA","TMGMSG")
377 . . do ShowIfDIERR^TMGDEBUG(.TMGMSG)
378 . . set count=count+1
379
380 write !,count," Modifications Made.",!
381
382 do PressToCont^TMGUSRIF
383 quit
384
385
386Check4Dangle
387 ;"Purpose: to ensure that there are no dangling entries in the PHARMACY
388 ;" ORDERABLE ITEM file
389
390 new fixArray
391
392 new goodCount set goodCount=0
393 new badCount set badCount=0
394 new count set count=0
395 new Itr,IEN50d7
396 new abort set abort=0
397 set IEN50d7=$$ItrInit^TMGITR(50.7,.Itr)
398 do PrepProgress^TMGITR(.Itr,20,0,"IEN50d7")
399 if IEN50d7'="" for do quit:(+$$ItrNext^TMGITR(.Itr,.IEN50d7)'>0)!abort
400 . if $$UserAborted^TMGUSRIF set abort=1 quit
401 . new dangle set dangle=1 ;"default to dangle
402 .
403 . new tempC,tempA,IEN50
404 . merge tempA=^PSDRUG("ASP",IEN50d7)
405 . do GetpDRUGs^TMGNDFUT(IEN50d7,.tempC,1)
406 .
407 . set IEN50=""
408 . for set IEN50=$order(tempC(IEN50)) quit:(IEN50="") kill tempA(IEN50)
409 . set IEN50="" for set IEN50=$order(tempA(IEN50)) quit:(IEN50="") do
410 . . if $piece($get(^PSDRUG(IEN50,"I")),"^",1)'="" kill tempA(IEN50)
411 .
412 . set IEN50=""
413 . for set IEN50=$order(tempA(IEN50)) quit:(IEN50="") do
414 . . write "50 #",IEN50," (",$$GET1^DIQ(50,IEN50_",",.01),") found that",!
415 . . write " --> POI #",IEN50d7,$$GET1^DIQ(50.7,IEN50d7_",",.01),")",!
416 . . new IEN22706d9
417 . . set IEN22706d9=$order(^TMG(22706.9,"DRUGT",IEN50,""))
418 . . if IEN22706d9="" do
419 . . . write "But there is no entry in 22706.9 pointing to this #50 record.",!
420 . . . write " ... deleting.",!
421 . . . do KillPOI^TMGNDFUT(IEN50d7)
422 . . else do
423 . . . if $piece($get(^TMG(22706.9,IEN22706d9,1)),"^",4)=1 do quit; 1= SKIP
424 . . . . write "But the 22706.9 entry pointing to this is SKIPPED",!
425 . . . else do
426 . . . . write "Here is the 22706.9 pointing to it: #",IEN22706d9," ",$$GET1^DIQ(22706.9,IEN22706d9_",",.056),")",!
427 . . . . new POI set POI=+$piece($get(^TMG(22706.9,IEN22706d9,8)),"^",3)
428 . . . . write "And this record points to POI #",POI," ",$$GET1^DIQ(50.7,POI_",",.01),")",!
429 . . set IEN22706d9=$order(^TMG(22706.9,"DRUGG",IEN50,""))
430 . . if IEN22706d9="" do
431 . . . write "But there is no entry in 22706.9 pointing to this #50 record.",!
432 . . else do
433 . . . if $piece($get(^TMG(22706.9,IEN22706d9,1)),"^",4)=1 do quit; 1= SKIP
434 . . . . write "But the 22706.9 entry pointing to this is SKIPPED",!
435 . . . else do
436 . . . . write "Here is the 22706.9 pointing to it: #",IEN22706d9," ",$$GET1^DIQ(22706.9,IEN22706d9_",",.056),")",!
437 . . . . new POI set POI=+$piece($get(^TMG(22706.9,IEN22706d9,8)),"^",4)
438 . . . . write "And this record points to POI #",POI," ",$$GET1^DIQ(50.7,POI_",",.01),")",!
439 .
440 .
441 . ;"--------Check trade drug links------------
442 . new tempA
443 . merge tempA=^TMG(22706.9,"POIT",IEN50d7)
444 . new IEN22706d9 set IEN22706d9=""
445 . for set IEN22706d9=$order(tempA(IEN22706d9)) quit:(IEN22706d9="") do
446 . . set dangle=0 ;"at least one link was found, so not dangling.
447 . . if $piece($get(^TMG(22706.9,IEN22706d9,1)),"^",4)=1 do quit; 1= SKIP
448 . . . write "?? PHARMACY ORDERABLE ITEM #",IEN50d7," points to skipped record!",!
449 . . . set fixArray(IEN50d7)=""
450 . . new tIEN50 set tIEN50=+$piece($get(^TMG(22706.9,IEN22706d9,7)),"^",1)
451 . . if tIEN50=0 write "??!!??",! quit
452 . . new tempIEN set tempIEN=+$piece($get(^PSDRUG(tIEN50,2)),"^",1)
453 . . if tempIEN=IEN50d7 quit
454 . . write !,"22706.9 #",IEN22706d9," (T) ",$$GET1^DIQ(22706.9,IEN22706d9_",",.056),")",!
455 . . write " --> POI #",IEN50d7," (",$$GET1^DIQ(50.7,IEN50d7_",",.01),")",!
456 . . write " --> 50 #",tIEN50," (",$$GET1^DIQ(50,tIEN50_",",.01),")",!
457 . . write " ---> POI #",tempIEN," (",$$GET1^DIQ(50.7,tempIEN_",",.01),")",!
458 . . write " Fixing this...",!
459 . . new TMGFDA,TMGMSG
460 . . set TMGFDA(50,tIEN50_",",2.1)=IEN50d7
461 . . do FILE^DIE("","TMGFDA","TMGMSG")
462 . . do ShowIfDIERR^TMGDEBUG(.TMGMSG)
463 . . set count=count+1
464 . ;"--------Now check generic drug links------------
465 . kill tempA
466 . merge tempA=^TMG(22706.9,"POIG",IEN50d7)
467 . new IEN22706d9 set IEN22706d9=""
468 . for set IEN22706d9=$order(tempA(IEN22706d9)) quit:(IEN22706d9="") do
469 . . set dangle=0 ;"at least one link was found, so not dangling.
470 . . if $piece($get(^TMG(22706.9,IEN22706d9,1)),"^",4)=1 do quit; 1= SKIP
471 . . . write "?? PHARMACY ORDERABLE ITEM #",IEN50d7," points to skipped 22706.9 record!",!
472 . . . set fixArray(IEN50d7)=""
473 . . new gIEN50 set gIEN50=+$piece($get(^TMG(22706.9,IEN22706d9,7)),"^",2)
474 . . if gIEN50=0 write "??!!??",! quit
475 . . new tempIEN set tempIEN=+$piece($get(^PSDRUG(gIEN50,2)),"^",1)
476 . . if tempIEN=IEN50d7 quit
477 . . write "22706.9 #",IEN22706d9," (T) ",$$GET1^DIQ(22706.9,IEN22706d9_",",.056),")",!
478 . . write " --> POI #",IEN50d7,$$GET1^DIQ(50.7,IEN50d7_",",.01),")",!
479 . . write " --> 50 #",gIEN50," (",$$GET1^DIQ(50,gIEN50_",",.01),")",!
480 . . write " ---> POI #",tempIEN," (",$$GET1^DIQ(50.7,tempIEN_",",.01),")",!
481 . . write " Fixing this...",!
482 . . new TMGFDA,TMGMSG
483 . . set TMGFDA(50,gIEN50_",",2.1)=IEN50d7
484 . . do FILE^DIE("","TMGFDA","TMGMSG")
485 . . do ShowIfDIERR^TMGDEBUG(.TMGMSG)
486 . . set count=count+1
487 . if dangle=1 set badCount=badCount+1
488
489 do ProgressDone^TMGITR(.Itr)
490
491 ;"remove this line later
492 set abort=0
493
494 write "Scanning 22706.9 for pointers to non-existant generic POI records",!
495 new IEN50d7 set IEN50d7=""
496 set IEN50d7=$$ItrAInit^TMGITR($name(^TMG(22706.9,"POIG")),.Itr)
497 do PrepProgress^TMGITR(.Itr,20,1,"IEN50d7")
498 if IEN50d7'="" for do quit:($$ItrANext^TMGITR(.Itr,.IEN50d7)="")!abort
499 . new Itr2
500 . set IEN22706d9=$$ItrAInit^TMGITR($name(^TMG(22706.9,"POIG",IEN50d7)),.Itr2)
501 . if IEN22706d9'="" for do quit:($$ItrANext^TMGITR(.Itr2,.IEN22706d9)="")!abort
502 . . if $$UserAborted^TMGUSRIF set abort=1 quit
503 . . if $data(^PS(50.7,IEN50d7))=0 do
504 . . . write !,"Dangling pointer in 22706.9 #",IEN22706d9," (G)",!
505 . . . write " .. Deleting",!
506 . . . do KillPOI^TMGNDFUT(IEN50d7)
507 . . . set count=count+1
508
509 write "Scanning 22706.9 for pointers to non-existant trade POI records",!
510 kill Itr
511 new IEN50d7 set IEN50d7=""
512 set IEN50d7=$$ItrAInit^TMGITR($name(^TMG(22706.9,"POIT")),.Itr)
513 do PrepProgress^TMGITR(.Itr,20,1,"IEN50d7")
514 if IEN50d7'="" for do quit:($$ItrANext^TMGITR(.Itr,.IEN50d7)="")!abort
515 . new Itr2
516 . set IEN22706d9=$$ItrAInit^TMGITR($name(^TMG(22706.9,"POIT",IEN50d7)),.Itr2)
517 . if IEN22706d9'="" for do quit:($$ItrANext^TMGITR(.Itr2,.IEN22706d9)="")!abort
518 . . if $$UserAborted^TMGUSRIF set abort=1 quit
519 . . if $data(^PS(50.7,IEN50d7))=0 do
520 . . . write !,"Dangling pointer in 22706.9 #",IEN22706d9," (T)",!
521 . . . write " .. Deleting",!
522 . . . do KillPOI^TMGNDFUT(IEN50d7)
523 . . . set count=count+1
524
525 goto C4D2 ;"xref not missing it after all. This step not needed
526 ;"For some reason xref is missing a record, so will do brute force search
527 write "Brute force scan of 22706.9...",!
528 kill Itr
529 set IEN22706d9=$$ItrInit^TMGITR(22706.9,.Itr)
530 do PrepProgress^TMGITR(.Itr,20,0,"IEN22706d9")
531 if IEN22706d9'="" for do quit:(+$$ItrNext^TMGITR(.Itr,.IEN22706d9)'>0)!abort
532 . if $$UserAborted^TMGUSRIF set abort=1 quit
533 . new tIEN50d7,gIEN50d7
534 . set tIEN50d7=+$piece($get(^TMG(22706.9,IEN22706d9,8)),"^",3)
535 . set gIEN50d7=+$piece($get(^TMG(22706.9,IEN22706d9,8)),"^",4)
536 . if (tIEN50d7>0),$data(^PS(50.7,tIEN50d7))=0 do
537 . . write !,"Dangling pointer in 22706.9 #",IEN22706d9," (T)",!
538 . . write " .. Deleting",!
539 . . do KillPOI^TMGNDFUT(tIEN50d7)
540 . . set count=count+1
541 . . set tIEN50d7=0
542 . if (gIEN50d7>0),$data(^PS(50.7,gIEN50d7))=0 do
543 . . write !,"Dangling pointer in 22706.9 #",IEN22706d9," (G)",!
544 . . write " .. Deleting",!
545 . . do KillPOI^TMGNDFUT(gIEN50d7)
546 . . set count=count+1
547 . . set gIEN50d7=0
548 . new TMGFDA,TMGMSG
549 . if tIEN50d7=0 set TMGFDA(22706.9,IEN22706d9_",",5.61)="@"
550 . if gIEN50d7=0 set TMGFDA(22706.9,IEN22706d9_",",5.71)="@"
551 . if $data(TMGFDA) do
552 . . do FILE^DIE("","TMGFDA","TMGMSG")
553 . . do ShowIfDIERR^TMGDEBUG(.TMGMSG)
554 . . set count=count+1
555 do ProgressDone^TMGITR(.Itr)
556C4D2
557 write "Scanning 22706.9 for pointers to non-existant generic OI records",!
558 new IEN101d43 set IEN101d43=""
559 set IEN101d43=$$ItrAInit^TMGITR($name(^TMG(22706.9,"OIG")),.Itr)
560 do PrepProgress^TMGITR(.Itr,20,1,"IEN101d43")
561 if IEN101d43'="" for do quit:($$ItrANext^TMGITR(.Itr,.IEN101d43)="")!abort
562 . new Itr2
563 . set IEN22706d9=$$ItrAInit^TMGITR($name(^TMG(22706.9,"OIG",IEN101d43)),.Itr2)
564 . if IEN22706d9'="" for do quit:($$ItrANext^TMGITR(.Itr2,.IEN22706d9)="")!abort
565 . . if $$UserAborted^TMGUSRIF set abort=1 quit
566 . . if $data(^ORD(101.43,IEN101d43))=0 do
567 . . . write !,"Dangling pointer in 22706.9 #",IEN22706d9," (G)",!
568 . . . write " ... Deleting",!
569 . . . set TMGFDA(22706.9,IEN22706d9_",",5.711)="@"
570 . . . do FILE^DIE("","TMGFDA","TMGMSG")
571 . . . do ShowIfDIERR^TMGDEBUG(.TMGMSG)
572 . . . set count=count+1
573
574 write "Scanning 22706.9 for pointers to non-existant trade OI records",!
575 new IEN101d43 set IEN101d43=""
576 set IEN101d43=$$ItrAInit^TMGITR($name(^TMG(22706.9,"OIT")),.Itr)
577 do PrepProgress^TMGITR(.Itr,20,1,"IEN101d43")
578 if IEN101d43'="" for do quit:($$ItrANext^TMGITR(.Itr,.IEN101d43)="")!abort
579 . new Itr2
580 . set IEN22706d9=$$ItrAInit^TMGITR($name(^TMG(22706.9,"OIT",IEN101d43)),.Itr2)
581 . if IEN22706d9'="" for do quit:($$ItrANext^TMGITR(.Itr2,.IEN22706d9)="")!abort
582 . . if $$UserAborted^TMGUSRIF set abort=1 quit
583 . . if $data(^ORD(101.43,IEN101d43))=0 do
584 . . . write !,"Dangling pointer in 22706.9 #",IEN22706d9," (T)",!
585 . . . write " .. Deleting",!
586 . . . set TMGFDA(22706.9,IEN22706d9_",",5.611)="@"
587 . . . do FILE^DIE("","TMGFDA","TMGMSG")
588 . . . do ShowIfDIERR^TMGDEBUG(.TMGMSG)
589 . . . set count=count+1
590
591 write "Scanning 50 for pointers to non-existant POI records",!
592 new IEN50d7 set IEN50d7=""
593 set IEN50d7=$$ItrAInit^TMGITR($name(^PSDRUG("ASP")),.Itr)
594 do PrepProgress^TMGITR(.Itr,20,1,"IEN50d7")
595 if IEN50d7'="" for do quit:($$ItrANext^TMGITR(.Itr,.IEN50d7)="")!abort
596 . new Itr2
597 . set IEN50=$$ItrAInit^TMGITR($name(^PSDRUG("ASP",IEN50d7)),.Itr2)
598 . if IEN50'="" for do quit:($$ItrANext^TMGITR(.Itr2,.IEN50)="")!abort
599 . . if $$UserAborted^TMGUSRIF set abort=1 quit
600 . . if $data(^PS(50.7,IEN50d7))=0 do
601 . . . write !,"Dangling pointer in 50 #",IEN50,!
602 . . . write " .. Deleting",!
603 . . . do KillPOI^TMGNDFUT(IEN50d7)
604 . . . set count=count+1
605
606 write "Scanning 101.43 for pointers to non-existant POI records",!
607 new ID set ID=""
608 set ID=$$ItrAInit^TMGITR($name(^ORD(101.43,"ID")),.Itr)
609 do PrepProgress^TMGITR(.Itr,20,1,"ID")
610 if ID'="" for do quit:($$ItrANext^TMGITR(.Itr,.ID)="")!abort
611 . if $$UserAborted^TMGUSRIF set abort=1 quit
612 . set IEN50d7=$piece(ID,";",1)
613 . if $data(^PS(50.7,IEN50d7))=0 do
614 . . write !,"Dangling pointer in 101.43 #",IEN50,!
615 . . write " .. Deleting",!
616 . . do KillPOI^TMGNDFUT(IEN50d7)
617 . . set count=count+1
618
619 do ProgressDone^TMGITR(.Itr)
620
621 ;"write goodCount," entries are not dangling.",!
622 write badCount," entries are dangling",!
623
624 set IEN50d7=""
625 for set IEN50d7=$order(fixArray(IEN50d7)) quit:(IEN50d7="")!abort do
626 . if $$UserAborted^TMGUSRIF set abort=1 quit
627 . write "Checking POI# ",IEN50d7,!
628 . new temp merge temp=^PSDRUG("ASP",IEN50d7)
629 . new IEN50 set IEN50=""
630 . for set IEN50=$order(temp(IEN50)) quit:(IEN50="") do
631 . . new name set name=$$GET1^DIQ(50,IEN50_",",.01) quit:(name="")
632 . . write " POI #",IEN50d7," IS pointed to from DRUG file, record #",IEN50," ",name,!
633 . . if $$IsImport^TMGNDFUT(IEN50d7) do quit
634 . . . write " (This record IS an active import)",!
635 . . . new tempA
636 . . . merge tempA=^TMG(22706.9,"POIG",IEN50d7)
637 . . . merge tempA=^TMG(22706.9,"POIT",IEN50d7)
638 . . . new IEN22706d9 set IEN22706d9=""
639 . . . for set IEN22706d9=$order(tempA(IEN22706d9)) quit:(IEN22706d9="") do
640 . . . . if $piece($get(^TMG(22706.9,IEN22706d9,1)),"^",4)=1 do quit; 1= SKIP
641 . . . . . write "?? PHARMACY ORDERABLE ITEM #",IEN50d7," points to skipped record!",!
642 . . . . new tIEN50,gIEN50
643 . . . . set tIEN50=+$piece($get(^TMG(22706.9,IEN22706d9,7)),"^",1)
644 . . . . if tIEN50>0 do
645 . . . . . write "22706.9 #",IEN22706d9," points to this from trade link",!
646 . . . . set gIEN50=+$piece($get(^TMG(22706.9,IEN22706d9,7)),"^",2)
647 . . . . if gIEN50>0 do
648 . . . . . write "22706.9 #",IEN22706d9," points to this from generic link",!
649 . . else do
650 . . . write " (This record is NOT an active import)",!
651 . . . new TMGFDA,TMGMSG
652 . . . set TMGFDA(50,IEN50_",",.01)="@"
653 . . . do Unlock50^TMGNDFUT
654 . . . do FILE^DIE("","TMGFDA","TMGMSG")
655 . . . do ShowIfDIERR^TMGDEBUG(.TMGMSG)
656 . . . do Lock50^TMGNDFUT
657 . . . write "Dangling entry in file 50 REMOVED.",!
658 . . . set count=count+1
659 . new TMGFDA,TMGMSG
660 . set TMGFDA(50.7,IEN50d7_",",.01)="@"
661 . do FILE^DIE("","TMGFDA","TMGMSG")
662 . do ShowIfDIERR^TMGDEBUG(.TMGMSG)
663 . write "Dangling entries in file 50.7 REMOVED.",!
664 . set count=count+1
665
666
667 write !,count," Modifications Made.",!
668 if count>0 write "Please run this process AGAIN.",!
669
670 do PressToCont^TMGUSRIF
671 quit
Note: See TracBrowser for help on using the repository browser.