TIURB2 ; SLC/JER,AJB - More Review Screen Actions ;11-Nov-2013 14:40;DU
;;1.0;TEXT INTEGRATION UTILITIES;**100,109,154,112,1009,184,1010,232,1013**;Jun 20, 1997;Build 33
; 2/3: Update TEXTEDIT from TIUEDIT to TIUEDI4
; 9/28 Moved DELETE, DEL, DELTEXT, DIK to new rtn TIURB2
; 8/2/02 DELTEXT logic to bypass user-response if called by GUI TIU*1*154
; GODEL+12, changed direct access of DPT global to FM
;IHS/ITSC/LJF 02/27/2003 update VNote entry when deleting note
Q
DELETE ; Delete action
N TIUI,TIUY,TIUCHNG,Y,DIROUT,DTOUT,DUOUT
N TIULNO,TIUJ,PRNTDA,LSTDA
I '$D(VALMY) D EN^VALM2(XQORNOD(0))
S TIUI=0
F S TIUI=$O(VALMY(TIUI)) Q:+TIUI'>0 D Q:$D(DIROUT)
. N TIUDATA,DA,RSTRCTD
. S TIUDATA=$G(^TMP("TIURIDX",$J,TIUI))
. S DA=+$P(TIUDATA,U,2)
. W !!,"Processing Item #",TIUI
. L +^TIU(8925,+DA):1
. E D Q
. . W !?5,$C(7),"Another user is editing this entry."
. . I $$READ^TIUU("EA","Press RETURN to continue...") W ""
. . D PICK^TIULM(TIUI)
. S RSTRCTD=$$DOCRES^TIULRR(DA)
. I RSTRCTD D Q
. . W !!,$C(7),"Ok, no harm done...",! ; Echo denial message
. . I $$READ^TIUU("EA","RETURN to continue...") ; pause
. D DEL(DA)
. L -^TIU(8925,+DA)
; -- Update or Rebuild list, restore video:
S TIUCHNG("RBLD")=1
D UPRBLD^TIURL(.TIUCHNG,.VALMY) K VALMY
S VALMBCK="R"
Q
DEL(DA) ; We don't hand out pencils, without erasers
GODEL ; -- Called from DEL^TIURB
N CANDEL,TIUDA,TIUD0,TIUI,TIUDFLT,TIUPT,TIUVDT,TIUTYP,PROMPT,TIUAUDIT
N TIUMSG,TIURSN,TIUVTYP,TIUABORT,ADDMPRNT,IDPRNT,TIUAUTH,TIUD12,STATUS
L +^TIU(8925,+DA):1
E D Q
. W !?5,$C(7),"Another user is editing this entry."
. I $$READ^TIUU("EA","Press RETURN to continue...") W ""
I +$$HASIMG(DA) D IMGNOTE Q
S TIUD0=$G(^TIU(8925,+DA,0)),TIUD12=$G(^(12))
S TIUTYP=$$UP^XLFSTR($$PNAME^TIULC1(+TIUD0)),TIUAUTH=$P(TIUD12,U,2)
S STATUS=$P(TIUD0,U,5),ADDMPRNT=+$P(TIUD0,U,6)
S IDPRNT=+$P($G(^TMP("TIUR",$J,"IDDATA",DA)),U,3)
S TIUPT=$$NAME^TIULS($P($G(^DPT(+$P(TIUD0,U,2),0)),U),"FIRST LAST")
S TIUVDT=+$P(TIUD0,U,7)
S TIUVDT=$$DATE^TIULS(TIUVDT,"MM/DD/YY"_$S($L(TIUVDT,".")=2:" HR:MIN",1:""))
S TIUVTYP=$S(+$$ISDS^TIULX(+TIUD0):" Admission",1:" Visit")
S TIUMSG="DELETING "_TIUTYP_" For "_TIUPT_"'s "_TIUVDT_TIUVTYP_"."
S CANDEL=$$CANDO^TIULP(DA,"DELETE RECORD")
;VMP/ELR NEXT PARAGRAPH ADDED LONGER HANG FOR LONG ERROR MESSAGES
I 'CANDEL D G DELX
. NEW TIUHANG S TIUHANG=2 I $L($G(CANDEL))>99 S TIUHANG=5
. W !!,$C(7),$C(7),$C(7),$P(CANDEL,U,2),! H TIUHANG
I $$HASIDKID^TIUGBR(DA) W !!,"This interdisciplinary parent cannot be deleted; its entries must first",!,"be detached.",! H 3 G DELX
I $O(^TIU(8925,"DAD",+DA,0))>0,$$HASADDEN^TIULC1(DA) D
. W !!,"This "_TIUTYP_" has ADDENDA."
W !,$C(7) F TIUI=1:1:$L(TIUMSG,"|") W !,$P(TIUMSG,"|",TIUI)
W ! S PROMPT="Are you SURE you want to DELETE"
I '$$READ^TIUU("YO",PROMPT,"NO") W !,"Nothing DELETED.",! H 2 S TIUCHNG=0 G DELX
S PROMPT="DELETE the TEXT ONLY, leaving audit trail information"
S TIUDA=DA
I STATUS'>5,$S(DUZ=TIUAUTH:1,+$$ISA^USRLM(DUZ,"MEDICAL INFORMATION SECTION")'>0:1,1:0) S TIUAUDIT=0 I 1
E D G:$D(TIUABORT) DELX
. I +$P($G(^TIU(8925,+TIUDA,0)),U,5)'<6 S TIUAUDIT=1
. E D
. . S TIUAUDIT=+$$READ^TIUU("YO",PROMPT,"NO")
. . I $D(DTOUT)!($D(DUOUT)) D
. . . W !,"Nothing DELETED.",!
. . . S TIUCHNG=0,TIUABORT=1
. . . I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
K ^TIU(8925,"ASAVE",DUZ,TIUDA) ; Remove SAVE-flag
I +TIUAUDIT'>0 D G DELX
. W !,"DELETING Entire "_TIUTYP_" record.",!
. D DELIRT^TIUDIRT(TIUDA),DIK(TIUDA) H 2
. S TIUCHNG=2,TIUCHNG("DELETE")=1
. D ALERTDEL^TIUALRT(TIUDA),DELSGNR^TIURB1(TIUDA)
S PROMPT="Reason for DELETION (Privacy Act or Administrative): "
S TIURSN=$P($$READ^TIUU("SA^P:privacy act;A:administrative",PROMPT,"PRIVACY ACT"),U)
I '$L(TIURSN) D G DELX
. W !,"Nothing DELETED.",!
. S TIUCHNG=0,TIUABORT=1
. I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
D ALERTDEL^TIUALRT(TIUDA),DELSGNR^TIURB1(TIUDA)
D DELTEXT(TIUDA,TIURSN),AUDEL^TIURB1(TIUDA,TIURSN) S TIUCHNG=1
DELX L -^TIU(8925,+DA)
Q
DELTEXT(DA,TIURSN) ; After signature, only retraction possible
N DR,DIE,TIUDA,TIUY I '$D(ZTQUEUED) D FULL^VALM1
S TIUDA=DA
W !!?5,$C(7),"***********************************************************************"
W !?5,"* This document will now be RETRACTED. As such, it has been removed *"
W !?5,"* from public view, and from typical Releases of Information, *"
W !?5,"* but will remain indefinitely discoverable to HIMS. *"
W !?5,"***********************************************************************",!
S DIE=8925
S DR="1610////^S X=+DUZ;1611////^S X=+$$NOW^XLFDT;1612////^S X=TIURSN"
D ^DIE
S DA=$$RETRACT^TIURD2(DA,"",14)
; Unlink PRF titles when TIU changes require it TIU*1*184
D ISPRFTTL^TIUPRF2(.TIUY,+$G(^TIU(8925,TIUDA,0))) I +TIUY D UNLINK^TIUPRF1(TIUDA)
; Roll back SURGICAL REPORT TITLES when TIU changes require it ; TIU*1*112
D ISSURG^TIUSROI(.TIUY,+$G(^TIU(8925,TIUDA,0))) I +TIUY D RETRACT^TIUSROI1(TIUDA)
; Remove link to consult if a Consult Title
D ISCNSLT^TIUCNSLT(.TIUY,+$G(^TIU(8925,TIUDA,0))) I +TIUY D REMCNSLT^TIUCNSLT(TIUDA)
I '$$BROKER^XWBLIB D
. I '$D(ZTQUEUED),$$READ^TIUU("EA","Press RETURN to continue...")
Q
DIK(DA,SUPPACT) ; Call ^DIK to delete the record
; [SUPPACT] = Boolean to suppress delete action
N DIK,TIUTYP,TIUTYPE,TIUDA,TIUVSIT,TIUVKILL,TIUDELX S TIUDA=0
F S TIUDA=+$O(^TIU(8925,"DAD",+DA,TIUDA)) Q:+TIUDA'>0 D DIK(TIUDA)
S TIUTYPE=+$G(^TIU(8925,+DA,0)),SUPPACT=+$G(SUPPACT)
S TIUTYP=$P($G(^TIU(8925.1,TIUTYPE,0)),U)
S TIUVSIT=+$P($G(^TIU(8925,DA,0)),U,3),TIUDA=DA
S TIUDELX=$$DELETE^TIULC1(TIUTYPE)
I TIUDELX]"",'SUPPACT X TIUDELX
S DIK="^TIU(8925,"
D ^DIK ; W:'$D(ZTQUEUED) "."
D DELAUDIT^TIUEDI1(DA)
D DELPROB^TIURB1(DA)
D DELSGNR^TIURB1(DA)
D DELIMG(DA)
D ALERTDEL^TIUALRT(DA)
D VNOTE^BTIURB(DA) ;IHS/ITSC/LJF delete V note on delete
; **52** Disable call to $$DELVFILE^PXAPI 'til further notice
; I +TIUVSIT,$D(^AUPNVSIT(+TIUVSIT)) S TIUVKILL=$$DELVFILE^PXAPI("ALL",TIUVSIT,"","TEXT INTEGRATION UTILITIES")
Q
HASIMG(TIUDA) ; Evaluate whether images are linked
Q +$O(^TIU(8925.91,"B",TIUDA,0))
IMGNOTE ; Present Notice of Linked Images
D FULL^VALM1
W !!?5,$C(7),"***********************************************************************"
W !?5,"* This document has linked images. You must ""delete"" the Images using *"
W !?5,"* the Imaging Package before proceeding with this action. *"
W !?5,"* The images will be hidden from public view, but will remain *"
W !?5,"* indefinitely discoverable to HIMS. *"
W !?5,"***********************************************************************",!
I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
Q
DELIMG(TIUDA) ; Remove linked images, when document deleted
N DA,DIK S DIK="^TIU(8925.91,",DA=0
F S DA=$O(^TIU(8925.91,"B",TIUDA,DA)) Q:+DA'>0 D ^DIK
Q
TIURB2 ; SLC/JER,AJB - More Review Screen Actions ;11-Nov-2013 14:40;DU
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**100,109,154,112,1009,184,1010,232,1013**;Jun 20, 1997;Build 33
+2 ; 2/3: Update TEXTEDIT from TIUEDIT to TIUEDI4
+3 ; 9/28 Moved DELETE, DEL, DELTEXT, DIK to new rtn TIURB2
+4 ; 8/2/02 DELTEXT logic to bypass user-response if called by GUI TIU*1*154
+5 ; GODEL+12, changed direct access of DPT global to FM
+6 ;IHS/ITSC/LJF 02/27/2003 update VNote entry when deleting note
+7 QUIT
DELETE ; Delete action
+1 NEW TIUI,TIUY,TIUCHNG,Y,DIROUT,DTOUT,DUOUT
+2 NEW TIULNO,TIUJ,PRNTDA,LSTDA
+3 IF '$DATA(VALMY)
DO EN^VALM2(XQORNOD(0))
+4 SET TIUI=0
+5 FOR
SET TIUI=$ORDER(VALMY(TIUI))
IF +TIUI'>0
QUIT
Begin DoDot:1
+6 NEW TIUDATA,DA,RSTRCTD
+7 SET TIUDATA=$GET(^TMP("TIURIDX",$JOB,TIUI))
+8 SET DA=+$PIECE(TIUDATA,U,2)
+9 WRITE !!,"Processing Item #",TIUI
+10 LOCK +^TIU(8925,+DA):1
+11 IF '$TEST
Begin DoDot:2
+12 WRITE !?5,$CHAR(7),"Another user is editing this entry."
+13 IF $$READ^TIUU("EA","Press RETURN to continue...")
WRITE ""
+14 DO PICK^TIULM(TIUI)
End DoDot:2
QUIT
+15 SET RSTRCTD=$$DOCRES^TIULRR(DA)
+16 IF RSTRCTD
Begin DoDot:2
+17 ; Echo denial message
WRITE !!,$CHAR(7),"Ok, no harm done...",!
+18 ; pause
IF $$READ^TIUU("EA","RETURN to continue...")
End DoDot:2
QUIT
+19 DO DEL(DA)
+20 LOCK -^TIU(8925,+DA)
End DoDot:1
IF $DATA(DIROUT)
QUIT
+21 ; -- Update or Rebuild list, restore video:
+22 SET TIUCHNG("RBLD")=1
+23 DO UPRBLD^TIURL(.TIUCHNG,.VALMY)
KILL VALMY
+24 SET VALMBCK="R"
+25 QUIT
DEL(DA) ; We don't hand out pencils, without erasers
GODEL ; -- Called from DEL^TIURB
+1 NEW CANDEL,TIUDA,TIUD0,TIUI,TIUDFLT,TIUPT,TIUVDT,TIUTYP,PROMPT,TIUAUDIT
+2 NEW TIUMSG,TIURSN,TIUVTYP,TIUABORT,ADDMPRNT,IDPRNT,TIUAUTH,TIUD12,STATUS
+3 LOCK +^TIU(8925,+DA):1
+4 IF '$TEST
Begin DoDot:1
+5 WRITE !?5,$CHAR(7),"Another user is editing this entry."
+6 IF $$READ^TIUU("EA","Press RETURN to continue...")
WRITE ""
End DoDot:1
QUIT
+7 IF +$$HASIMG(DA)
DO IMGNOTE
QUIT
+8 SET TIUD0=$GET(^TIU(8925,+DA,0))
SET TIUD12=$GET(^(12))
+9 SET TIUTYP=$$UP^XLFSTR($$PNAME^TIULC1(+TIUD0))
SET TIUAUTH=$PIECE(TIUD12,U,2)
+10 SET STATUS=$PIECE(TIUD0,U,5)
SET ADDMPRNT=+$PIECE(TIUD0,U,6)
+11 SET IDPRNT=+$PIECE($GET(^TMP("TIUR",$JOB,"IDDATA",DA)),U,3)
+12 SET TIUPT=$$NAME^TIULS($PIECE($GET(^DPT(+$PIECE(TIUD0,U,2),0)),U),"FIRST LAST")
+13 SET TIUVDT=+$PIECE(TIUD0,U,7)
+14 SET TIUVDT=$$DATE^TIULS(TIUVDT,"MM/DD/YY"_$SELECT($LENGTH(TIUVDT,".")=2:" HR:MIN",1:""))
+15 SET TIUVTYP=$SELECT(+$$ISDS^TIULX(+TIUD0):" Admission",1:" Visit")
+16 SET TIUMSG="DELETING "_TIUTYP_" For "_TIUPT_"'s "_TIUVDT_TIUVTYP_"."
+17 SET CANDEL=$$CANDO^TIULP(DA,"DELETE RECORD")
+18 ;VMP/ELR NEXT PARAGRAPH ADDED LONGER HANG FOR LONG ERROR MESSAGES
+19 IF 'CANDEL
Begin DoDot:1
+20 NEW TIUHANG
SET TIUHANG=2
IF $LENGTH($GET(CANDEL))>99
SET TIUHANG=5
+21 WRITE !!,$CHAR(7),$CHAR(7),$CHAR(7),$PIECE(CANDEL,U,2),!
HANG TIUHANG
End DoDot:1
GOTO DELX
+22 IF $$HASIDKID^TIUGBR(DA)
WRITE !!,"This interdisciplinary parent cannot be deleted; its entries must first",!,"be detached.",!
HANG 3
GOTO DELX
+23 IF $ORDER(^TIU(8925,"DAD",+DA,0))>0
IF $$HASADDEN^TIULC1(DA)
Begin DoDot:1
+24 WRITE !!,"This "_TIUTYP_" has ADDENDA."
End DoDot:1
+25 WRITE !,$CHAR(7)
FOR TIUI=1:1:$LENGTH(TIUMSG,"|")
WRITE !,$PIECE(TIUMSG,"|",TIUI)
+26 WRITE !
SET PROMPT="Are you SURE you want to DELETE"
+27 IF '$$READ^TIUU("YO",PROMPT,"NO")
WRITE !,"Nothing DELETED.",!
HANG 2
SET TIUCHNG=0
GOTO DELX
+28 SET PROMPT="DELETE the TEXT ONLY, leaving audit trail information"
+29 SET TIUDA=DA
+30 IF STATUS'>5
IF $SELECT(DUZ=TIUAUTH:1,+$$ISA^USRLM(DUZ,"MEDICAL INFORMATION SECTION")'>0:1,1:0)
SET TIUAUDIT=0
IF 1
+31 IF '$TEST
Begin DoDot:1
+32 IF +$PIECE($GET(^TIU(8925,+TIUDA,0)),U,5)'<6
SET TIUAUDIT=1
+33 IF '$TEST
Begin DoDot:2
+34 SET TIUAUDIT=+$$READ^TIUU("YO",PROMPT,"NO")
+35 IF $DATA(DTOUT)!($DATA(DUOUT))
Begin DoDot:3
+36 WRITE !,"Nothing DELETED.",!
+37 SET TIUCHNG=0
SET TIUABORT=1
+38 ; pause
IF $$READ^TIUU("EA","Press RETURN to continue...")
End DoDot:3
End DoDot:2
End DoDot:1
IF $DATA(TIUABORT)
GOTO DELX
+39 ; Remove SAVE-flag
KILL ^TIU(8925,"ASAVE",DUZ,TIUDA)
+40 IF +TIUAUDIT'>0
Begin DoDot:1
+41 WRITE !,"DELETING Entire "_TIUTYP_" record.",!
+42 DO DELIRT^TIUDIRT(TIUDA)
DO DIK(TIUDA)
HANG 2
+43 SET TIUCHNG=2
SET TIUCHNG("DELETE")=1
+44 DO ALERTDEL^TIUALRT(TIUDA)
DO DELSGNR^TIURB1(TIUDA)
End DoDot:1
GOTO DELX
+45 SET PROMPT="Reason for DELETION (Privacy Act or Administrative): "
+46 SET TIURSN=$PIECE($$READ^TIUU("SA^P:privacy act;A:administrative",PROMPT,"PRIVACY ACT"),U)
+47 IF '$LENGTH(TIURSN)
Begin DoDot:1
+48 WRITE !,"Nothing DELETED.",!
+49 SET TIUCHNG=0
SET TIUABORT=1
+50 ; pause
IF $$READ^TIUU("EA","Press RETURN to continue...")
End DoDot:1
GOTO DELX
+51 DO ALERTDEL^TIUALRT(TIUDA)
DO DELSGNR^TIURB1(TIUDA)
+52 DO DELTEXT(TIUDA,TIURSN)
DO AUDEL^TIURB1(TIUDA,TIURSN)
SET TIUCHNG=1
DELX LOCK -^TIU(8925,+DA)
+1 QUIT
DELTEXT(DA,TIURSN) ; After signature, only retraction possible
+1 NEW DR,DIE,TIUDA,TIUY
IF '$DATA(ZTQUEUED)
DO FULL^VALM1
+2 SET TIUDA=DA
+3 WRITE !!?5,$CHAR(7),"***********************************************************************"
+4 WRITE !?5,"* This document will now be RETRACTED. As such, it has been removed *"
+5 WRITE !?5,"* from public view, and from typical Releases of Information, *"
+6 WRITE !?5,"* but will remain indefinitely discoverable to HIMS. *"
+7 WRITE !?5,"***********************************************************************",!
+8 SET DIE=8925
+9 SET DR="1610////^S X=+DUZ;1611////^S X=+$$NOW^XLFDT;1612////^S X=TIURSN"
+10 DO ^DIE
+11 SET DA=$$RETRACT^TIURD2(DA,"",14)
+12 ; Unlink PRF titles when TIU changes require it TIU*1*184
+13 DO ISPRFTTL^TIUPRF2(.TIUY,+$GET(^TIU(8925,TIUDA,0)))
IF +TIUY
DO UNLINK^TIUPRF1(TIUDA)
+14 ; Roll back SURGICAL REPORT TITLES when TIU changes require it ; TIU*1*112
+15 DO ISSURG^TIUSROI(.TIUY,+$GET(^TIU(8925,TIUDA,0)))
IF +TIUY
DO RETRACT^TIUSROI1(TIUDA)
+16 ; Remove link to consult if a Consult Title
+17 DO ISCNSLT^TIUCNSLT(.TIUY,+$GET(^TIU(8925,TIUDA,0)))
IF +TIUY
DO REMCNSLT^TIUCNSLT(TIUDA)
+18 IF '$$BROKER^XWBLIB
Begin DoDot:1
+19 IF '$DATA(ZTQUEUED)
IF $$READ^TIUU("EA","Press RETURN to continue...")
End DoDot:1
+20 QUIT
DIK(DA,SUPPACT) ; Call ^DIK to delete the record
+1 ; [SUPPACT] = Boolean to suppress delete action
+2 NEW DIK,TIUTYP,TIUTYPE,TIUDA,TIUVSIT,TIUVKILL,TIUDELX
SET TIUDA=0
+3 FOR
SET TIUDA=+$ORDER(^TIU(8925,"DAD",+DA,TIUDA))
IF +TIUDA'>0
QUIT
DO DIK(TIUDA)
+4 SET TIUTYPE=+$GET(^TIU(8925,+DA,0))
SET SUPPACT=+$GET(SUPPACT)
+5 SET TIUTYP=$PIECE($GET(^TIU(8925.1,TIUTYPE,0)),U)
+6 SET TIUVSIT=+$PIECE($GET(^TIU(8925,DA,0)),U,3)
SET TIUDA=DA
+7 SET TIUDELX=$$DELETE^TIULC1(TIUTYPE)
+8 IF TIUDELX]""
IF 'SUPPACT
XECUTE TIUDELX
+9 SET DIK="^TIU(8925,"
+10 ; W:'$D(ZTQUEUED) "."
DO ^DIK
+11 DO DELAUDIT^TIUEDI1(DA)
+12 DO DELPROB^TIURB1(DA)
+13 DO DELSGNR^TIURB1(DA)
+14 DO DELIMG(DA)
+15 DO ALERTDEL^TIUALRT(DA)
+16 ;IHS/ITSC/LJF delete V note on delete
DO VNOTE^BTIURB(DA)
+17 ; **52** Disable call to $$DELVFILE^PXAPI 'til further notice
+18 ; I +TIUVSIT,$D(^AUPNVSIT(+TIUVSIT)) S TIUVKILL=$$DELVFILE^PXAPI("ALL",TIUVSIT,"","TEXT INTEGRATION UTILITIES")
+19 QUIT
HASIMG(TIUDA) ; Evaluate whether images are linked
+1 QUIT +$ORDER(^TIU(8925.91,"B",TIUDA,0))
IMGNOTE ; Present Notice of Linked Images
+1 DO FULL^VALM1
+2 WRITE !!?5,$CHAR(7),"***********************************************************************"
+3 WRITE !?5,"* This document has linked images. You must ""delete"" the Images using *"
+4 WRITE !?5,"* the Imaging Package before proceeding with this action. *"
+5 WRITE !?5,"* The images will be hidden from public view, but will remain *"
+6 WRITE !?5,"* indefinitely discoverable to HIMS. *"
+7 WRITE !?5,"***********************************************************************",!
+8 ; pause
IF $$READ^TIUU("EA","Press RETURN to continue...")
+9 QUIT
DELIMG(TIUDA) ; Remove linked images, when document deleted
+1 NEW DA,DIK
SET DIK="^TIU(8925.91,"
SET DA=0
+2 FOR
SET DA=$ORDER(^TIU(8925.91,"B",TIUDA,DA))
IF +DA'>0
QUIT
DO ^DIK
+3 QUIT
