- TIURB2 ;SLC/JER,AJB - More Review Screen Actions ;04/18/17 07:26
- ;;1.0;TEXT INTEGRATION UTILITIES;**100,109,154,112,184,232,290,340**;Jun 20, 1997;Build 2
- ; 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
- Q
- DELETE ; Delete action
- N TIUI,TIUY,TIUCHNG,Y,DIROUT,DTOUT,DUOUT
- N TIULNO,TIUJ,PRNTDA,LSTDA,TIU
- 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
- N TIURTRCK
- 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.",!
- . ;TIU*1*340 Move to here from 5 lines below
- . D NOTIFY^TIUUTL("DELETE",+$P(TIUD0,U,2),,.TIU,TIUDA)
- . D DELIRT^TIUDIRT(TIUDA),DIK(TIUDA) H 2
- . S TIUCHNG=2,TIUCHNG("DELETE")=1
- . D ALERTDEL^TIUALRT(TIUDA),DELSGNR^TIURB1(TIUDA)
- . ;D NOTIFY^TIUUTL("DELETE",+$P(TIUD0,U,2),,.TIU,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
- D:'$G(TIURTRCK) NOTIFY^TIUUTL("DELETE",+$P(TIUD0,U,2),,.TIU,TIUDA)
- 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,TIURTRCK=1
- 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 DELPST^TIUCOP(DA) ;Delete associated pastes in file 8928
- ; **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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIURB2 7252 printed Jan 18, 2025@03:46:12 Page 2
- 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
- +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 QUIT
- DELETE ; Delete action
- +1 NEW TIUI,TIUY,TIUCHNG,Y,DIROUT,DTOUT,DUOUT
- +2 NEW TIULNO,TIUJ,PRNTDA,LSTDA,TIU
- +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 NEW TIURTRCK
- +4 LOCK +^TIU(8925,+DA):1
- +5 IF '$TEST
- Begin DoDot:1
- +6 WRITE !?5,$CHAR(7),"Another user is editing this entry."
- +7 IF $$READ^TIUU("EA","Press RETURN to continue...")
- WRITE ""
- End DoDot:1
- QUIT
- +8 IF +$$HASIMG(DA)
- DO IMGNOTE
- QUIT
- +9 SET TIUD0=$GET(^TIU(8925,+DA,0))
- SET TIUD12=$GET(^(12))
- +10 SET TIUTYP=$$UP^XLFSTR($$PNAME^TIULC1(+TIUD0))
- SET TIUAUTH=$PIECE(TIUD12,U,2)
- +11 SET STATUS=$PIECE(TIUD0,U,5)
- SET ADDMPRNT=+$PIECE(TIUD0,U,6)
- +12 SET IDPRNT=+$PIECE($GET(^TMP("TIUR",$JOB,"IDDATA",DA)),U,3)
- +13 SET TIUPT=$$NAME^TIULS($PIECE($GET(^DPT(+$PIECE(TIUD0,U,2),0)),U),"FIRST LAST")
- +14 SET TIUVDT=+$PIECE(TIUD0,U,7)
- +15 SET TIUVDT=$$DATE^TIULS(TIUVDT,"MM/DD/YY"_$SELECT($LENGTH(TIUVDT,".")=2:" HR:MIN",1:""))
- +16 SET TIUVTYP=$SELECT(+$$ISDS^TIULX(+TIUD0):" Admission",1:" Visit")
- +17 SET TIUMSG="DELETING "_TIUTYP_" For "_TIUPT_"'s "_TIUVDT_TIUVTYP_"."
- +18 SET CANDEL=$$CANDO^TIULP(DA,"DELETE RECORD")
- +19 ;VMP/ELR NEXT PARAGRAPH ADDED LONGER HANG FOR LONG ERROR MESSAGES
- +20 IF 'CANDEL
- Begin DoDot:1
- +21 NEW TIUHANG
- SET TIUHANG=2
- IF $LENGTH($GET(CANDEL))>99
- SET TIUHANG=5
- +22 WRITE !!,$CHAR(7),$CHAR(7),$CHAR(7),$PIECE(CANDEL,U,2),!
- HANG TIUHANG
- End DoDot:1
- GOTO DELX
- +23 IF $$HASIDKID^TIUGBR(DA)
- WRITE !!,"This interdisciplinary parent cannot be deleted; its entries must first",!,"be detached.",!
- HANG 3
- GOTO DELX
- +24 IF $ORDER(^TIU(8925,"DAD",+DA,0))>0
- IF $$HASADDEN^TIULC1(DA)
- Begin DoDot:1
- +25 WRITE !!,"This "_TIUTYP_" has ADDENDA."
- End DoDot:1
- +26 WRITE !,$CHAR(7)
- FOR TIUI=1:1:$LENGTH(TIUMSG,"|")
- WRITE !,$PIECE(TIUMSG,"|",TIUI)
- +27 WRITE !
- SET PROMPT="Are you SURE you want to DELETE"
- +28 IF '$$READ^TIUU("YO",PROMPT,"NO")
- WRITE !,"Nothing DELETED.",!
- HANG 2
- SET TIUCHNG=0
- GOTO DELX
- +29 SET PROMPT="DELETE the TEXT ONLY, leaving audit trail information"
- +30 SET TIUDA=DA
- +31 IF STATUS'>5
- IF $SELECT(DUZ=TIUAUTH:1,+$$ISA^USRLM(DUZ,"MEDICAL INFORMATION SECTION")'>0:1,1:0)
- SET TIUAUDIT=0
- IF 1
- +32 IF '$TEST
- Begin DoDot:1
- +33 IF +$PIECE($GET(^TIU(8925,+TIUDA,0)),U,5)'<6
- SET TIUAUDIT=1
- +34 IF '$TEST
- Begin DoDot:2
- +35 SET TIUAUDIT=+$$READ^TIUU("YO",PROMPT,"NO")
- +36 IF $DATA(DTOUT)!($DATA(DUOUT))
- Begin DoDot:3
- +37 WRITE !,"Nothing DELETED.",!
- +38 SET TIUCHNG=0
- SET TIUABORT=1
- +39 ; pause
- IF $$READ^TIUU("EA","Press RETURN to continue...")
- End DoDot:3
- End DoDot:2
- End DoDot:1
- if $DATA(TIUABORT)
- GOTO DELX
- +40 ; Remove SAVE-flag
- KILL ^TIU(8925,"ASAVE",DUZ,TIUDA)
- +41 IF +TIUAUDIT'>0
- Begin DoDot:1
- +42 WRITE !,"DELETING Entire "_TIUTYP_" record.",!
- +43 ;TIU*1*340 Move to here from 5 lines below
- +44 DO NOTIFY^TIUUTL("DELETE",+$PIECE(TIUD0,U,2),,.TIU,TIUDA)
- +45 DO DELIRT^TIUDIRT(TIUDA)
- DO DIK(TIUDA)
- HANG 2
- +46 SET TIUCHNG=2
- SET TIUCHNG("DELETE")=1
- +47 DO ALERTDEL^TIUALRT(TIUDA)
- DO DELSGNR^TIURB1(TIUDA)
- +48 ;D NOTIFY^TIUUTL("DELETE",+$P(TIUD0,U,2),,.TIU,TIUDA)
- End DoDot:1
- GOTO DELX
- +49 SET PROMPT="Reason for DELETION (Privacy Act or Administrative): "
- +50 SET TIURSN=$PIECE($$READ^TIUU("SA^P:privacy act;A:administrative",PROMPT,"PRIVACY ACT"),U)
- +51 IF '$LENGTH(TIURSN)
- Begin DoDot:1
- +52 WRITE !,"Nothing DELETED.",!
- +53 SET TIUCHNG=0
- SET TIUABORT=1
- +54 ; pause
- IF $$READ^TIUU("EA","Press RETURN to continue...")
- End DoDot:1
- GOTO DELX
- +55 DO ALERTDEL^TIUALRT(TIUDA)
- DO DELSGNR^TIURB1(TIUDA)
- +56 DO DELTEXT(TIUDA,TIURSN)
- DO AUDEL^TIURB1(TIUDA,TIURSN)
- SET TIUCHNG=1
- +57 if '$GET(TIURTRCK)
- DO NOTIFY^TIUUTL("DELETE",+$PIECE(TIUD0,U,2),,.TIU,TIUDA)
- 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
- SET TIURTRCK=1
- +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 ;Delete associated pastes in file 8928
- DO DELPST^TIUCOP(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