source: cprs/branches/tmg-cprs/m_files/TMGDELPT.m@ 1705

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

Initial upload
File size: 3.3 KB
RevLine 
[796]1TMGDELPT ;TMG/kst/Low-level Patient Deletion Utilities ;08/13/08
2 ;;1.0;TMG-LIB;**1**;08/12/08
3
4
5DelPt
6 ;"Purpose: to try to safely delete a patient
7 ;"NOTICE: Deleting could be a violation of laws regulating the maintanance
8 ;" of patient records. I.e. if you delete who a patient is, then
9 ;" you destroy all records associated with that patient.
10 ;" SO, only delete a patient if you are sure that you what you are
11 ;" doing, and are sure that you are not causing perminant injury!
12
13 new DFN,DIC,X,Y,PtIEN
14Loop1
15 set DIC=2,DIC(0)="MAEQ"
16 do ^DIC write !
17 if +Y=-1 do goto DPDone
18 . write "Goodbye.",!
19 set PtIEN=+Y
20
21 do DelOne(PtIEN,0)
22
23 write "Delete another patient (caution!)" do YN^DICN write !
24 if %=1 goto Loop1
25 quit
26
27
28DelOne(PtIEN,Quiet)
29 ;"Purpose: to try to safely delete a patient
30 ;"NOTICE: Deleting could be a violation of laws regulating the maintanance
31 ;" of patient records. I.e. if you delete who a patient is, then
32 ;" you destroy all records associated with that patient.
33 ;" SO, only delete a patient if you are sure that you what you are
34 ;" doing, and are sure that you are not causing perminant injury!
35 ;"Input: PtIEN -- the IEN in file 2
36 ;" Quiet -- OPTIONAL. If 1, then user is not prompted.
37 ;
38 set Quiet=+$get(Quiet,0)
39 new PtrsIn
40 new File,Field,A,GL,Q,ERR
41 set Qt="""",ERR=0,File=0
42 for SET File=$O(^DD(2,0,"PT",File)) quit:'File do
43 . SET Field=0
44 . for S Field=$O(^DD(2,0,"PT",File,Field)) quit:'Field do
45 . . SET K=0
46 . . for S K=$O(^DD(File,+Field,1,K)) quit:'K DO
47 . . . SET A=$G(^DD(File,+Field,1,K,0))
48 . . . if '$L($P(A,U,2)) quit
49 . . . if $L($P(A,U,3)) quit
50 . . . set GL=$G(^DIC(+File,0,"GL"))
51 . . . quit:'$L(GL)
52 . . . set GL=GL_Qt_$P(A,U,2)_Qt_","_PtIEN_")"
53 . . . if $D(@GL) D
54 . . . . new IEN set IEN=$O(@GL@(""))
55 . . . . set PtrsIn(File,IEN)=""
56
57 set File="",Field=""
58 for set File=$order(PtrsIn(File)) quit:(File="") do
59 . set IEN=""
60 . for set IEN=$order(PtrsIn(File,IEN)) quit:(IEN="") do
61 . . if Quiet'=1 do
62 . . . write "Entry #",IEN," in file ",$piece($get(^DIC(File,0)),"^",1)," (",File,") "
63 . . . write "points to this patient.",!
64 . . new % set %=2
65 . . if Quiet=1 set %=1
66 . . else write "Delete this entry" do YN^DICN write !
67 . . if %'=1 quit
68 . . new TMGFDA,TMGMSG
69 . . set TMGFDA(File,IEN_",",.01)="@"
70 . . do FILE^DIE("","TMGFDA","TMGMSG")
71 . . do ShowIfDIERR^TMGDEBUG(.TMGMSG)
72
73 new % set %=2
74 if Quiet=1 set %=1
75 else write "Delete ",$piece(Y,"^",2) do YN^DICN write !
76 if %'=1 goto DPDone
77
78 new TMGFDA,TMGMSG
79 set TMGFDA(2,PtIEN_",",.01)="@"
80 do FILE^DIE("","TMGFDA","TMGMSG")
81 do ShowIfDIERR^TMGDEBUG(.TMGMSG)
82
83DPDone
84 quit
85
86
87
88TempDel
89 ;"Purpose: to delete all TMG-* named patients (testing only...)
90
91 new IEN,name
92 set name=""
93 for set name=$order(^DPT("B",name)) quit:(name="") do
94 . if 'name["TMG-" quit
95 . set IEN=$order(^DPT("B",name,""))
96 . write "Deleting: ",name,"..."
97 . do DelOne(IEN,1)
98 . write !
99
100 quit
Note: See TracBrowser for help on using the repository browser.