DVBAUDU2 ;ALB/CP - API Calls Routine #2;02/26/18 13:11 ; 4/12/18 6:06pm
;;2.7;AMIE;**256**;;Build 19
; Per VHA Directive 6402 this routine should not be modified
; GETS^DIQ ; # 2056
; ^DIC(19, ; IA # 2246
; ^DIC(19.2, ; IA # 1064
Q
;
BUILDOS(DVBRTN,DVBEDIT,DVBOPTYPE) ; Build DVBTARGET(OptionName,OptionIEN)=""
;
N DVBCNT,DVBIEN,DVBFOUND,DVBQUIT
; ZEXCEPT: IOF,IOM,DVBTARGET
;
S DVBQUIT=0 ; Default to a successful search and build
;
Q:DVBEDIT'=3 ;Quit if not deleting Options out of order from DVBAUDOAD
Q:"^DVBAUDOAD^"'[("^"_DVBRTN_"^") ; Quit if not appropriate DVBRTN
;
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 Options meeting the criteria
;
W @IOF
W !?2,"Searching for OPTION SCHEDULING file audits which match your criteria"
W !
S DVBIEN=0
F S DVBIEN=$O(^DIC(19.2,DVBIEN)) Q:'DVBIEN!DVBQUIT D ;
. S DVBCNT("OPT")=DVBCNT("OPT")+1
. D DOTS^DVBAUDPRT2(DVBCNT("OPT"),25) ; Displays a '.' every 50 records
. Q:'$D(^DIC(19.2,DVBIEN,0)) ; No zero node found for the DVBIEN
. ;
. ; Retreive OPTION SCHEDULING file #19.2 and OPTION file #19 data
. 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:DVBOPT("ENTRYACTION")'["D AUDIT^DVBAUDOA"
. Q:'DVBOPTSCH("TASKID")
. ;
. ; IF scheduled every 'X' number of seconds, do not allow auditing
. I "S"=$E(DVBOPTSCH("FREQ"),$L(DVBOPTSCH("FREQ"))) Q
. ;
. ; IF hourly and less than 24H quit, do not allow auditing
. I "H"=$E(DVBOPTSCH("FREQ"),$L(DVBOPTSCH("FREQ"))),DVBOPTSCH("FREQ")<24 Q
. ;
. 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
Q:DVBQUIT
;
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 regularly scheduled options were found for your selected criteria"
. D CENTER^DVBAUDPRT1(DVBMSG,2,IOM,1)
. S DVBMSG="with an ENTRY ACTION containing 'D AUDIT^DVBAUDOA'."
. D CENTER^DVBAUDPRT1(DVBMSG,1,IOM,1)
;
Q ; Quit BUILDOS
;
OPTBUILD(DVBRTN,DVBEDIT,DVBOPTYPE,DVBNAMSPC) ; Build DVBTARGET(array) of option
;
N DVBCNT,DVBOPTNAME,DVBFOUND,DVBOPT
; ZEXCEPT: DVBACTION,IOM,DVBTARGET
;
Q:DVBEDIT'=2 ;Quit, if not editing by prefix w/wildcard (*)/namespace
; Quit if not appropriate DVBRTN
Q:"^DVBAUDOA^DVBAUDOAD^DVBAUDU3^"'[("^"_DVBRTN_"^")
;
; DVBFOUND, set to 1 once one Option is found matching DVBNAMSPC
S DVBFOUND=0
;
W !
I DVBRTN="DVBAUDOA" D ;
. W !,"Searching for Options to audit which match your criteria..."
I DVBRTN="DVBAUDOAD" D ;
. W !,"Searching for audited Options which match your criteria..."
;
; DVBEDIT=2 Options for a selected NAMESPACE (used with wildcard '*')
;
K DVBTARGET ; Refresh output array
S DVBCNT=0 ; Number of target options for editing ENTRY DVBACTION.
S DVBOPT=$P(DVBNAMSPC,"*",1) ; PREFIX selected in SELWILD1^DVBAUDU1
S DVBOPTNAME=$E(DVBOPT,1,$L(DVBOPT)-1)_$C($A($E(DVBOPT,$L(DVBOPT)))-1)
F S DVBOPTNAME=$O(^DIC(19,"B",DVBOPTNAME)) Q:DVBOPTNAME=""!($E(DVBOPTNAME,1,$L(DVBOPT))]"DVBA") D
. N DVBIEN19
. ; Needed for AMIE to avoid R1 options
. Q:$E(DVBOPTNAME,1,$L(DVBOPT))'=DVBOPT
. ; Option file #19 internal entry number
. S DVBIEN19=$O(^DIC(19,"B",DVBOPTNAME,0))
. S DVBFOUND=1 ; Indicates that an Option was found for the selected DVBNAMSPC
. Q:'$$OPTIONOK(DVBRTN,DVBOPTYPE,DVBIEN19)
. ;
. ; Add the Option to the list of DVBTARGET array of output options
. S DVBTARGET(DVBOPTNAME,DVBIEN19)=$$GET1^DIQ(19,DVBIEN19,4) ; TYPE field #4
. S DVBCNT=DVBCNT+1
;
I DVBCNT>1 D ; Display number of DVBTARGET options found
. N DVBMSG
. ; ZEXCEPT: IOM
. S DVBMSG="I found "_DVBCNT_" candidate Options matching your criteria"
. S DVBMSG=DVBMSG_$S(DVBRTN="DVBAUDU3":".",1:"")
. Q:DVBRTN="DVBAUDU3"
. D CENTER^DVBAUDPRT1(DVBMSG,2,IOM,1)
. S DVBMSG="and I will now present these one at a time"
. S DVBMSG=DVBMSG_" for your approval!"
. D CENTER^DVBAUDPRT1(DVBMSG,1,IOM,1)
;
I $O(DVBTARGET(""))="",DVBRTN="DVBAUDOA" D ;
. N DVBMSG
. S DVBMSG="No active Option(s) were found for the namespace of '"
. S DVBMSG=DVBMSG_DVBNAMSPC_"'"
. D CENTER^DVBAUDPRT1(DVBMSG,2,IOM,1)
. S DVBMSG="that match your selection criteria"
. D CENTER^DVBAUDPRT1(DVBMSG,1,IOM,1)
. S DVBMSG="that are not already audited."
. D CENTER^DVBAUDPRT1(DVBMSG,1,IOM,1)
. D CONTINUE^DVBAUDPRT1(2,"R")
;
I $O(DVBTARGET(""))="",DVBRTN="DVBAUDOAD" D Q ; If no target opts found
. N DVBMSG
. S DVBMSG="No active Option(s) were found for the namespace of "
. S DVBMSG=DVBMSG_"'"_$S($D(DVBNAMSPC):DVBNAMSPC,1:DVBNAMESPC)_"'"
. D CENTER^DVBAUDPRT1(DVBMSG,2,IOM,1)
. S DVBMSG="for your selected criteria"
. D CENTER^DVBAUDPRT1(DVBMSG,1,IOM,1)
. S DVBMSG="with an ENTRY ACTION containing 'D AUDIT^DVBAUDOA'."
. D CENTER^DVBAUDPRT1(DVBMSG,1,IOM,1)
;
Q ; Quit OPTBUILD
;
OPTIONOK(DVBRTN,DVBOPTYPE,DVBIEN19) ; Extrinsic function to screen OPTION
;
N DIERR,DVBOPT,DVBQUIT,DVBRETURN
; ZEXCEPT: DVBACTION ; ACTION = 'BUILD' or 'DELETE'
; ZEXCEPT: DVBEDIT ; Value of 1 thru 4, depends on calling routine
;
S DVBRETURN=0 ; Default to bypass the Option
Q:'DVBIEN19 DVBRETURN ; Option DVBIEN not defined
;
S DVBQUIT=0 D OPTION^DVBAUDDIQ(DVBIEN19) Q:DVBQUIT DVBRETURN
Q:DVBOPT("TYPEI")="" DVBRETURN
; Option not target TYPE selected by user
Q:DVBOPTYPE'[DVBOPT("TYPEI") DVBRETURN
;
I $G(DVBACTION)'="DELETE","^DVBAUDOA^DVBAUDU3^"[("^"_DVBRTN_"^") D Q DVBRETURN ;
. Q:DVBOPT("OOOMSG")]"" ;.................. Option OUT OF ORDER MESSAGE exists
. Q:DVBOPT("ENTRYACTION")["AUDIT^R2IVVOA" ; ENTRY ACTION already shows an audit
. S DVBRETURN=1 ; All screens pass for editing this DVBIEN19
;
I DVBRTN="DVBAUDOAD"!($G(DVBACTION)="DELETE") D Q DVBRETURN
. ; DVBIEN19 not audited, nothing to delete
. Q:DVBOPT("ENTRYACTION")'["AUDIT^DVBAUDOA"
. I DVBEDIT=4 Q:DVBOPT("OOOMSG")="" ; Looking only for inactive Options
. S DVBRETURN=1 ; All screens for deleting D AUDIT^DVBAUDOA pass 4 this DVBIEN19
;
Q DVBRETURN ; Quit $$OPTIONOK extrinsic
;
STRIPAUD(DVBACTION) ; Extrinsic function
;
N DVBPOS,DVBRETURN
;
I DVBACTION["D AUDIT^DVBAUDOA"!(DVBACTION["D PTIME^DVBAUDOA") D ;
. S:DVBACTION["D AUDIT^DVBAUDOA" DVBPOS=$F(DVBACTION,"D AUDIT^DVBAUDOA")
. S:DVBACTION["D PTIME^DVBAUDOA" DVBPOS=$F(DVBACTION,"D PTIME^DVBAUDOA")
. S DVBRETURN=$E(DVBACTION,1,DVBPOS-17)
. S DVBRETURN=DVBRETURN_$P($E(DVBACTION,DVBPOS,$L(DVBACTION))," ",2,999)
. S DVBRETURN=$$STRIPSPL^DVBAUDSTR1(DVBRETURN) ; Strip leading spaces
;
I DVBACTION'["D AUDIT^DVBAUDOA",DVBACTION'["D PTIME^DVBAUDOA" S DVBRETURN=DVBACTION
;
Q DVBRETURN ; Quit $$STRIPAUD extrinsic
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBAUDU2 7593 printed Sep 17, 2026@20:27:31 Page 2
DVBAUDU2 ;ALB/CP - API Calls Routine #2;02/26/18 13:11 ; 4/12/18 6:06pm
+1 ;;2.7;AMIE;**256**;;Build 19
+2 ; Per VHA Directive 6402 this routine should not be modified
+3 ; GETS^DIQ ; # 2056
+4 ; ^DIC(19, ; IA # 2246
+5 ; ^DIC(19.2, ; IA # 1064
+6 QUIT
+7 ;
BUILDOS(DVBRTN,DVBEDIT,DVBOPTYPE) ; Build DVBTARGET(OptionName,OptionIEN)=""
+1 ;
+2 NEW DVBCNT,DVBIEN,DVBFOUND,DVBQUIT
+3 ; ZEXCEPT: IOF,IOM,DVBTARGET
+4 ;
+5 ; Default to a successful search and build
SET DVBQUIT=0
+6 ;
+7 ;Quit if not deleting Options out of order from DVBAUDOAD
if DVBEDIT'=3
QUIT
+8 ; Quit if not appropriate DVBRTN
if "^DVBAUDOAD^"'[("^"_DVBRTN_"^")
QUIT
+9 ;
+10 ; Num. of OPTION SCHEDULING file entries processed.
SET DVBCNT("OPT")=0
+11 ; Num. of OPTION SCHEDULING entry candidates presented for auditing.
+12 SET DVBCNT("PRE")=0
+13 ; DVBFOUND, set to 1 once one Option is found matching the criteria
+14 SET DVBFOUND=0
+15 ;
+16 ; Refresh output array of Options meeting the criteria
KILL DVBTARGET
+17 ;
+18 WRITE @IOF
+19 WRITE !?2,"Searching for OPTION SCHEDULING file audits which match your criteria"
+20 WRITE !
+21 SET DVBIEN=0
+22 ;
FOR
SET DVBIEN=$ORDER(^DIC(19.2,DVBIEN))
if 'DVBIEN!DVBQUIT
QUIT
Begin DoDot:1
+23 SET DVBCNT("OPT")=DVBCNT("OPT")+1
+24 ; Displays a '.' every 50 records
DO DOTS^DVBAUDPRT2(DVBCNT("OPT"),25)
+25 ; No zero node found for the DVBIEN
if '$DATA(^DIC(19.2,DVBIEN,0))
QUIT
+26 ;
+27 ; Retreive OPTION SCHEDULING file #19.2 and OPTION file #19 data
+28 NEW DVBOPT,DVBOPTSCH
+29 ;
+30 ; Retrieve DVBOPTSCH(array) of data fields from file 19.2
+31 DO OPTSCH^DVBAUDDIQ(DVBIEN)
if DVBQUIT
QUIT
+32 ; Retrieve DVBOPT(array) of data fields from file 19
+33 DO OPTION^DVBAUDDIQ(DVBOPTSCH("DVBIEN19"))
if DVBQUIT
QUIT
+34 ;
+35 if DVBOPT("ENTRYACTION")'["D AUDIT^DVBAUDOA"
QUIT
+36 if 'DVBOPTSCH("TASKID")
QUIT
+37 ;
+38 ; IF scheduled every 'X' number of seconds, do not allow auditing
+39 IF "S"=$EXTRACT(DVBOPTSCH("FREQ"),$LENGTH(DVBOPTSCH("FREQ")))
QUIT
+40 ;
+41 ; IF hourly and less than 24H quit, do not allow auditing
+42 IF "H"=$EXTRACT(DVBOPTSCH("FREQ"),$LENGTH(DVBOPTSCH("FREQ")))
IF DVBOPTSCH("FREQ")<24
QUIT
+43 ;
+44 SET DVBFOUND=1
+45 ; Add to (or accumulate) DVBTARGET array of output options
+46 SET DVBTARGET(DVBOPTSCH("OPTNAME"),DVBOPTSCH("DVBIEN19"))=DVBOPT("TYPE")
+47 ; Count Options presented for auditing
SET DVBCNT("PRE")=DVBCNT("PRE")+1
End DoDot:1
+48 if DVBQUIT
QUIT
+49 ;
+50 ; Display number of DVBTARGET options found
IF DVBCNT("PRE")>1
Begin DoDot:1
+51 NEW DVBMSG
+52 ; ZEXCEPT: IOM
+53 SET DVBMSG="I found "_DVBCNT("PRE")_" candidate Options matching your criteria and"
+54 DO CENTER^DVBAUDPRT1(DVBMSG,2,IOM,1)
+55 SET DVBMSG="I will now present these one at a time for your approval!"
+56 DO CENTER^DVBAUDPRT1(DVBMSG,1,IOM,1)
End DoDot:1
+57 ;
+58 ;
IF $ORDER(DVBTARGET(""))=""
IF DVBRTN'="DVBAUDU1"
Begin DoDot:1
+59 NEW DVBMSG
+60 SET DVBMSG="No regularly scheduled options were found for your selected criteria"
+61 DO CENTER^DVBAUDPRT1(DVBMSG,2,IOM,1)
+62 SET DVBMSG="with an ENTRY ACTION containing 'D AUDIT^DVBAUDOA'."
+63 DO CENTER^DVBAUDPRT1(DVBMSG,1,IOM,1)
End DoDot:1
QUIT
+64 ;
+65 ; Quit BUILDOS
QUIT
+66 ;
OPTBUILD(DVBRTN,DVBEDIT,DVBOPTYPE,DVBNAMSPC) ; Build DVBTARGET(array) of option
+1 ;
+2 NEW DVBCNT,DVBOPTNAME,DVBFOUND,DVBOPT
+3 ; ZEXCEPT: DVBACTION,IOM,DVBTARGET
+4 ;
+5 ;Quit, if not editing by prefix w/wildcard (*)/namespace
if DVBEDIT'=2
QUIT
+6 ; Quit if not appropriate DVBRTN
+7 if "^DVBAUDOA^DVBAUDOAD^DVBAUDU3^"'[("^"_DVBRTN_"^")
QUIT
+8 ;
+9 ; DVBFOUND, set to 1 once one Option is found matching DVBNAMSPC
+10 SET DVBFOUND=0
+11 ;
+12 WRITE !
+13 ;
IF DVBRTN="DVBAUDOA"
Begin DoDot:1
+14 WRITE !,"Searching for Options to audit which match your criteria..."
End DoDot:1
+15 ;
IF DVBRTN="DVBAUDOAD"
Begin DoDot:1
+16 WRITE !,"Searching for audited Options which match your criteria..."
End DoDot:1
+17 ;
+18 ; DVBEDIT=2 Options for a selected NAMESPACE (used with wildcard '*')
+19 ;
+20 ; Refresh output array
KILL DVBTARGET
+21 ; Number of target options for editing ENTRY DVBACTION.
SET DVBCNT=0
+22 ; PREFIX selected in SELWILD1^DVBAUDU1
SET DVBOPT=$PIECE(DVBNAMSPC,"*",1)
+23 SET DVBOPTNAME=$EXTRACT(DVBOPT,1,$LENGTH(DVBOPT)-1)_$CHAR($ASCII($EXTRACT(DVBOPT,$LENGTH(DVBOPT)))-1)
+24 FOR
SET DVBOPTNAME=$ORDER(^DIC(19,"B",DVBOPTNAME))
if DVBOPTNAME=""!($EXTRACT(DVBOPTNAME,1,$LENGTH(DVBOPT))]"DVBA")
QUIT
Begin DoDot:1
+25 NEW DVBIEN19
+26 ; Needed for AMIE to avoid R1 options
+27 if $EXTRACT(DVBOPTNAME,1,$LENGTH(DVBOPT))'=DVBOPT
QUIT
+28 ; Option file #19 internal entry number
+29 SET DVBIEN19=$ORDER(^DIC(19,"B",DVBOPTNAME,0))
+30 ; Indicates that an Option was found for the selected DVBNAMSPC
SET DVBFOUND=1
+31 if '$$OPTIONOK(DVBRTN,DVBOPTYPE,DVBIEN19)
QUIT
+32 ;
+33 ; Add the Option to the list of DVBTARGET array of output options
+34 ; TYPE field #4
SET DVBTARGET(DVBOPTNAME,DVBIEN19)=$$GET1^DIQ(19,DVBIEN19,4)
+35 SET DVBCNT=DVBCNT+1
End DoDot:1
+36 ;
+37 ; Display number of DVBTARGET options found
IF DVBCNT>1
Begin DoDot:1
+38 NEW DVBMSG
+39 ; ZEXCEPT: IOM
+40 SET DVBMSG="I found "_DVBCNT_" candidate Options matching your criteria"
+41 SET DVBMSG=DVBMSG_$SELECT(DVBRTN="DVBAUDU3":".",1:"")
+42 if DVBRTN="DVBAUDU3"
QUIT
+43 DO CENTER^DVBAUDPRT1(DVBMSG,2,IOM,1)
+44 SET DVBMSG="and I will now present these one at a time"
+45 SET DVBMSG=DVBMSG_" for your approval!"
+46 DO CENTER^DVBAUDPRT1(DVBMSG,1,IOM,1)
End DoDot:1
+47 ;
+48 ;
IF $ORDER(DVBTARGET(""))=""
IF DVBRTN="DVBAUDOA"
Begin DoDot:1
+49 NEW DVBMSG
+50 SET DVBMSG="No active Option(s) were found for the namespace of '"
+51 SET DVBMSG=DVBMSG_DVBNAMSPC_"'"
+52 DO CENTER^DVBAUDPRT1(DVBMSG,2,IOM,1)
+53 SET DVBMSG="that match your selection criteria"
+54 DO CENTER^DVBAUDPRT1(DVBMSG,1,IOM,1)
+55 SET DVBMSG="that are not already audited."
+56 DO CENTER^DVBAUDPRT1(DVBMSG,1,IOM,1)
+57 DO CONTINUE^DVBAUDPRT1(2,"R")
End DoDot:1
+58 ;
+59 ; If no target opts found
IF $ORDER(DVBTARGET(""))=""
IF DVBRTN="DVBAUDOAD"
Begin DoDot:1
+60 NEW DVBMSG
+61 SET DVBMSG="No active Option(s) were found for the namespace of "
+62 SET DVBMSG=DVBMSG_"'"_$SELECT($DATA(DVBNAMSPC):DVBNAMSPC,1:DVBNAMESPC)_"'"
+63 DO CENTER^DVBAUDPRT1(DVBMSG,2,IOM,1)
+64 SET DVBMSG="for your selected criteria"
+65 DO CENTER^DVBAUDPRT1(DVBMSG,1,IOM,1)
+66 SET DVBMSG="with an ENTRY ACTION containing 'D AUDIT^DVBAUDOA'."
+67 DO CENTER^DVBAUDPRT1(DVBMSG,1,IOM,1)
End DoDot:1
QUIT
+68 ;
+69 ; Quit OPTBUILD
QUIT
+70 ;
OPTIONOK(DVBRTN,DVBOPTYPE,DVBIEN19) ; Extrinsic function to screen OPTION
+1 ;
+2 NEW DIERR,DVBOPT,DVBQUIT,DVBRETURN
+3 ; ZEXCEPT: DVBACTION ; ACTION = 'BUILD' or 'DELETE'
+4 ; ZEXCEPT: DVBEDIT ; Value of 1 thru 4, depends on calling routine
+5 ;
+6 ; Default to bypass the Option
SET DVBRETURN=0
+7 ; Option DVBIEN not defined
if 'DVBIEN19
QUIT DVBRETURN
+8 ;
+9 SET DVBQUIT=0
DO OPTION^DVBAUDDIQ(DVBIEN19)
if DVBQUIT
QUIT DVBRETURN
+10 if DVBOPT("TYPEI")=""
QUIT DVBRETURN
+11 ; Option not target TYPE selected by user
+12 if DVBOPTYPE'[DVBOPT("TYPEI")
QUIT DVBRETURN
+13 ;
+14 ;
IF $GET(DVBACTION)'="DELETE"
IF "^DVBAUDOA^DVBAUDU3^"[("^"_DVBRTN_"^")
Begin DoDot:1
+15 ;.................. Option OUT OF ORDER MESSAGE exists
if DVBOPT("OOOMSG")]""
QUIT
+16 ; ENTRY ACTION already shows an audit
if DVBOPT("ENTRYACTION")["AUDIT^R2IVVOA"
QUIT
+17 ; All screens pass for editing this DVBIEN19
SET DVBRETURN=1
End DoDot:1
QUIT DVBRETURN
+18 ;
+19 IF DVBRTN="DVBAUDOAD"!($GET(DVBACTION)="DELETE")
Begin DoDot:1
+20 ; DVBIEN19 not audited, nothing to delete
+21 if DVBOPT("ENTRYACTION")'["AUDIT^DVBAUDOA"
QUIT
+22 ; Looking only for inactive Options
IF DVBEDIT=4
if DVBOPT("OOOMSG")=""
QUIT
+23 ; All screens for deleting D AUDIT^DVBAUDOA pass 4 this DVBIEN19
SET DVBRETURN=1
End DoDot:1
QUIT DVBRETURN
+24 ;
+25 ; Quit $$OPTIONOK extrinsic
QUIT DVBRETURN
+26 ;
STRIPAUD(DVBACTION) ; Extrinsic function
+1 ;
+2 NEW DVBPOS,DVBRETURN
+3 ;
+4 ;
IF DVBACTION["D AUDIT^DVBAUDOA"!(DVBACTION["D PTIME^DVBAUDOA")
Begin DoDot:1
+5 if DVBACTION["D AUDIT^DVBAUDOA"
SET DVBPOS=$FIND(DVBACTION,"D AUDIT^DVBAUDOA")
+6 if DVBACTION["D PTIME^DVBAUDOA"
SET DVBPOS=$FIND(DVBACTION,"D PTIME^DVBAUDOA")
+7 SET DVBRETURN=$EXTRACT(DVBACTION,1,DVBPOS-17)
+8 SET DVBRETURN=DVBRETURN_$PIECE($EXTRACT(DVBACTION,DVBPOS,$LENGTH(DVBACTION))," ",2,999)
+9 ; Strip leading spaces
SET DVBRETURN=$$STRIPSPL^DVBAUDSTR1(DVBRETURN)
End DoDot:1
+10 ;
+11 IF DVBACTION'["D AUDIT^DVBAUDOA"
IF DVBACTION'["D PTIME^DVBAUDOA"
SET DVBRETURN=DVBACTION
+12 ;
+13 ; Quit $$STRIPAUD extrinsic
QUIT DVBRETURN
