Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: TIURB2

TIURB2.m

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