source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIURB2.m@ 1489

Last change on this file since 1489 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 6.5 KB
Line 
1TIURB2 ; SLC/JER,AJB - More Review Screen Actions ; 1/18/05
2 ;;1.0;TEXT INTEGRATION UTILITIES;**100,109,154,112,184**;Jun 20, 1997
3 ; 2/3: Update TEXTEDIT from TIUEDIT to TIUEDI4
4 ; 9/28 Moved DELETE, DEL, DELTEXT, DIK to new rtn TIURB2
5 ; 8/2/02 DELTEXT logic to bypass user-response if called by GUI TIU*1*154
6 ; GODEL+12, changed direct access of DPT global to FM
7 Q
8DELETE ; Delete action
9 N TIUI,TIUY,TIUCHNG,Y,DIROUT,DTOUT,DUOUT
10 N TIULNO,TIUJ,PRNTDA,LSTDA
11 I '$D(VALMY) D EN^VALM2(XQORNOD(0))
12 S TIUI=0
13 F S TIUI=$O(VALMY(TIUI)) Q:+TIUI'>0 D Q:$D(DIROUT)
14 . N TIUDATA,DA,RSTRCTD
15 . S TIUDATA=$G(^TMP("TIURIDX",$J,TIUI))
16 . S DA=+$P(TIUDATA,U,2)
17 . W !!,"Processing Item #",TIUI
18 . L +^TIU(8925,+DA):1
19 . E D Q
20 . . W !?5,$C(7),"Another user is editing this entry."
21 . . I $$READ^TIUU("EA","Press RETURN to continue...") W ""
22 . . D PICK^TIULM(TIUI)
23 . S RSTRCTD=$$DOCRES^TIULRR(DA)
24 . I RSTRCTD D Q
25 . . W !!,$C(7),"Ok, no harm done...",! ; Echo denial message
26 . . I $$READ^TIUU("EA","RETURN to continue...") ; pause
27 . D DEL(DA)
28 . L -^TIU(8925,+DA)
29 ; -- Update or Rebuild list, restore video:
30 S TIUCHNG("RBLD")=1
31 D UPRBLD^TIURL(.TIUCHNG,.VALMY) K VALMY
32 S VALMBCK="R"
33 Q
34DEL(DA) ; We don't hand out pencils, without erasers
35GODEL ; -- Called from DEL^TIURB
36 N CANDEL,TIUDA,TIUD0,TIUI,TIUDFLT,TIUPT,TIUVDT,TIUTYP,PROMPT,TIUAUDIT
37 N TIUMSG,TIURSN,TIUVTYP,TIUABORT,ADDMPRNT,IDPRNT,TIUAUTH,TIUD12,STATUS
38 L +^TIU(8925,+DA):1
39 E D Q
40 . W !?5,$C(7),"Another user is editing this entry."
41 . I $$READ^TIUU("EA","Press RETURN to continue...") W ""
42 I +$$HASIMG(DA) D IMGNOTE Q
43 S TIUD0=$G(^TIU(8925,+DA,0)),TIUD12=$G(^(12))
44 S TIUTYP=$$UP^XLFSTR($$PNAME^TIULC1(+TIUD0)),TIUAUTH=$P(TIUD12,U,2)
45 S STATUS=$P(TIUD0,U,5),ADDMPRNT=+$P(TIUD0,U,6)
46 S IDPRNT=+$P($G(^TMP("TIUR",$J,"IDDATA",DA)),U,3)
47 S TIUPT=$$NAME^TIULS($P($G(^DPT(+$P(TIUD0,U,2),0)),U),"FIRST LAST")
48 S TIUVDT=+$P(TIUD0,U,7)
49 S TIUVDT=$$DATE^TIULS(TIUVDT,"MM/DD/YY"_$S($L(TIUVDT,".")=2:" HR:MIN",1:""))
50 S TIUVTYP=$S(+$$ISDS^TIULX(+TIUD0):" Admission",1:" Visit")
51 S TIUMSG="DELETING "_TIUTYP_" For "_TIUPT_"'s "_TIUVDT_TIUVTYP_"."
52 S CANDEL=$$CANDO^TIULP(DA,"DELETE RECORD")
53 I 'CANDEL W !!,$C(7),$C(7),$C(7),$P(CANDEL,U,2),! H 2 G DELX
54 I $$HASIDKID^TIUGBR(DA) W !!,"This interdisciplinary parent cannot be deleted; it's entries must first",!,"be detached.",! H 3 G DELX
55 I $O(^TIU(8925,"DAD",+DA,0))>0,$$HASADDEN^TIULC1(DA) D
56 . W !!,"This "_TIUTYP_" has ADDENDA."
57 W !,$C(7) F TIUI=1:1:$L(TIUMSG,"|") W !,$P(TIUMSG,"|",TIUI)
58 W ! S PROMPT="Are you SURE you want to DELETE"
59 I '$$READ^TIUU("YO",PROMPT,"NO") W !,"Nothing DELETED.",! H 2 S TIUCHNG=0 G DELX
60 S PROMPT="DELETE the TEXT ONLY, leaving audit trail information"
61 S TIUDA=DA
62 I STATUS'>5,$S(DUZ=TIUAUTH:1,+$$ISA^USRLM(DUZ,"MEDICAL INFORMATION SECTION")'>0:1,1:0) S TIUAUDIT=0 I 1
63 E D G:$D(TIUABORT) DELX
64 . I +$P($G(^TIU(8925,+TIUDA,0)),U,5)'<6 S TIUAUDIT=1
65 . E D
66 . . S TIUAUDIT=+$$READ^TIUU("YO",PROMPT,"NO")
67 . . I $D(DTOUT)!($D(DUOUT)) D
68 . . . W !,"Nothing DELETED.",!
69 . . . S TIUCHNG=0,TIUABORT=1
70 . . . I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
71 K ^TIU(8925,"ASAVE",DUZ,TIUDA) ; Remove SAVE-flag
72 I +TIUAUDIT'>0 D G DELX
73 . W !,"DELETING Entire "_TIUTYP_" record.",!
74 . D DELIRT^TIUDIRT(TIUDA),DIK(TIUDA) H 2
75 . S TIUCHNG=2,TIUCHNG("DELETE")=1
76 . D ALERTDEL^TIUALRT(TIUDA),DELSGNR^TIURB1(TIUDA)
77 S PROMPT="Reason for DELETION (Privacy Act or Administrative): "
78 S TIURSN=$P($$READ^TIUU("SA^P:privacy act;A:administrative",PROMPT,"PRIVACY ACT"),U)
79 I '$L(TIURSN) D G DELX
80 . W !,"Nothing DELETED.",!
81 . S TIUCHNG=0,TIUABORT=1
82 . I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
83 D ALERTDEL^TIUALRT(TIUDA),DELSGNR^TIURB1(TIUDA)
84 D DELTEXT(TIUDA,TIURSN),AUDEL^TIURB1(TIUDA,TIURSN) S TIUCHNG=1
85DELX L -^TIU(8925,+DA)
86 Q
87DELTEXT(DA,TIURSN) ; After signature, only retraction possible
88 N DR,DIE,TIUDA,TIUY I '$D(ZTQUEUED) D FULL^VALM1
89 S TIUDA=DA
90 W !!?5,$C(7),"***********************************************************************"
91 W !?5,"* This document will now be RETRACTED. As such, it has been removed *"
92 W !?5,"* from public view, and from typical Releases of Information, *"
93 W !?5,"* but will remain indefinitely discoverable to HIMS. *"
94 W !?5,"***********************************************************************",!
95 S DIE=8925
96 S DR="1610////^S X=+DUZ;1611////^S X=+$$NOW^XLFDT;1612////^S X=TIURSN"
97 D ^DIE
98 S DA=$$RETRACT^TIURD2(DA,"",14)
99 ; Unlink PRF titles when TIU changes require it TIU*1*184
100 D ISPRFTTL^TIUPRF2(.TIUY,+$G(^TIU(8925,TIUDA,0))) I +TIUY D UNLINK^TIUPRF1(TIUDA)
101 ; Roll back SURGICAL REPORT TITLES when TIU changes require it ; TIU*1*112
102 D ISSURG^TIUSROI(.TIUY,+$G(^TIU(8925,TIUDA,0))) I +TIUY D RETRACT^TIUSROI1(TIUDA)
103 ; Remove link to consult if a Consult Title
104 D ISCNSLT^TIUCNSLT(.TIUY,+$G(^TIU(8925,TIUDA,0))) I +TIUY D REMCNSLT^TIUCNSLT(TIUDA)
105 I '$$BROKER^XWBLIB D
106 . I '$D(ZTQUEUED),$$READ^TIUU("EA","Press RETURN to continue...")
107 Q
108DIK(DA,SUPPACT) ; Call ^DIK to delete the record
109 ; [SUPPACT] = Boolean to suppress delete action
110 N DIK,TIUTYP,TIUTYPE,TIUDA,TIUVSIT,TIUVKILL,TIUDELX S TIUDA=0
111 F S TIUDA=+$O(^TIU(8925,"DAD",+DA,TIUDA)) Q:+TIUDA'>0 D DIK(TIUDA)
112 S TIUTYPE=+$G(^TIU(8925,+DA,0)),SUPPACT=+$G(SUPPACT)
113 S TIUTYP=$P($G(^TIU(8925.1,TIUTYPE,0)),U)
114 S TIUVSIT=+$P($G(^TIU(8925,DA,0)),U,3),TIUDA=DA
115 S TIUDELX=$$DELETE^TIULC1(TIUTYPE)
116 I TIUDELX]"",'SUPPACT X TIUDELX
117 S DIK="^TIU(8925,"
118 D ^DIK ; W:'$D(ZTQUEUED) "."
119 D DELAUDIT^TIUEDI1(DA)
120 D DELPROB^TIURB1(DA)
121 D DELSGNR^TIURB1(DA)
122 D DELIMG(DA)
123 D ALERTDEL^TIUALRT(DA)
124 ; **52** Disable call to $$DELVFILE^PXAPI 'til further notice
125 ; I +TIUVSIT,$D(^AUPNVSIT(+TIUVSIT)) S TIUVKILL=$$DELVFILE^PXAPI("ALL",TIUVSIT,"","TEXT INTEGRATION UTILITIES")
126 Q
127HASIMG(TIUDA) ; Evaluate whether images are linked
128 Q +$O(^TIU(8925.91,"B",TIUDA,0))
129IMGNOTE ; Present Notice of Linked Images
130 D FULL^VALM1
131 W !!?5,$C(7),"***********************************************************************"
132 W !?5,"* This document has linked images. You must ""delete"" the Images using *"
133 W !?5,"* the Imaging Package before proceeding with this action. *"
134 W !?5,"* The images will be hidden from public view, but will remain *"
135 W !?5,"* indefinitely discoverable to HIMS. *"
136 W !?5,"***********************************************************************",!
137 I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
138 Q
139DELIMG(TIUDA) ; Remove linked images, when document deleted
140 N DA,DIK S DIK="^TIU(8925.91,",DA=0
141 F S DA=$O(^TIU(8925.91,"B",TIUDA,DA)) Q:+DA'>0 D ^DIK
142 Q
Note: See TracBrowser for help on using the repository browser.