DVBAUDDIR ;ALB/CP - FM DIR API Subroutine Calls ; 4/3/18 8:56am
;;2.7;AMIE;**256**;;Build 19
; Per VHA Directive 6402 this routine should not be modified
; ^DIR ; #10026
; ^DISV ; IA # 510
;
Q
;
SELEDIT(DVBRTN) ; Prompt user to determine if wildcard will be used to
;
N @($$DIR^DVBAUDNEW1())
; ZEXCEPT: DIR,DUZ,DVBEDIT,DVBQUIT,Y
;
S DVBQUIT=0 ; DVBDEFAULT the return quit variable to successful.
I $G(DVBRTN)="" S DVBQUIT=1 Q ; Missing required input parameter
;
S DIR(0)="SO^1:Option NAME;"
S DIR(0)=DIR(0)_"2:Option NAMESPACE (used with wildcard '*');"
S DIR(0)=DIR(0)_"3:Options scheduled as regular recurring tasks;"
I DVBRTN="DVBAUDOAD" D ;
. S DIR(0)=DIR(0)_"4:All options with an OUT OF ORDER MESSAGE;"
S DIR("A")="CHOOSE AUDITING BY"
S DIR("B")=$G(^DISV(DUZ,DVBRTN,"DVBEDIT"),2)
;
; If repeating a 2nd time, Kill DVBDEFAULT to allow easy user exiting
I $G(DVBEDIT) K DIR("B"),DVBEDIT
;
D ^DIR
; 2nd time through, Y can equal null if the user hits return on no DVBDEFAULT
I Y="" S DVBQUIT=1 Q
I Y["^" S DVBEDIT="",DVBQUIT=1 Q ; User entered an '^' to EXIT
;
S DVBEDIT=Y ; Save the valid response to the prompt, to save for next DVBDEFAULT
S ^DISV(DUZ,DVBRTN,"DVBEDIT")=Y ; Save for next DVBDEFAULT response
;
Q ; Quit SELEDIT
;
SELTYPE(DVBRTN) ; Get Option TYPE selection(s) which are candidates for auditing.
;
N DVBCNT,DVBOPTTYPE,DVBOPTTYPEI,DVBOPTTYPES,DVBTYPE
; ZEXCEPT: DUZ
;
S DVBQUIT=0 ; Initialize the return quit variable to successful.
I $G(DVBRTN)="" S DVBQUIT=1 Q ; Missing required input parameter
;
S DVBCNT=0
F DVBOPTTYPEI="A","E","I","M","P","R","X","S","C" D ;
. S DVBCNT=DVBCNT+1
. S DVBTYPE(DVBCNT)=DVBOPTTYPEI ; Setup 9 option TYPEs
;
S DVBCNT=0
F DVBOPTTYPE="1 A:action","2 E:edit","3 I:inquire","4 M:menu" D ;
. S DVBCNT=DVBCNT+1
. S DVBOPTTYPES(DVBCNT)=DVBOPTTYPE
;
F DVBOPTTYPE="5 P:print","6 R:run routine" D ;
. S DVBCNT=DVBCNT+1
. S DVBOPTTYPES(DVBCNT)=DVBOPTTYPE
;
F DVBOPTTYPE="7 X:extended action","8 S:server" D ;
. S DVBCNT=DVBCNT+1
. S DVBOPTTYPES(DVBCNT)=DVBOPTTYPE
;
F DVBOPTTYPE="9 C:ScreenMan" D ;,"10 Broker (Client/Server)" D ;
. S DVBCNT=DVBCNT+1
. S DVBOPTTYPES(DVBCNT)=DVBOPTTYPE
;
; Display the available option types for auditing to the user
;
W !!,"Select Option TYPEs to be audited:"
S DVBOPTTYPE=0
F S DVBOPTTYPE=$O(DVBOPTTYPES(DVBOPTTYPE)) Q:DVBOPTTYPE="" D ;
. W !,?5,DVBOPTTYPES(DVBOPTTYPE)
;
N @($$DIR^DVBAUDNEW1()),DVBDEFAULT
; ZEXCEPT: DIR,DVBACTION,DVBOPTYPE,DVBQUIT,X,Y
;
S DVBDEFAULT=$S(DVBRTN="DVBAUDOA":"1-3,5-9",DVBRTN="DVBAUDOAD":"1-9",1:"1-3,5-9")
I DVBRTN="DVBAUDU3",DVBACTION="CREATE" S DVBDEFAULT="1-3,5-9" ; Skip menus
I DVBRTN="DVBAUDU3",DVBACTION="DELETE" S DVBDEFAULT="1-9" ; Include menus
;
S DIR(0)="LO^1:"_DVBCNT
S DIR("B")=$G(^DISV(DUZ,DVBRTN,"DVBOPTYPE"),DVBDEFAULT)
I DVBRTN="DVBAUDU3" S DIR("B")=DVBDEFAULT
W !
D ^DIR I Y["^" S DVBQUIT=1 Q ; User entered an '^' to EXIT
S ^DISV(DUZ,DVBRTN,"DVBOPTYPE")=X ; Save for next DVBDEFAULT response
;
N DVBCHOICE,DVBPCE
S DVBOPTYPE=""
F DVBPCE=1:1 S DVBCHOICE=$P(Y,",",DVBPCE) Q:'DVBCHOICE D ;
. S DVBOPTYPE=DVBOPTYPE_DVBTYPE(DVBCHOICE)
;
Q ; Quit SELTYPE
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBAUDDIR 3337 printed Sep 17, 2026@20:27:21 Page 2
DVBAUDDIR ;ALB/CP - FM DIR API Subroutine Calls ; 4/3/18 8:56am
+1 ;;2.7;AMIE;**256**;;Build 19
+2 ; Per VHA Directive 6402 this routine should not be modified
+3 ; ^DIR ; #10026
+4 ; ^DISV ; IA # 510
+5 ;
+6 QUIT
+7 ;
SELEDIT(DVBRTN) ; Prompt user to determine if wildcard will be used to
+1 ;
+2 NEW @($$DIR^DVBAUDNEW1())
+3 ; ZEXCEPT: DIR,DUZ,DVBEDIT,DVBQUIT,Y
+4 ;
+5 ; DVBDEFAULT the return quit variable to successful.
SET DVBQUIT=0
+6 ; Missing required input parameter
IF $GET(DVBRTN)=""
SET DVBQUIT=1
QUIT
+7 ;
+8 SET DIR(0)="SO^1:Option NAME;"
+9 SET DIR(0)=DIR(0)_"2:Option NAMESPACE (used with wildcard '*');"
+10 SET DIR(0)=DIR(0)_"3:Options scheduled as regular recurring tasks;"
+11 ;
IF DVBRTN="DVBAUDOAD"
Begin DoDot:1
+12 SET DIR(0)=DIR(0)_"4:All options with an OUT OF ORDER MESSAGE;"
End DoDot:1
+13 SET DIR("A")="CHOOSE AUDITING BY"
+14 SET DIR("B")=$GET(^DISV(DUZ,DVBRTN,"DVBEDIT"),2)
+15 ;
+16 ; If repeating a 2nd time, Kill DVBDEFAULT to allow easy user exiting
+17 IF $GET(DVBEDIT)
KILL DIR("B"),DVBEDIT
+18 ;
+19 DO ^DIR
+20 ; 2nd time through, Y can equal null if the user hits return on no DVBDEFAULT
+21 IF Y=""
SET DVBQUIT=1
QUIT
+22 ; User entered an '^' to EXIT
IF Y["^"
SET DVBEDIT=""
SET DVBQUIT=1
QUIT
+23 ;
+24 ; Save the valid response to the prompt, to save for next DVBDEFAULT
SET DVBEDIT=Y
+25 ; Save for next DVBDEFAULT response
SET ^DISV(DUZ,DVBRTN,"DVBEDIT")=Y
+26 ;
+27 ; Quit SELEDIT
QUIT
+28 ;
SELTYPE(DVBRTN) ; Get Option TYPE selection(s) which are candidates for auditing.
+1 ;
+2 NEW DVBCNT,DVBOPTTYPE,DVBOPTTYPEI,DVBOPTTYPES,DVBTYPE
+3 ; ZEXCEPT: DUZ
+4 ;
+5 ; Initialize the return quit variable to successful.
SET DVBQUIT=0
+6 ; Missing required input parameter
IF $GET(DVBRTN)=""
SET DVBQUIT=1
QUIT
+7 ;
+8 SET DVBCNT=0
+9 ;
FOR DVBOPTTYPEI="A","E","I","M","P","R","X","S","C"
Begin DoDot:1
+10 SET DVBCNT=DVBCNT+1
+11 ; Setup 9 option TYPEs
SET DVBTYPE(DVBCNT)=DVBOPTTYPEI
End DoDot:1
+12 ;
+13 SET DVBCNT=0
+14 ;
FOR DVBOPTTYPE="1 A:action","2 E:edit","3 I:inquire","4 M:menu"
Begin DoDot:1
+15 SET DVBCNT=DVBCNT+1
+16 SET DVBOPTTYPES(DVBCNT)=DVBOPTTYPE
End DoDot:1
+17 ;
+18 ;
FOR DVBOPTTYPE="5 P:print","6 R:run routine"
Begin DoDot:1
+19 SET DVBCNT=DVBCNT+1
+20 SET DVBOPTTYPES(DVBCNT)=DVBOPTTYPE
End DoDot:1
+21 ;
+22 ;
FOR DVBOPTTYPE="7 X:extended action","8 S:server"
Begin DoDot:1
+23 SET DVBCNT=DVBCNT+1
+24 SET DVBOPTTYPES(DVBCNT)=DVBOPTTYPE
End DoDot:1
+25 ;
+26 ;,"10 Broker (Client/Server)" D ;
FOR DVBOPTTYPE="9 C:ScreenMan"
Begin DoDot:1
+27 SET DVBCNT=DVBCNT+1
+28 SET DVBOPTTYPES(DVBCNT)=DVBOPTTYPE
End DoDot:1
+29 ;
+30 ; Display the available option types for auditing to the user
+31 ;
+32 WRITE !!,"Select Option TYPEs to be audited:"
+33 SET DVBOPTTYPE=0
+34 ;
FOR
SET DVBOPTTYPE=$ORDER(DVBOPTTYPES(DVBOPTTYPE))
if DVBOPTTYPE=""
QUIT
Begin DoDot:1
+35 WRITE !,?5,DVBOPTTYPES(DVBOPTTYPE)
End DoDot:1
+36 ;
+37 NEW @($$DIR^DVBAUDNEW1()),DVBDEFAULT
+38 ; ZEXCEPT: DIR,DVBACTION,DVBOPTYPE,DVBQUIT,X,Y
+39 ;
+40 SET DVBDEFAULT=$SELECT(DVBRTN="DVBAUDOA":"1-3,5-9",DVBRTN="DVBAUDOAD":"1-9",1:"1-3,5-9")
+41 ; Skip menus
IF DVBRTN="DVBAUDU3"
IF DVBACTION="CREATE"
SET DVBDEFAULT="1-3,5-9"
+42 ; Include menus
IF DVBRTN="DVBAUDU3"
IF DVBACTION="DELETE"
SET DVBDEFAULT="1-9"
+43 ;
+44 SET DIR(0)="LO^1:"_DVBCNT
+45 SET DIR("B")=$GET(^DISV(DUZ,DVBRTN,"DVBOPTYPE"),DVBDEFAULT)
+46 IF DVBRTN="DVBAUDU3"
SET DIR("B")=DVBDEFAULT
+47 WRITE !
+48 ; User entered an '^' to EXIT
DO ^DIR
IF Y["^"
SET DVBQUIT=1
QUIT
+49 ; Save for next DVBDEFAULT response
SET ^DISV(DUZ,DVBRTN,"DVBOPTYPE")=X
+50 ;
+51 NEW DVBCHOICE,DVBPCE
+52 SET DVBOPTYPE=""
+53 ;
FOR DVBPCE=1:1
SET DVBCHOICE=$PIECE(Y,",",DVBPCE)
if 'DVBCHOICE
QUIT
Begin DoDot:1
+54 SET DVBOPTYPE=DVBOPTYPE_DVBTYPE(DVBCHOICE)
End DoDot:1
+55 ;
+56 ; Quit SELTYPE
QUIT
