DVBAUDU1 ;ALB/CP - API Calls Routine #1 ; 6/11/18 12:41pm
;;2.7;AMIE;**256**;;Build 19
; Per VHA Directive 6402 this routine should not be modified
; ^%DT ; IA #10003
; GETS^DIQ ; IA # 2056
; $$FMDIFF^XLFDT ; IA #10103
; $$NOW^XLFDT ; IA #10103
; ^DIC(19,"B", ; IA # 2246 & # 2509
; ^DIC(19, ; IA # 2539 & #10156
; ^DIC(19.2, ; IA # 1064
;
Q
;
BUILDOOO(DVBRTN,DVBEDIT,DVBOPTYPE) ; Build DVBTARGET(array) of option candidate(s)
;
N DVBCNT,DVBIEN19,DVBOPTNAME,DVBOPT
; ZEXCEPT: IOF,IOM,DVBQUIT,DVBTARGET
;
K DVBTARGET ; Refresh output array of Options meeting the criteria
S DVBQUIT=0
;
; If any of the required input variables are missing SET DVBQUIT=1
I $G(DVBRTN)=""!($G(DVBEDIT)="")!($G(DVBOPTYPE)="") S DVBQUIT=1 Q
;
Q:DVBEDIT'=4 ; Quit, if not deleting Options out of order
Q:"^DVBAUDOAD^"'[("^"_DVBRTN_"^") ; Quit if not appropriate DVBRTN
;
W @IOF
W !?4,"Searching for audited Options which are OUT OF ORDER that match your"
W !?4,"selected Option TYPE criteria. We will be present these one at a"
W !?4,"time to determine if you would like to remove that Option Audit."
W !
S DVBCNT("OPT")=0 ; Num. of Option file entries processed.
S DVBCNT("PRE")=0 ; Num. of candidates presented for audit removal.
;
S DVBOPTNAME="" ; ICR #2246 & 2509
F S DVBOPTNAME=$O(^DIC(19,"B",DVBOPTNAME)) Q:DVBOPTNAME="" S DVBIEN19=0 D ;
. F S DVBIEN19=$O(^DIC(19,"B",DVBOPTNAME,DVBIEN19)) Q:'DVBIEN19 D ;
. . S DVBCNT("OPT")=DVBCNT("OPT")+1
. . D DOTS^DVBAUDPRT2(DVBCNT("OPT"),400) ; Display a dot every 400 records
. . Q:'$$OPTIONOK^DVBAUDU2(DVBRTN,DVBOPTYPE,DVBIEN19)
. . ; Add to (or accumulate) DVBTARGET array of output options
. . S DVBTARGET(DVBOPTNAME,DVBIEN19)=$$GET1^DIQ(19,DVBIEN19,4) ; TYPE field #4
. . S DVBCNT("PRE")=DVBCNT("PRE")+1
;
I DVBCNT("PRE")>0 D ; Display # of candidate options found
. N DVBMSG
. S DVBMSG=DVBCNT("PRE")
. S DVBMSG=DVBMSG_" Option file candidate"
. S DVBMSG=DVBMSG_$S(DVBCNT("PRE")>1:"s",1:"") ; Add 's' if plural
. S DVBMSG=DVBMSG_" found."
. D CENTER^DVBAUDPRT1(DVBMSG,2,IOM,1) ;2 linefeeds w/IOM width & rev. video
;
I $O(DVBTARGET(""))="" D Q
. N DVBMSG
. S DVBMSG="No inactive Option(s) were found for your selected criteria"
. I DVBCNT("PRE")=0 S DVBMSG=DVBMSG_"." ; If no options are found add a period
. D CENTER^DVBAUDPRT1(DVBMSG,2,IOM,1)
. I DVBCNT("PRE") D ;
. . S DVBMSG="with an ENTRY ACTION containing 'AUDIT^DVBAUDOA'."
. . D CENTER^DVBAUDPRT1(DVBMSG,1,IOM,1)
;
Q ; Quit BUILDOOO
;
MSGIGNOR(DVBRTN) ; Display a warning message that option(s) will be ignored
;
N DVBMSG
; ZEXCEPT: IOM,DVBQUIT
;
S DVBQUIT=0 I $G(DVBRTN)="" S DVBQUIT=1 Q
;
S DVBMSG="Options "_$S(DVBRTN="DVBAUDOAD":"without ",1:"with ")
S DVBMSG=DVBMSG_"'D AUDIT^DVBAUDOA' in the ENTRY ACTION "
S DVBMSG=DVBMSG_"will be ignored."
D CENTER^DVBAUDPRT1(DVBMSG,2,IOM,1)
;
Q ; Quit MSGIGNOR
;
OPTSCH(DVBRTN,DVBEDIT,DVBOPTYPE) ; Build DVBTARGET(array) of option
;
N DVBCNT,DVBIEN,DVBOPTSCH,DVBFOUND
; ZEXCEPT: IOM,DVBQUIT,DVBTARGET
;
S DVBQUIT=0
;
I $G(DVBRTN)=""!($G(DVBEDIT)="")!($G(DVBOPTYPE)="") S DVBQUIT=1 Q
;
Q:DVBEDIT'=3
Q:"^DVBAUDOA^"'[("^"_DVBRTN_"^") ; Quit if not appropriate DVBRTN
;
W !!,"Searching for OPTION SCHEDULING file Options to audit which match your cr"
;
S DVBCNT("OPT")=0 ; Num. of OPTION SCHEDULING file entries processed.
; Num. of OPTION SCHEDULING entry candidates presented for auditing.
S DVBCNT("PRE")=0
; DVBFOUND, set to 1 once one Option is found matching the criteria
S DVBFOUND=0
;
K DVBTARGET ; Refresh output array of wildcard selected options
S DVBIEN=0
F S DVBIEN=$O(^DIC(19.2,DVBIEN)) Q:'DVBIEN D ;
. S DVBCNT("OPT")=DVBCNT("OPT")+1
. Q:'$D(^DIC(19.2,DVBIEN,0)) ; No zero node found for the DVBIEN
. ;
. N DVBOPT,DVBOPTSCH
. ;
. ; Retrieve DVBOPTSCH(array) of data fields from file 19.2
. D OPTSCH^DVBAUDDIQ(DVBIEN) Q:DVBQUIT
. ; Retrieve DVBOPT(array) of data fields from file 19
. D OPTION^DVBAUDDIQ(DVBOPTSCH("DVBIEN19")) Q:DVBQUIT
. ;
. Q:'$$OPTIONOK^DVBAUDU2(DVBRTN,DVBOPTYPE,DVBOPTSCH("DVBIEN19"))
. I DVBRTN="DVBAUDOA" Q:'$$OPTSCHOK(DVBRTN,.DVBOPTSCH) ; Does not qualify
. ;
. Q:$D(DVBTARGET(DVBOPTSCH("OPTNAME"),DVBOPTSCH("DVBIEN19"))) ; Target exists
. S DVBFOUND=1
. ;
. ; Add to (or accumulate) DVBTARGET array of output options
. S DVBTARGET(DVBOPTSCH("OPTNAME"),DVBOPTSCH("DVBIEN19"))=DVBOPT("TYPE")
. S DVBCNT("PRE")=DVBCNT("PRE")+1 ; Count Options presented for auditing
;
I DVBCNT("PRE")>1 D ; Display number of DVBTARGET options found
. N DVBMSG
. ; ZEXCEPT: IOM
. S DVBMSG="I found "_DVBCNT("PRE")_" candidate Options matching your criteria and"
. D CENTER^DVBAUDPRT1(DVBMSG,2,IOM,1)
. S DVBMSG="I will now present these one at a time for your approval!"
. D CENTER^DVBAUDPRT1(DVBMSG,1,IOM,1)
;
I $O(DVBTARGET(""))="",DVBRTN'="DVBAUDU1" D Q ;
. N DVBMSG
. S DVBMSG="No active Option(s) were found for your selected criteria"
. I DVBFOUND=0 S DVBMSG=DVBMSG_"." ; When no options are found, add a period
. D CENTER^DVBAUDPRT1(DVBMSG,2,IOM,1)
. I DVBFOUND D ;
. . I DVBRTN="DVBAUDOA" S DVBMSG="that are not already audited."
. . I DVBRTN="DVBAUDOAD" S DVBMSG="with an ENTRY ACTION containing 'D AUDIT^DVBAUDOA'."
. . D CENTER^DVBAUDPRT1(DVBMSG,1,IOM,1)
;
Q ; Quit OPTSCH
;
OPTSCHOK(DVBRTN,DVBOPTSCH) ; Extrinsic function
;
N DVBVAL
S DVBVAL=0
;
; If any of the required input variables are missing SET DVBQUIT=1
S DVBQUIT=0
I DVBRTN="" S DVBQUIT=1 Q ; Missing required DVBRTN input variable
I $O(DVBOPTSCH(""))="" S DVBQUIT=1 Q ; Missing required input array
;
Q:"^DVBAUDDIE^DVBAUDOA^DVBAUDOAS^DVBAUDU3S^"'[("^"_DVBRTN_"^") ; **1**
;
I DVBOPTSCH("TASKID")>0,DVBOPTSCH("QTORUNTIMEI")>$$NOW^XLFDT() D ;
. Q:DVBOPTSCH("FREQ")="" ; RESCHEDULING FREQUENCY is null
. ;
. I "H"=$E(DVBOPTSCH("FREQ"),$L(DVBOPTSCH("FREQ"))),DVBOPTSCH("FREQ")<24 Q
. ;
. I "S"=$E(DVBOPTSCH("FREQ"),$L(DVBOPTSCH("FREQ"))) Q
. S DVBVAL=1 ; Option qualifies; all criteria has been met
;
Q DVBVAL ; Quit $$OPSCHOK extrinsic
;
PGMACCSS(DVBRTN,DUZ) ; Determine if user's DUZ(0) has programmer (@) access
;
; ZEXCEPT: DVBQUIT
S DVBQUIT=0 ; Default the return quit variable to successful.
;
Q:$G(DUZ(0))["@" ; Quit if the user has programmer access
;
W !
;
I DVBRTN="DVBAUDOA" D ;
. W !?5
. D REVVIDEO^DVBAUDPRT1("ON")
. W "Access denied - Only users with programmer access may initiate"
. D REVVIDEO^DVBAUDPRT1("OFF")
. W !?5
. D REVVIDEO^DVBAUDPRT1("ON")
. W "the Option Audit process for various VistA package options."
. D REVVIDEO^DVBAUDPRT1("OFF")
;
I DVBRTN="DVBAUDOAD" D ;
. W !?5
. D REVVIDEO^DVBAUDPRT1("ON")
. W "Access denied - Only users with programmer access may delete"
. D REVVIDEO^DVBAUDPRT1("OFF")
. W !?5
. D REVVIDEO^DVBAUDPRT1("ON")
. W "existing Option Audit's from the OPTION file's ENTRY ACTION."
. D REVVIDEO^DVBAUDPRT1("OFF")
;
D CONTINUE^DVBAUDPRT1(2,"R")
S DVBQUIT=1
;
Q ; Quit PGMACCSS
;
PROCTIME(DVBIEN19,DVBOCCURIEN) ; Returns the processing time for the
;
N DVBOCCRMULT,DVBTIMEBEG,DVBTIMEEND,DVBVAL
N %,DVBDAYS,DVBDIFF,DVBHRS,DVBMINS,DVBSECS
N @($$%DT^DVBAUDNEW1())
; ZEXCEPT: %DT,X,Y
;
S DVBVAL="" ; Initialize output from extrinsic function to null
;
; Validate input variables
;
Q:'$G(DVBIEN19) DVBVAL
Q:'$G(DVBOCCURIEN) DVBVAL
Q:$$GET1^DIQ(396.9991,DVBIEN19,.01,"I")'=DVBIEN19 DVBVAL
Q:'$D(^DVB(396.9991,DVBIEN19,"OCCUR","B",DVBOCCURIEN,DVBOCCURIEN)) DVBVAL
D OCCRMULT^DVBAUDDIQ(DVBIEN19,DVBOCCURIEN)
S DVBTIMEBEG=DVBOCCRMULT("TIMEBEG") ; Internal O-DATE/TIME TASKED AUDIT BEGAN
S DVBTIMEEND=DVBOCCRMULT("TIMEEND") ; Internal O-DATE/TIME TASKED AUDIT ENDED
;
S %DT="ST"
S X=DVBTIMEBEG
K Y D ^%DT I Y=-1!($P(DVBTIMEBEG,".")'?7N) Q ""
S X=DVBTIMEEND
K Y D ^%DT I Y=-1!($P(DVBTIMEEND,".")'?7N) Q ""
;
S DVBDIFF=$$FMDIFF^XLFDT(DVBTIMEEND,DVBTIMEBEG,3) ; Returns: DD HH:MM:SS
;
; Convert processing time to external format and display results
;
S DVBDAYS=+$P(DVBDIFF," ")
S DVBHRS=+$P($P(DVBDIFF," ",2),":")
S DVBMINS=+$P($P(DVBDIFF," ",2),":",2)
S DVBSECS=+$P($P(DVBDIFF," ",2),":",3)
S:DVBSECS="" DVBSECS=1
S:DVBDAYS DVBVAL=DVBVAL_" DAYS: "_DVBDAYS
S:DVBHRS DVBVAL=DVBVAL_" HOURS: "_DVBHRS
S:DVBMINS DVBVAL=DVBVAL_" MINS: "_DVBMINS
S:DVBSECS DVBVAL=DVBVAL_" SECS: "_DVBSECS
S DVBVAL=$E(DVBVAL,3,999)
;
Q DVBVAL ; Quit $$PROCTIME extrinsic
;
SELWILD(DVBEDIT) ; Prompt "Select an Option NAMESPACE with wild card '*': "
;
; ZEXCEPT: DTIME,IOM,DVBNAMSPC,DVBQUIT,DVBTEXT
;
S DVBNAMSPC="" ; Default the output namespace to null.
S DVBQUIT=0 ;... Default the return quit variable to successful.
I $G(DVBEDIT)="" S DVBQUIT=1 Q
Q:DVBEDIT'=2 ; Quit, if not editing by wildcard character (*)
SELWILD1 ;
W !!
R "Select an Option NAMESPACE with wild card '*': ",DVBNAMSPC:DTIME
I "^"[DVBNAMSPC S DVBQUIT=1 Q ; User hit <Enter> or entered '^', exit
I $E(DVBNAMSPC,$L(DVBNAMSPC),$L(DVBNAMSPC))'="*"!(DVBNAMSPC["?") D G SELWILD1
. N DVBTEXT
. W:DVBNAMSPC'["?" " ??"
. S DVBTEXT="For example, if the package namespace is 'DGZ' enter 'DGZ*'"
. D CENTER^DVBAUDPRT1(DVBTEXT,2,IOM,1)
Q ; Quit SELWILD & SELWILD1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBAUDU1 9462 printed Sep 17, 2026@20:27:30 Page 2
DVBAUDU1 ;ALB/CP - API Calls Routine #1 ; 6/11/18 12:41pm
+1 ;;2.7;AMIE;**256**;;Build 19
+2 ; Per VHA Directive 6402 this routine should not be modified
+3 ; ^%DT ; IA #10003
+4 ; GETS^DIQ ; IA # 2056
+5 ; $$FMDIFF^XLFDT ; IA #10103
+6 ; $$NOW^XLFDT ; IA #10103
+7 ; ^DIC(19,"B", ; IA # 2246 & # 2509
+8 ; ^DIC(19, ; IA # 2539 & #10156
+9 ; ^DIC(19.2, ; IA # 1064
+10 ;
+11 QUIT
+12 ;
BUILDOOO(DVBRTN,DVBEDIT,DVBOPTYPE) ; Build DVBTARGET(array) of option candidate(s)
+1 ;
+2 NEW DVBCNT,DVBIEN19,DVBOPTNAME,DVBOPT
+3 ; ZEXCEPT: IOF,IOM,DVBQUIT,DVBTARGET
+4 ;
+5 ; Refresh output array of Options meeting the criteria
KILL DVBTARGET
+6 SET DVBQUIT=0
+7 ;
+8 ; If any of the required input variables are missing SET DVBQUIT=1
+9 IF $GET(DVBRTN)=""!($GET(DVBEDIT)="")!($GET(DVBOPTYPE)="")
SET DVBQUIT=1
QUIT
+10 ;
+11 ; Quit, if not deleting Options out of order
if DVBEDIT'=4
QUIT
+12 ; Quit if not appropriate DVBRTN
if "^DVBAUDOAD^"'[("^"_DVBRTN_"^")
QUIT
+13 ;
+14 WRITE @IOF
+15 WRITE !?4,"Searching for audited Options which are OUT OF ORDER that match your"
+16 WRITE !?4,"selected Option TYPE criteria. We will be present these one at a"
+17 WRITE !?4,"time to determine if you would like to remove that Option Audit."
+18 WRITE !
+19 ; Num. of Option file entries processed.
SET DVBCNT("OPT")=0
+20 ; Num. of candidates presented for audit removal.
SET DVBCNT("PRE")=0
+21 ;
+22 ; ICR #2246 & 2509
SET DVBOPTNAME=""
+23 ;
FOR
SET DVBOPTNAME=$ORDER(^DIC(19,"B",DVBOPTNAME))
if DVBOPTNAME=""
QUIT
SET DVBIEN19=0
Begin DoDot:1
+24 ;
FOR
SET DVBIEN19=$ORDER(^DIC(19,"B",DVBOPTNAME,DVBIEN19))
if 'DVBIEN19
QUIT
Begin DoDot:2
+25 SET DVBCNT("OPT")=DVBCNT("OPT")+1
+26 ; Display a dot every 400 records
DO DOTS^DVBAUDPRT2(DVBCNT("OPT"),400)
+27 if '$$OPTIONOK^DVBAUDU2(DVBRTN,DVBOPTYPE,DVBIEN19)
QUIT
+28 ; Add to (or accumulate) DVBTARGET array of output options
+29 ; TYPE field #4
SET DVBTARGET(DVBOPTNAME,DVBIEN19)=$$GET1^DIQ(19,DVBIEN19,4)
+30 SET DVBCNT("PRE")=DVBCNT("PRE")+1
End DoDot:2
End DoDot:1
+31 ;
+32 ; Display # of candidate options found
IF DVBCNT("PRE")>0
Begin DoDot:1
+33 NEW DVBMSG
+34 SET DVBMSG=DVBCNT("PRE")
+35 SET DVBMSG=DVBMSG_" Option file candidate"
+36 ; Add 's' if plural
SET DVBMSG=DVBMSG_$SELECT(DVBCNT("PRE")>1:"s",1:"")
+37 SET DVBMSG=DVBMSG_" found."
+38 ;2 linefeeds w/IOM width & rev. video
DO CENTER^DVBAUDPRT1(DVBMSG,2,IOM,1)
End DoDot:1
+39 ;
+40 IF $ORDER(DVBTARGET(""))=""
Begin DoDot:1
+41 NEW DVBMSG
+42 SET DVBMSG="No inactive Option(s) were found for your selected criteria"
+43 ; If no options are found add a period
IF DVBCNT("PRE")=0
SET DVBMSG=DVBMSG_"."
+44 DO CENTER^DVBAUDPRT1(DVBMSG,2,IOM,1)
+45 ;
IF DVBCNT("PRE")
Begin DoDot:2
+46 SET DVBMSG="with an ENTRY ACTION containing 'AUDIT^DVBAUDOA'."
+47 DO CENTER^DVBAUDPRT1(DVBMSG,1,IOM,1)
End DoDot:2
End DoDot:1
QUIT
+48 ;
+49 ; Quit BUILDOOO
QUIT
+50 ;
MSGIGNOR(DVBRTN) ; Display a warning message that option(s) will be ignored
+1 ;
+2 NEW DVBMSG
+3 ; ZEXCEPT: IOM,DVBQUIT
+4 ;
+5 SET DVBQUIT=0
IF $GET(DVBRTN)=""
SET DVBQUIT=1
QUIT
+6 ;
+7 SET DVBMSG="Options "_$SELECT(DVBRTN="DVBAUDOAD":"without ",1:"with ")
+8 SET DVBMSG=DVBMSG_"'D AUDIT^DVBAUDOA' in the ENTRY ACTION "
+9 SET DVBMSG=DVBMSG_"will be ignored."
+10 DO CENTER^DVBAUDPRT1(DVBMSG,2,IOM,1)
+11 ;
+12 ; Quit MSGIGNOR
QUIT
+13 ;
OPTSCH(DVBRTN,DVBEDIT,DVBOPTYPE) ; Build DVBTARGET(array) of option
+1 ;
+2 NEW DVBCNT,DVBIEN,DVBOPTSCH,DVBFOUND
+3 ; ZEXCEPT: IOM,DVBQUIT,DVBTARGET
+4 ;
+5 SET DVBQUIT=0
+6 ;
+7 IF $GET(DVBRTN)=""!($GET(DVBEDIT)="")!($GET(DVBOPTYPE)="")
SET DVBQUIT=1
QUIT
+8 ;
+9 if DVBEDIT'=3
QUIT
+10 ; Quit if not appropriate DVBRTN
if "^DVBAUDOA^"'[("^"_DVBRTN_"^")
QUIT
+11 ;
+12 WRITE !!,"Searching for OPTION SCHEDULING file Options to audit which match your cr"
+13 ;
+14 ; Num. of OPTION SCHEDULING file entries processed.
SET DVBCNT("OPT")=0
+15 ; Num. of OPTION SCHEDULING entry candidates presented for auditing.
+16 SET DVBCNT("PRE")=0
+17 ; DVBFOUND, set to 1 once one Option is found matching the criteria
+18 SET DVBFOUND=0
+19 ;
+20 ; Refresh output array of wildcard selected options
KILL DVBTARGET
+21 SET DVBIEN=0
+22 ;
FOR
SET DVBIEN=$ORDER(^DIC(19.2,DVBIEN))
if 'DVBIEN
QUIT
Begin DoDot:1
+23 SET DVBCNT("OPT")=DVBCNT("OPT")+1
+24 ; No zero node found for the DVBIEN
if '$DATA(^DIC(19.2,DVBIEN,0))
QUIT
+25 ;
+26 NEW DVBOPT,DVBOPTSCH
+27 ;
+28 ; Retrieve DVBOPTSCH(array) of data fields from file 19.2
+29 DO OPTSCH^DVBAUDDIQ(DVBIEN)
if DVBQUIT
QUIT
+30 ; Retrieve DVBOPT(array) of data fields from file 19
+31 DO OPTION^DVBAUDDIQ(DVBOPTSCH("DVBIEN19"))
if DVBQUIT
QUIT
+32 ;
+33 if '$$OPTIONOK^DVBAUDU2(DVBRTN,DVBOPTYPE,DVBOPTSCH("DVBIEN19"))
QUIT
+34 ; Does not qualify
IF DVBRTN="DVBAUDOA"
if '$$OPTSCHOK(DVBRTN,.DVBOPTSCH)
QUIT
+35 ;
+36 ; Target exists
if $DATA(DVBTARGET(DVBOPTSCH("OPTNAME"),DVBOPTSCH("DVBIEN19")))
QUIT
+37 SET DVBFOUND=1
+38 ;
+39 ; Add to (or accumulate) DVBTARGET array of output options
+40 SET DVBTARGET(DVBOPTSCH("OPTNAME"),DVBOPTSCH("DVBIEN19"))=DVBOPT("TYPE")
+41 ; Count Options presented for auditing
SET DVBCNT("PRE")=DVBCNT("PRE")+1
End DoDot:1
+42 ;
+43 ; Display number of DVBTARGET options found
IF DVBCNT("PRE")>1
Begin DoDot:1
+44 NEW DVBMSG
+45 ; ZEXCEPT: IOM
+46 SET DVBMSG="I found "_DVBCNT("PRE")_" candidate Options matching your criteria and"
+47 DO CENTER^DVBAUDPRT1(DVBMSG,2,IOM,1)
+48 SET DVBMSG="I will now present these one at a time for your approval!"
+49 DO CENTER^DVBAUDPRT1(DVBMSG,1,IOM,1)
End DoDot:1
+50 ;
+51 ;
IF $ORDER(DVBTARGET(""))=""
IF DVBRTN'="DVBAUDU1"
Begin DoDot:1
+52 NEW DVBMSG
+53 SET DVBMSG="No active Option(s) were found for your selected criteria"
+54 ; When no options are found, add a period
IF DVBFOUND=0
SET DVBMSG=DVBMSG_"."
+55 DO CENTER^DVBAUDPRT1(DVBMSG,2,IOM,1)
+56 ;
IF DVBFOUND
Begin DoDot:2
+57 IF DVBRTN="DVBAUDOA"
SET DVBMSG="that are not already audited."
+58 IF DVBRTN="DVBAUDOAD"
SET DVBMSG="with an ENTRY ACTION containing 'D AUDIT^DVBAUDOA'."
+59 DO CENTER^DVBAUDPRT1(DVBMSG,1,IOM,1)
End DoDot:2
End DoDot:1
QUIT
+60 ;
+61 ; Quit OPTSCH
QUIT
+62 ;
OPTSCHOK(DVBRTN,DVBOPTSCH) ; Extrinsic function
+1 ;
+2 NEW DVBVAL
+3 SET DVBVAL=0
+4 ;
+5 ; If any of the required input variables are missing SET DVBQUIT=1
+6 SET DVBQUIT=0
+7 ; Missing required DVBRTN input variable
IF DVBRTN=""
SET DVBQUIT=1
QUIT
+8 ; Missing required input array
IF $ORDER(DVBOPTSCH(""))=""
SET DVBQUIT=1
QUIT
+9 ;
+10 ; **1**
if "^DVBAUDDIE^DVBAUDOA^DVBAUDOAS^DVBAUDU3S^"'[("^"_DVBRTN_"^")
QUIT
+11 ;
+12 ;
IF DVBOPTSCH("TASKID")>0
IF DVBOPTSCH("QTORUNTIMEI")>$$NOW^XLFDT()
Begin DoDot:1
+13 ; RESCHEDULING FREQUENCY is null
if DVBOPTSCH("FREQ")=""
QUIT
+14 ;
+15 IF "H"=$EXTRACT(DVBOPTSCH("FREQ"),$LENGTH(DVBOPTSCH("FREQ")))
IF DVBOPTSCH("FREQ")<24
QUIT
+16 ;
+17 IF "S"=$EXTRACT(DVBOPTSCH("FREQ"),$LENGTH(DVBOPTSCH("FREQ")))
QUIT
+18 ; Option qualifies; all criteria has been met
SET DVBVAL=1
End DoDot:1
+19 ;
+20 ; Quit $$OPSCHOK extrinsic
QUIT DVBVAL
+21 ;
PGMACCSS(DVBRTN,DUZ) ; Determine if user's DUZ(0) has programmer (@) access
+1 ;
+2 ; ZEXCEPT: DVBQUIT
+3 ; Default the return quit variable to successful.
SET DVBQUIT=0
+4 ;
+5 ; Quit if the user has programmer access
if $GET(DUZ(0))["@"
QUIT
+6 ;
+7 WRITE !
+8 ;
+9 ;
IF DVBRTN="DVBAUDOA"
Begin DoDot:1
+10 WRITE !?5
+11 DO REVVIDEO^DVBAUDPRT1("ON")
+12 WRITE "Access denied - Only users with programmer access may initiate"
+13 DO REVVIDEO^DVBAUDPRT1("OFF")
+14 WRITE !?5
+15 DO REVVIDEO^DVBAUDPRT1("ON")
+16 WRITE "the Option Audit process for various VistA package options."
+17 DO REVVIDEO^DVBAUDPRT1("OFF")
End DoDot:1
+18 ;
+19 ;
IF DVBRTN="DVBAUDOAD"
Begin DoDot:1
+20 WRITE !?5
+21 DO REVVIDEO^DVBAUDPRT1("ON")
+22 WRITE "Access denied - Only users with programmer access may delete"
+23 DO REVVIDEO^DVBAUDPRT1("OFF")
+24 WRITE !?5
+25 DO REVVIDEO^DVBAUDPRT1("ON")
+26 WRITE "existing Option Audit's from the OPTION file's ENTRY ACTION."
+27 DO REVVIDEO^DVBAUDPRT1("OFF")
End DoDot:1
+28 ;
+29 DO CONTINUE^DVBAUDPRT1(2,"R")
+30 SET DVBQUIT=1
+31 ;
+32 ; Quit PGMACCSS
QUIT
+33 ;
PROCTIME(DVBIEN19,DVBOCCURIEN) ; Returns the processing time for the
+1 ;
+2 NEW DVBOCCRMULT,DVBTIMEBEG,DVBTIMEEND,DVBVAL
+3 NEW %,DVBDAYS,DVBDIFF,DVBHRS,DVBMINS,DVBSECS
+4 NEW @($$%DT^DVBAUDNEW1())
+5 ; ZEXCEPT: %DT,X,Y
+6 ;
+7 ; Initialize output from extrinsic function to null
SET DVBVAL=""
+8 ;
+9 ; Validate input variables
+10 ;
+11 if '$GET(DVBIEN19)
QUIT DVBVAL
+12 if '$GET(DVBOCCURIEN)
QUIT DVBVAL
+13 if $$GET1^DIQ(396.9991,DVBIEN19,.01,"I")'=DVBIEN19
QUIT DVBVAL
+14 if '$DATA(^DVB(396.9991,DVBIEN19,"OCCUR","B",DVBOCCURIEN,DVBOCCURIEN))
QUIT DVBVAL
+15 DO OCCRMULT^DVBAUDDIQ(DVBIEN19,DVBOCCURIEN)
+16 ; Internal O-DATE/TIME TASKED AUDIT BEGAN
SET DVBTIMEBEG=DVBOCCRMULT("TIMEBEG")
+17 ; Internal O-DATE/TIME TASKED AUDIT ENDED
SET DVBTIMEEND=DVBOCCRMULT("TIMEEND")
+18 ;
+19 SET %DT="ST"
+20 SET X=DVBTIMEBEG
+21 KILL Y
DO ^%DT
IF Y=-1!($PIECE(DVBTIMEBEG,".")'?7N)
QUIT ""
+22 SET X=DVBTIMEEND
+23 KILL Y
DO ^%DT
IF Y=-1!($PIECE(DVBTIMEEND,".")'?7N)
QUIT ""
+24 ;
+25 ; Returns: DD HH:MM:SS
SET DVBDIFF=$$FMDIFF^XLFDT(DVBTIMEEND,DVBTIMEBEG,3)
+26 ;
+27 ; Convert processing time to external format and display results
+28 ;
+29 SET DVBDAYS=+$PIECE(DVBDIFF," ")
+30 SET DVBHRS=+$PIECE($PIECE(DVBDIFF," ",2),":")
+31 SET DVBMINS=+$PIECE($PIECE(DVBDIFF," ",2),":",2)
+32 SET DVBSECS=+$PIECE($PIECE(DVBDIFF," ",2),":",3)
+33 if DVBSECS=""
SET DVBSECS=1
+34 if DVBDAYS
SET DVBVAL=DVBVAL_" DAYS: "_DVBDAYS
+35 if DVBHRS
SET DVBVAL=DVBVAL_" HOURS: "_DVBHRS
+36 if DVBMINS
SET DVBVAL=DVBVAL_" MINS: "_DVBMINS
+37 if DVBSECS
SET DVBVAL=DVBVAL_" SECS: "_DVBSECS
+38 SET DVBVAL=$EXTRACT(DVBVAL,3,999)
+39 ;
+40 ; Quit $$PROCTIME extrinsic
QUIT DVBVAL
+41 ;
SELWILD(DVBEDIT) ; Prompt "Select an Option NAMESPACE with wild card '*': "
+1 ;
+2 ; ZEXCEPT: DTIME,IOM,DVBNAMSPC,DVBQUIT,DVBTEXT
+3 ;
+4 ; Default the output namespace to null.
SET DVBNAMSPC=""
+5 ;... Default the return quit variable to successful.
SET DVBQUIT=0
+6 IF $GET(DVBEDIT)=""
SET DVBQUIT=1
QUIT
+7 ; Quit, if not editing by wildcard character (*)
if DVBEDIT'=2
QUIT
SELWILD1 ;
+1 WRITE !!
+2 READ "Select an Option NAMESPACE with wild card '*': ",DVBNAMSPC:DTIME
+3 ; User hit <Enter> or entered '^', exit
IF "^"[DVBNAMSPC
SET DVBQUIT=1
QUIT
+4 IF $EXTRACT(DVBNAMSPC,$LENGTH(DVBNAMSPC),$LENGTH(DVBNAMSPC))'="*"!(DVBNAMSPC["?")
Begin DoDot:1
+5 NEW DVBTEXT
+6 if DVBNAMSPC'["?"
WRITE " ??"
+7 SET DVBTEXT="For example, if the package namespace is 'DGZ' enter 'DGZ*'"
+8 DO CENTER^DVBAUDPRT1(DVBTEXT,2,IOM,1)
End DoDot:1
GOTO SELWILD1
+9 ; Quit SELWILD & SELWILD1
QUIT
