DVBAUDDIFD ;ALB/CP - File Deletion Utility ;09/13/16 15:52
;;2.7;AMIE;**256**;;Build 19
; Per VHA Directive 6402 this routine should not be modified
; HOME^%ZIS ; IA #10086
; ^DIC ; IA #10006
; ^DIU2 ; IA #10014
;
Q
;
ENTER ; Primary entry point for this API utility routine
N DVBASK,DVBFILE,DVBMETHOD,DVBOPTION,DVBQUIT,X,Y
; ZEXCEPT: DTIME
;
D:'$D(IOF) HOME^%ZIS S:'$D(DTIME) DTIME=300
I '$G(DUZ)!($G(DUZ(0))="") D G EXIT
. W !
. D CENTER^DVBAUDPRT1("Both the DUZ and DUZ(0) need to be defined.")
. D CONTINUE^DVBAUDPRT1(2,"R") ; Press <Enter> to continue.
S DVBOPTION="FILE DELETION UTILITY"
S DVBQUIT=0
PROMPT ; Present user prompts
D SHOWOPT^DVBAUDPRT2(DVBOPTION) ; Show option text, set DVBQUIT=0
D GETFILES ; Return DVBFILE(DVBFILENUM)="" ; Array of file numbers
G:DVBQUIT EXIT ; Exit, once the user is done deleting
D ASKMETH G:DVBQUIT PROMPT ; Which deletion method do you prefer
D ASKOK(.DVBFILE) G:DVBQUIT PROMPT D DELETE(DVBASK,.DVBFILE)
G PROMPT
EXIT ; Exit the file deletion utility API
Q
;------------------------------------------------------------------
ASKMETH ; Prompt: 'Which deletion method do you prefer'
;
W !!,"Which deletion method do you prefer"
W !?4,"1. Ask before deleting DATA & TEMPLATES"
W !?4,"2. Delete DATA & TEMPLATES without asking"
W !
S DVBASK=$$ASKNUM^DVBAUDASK1(2,2)
I DVBASK="^" S DVBQUIT=1 Q
;
Q
;------------------------------------------------------------------
ASKOK(DVBFILE) ; Prompt: OK TO DELETE?
;
N DVBFILENUM
; ZEXCEPT: IOF,DVBASK,DVBQUIT
;
W @IOF
W !,"WARNING! The following file(s) are selected for DELETION:",!
S DVBFILENUM=""
F S DVBFILENUM=$O(DVBFILE(DVBFILENUM)) Q:DVBFILENUM="" D Q:DVBQUIT
. N DIERR
. W !?2,$$GET1^DIQ(1,DVBFILENUM,.01)
. I $D(DIERR) D DIERR^DVBAUDDILG1(60,5,"DVBERROR","ASKOK^"_$T(+0)) Q
Q:DVBQUIT
;
; Previous FOR loop eliminated do to direct global access as follows
;F S DVBFILENUM=$O(DVBFILE(DVBFILENUM)) Q:DVBFILENUM="" W !?2,$P(^DIC(DVBFILENUM,0),U,1)
W !
S DVBASK=$$ASKYESNO^DVBAUDASK1("OK TO DELETE","NO")
I "^N"[DVBASK S DVBQUIT=1 Q ; User answered with "N" or "^"
;
Q
;------------------------------------------------------------------
GETFILES ; Build DVBFILE(array)
;
N @($$DIC^DVBAUDNEW1())
N DVBCNT,DIC,Y
; ZEXCEPT: DVBFILE,DVBQUIT
;
K DVBFILE ; Refresh output array.
S DVBCNT=1
S DIC="^DIC(" ; File #1 (file of files)
S DIC(0)="AEMQ" ; (A)sk (E)cho (M)ultiple index (Q)uestion errs
S DIC("S")="I '$D(DVBFILE(+Y))" ; Prevent picking the same file
W !!,"Select file(s) you wish deleted:"
GETFILE1 ; Loop branching label for prompting for multiple files
S DIC("A")="Select FILE "_DVBCNT_": "
W !
D ^DIC I Y<0 S:'$D(DVBFILE) DVBQUIT=1 G GETFILEX
I '$D(^DIC(+Y,0)) W " Invalid File ??" G GETFILE1
;
S DVBFILE(+Y)=""
S DVBCNT=DVBCNT+1
G GETFILE1
;
GETFILEX ; Exit GETFILES
Q
;------------------------------------------------------------------
DELETE(DVBASK,DVBFILE) ; Delete files
N @($$DIC^DVBAUDNEW1())
N DIC,DVBFILENUM
;
I DVBASK=2 W !!
S DVBFILENUM=""
F S DVBFILENUM=$O(DVBFILE(DVBFILENUM)) Q:DVBFILENUM="" D ;
. N @($$DIU2^DVBAUDNEW1())
. ; ZEXCEPT: DIU,DVBQUIT
. I DVBASK=1 W !!
. W "FILE: ",$P($G(^DIC(DVBFILENUM,0)),"^",1)
. D TEMP I DVBQUIT S DVBQUIT=0 Q
. S DIU=DVBFILENUM
. D EN^DIU2
;
D CONTINUE^DVBAUDPRT1(2,"R") ; Press <Enter> to continue
;
Q
;------------------------------------------------------------------
TEMP ; Delete templates & data?
;
; ZEXCEPT: DIU,DVBASK,DVBQUIT
;
I DVBASK=2 S DIU(0)="DT" Q
S DVBASK=$$ASKYESNO^DVBAUDASK1("Do you want to delete templates","No")
I DVBASK="^" S DVBQUIT=1 Q
;
S DIU(0)=$S(DVBASK="Y":"DET",1:"DE")
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBAUDDIFD 3828 printed Sep 17, 2026@20:27:17 Page 2
DVBAUDDIFD ;ALB/CP - File Deletion Utility ;09/13/16 15:52
+1 ;;2.7;AMIE;**256**;;Build 19
+2 ; Per VHA Directive 6402 this routine should not be modified
+3 ; HOME^%ZIS ; IA #10086
+4 ; ^DIC ; IA #10006
+5 ; ^DIU2 ; IA #10014
+6 ;
+7 QUIT
+8 ;
ENTER ; Primary entry point for this API utility routine
+1 NEW DVBASK,DVBFILE,DVBMETHOD,DVBOPTION,DVBQUIT,X,Y
+2 ; ZEXCEPT: DTIME
+3 ;
+4 if '$DATA(IOF)
DO HOME^%ZIS
if '$DATA(DTIME)
SET DTIME=300
+5 IF '$GET(DUZ)!($GET(DUZ(0))="")
Begin DoDot:1
+6 WRITE !
+7 DO CENTER^DVBAUDPRT1("Both the DUZ and DUZ(0) need to be defined.")
+8 ; Press <Enter> to continue.
DO CONTINUE^DVBAUDPRT1(2,"R")
End DoDot:1
GOTO EXIT
+9 SET DVBOPTION="FILE DELETION UTILITY"
+10 SET DVBQUIT=0
PROMPT ; Present user prompts
+1 ; Show option text, set DVBQUIT=0
DO SHOWOPT^DVBAUDPRT2(DVBOPTION)
+2 ; Return DVBFILE(DVBFILENUM)="" ; Array of file numbers
DO GETFILES
+3 ; Exit, once the user is done deleting
if DVBQUIT
GOTO EXIT
+4 ; Which deletion method do you prefer
DO ASKMETH
if DVBQUIT
GOTO PROMPT
+5 DO ASKOK(.DVBFILE)
if DVBQUIT
GOTO PROMPT
DO DELETE(DVBASK,.DVBFILE)
+6 GOTO PROMPT
EXIT ; Exit the file deletion utility API
+1 QUIT
+2 ;------------------------------------------------------------------
ASKMETH ; Prompt: 'Which deletion method do you prefer'
+1 ;
+2 WRITE !!,"Which deletion method do you prefer"
+3 WRITE !?4,"1. Ask before deleting DATA & TEMPLATES"
+4 WRITE !?4,"2. Delete DATA & TEMPLATES without asking"
+5 WRITE !
+6 SET DVBASK=$$ASKNUM^DVBAUDASK1(2,2)
+7 IF DVBASK="^"
SET DVBQUIT=1
QUIT
+8 ;
+9 QUIT
+10 ;------------------------------------------------------------------
ASKOK(DVBFILE) ; Prompt: OK TO DELETE?
+1 ;
+2 NEW DVBFILENUM
+3 ; ZEXCEPT: IOF,DVBASK,DVBQUIT
+4 ;
+5 WRITE @IOF
+6 WRITE !,"WARNING! The following file(s) are selected for DELETION:",!
+7 SET DVBFILENUM=""
+8 FOR
SET DVBFILENUM=$ORDER(DVBFILE(DVBFILENUM))
if DVBFILENUM=""
QUIT
Begin DoDot:1
+9 NEW DIERR
+10 WRITE !?2,$$GET1^DIQ(1,DVBFILENUM,.01)
+11 IF $DATA(DIERR)
DO DIERR^DVBAUDDILG1(60,5,"DVBERROR","ASKOK^"_$TEXT(+0))
QUIT
End DoDot:1
if DVBQUIT
QUIT
+12 if DVBQUIT
QUIT
+13 ;
+14 ; Previous FOR loop eliminated do to direct global access as follows
+15 ;F S DVBFILENUM=$O(DVBFILE(DVBFILENUM)) Q:DVBFILENUM="" W !?2,$P(^DIC(DVBFILENUM,0),U,1)
+16 WRITE !
+17 SET DVBASK=$$ASKYESNO^DVBAUDASK1("OK TO DELETE","NO")
+18 ; User answered with "N" or "^"
IF "^N"[DVBASK
SET DVBQUIT=1
QUIT
+19 ;
+20 QUIT
+21 ;------------------------------------------------------------------
GETFILES ; Build DVBFILE(array)
+1 ;
+2 NEW @($$DIC^DVBAUDNEW1())
+3 NEW DVBCNT,DIC,Y
+4 ; ZEXCEPT: DVBFILE,DVBQUIT
+5 ;
+6 ; Refresh output array.
KILL DVBFILE
+7 SET DVBCNT=1
+8 ; File #1 (file of files)
SET DIC="^DIC("
+9 ; (A)sk (E)cho (M)ultiple index (Q)uestion errs
SET DIC(0)="AEMQ"
+10 ; Prevent picking the same file
SET DIC("S")="I '$D(DVBFILE(+Y))"
+11 WRITE !!,"Select file(s) you wish deleted:"
GETFILE1 ; Loop branching label for prompting for multiple files
+1 SET DIC("A")="Select FILE "_DVBCNT_": "
+2 WRITE !
+3 DO ^DIC
IF Y<0
if '$DATA(DVBFILE)
SET DVBQUIT=1
GOTO GETFILEX
+4 IF '$DATA(^DIC(+Y,0))
WRITE " Invalid File ??"
GOTO GETFILE1
+5 ;
+6 SET DVBFILE(+Y)=""
+7 SET DVBCNT=DVBCNT+1
+8 GOTO GETFILE1
+9 ;
GETFILEX ; Exit GETFILES
+1 QUIT
+2 ;------------------------------------------------------------------
DELETE(DVBASK,DVBFILE) ; Delete files
+1 NEW @($$DIC^DVBAUDNEW1())
+2 NEW DIC,DVBFILENUM
+3 ;
+4 IF DVBASK=2
WRITE !!
+5 SET DVBFILENUM=""
+6 ;
FOR
SET DVBFILENUM=$ORDER(DVBFILE(DVBFILENUM))
if DVBFILENUM=""
QUIT
Begin DoDot:1
+7 NEW @($$DIU2^DVBAUDNEW1())
+8 ; ZEXCEPT: DIU,DVBQUIT
+9 IF DVBASK=1
WRITE !!
+10 WRITE "FILE: ",$PIECE($GET(^DIC(DVBFILENUM,0)),"^",1)
+11 DO TEMP
IF DVBQUIT
SET DVBQUIT=0
QUIT
+12 SET DIU=DVBFILENUM
+13 DO EN^DIU2
End DoDot:1
+14 ;
+15 ; Press <Enter> to continue
DO CONTINUE^DVBAUDPRT1(2,"R")
+16 ;
+17 QUIT
+18 ;------------------------------------------------------------------
TEMP ; Delete templates & data?
+1 ;
+2 ; ZEXCEPT: DIU,DVBASK,DVBQUIT
+3 ;
+4 IF DVBASK=2
SET DIU(0)="DT"
QUIT
+5 SET DVBASK=$$ASKYESNO^DVBAUDASK1("Do you want to delete templates","No")
+6 IF DVBASK="^"
SET DVBQUIT=1
QUIT
+7 ;
+8 SET DIU(0)=$SELECT(DVBASK="Y":"DET",1:"DE")
+9 ;
+10 QUIT
