| 1 | TMGDELPT ;TMG/kst/Low-level Patient Deletion Utilities ;08/13/08
|
|---|
| 2 | ;;1.0;TMG-LIB;**1**;08/12/08
|
|---|
| 3 |
|
|---|
| 4 |
|
|---|
| 5 | DelPt
|
|---|
| 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
|
|---|
| 14 | Loop1
|
|---|
| 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 |
|
|---|
| 28 | DelOne(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 |
|
|---|
| 83 | DPDone
|
|---|
| 84 | quit
|
|---|
| 85 |
|
|---|
| 86 |
|
|---|
| 87 |
|
|---|
| 88 | TempDel
|
|---|
| 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 |
|---|
