DVBAUDU3S ;ALB/CP - Support calls for API routine DVBAUDU3 ; 10/15/18 1:43pm
;;2.7;AMIE;**256**;;Build 19
; Per VHA Directive 6402 this routine should not be modified
; $$FIND1^DIC ; IA # 2051
; $$GET1^DIQ ; IA # 2056
Q
;
BUILD(DVBENTRYPT,DVBTARGET,DVBOPTYPES) ; Loop thru DVBTARGET, and
;
N DVBCNT,DVBIENOSF,DVBMAXLEN,DVBOPTNAME,DVBFLAG1,DVBQUIT
; ZEXCEPT: DVBFLAGMP,DVBXPDNM
;
S DVBOPTYPES=$G(DVBOPTYPES,"AEIPRXSC")
;
S DVBCNT("SEL")=0 ; Number of DVBTARGET options selected for auditing.
S DVBQUIT=0 ;.... Quit/terminate flag, initialized to off (0)
S DVBMAXLEN=229 ;.. Maximum DVBLENGTH of ENTRY ACTION and EXIT ACTION
S DVBFLAG1=1 ; 1st time flag
;
S DVBOPTNAME=0
F S DVBOPTNAME=$O(DVBTARGET(DVBOPTNAME)) Q:(DVBOPTNAME="")!DVBQUIT D ;
. N DVBIEN19
. S DVBIEN19=0 ; DVBIEN19 is the IEN of the OPTION file #19
. F S DVBIEN19=$O(DVBTARGET(DVBOPTNAME,DVBIEN19)) Q:'DVBIEN19 D ;
. . N DIERR,DVBENACTION,DVBEXACTION,DVBOPT,DVBERRMSG
. . ; Quit if Option NAME no longer exists
. . Q:$$GET1^DIQ(19,DVBIEN19,.01)=""
. . ;
. . ; Return DVBOPT(array) of Option file fields
. . ;
. . D OPTION^DVBAUDDIQ(DVBIEN19) Q:DVBQUIT
. . Q:DVBOPT("ENTRYACTION")["D AUDIT^DVBAUDOA" ; Only allowed one time
. . ;
. . Q:DVBOPTYPES'[DVBOPT("TYPEI") ; Bypass non applicable DVBOPT. types
. . ;
. . S DVBENACTION("BEF")=DVBOPT("ENTRYACTION") ; ENTRY ACTION before
. . I $L(DVBENACTION("BEF"))>DVBMAXLEN Q
. . S DVBEXACTION("BEF")=DVBOPT("EXITACTION") ; EXIT ACTION before
. . I $L(DVBEXACTION("BEF"))>DVBMAXLEN Q
. . ;
. . S DVBENACTION("AFT")="D AUDIT^DVBAUDOA"
. . I DVBENACTION("BEF")'="" D ;
. . . S DVBENACTION("AFT")="D AUDIT^DVBAUDOA "_DVBENACTION("BEF")
. . ;
. . D EXITACT ; Format EXIT ACTION in DVBEXACTION("AFT")
. . ;
. . I DVBFLAG1=1 D MESSAGE(DVBENTRYPT)
. . ;
. . ; Update ENTRY ACTION of the OPTION DVBIEN19 entry
. . ;
. . D ENTRYACT^DVBAUDDIE(DVBIEN19,.DVBENACTION,.DVBEXACTION) Q:DVBQUIT
. . S DVBCNT("SEL")=DVBCNT("SEL")+1 ; Number of options selected for audit
. . W !?2,$J(DVBCNT("SEL"),3),". ",?6,DVBOPTNAME
. . W ?38,$$GET1^DIQ(19,DVBIEN19,4,"E",,"DVBERRMSG"),?55,"[Option Audit Added]"
. . D DIERR^DVBAUDDILG1(60,5,"DVBERRMSG","BUILD^"_$T(+0)) Q:DVBQUIT
. . D SUMSTUB^DVBAUDDIE(DVBIEN19) ; Create the SUMMARY record stub
. . Q:DVBQUIT
;
W !
;
; If more than 1 eligible option was presented, display statistics
I DVBCNT("SEL")>0 D ;
. W !,"Number of options selected for auditing: ",DVBCNT("SEL")
. W !
. ;
. W !,"Editing process complete for KIDS Build ",DVBXPDNM,"."
. D:$G(DVBFLAGMP) CONTINUE^DVBAUDPRT1(2,"R") ; Only if a mult-package
;
I DVBCNT("SEL")=0 D ; Display number of DVBTARGET options found
. N DVBMSG
. ; ZEXCEPT: IOM
. S DVBMSG="I could not find any active Options for the KIDS Build"
. D CENTER^DVBAUDPRT1(DVBMSG,2,IOM,1)
. D CENTER^DVBAUDPRT1(DVBXPDNM,1,IOM,1)
. S DVBMSG="that are not already audited."
. D CENTER^DVBAUDPRT1(DVBMSG,1,IOM,1)
;
Q ; Quit BUILD^DVBAUDU3S
;
DELETE(DVBENTRYPT,DVBTARGET,DVBOPTYPES) ; Cleanup Option ENTRY & EXIT actions
;
N DVBCNT,DVBDASHES,DVBENACTION,DVBLENGTH,DVBMSG
N DVBOPTNAME,DVBFLAG1,DVBQUIT,DVBRESPONSE,DVBSPACES,DVBSUB
; ZEXCEPT: DVBIEN19,IOM,DVBEDIT,DVBNAMSPC,DVBTARGET,DVBXPDNM
;
S DVBCNT("DEL")=0
S $P(DVBDASHES,".",IOM+1)="" ; Line of DVBDASHES ('-')
S $P(DVBSPACES," ",IOM+1)="" ; Line of DVBSPACES (' ')
S DVBFLAG1=1
;
S (DVBOPTNAME,DVBQUIT)=0
F S DVBOPTNAME=$O(DVBTARGET(DVBOPTNAME)) Q:(DVBOPTNAME="")!DVBQUIT D ;
. N DVBIEN19
. S DVBIEN19=0
. F S DVBIEN19=$O(DVBTARGET(DVBOPTNAME,DVBIEN19)) Q:'DVBIEN19!DVBQUIT D ;
. . N DIERR,DVBENACTION,DVBEXACTION,DVBMSG,DVBOPT,DVBERRMSG
. . ;
. . D OPTION^DVBAUDDIQ(DVBIEN19) Q:DVBQUIT
. . ;
. . Q:DVBOPT("ENTRYACTION")'["D AUDIT^DVBAUDOA" ; No audit to delete
. . Q:DVBOPTYPES'[DVBOPT("TYPEI") ; Bypass non-applicable option types
. . ;
. . S DVBENACTION("BEF")=DVBOPT("ENTRYACTION") ; Capture ENTRY ACTION
. . S DVBENACTION("AFT")=$$STRIPAUD^DVBAUDU2(DVBENACTION("BEF"))
. . S DVBEXACTION("BEF")=DVBOPT("EXITACTION") ;. Capture EXIT ACTION
. . ;
. . ; If first time, display informational message to the user
. . ;
. . I DVBFLAG1=1,DVBENTRYPT="AUDITBLD" D MESSAGE("DELBLD")
. . I DVBFLAG1=1,DVBENTRYPT="AUDITSPC" D MESSAGE("DELSPC")
. . ;
. . ; **2** Begin 10/15/2018
. . S DVBEXACTION("AFT")=DVBEXACTION("BEF") ; Initialized to prevent error
. . ; **2** End 10/15/2018
. . I DVBEXACTION("BEF")]"",DVBEXACTION("BEF")["D PTIME^DVBAUDOA" D ;
. . . S DVBEXACTION("AFT")=$$STRIPAUD^DVBAUDU2(DVBEXACTION("BEF"))
. . ;
. . I DVBENACTION("BEF")=DVBENACTION("AFT") D Q ;
. . . W !
. . . D REVVIDEO^DVBAUDPRT1("ON")
. . . W !,"Note: The ENTRY ACTION is not compatible with this Delete AMIE Audit "
. . . W !," utility, but is displayed in case you want to make note of th"
. . . W !," for cleaning it up manually later."
. . . D REVVIDEO^DVBAUDPRT1("OFF")
. . . D CONTINUE^DVBAUDPRT1(2,"R")
. . ;
. . N DVBIENEVENT,DVBASK,DVBEDITOK
. . S DVBASK="Y" ; Stuff, do not prompt
. . S DVBCNT("DEL")=DVBCNT("DEL")+1
. . D ENTRYACT^DVBAUDDIE(DVBIEN19,.DVBENACTION,.DVBEXACTION) Q:DVBQUIT
. . ;
. . ; Delete the OPTION DVBSUB-file entry from #396.9992 (User summaary)
. . D USEROPT^DVBAUDDIK(DVBIEN19)
. . ;
. . ; Delete the SUMMARY record from #396.9991
. . D OPTSUM^DVBAUDDIK(DVBIEN19)
. . ;
. . ; Delete any related events from file #396.999
. . S DVBIENEVENT=0
. . F S DVBIENEVENT=$O(^DVB(396.999,"OPTION",DVBIEN19,DVBIENEVENT)) Q:'DVBIENEVENT D ;
. . . D DELEVENT^DVBAUDDIK(DVBIENEVENT)
. . W !?2,$J(DVBCNT("DEL"),2),". ",?6,DVBOPTNAME
. . W ?38,$$GET1^DIQ(19,DVBIEN19,4,"E",,"DVBERRMSG"),?55,"[Option Audit Removed]"
;
W ! ; If any Options had their audits removed, display the statistics
;
I DVBCNT("DEL")>0 D ;
. W !,"Number of options where the AMIE audits were deleted: "
. W DVBCNT("DEL")
. W !
. W !,"Editing process completed."
. ;
. D CONTINUE^DVBAUDPRT1(2,"R")
;
I DVBCNT("DEL")=0,DVBENTRYPT="AUDITBLD" D ;
. N DVBMSG
. ; ZEXCEPT: DVBXPDNM
. S DVBMSG="No Options were found for KIDS Build "_DVBXPDNM
. D CENTER^DVBAUDPRT1(DVBMSG,1,IOM,1)
. S DVBMSG="that have 'D AUDIT^DVBAUDOA' in the ENTRY ACTION of the"
. S DVBMSG=DVBMSG_" Option."
. D CENTER^DVBAUDPRT1(DVBMSG,1,IOM,1)
. D CONTINUE^DVBAUDPRT1(2,"R")
;
Q ; Quit DELETE^DVBAUDU3S
;
EXITACT ; Format the EXIT ACTION field #15 for the OPTION
;
N DVBIENOSF
;
; **2** Begin 10/15/2018
S DVBEXACTION("AFT")=DVBEXACTION("BEF") ;Initialize EXIT ACTION to existing
; **2** End 10/15/2018
;
; Retrieve the IEN of the OPTION SCHEDULING file #19.2
S DVBIENOSF=$$FIND1^DIC(19.2,"","BO",DVBOPT("NAME"))
;
; If the option is in the SCHEDULING OPTION file #19.2
;
I DVBIENOSF,DVBEXACTION("BEF")'["D PTIME^DVBAUDOA" D ;
. N DVBOPTSCH ; Array of Option Scheduling attributes
. D OPTSCH^DVBAUDDIQ(DVBIENOSF) ; Place #19.2 data in DVBOPTSCH(array)
. Q:'$$OPTSCHOK^DVBAUDU1($T(+0),.DVBOPTSCH) ; Option is screened
. ;
. S DVBEXACTION("AFT")="D PTIME^DVBAUDOA" I DVBEXACTION("BEF")'="" D ;
. . S DVBEXACTION("AFT")="D PTIME^DVBAUDOA "_DVBEXACTION("BEF")
;
Q ; Quit EXITACT^DVBAUDU3S
;
MESSAGE(DVBENTRYPT) ; Display informational message to user loading the
;
; Quit if we encounter an invalid input parameter value
I "^AUDITBLD^AUDITSPC^DELBLD^DELSPC^"'[("^"_DVBENTRYPT_"^") Q
;
S DVBFLAG1=0 ; Reset flag to zero, only displays messages the 1st time.
;
I DVBENTRYPT="AUDITBLD" D Q
. ;
. N DVBFOUND
. S DVBFOUND=$G(DVBFOUND,0)
. I $O(DVBTARGET(""))="" D Q ; If no target options were found
. . N DVBMSG
. . S DVBMSG="No active Option(s) were found for '"_DVBNAMSPC_"' for your selected"
. . I DVBFOUND=0 S DVBMSG=DVBMSG_"." ; No options were found, add a period
. . D CENTER^DVBAUDPRT1(DVBMSG,2,IOM,1)
. . I DVBFOUND D ;
. . . I DVBACTION="CREATE" S DVBMSG="that are not already audited."
. . . I DVBACTION="DELETE" D ;
. . . . S DVBMSG="with an ENTRY ACTION containing 'D AUDIT^DVBAUDOA'."
. . . D CENTER^DVBAUDPRT1(DVBMSG,1,IOM,1)
. ;
. I $O(DVBTARGET(""))]"" D Q ; If target options were found
. . W !
. . W !?1,"Modification of eligible OPTION(s) associated with KIDS Build "
. . D CENTER^DVBAUDPRT1(DVBXPDNM,1,IOM,0)
. . W !?1,"will now take place. The ENTRY ACTION code for each of the Options"
. . W !?1,"will be prefixed with 'D AUDIT^DVBAUDOA' to automatically initiate t"
. . W !?1,"Option Audit feature. In addition, an AMIE AUDIT SUMMARY BY OPTION"
. . W !?1,"record will be created to allow accurate reports to be produced by "
. . W !
. . W !?1,"The following option's ENTRY ACTION code have been modified as prev"
. . W !?1,"described: "
. . W !
;
I DVBENTRYPT="AUDITSPC" D Q ; Building or deleting audits by namespace
. ;
. I $O(DVBTARGET(""))="" D Q ; If no target options were 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)
. . I DVBACTION="CREATE" S DVBMSG="that are not already audited."
. . I DVBACTION="DELETE" D ;
. . . S DVBMSG="with an ENTRY ACTION containing 'D AUDIT^DVBAUDOA'."
. . D CENTER^DVBAUDPRT1(DVBMSG,1,IOM,1)
. ;
. I $O(DVBTARGET(""))]"" D Q ; If target options were found
. . W !
. . W !?1,"Modification of eligible OPTION(s) for the namespace of '",DVBNAMESPC
. . W !?1,"will now take place. The ENTRY ACTION code for each of the Options"
. . W !?1,"Option Audit feature. In addition, an AMIE AUDIT SUMMARY BY OPTIO"
. . W !?1,"record will be created to allow accurate reports to be produced by "
. . W !
. . W !?1,"The following option's ENTRY ACTION code have been modified as prev"
. . W !?1,"described: "
. . W !
;
I DVBENTRYPT="DELBLD" D Q ;
. W !
. W !?1,"Modification of eligible OPTION(s) associated with KIDS Build "
. D CENTER^DVBAUDPRT1(DVBXPDNM,1,IOM,0)
. W !?1,"will now take place. The 'D AUDIT^DVBAUDOA' code for each of the Opti"
. W !?1,"will be removed from the ENTRY ACTION to delete the audit feature fro"
. W !?1,"Option."
. W !
. W !?1,"The following option's ENTRY ACTION code have been modified as previo"
. W !?1,"described: "
. W !
;
I DVBENTRYPT="DELSPC" D Q ;
. W !
. W !?1,"Modification of eligible OPTION(s) for the namespace of '",DVBNAMESPC,"'"
. W !?1,"will now take place. The 'D AUDIT^DVBAUDOA' code for each of the Opti"
. W !?1,"will be removed from the ENTRY ACTION to delete the audit feature fro"
. W !?1,"Option."
. W !
. W !?1,"The following option's ENTRY ACTION code have been modified as previo"
. W !?1,"described: "
. W !
;
Q ; Quit MESSAGE^DVBAUDU3S
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBAUDU3S 11036 printed Sep 17, 2026@20:27:32 Page 2
DVBAUDU3S ;ALB/CP - Support calls for API routine DVBAUDU3 ; 10/15/18 1:43pm
+1 ;;2.7;AMIE;**256**;;Build 19
+2 ; Per VHA Directive 6402 this routine should not be modified
+3 ; $$FIND1^DIC ; IA # 2051
+4 ; $$GET1^DIQ ; IA # 2056
+5 QUIT
+6 ;
BUILD(DVBENTRYPT,DVBTARGET,DVBOPTYPES) ; Loop thru DVBTARGET, and
+1 ;
+2 NEW DVBCNT,DVBIENOSF,DVBMAXLEN,DVBOPTNAME,DVBFLAG1,DVBQUIT
+3 ; ZEXCEPT: DVBFLAGMP,DVBXPDNM
+4 ;
+5 SET DVBOPTYPES=$GET(DVBOPTYPES,"AEIPRXSC")
+6 ;
+7 ; Number of DVBTARGET options selected for auditing.
SET DVBCNT("SEL")=0
+8 ;.... Quit/terminate flag, initialized to off (0)
SET DVBQUIT=0
+9 ;.. Maximum DVBLENGTH of ENTRY ACTION and EXIT ACTION
SET DVBMAXLEN=229
+10 ; 1st time flag
SET DVBFLAG1=1
+11 ;
+12 SET DVBOPTNAME=0
+13 ;
FOR
SET DVBOPTNAME=$ORDER(DVBTARGET(DVBOPTNAME))
if (DVBOPTNAME="")!DVBQUIT
QUIT
Begin DoDot:1
+14 NEW DVBIEN19
+15 ; DVBIEN19 is the IEN of the OPTION file #19
SET DVBIEN19=0
+16 ;
FOR
SET DVBIEN19=$ORDER(DVBTARGET(DVBOPTNAME,DVBIEN19))
if 'DVBIEN19
QUIT
Begin DoDot:2
+17 NEW DIERR,DVBENACTION,DVBEXACTION,DVBOPT,DVBERRMSG
+18 ; Quit if Option NAME no longer exists
+19 if $$GET1^DIQ(19,DVBIEN19,.01)=""
QUIT
+20 ;
+21 ; Return DVBOPT(array) of Option file fields
+22 ;
+23 DO OPTION^DVBAUDDIQ(DVBIEN19)
if DVBQUIT
QUIT
+24 ; Only allowed one time
if DVBOPT("ENTRYACTION")["D AUDIT^DVBAUDOA"
QUIT
+25 ;
+26 ; Bypass non applicable DVBOPT. types
if DVBOPTYPES'[DVBOPT("TYPEI")
QUIT
+27 ;
+28 ; ENTRY ACTION before
SET DVBENACTION("BEF")=DVBOPT("ENTRYACTION")
+29 IF $LENGTH(DVBENACTION("BEF"))>DVBMAXLEN
QUIT
+30 ; EXIT ACTION before
SET DVBEXACTION("BEF")=DVBOPT("EXITACTION")
+31 IF $LENGTH(DVBEXACTION("BEF"))>DVBMAXLEN
QUIT
+32 ;
+33 SET DVBENACTION("AFT")="D AUDIT^DVBAUDOA"
+34 ;
IF DVBENACTION("BEF")'=""
Begin DoDot:3
+35 SET DVBENACTION("AFT")="D AUDIT^DVBAUDOA "_DVBENACTION("BEF")
End DoDot:3
+36 ;
+37 ; Format EXIT ACTION in DVBEXACTION("AFT")
DO EXITACT
+38 ;
+39 IF DVBFLAG1=1
DO MESSAGE(DVBENTRYPT)
+40 ;
+41 ; Update ENTRY ACTION of the OPTION DVBIEN19 entry
+42 ;
+43 DO ENTRYACT^DVBAUDDIE(DVBIEN19,.DVBENACTION,.DVBEXACTION)
if DVBQUIT
QUIT
+44 ; Number of options selected for audit
SET DVBCNT("SEL")=DVBCNT("SEL")+1
+45 WRITE !?2,$JUSTIFY(DVBCNT("SEL"),3),". ",?6,DVBOPTNAME
+46 WRITE ?38,$$GET1^DIQ(19,DVBIEN19,4,"E",,"DVBERRMSG"),?55,"[Option Audit Added]"
+47 DO DIERR^DVBAUDDILG1(60,5,"DVBERRMSG","BUILD^"_$TEXT(+0))
if DVBQUIT
QUIT
+48 ; Create the SUMMARY record stub
DO SUMSTUB^DVBAUDDIE(DVBIEN19)
+49 if DVBQUIT
QUIT
End DoDot:2
End DoDot:1
+50 ;
+51 WRITE !
+52 ;
+53 ; If more than 1 eligible option was presented, display statistics
+54 ;
IF DVBCNT("SEL")>0
Begin DoDot:1
+55 WRITE !,"Number of options selected for auditing: ",DVBCNT("SEL")
+56 WRITE !
+57 ;
+58 WRITE !,"Editing process complete for KIDS Build ",DVBXPDNM,"."
+59 ; Only if a mult-package
if $GET(DVBFLAGMP)
DO CONTINUE^DVBAUDPRT1(2,"R")
End DoDot:1
+60 ;
+61 ; Display number of DVBTARGET options found
IF DVBCNT("SEL")=0
Begin DoDot:1
+62 NEW DVBMSG
+63 ; ZEXCEPT: IOM
+64 SET DVBMSG="I could not find any active Options for the KIDS Build"
+65 DO CENTER^DVBAUDPRT1(DVBMSG,2,IOM,1)
+66 DO CENTER^DVBAUDPRT1(DVBXPDNM,1,IOM,1)
+67 SET DVBMSG="that are not already audited."
+68 DO CENTER^DVBAUDPRT1(DVBMSG,1,IOM,1)
End DoDot:1
+69 ;
+70 ; Quit BUILD^DVBAUDU3S
QUIT
+71 ;
DELETE(DVBENTRYPT,DVBTARGET,DVBOPTYPES) ; Cleanup Option ENTRY & EXIT actions
+1 ;
+2 NEW DVBCNT,DVBDASHES,DVBENACTION,DVBLENGTH,DVBMSG
+3 NEW DVBOPTNAME,DVBFLAG1,DVBQUIT,DVBRESPONSE,DVBSPACES,DVBSUB
+4 ; ZEXCEPT: DVBIEN19,IOM,DVBEDIT,DVBNAMSPC,DVBTARGET,DVBXPDNM
+5 ;
+6 SET DVBCNT("DEL")=0
+7 ; Line of DVBDASHES ('-')
SET $PIECE(DVBDASHES,".",IOM+1)=""
+8 ; Line of DVBSPACES (' ')
SET $PIECE(DVBSPACES," ",IOM+1)=""
+9 SET DVBFLAG1=1
+10 ;
+11 SET (DVBOPTNAME,DVBQUIT)=0
+12 ;
FOR
SET DVBOPTNAME=$ORDER(DVBTARGET(DVBOPTNAME))
if (DVBOPTNAME="")!DVBQUIT
QUIT
Begin DoDot:1
+13 NEW DVBIEN19
+14 SET DVBIEN19=0
+15 ;
FOR
SET DVBIEN19=$ORDER(DVBTARGET(DVBOPTNAME,DVBIEN19))
if 'DVBIEN19!DVBQUIT
QUIT
Begin DoDot:2
+16 NEW DIERR,DVBENACTION,DVBEXACTION,DVBMSG,DVBOPT,DVBERRMSG
+17 ;
+18 DO OPTION^DVBAUDDIQ(DVBIEN19)
if DVBQUIT
QUIT
+19 ;
+20 ; No audit to delete
if DVBOPT("ENTRYACTION")'["D AUDIT^DVBAUDOA"
QUIT
+21 ; Bypass non-applicable option types
if DVBOPTYPES'[DVBOPT("TYPEI")
QUIT
+22 ;
+23 ; Capture ENTRY ACTION
SET DVBENACTION("BEF")=DVBOPT("ENTRYACTION")
+24 SET DVBENACTION("AFT")=$$STRIPAUD^DVBAUDU2(DVBENACTION("BEF"))
+25 ;. Capture EXIT ACTION
SET DVBEXACTION("BEF")=DVBOPT("EXITACTION")
+26 ;
+27 ; If first time, display informational message to the user
+28 ;
+29 IF DVBFLAG1=1
IF DVBENTRYPT="AUDITBLD"
DO MESSAGE("DELBLD")
+30 IF DVBFLAG1=1
IF DVBENTRYPT="AUDITSPC"
DO MESSAGE("DELSPC")
+31 ;
+32 ; **2** Begin 10/15/2018
+33 ; Initialized to prevent error
SET DVBEXACTION("AFT")=DVBEXACTION("BEF")
+34 ; **2** End 10/15/2018
+35 ;
IF DVBEXACTION("BEF")]""
IF DVBEXACTION("BEF")["D PTIME^DVBAUDOA"
Begin DoDot:3
+36 SET DVBEXACTION("AFT")=$$STRIPAUD^DVBAUDU2(DVBEXACTION("BEF"))
End DoDot:3
+37 ;
+38 ;
IF DVBENACTION("BEF")=DVBENACTION("AFT")
Begin DoDot:3
+39 WRITE !
+40 DO REVVIDEO^DVBAUDPRT1("ON")
+41 WRITE !,"Note: The ENTRY ACTION is not compatible with this Delete AMIE Audit "
+42 WRITE !," utility, but is displayed in case you want to make note of th"
+43 WRITE !," for cleaning it up manually later."
+44 DO REVVIDEO^DVBAUDPRT1("OFF")
+45 DO CONTINUE^DVBAUDPRT1(2,"R")
End DoDot:3
QUIT
+46 ;
+47 NEW DVBIENEVENT,DVBASK,DVBEDITOK
+48 ; Stuff, do not prompt
SET DVBASK="Y"
+49 SET DVBCNT("DEL")=DVBCNT("DEL")+1
+50 DO ENTRYACT^DVBAUDDIE(DVBIEN19,.DVBENACTION,.DVBEXACTION)
if DVBQUIT
QUIT
+51 ;
+52 ; Delete the OPTION DVBSUB-file entry from #396.9992 (User summaary)
+53 DO USEROPT^DVBAUDDIK(DVBIEN19)
+54 ;
+55 ; Delete the SUMMARY record from #396.9991
+56 DO OPTSUM^DVBAUDDIK(DVBIEN19)
+57 ;
+58 ; Delete any related events from file #396.999
+59 SET DVBIENEVENT=0
+60 ;
FOR
SET DVBIENEVENT=$ORDER(^DVB(396.999,"OPTION",DVBIEN19,DVBIENEVENT))
if 'DVBIENEVENT
QUIT
Begin DoDot:3
+61 DO DELEVENT^DVBAUDDIK(DVBIENEVENT)
End DoDot:3
+62 WRITE !?2,$JUSTIFY(DVBCNT("DEL"),2),". ",?6,DVBOPTNAME
+63 WRITE ?38,$$GET1^DIQ(19,DVBIEN19,4,"E",,"DVBERRMSG"),?55,"[Option Audit Removed]"
End DoDot:2
End DoDot:1
+64 ;
+65 ; If any Options had their audits removed, display the statistics
WRITE !
+66 ;
+67 ;
IF DVBCNT("DEL")>0
Begin DoDot:1
+68 WRITE !,"Number of options where the AMIE audits were deleted: "
+69 WRITE DVBCNT("DEL")
+70 WRITE !
+71 WRITE !,"Editing process completed."
+72 ;
+73 DO CONTINUE^DVBAUDPRT1(2,"R")
End DoDot:1
+74 ;
+75 ;
IF DVBCNT("DEL")=0
IF DVBENTRYPT="AUDITBLD"
Begin DoDot:1
+76 NEW DVBMSG
+77 ; ZEXCEPT: DVBXPDNM
+78 SET DVBMSG="No Options were found for KIDS Build "_DVBXPDNM
+79 DO CENTER^DVBAUDPRT1(DVBMSG,1,IOM,1)
+80 SET DVBMSG="that have 'D AUDIT^DVBAUDOA' in the ENTRY ACTION of the"
+81 SET DVBMSG=DVBMSG_" Option."
+82 DO CENTER^DVBAUDPRT1(DVBMSG,1,IOM,1)
+83 DO CONTINUE^DVBAUDPRT1(2,"R")
End DoDot:1
+84 ;
+85 ; Quit DELETE^DVBAUDU3S
QUIT
+86 ;
EXITACT ; Format the EXIT ACTION field #15 for the OPTION
+1 ;
+2 NEW DVBIENOSF
+3 ;
+4 ; **2** Begin 10/15/2018
+5 ;Initialize EXIT ACTION to existing
SET DVBEXACTION("AFT")=DVBEXACTION("BEF")
+6 ; **2** End 10/15/2018
+7 ;
+8 ; Retrieve the IEN of the OPTION SCHEDULING file #19.2
+9 SET DVBIENOSF=$$FIND1^DIC(19.2,"","BO",DVBOPT("NAME"))
+10 ;
+11 ; If the option is in the SCHEDULING OPTION file #19.2
+12 ;
+13 ;
IF DVBIENOSF
IF DVBEXACTION("BEF")'["D PTIME^DVBAUDOA"
Begin DoDot:1
+14 ; Array of Option Scheduling attributes
NEW DVBOPTSCH
+15 ; Place #19.2 data in DVBOPTSCH(array)
DO OPTSCH^DVBAUDDIQ(DVBIENOSF)
+16 ; Option is screened
if '$$OPTSCHOK^DVBAUDU1($TEXT(+0),.DVBOPTSCH)
QUIT
+17 ;
+18 ;
SET DVBEXACTION("AFT")="D PTIME^DVBAUDOA"
IF DVBEXACTION("BEF")'=""
Begin DoDot:2
+19 SET DVBEXACTION("AFT")="D PTIME^DVBAUDOA "_DVBEXACTION("BEF")
End DoDot:2
End DoDot:1
+20 ;
+21 ; Quit EXITACT^DVBAUDU3S
QUIT
+22 ;
MESSAGE(DVBENTRYPT) ; Display informational message to user loading the
+1 ;
+2 ; Quit if we encounter an invalid input parameter value
+3 IF "^AUDITBLD^AUDITSPC^DELBLD^DELSPC^"'[("^"_DVBENTRYPT_"^")
QUIT
+4 ;
+5 ; Reset flag to zero, only displays messages the 1st time.
SET DVBFLAG1=0
+6 ;
+7 IF DVBENTRYPT="AUDITBLD"
Begin DoDot:1
+8 ;
+9 NEW DVBFOUND
+10 SET DVBFOUND=$GET(DVBFOUND,0)
+11 ; If no target options were found
IF $ORDER(DVBTARGET(""))=""
Begin DoDot:2
+12 NEW DVBMSG
+13 SET DVBMSG="No active Option(s) were found for '"_DVBNAMSPC_"' for your selected"
+14 ; No options were found, add a period
IF DVBFOUND=0
SET DVBMSG=DVBMSG_"."
+15 DO CENTER^DVBAUDPRT1(DVBMSG,2,IOM,1)
+16 ;
IF DVBFOUND
Begin DoDot:3
+17 IF DVBACTION="CREATE"
SET DVBMSG="that are not already audited."
+18 ;
IF DVBACTION="DELETE"
Begin DoDot:4
+19 SET DVBMSG="with an ENTRY ACTION containing 'D AUDIT^DVBAUDOA'."
End DoDot:4
+20 DO CENTER^DVBAUDPRT1(DVBMSG,1,IOM,1)
End DoDot:3
End DoDot:2
QUIT
+21 ;
+22 ; If target options were found
IF $ORDER(DVBTARGET(""))]""
Begin DoDot:2
+23 WRITE !
+24 WRITE !?1,"Modification of eligible OPTION(s) associated with KIDS Build "
+25 DO CENTER^DVBAUDPRT1(DVBXPDNM,1,IOM,0)
+26 WRITE !?1,"will now take place. The ENTRY ACTION code for each of the Options"
+27 WRITE !?1,"will be prefixed with 'D AUDIT^DVBAUDOA' to automatically initiate t"
+28 WRITE !?1,"Option Audit feature. In addition, an AMIE AUDIT SUMMARY BY OPTION"
+29 WRITE !?1,"record will be created to allow accurate reports to be produced by "
+30 WRITE !
+31 WRITE !?1,"The following option's ENTRY ACTION code have been modified as prev"
+32 WRITE !?1,"described: "
+33 WRITE !
End DoDot:2
QUIT
End DoDot:1
QUIT
+34 ;
+35 ; Building or deleting audits by namespace
IF DVBENTRYPT="AUDITSPC"
Begin DoDot:1
+36 ;
+37 ; If no target options were found
IF $ORDER(DVBTARGET(""))=""
Begin DoDot:2
+38 NEW DVBMSG
+39 SET DVBMSG="No active Option(s) were found for the namespace of "
+40 SET DVBMSG=DVBMSG_"'"_$SELECT($DATA(DVBNAMSPC):DVBNAMSPC,1:DVBNAMESPC)_"'"
+41 DO CENTER^DVBAUDPRT1(DVBMSG,2,IOM,1)
+42 SET DVBMSG="for your selected criteria"
+43 DO CENTER^DVBAUDPRT1(DVBMSG,1,IOM,1)
+44 IF DVBACTION="CREATE"
SET DVBMSG="that are not already audited."
+45 ;
IF DVBACTION="DELETE"
Begin DoDot:3
+46 SET DVBMSG="with an ENTRY ACTION containing 'D AUDIT^DVBAUDOA'."
End DoDot:3
+47 DO CENTER^DVBAUDPRT1(DVBMSG,1,IOM,1)
End DoDot:2
QUIT
+48 ;
+49 ; If target options were found
IF $ORDER(DVBTARGET(""))]""
Begin DoDot:2
+50 WRITE !
+51 WRITE !?1,"Modification of eligible OPTION(s) for the namespace of '",DVBNAMESPC
+52 WRITE !?1,"will now take place. The ENTRY ACTION code for each of the Options"
+53 WRITE !?1,"Option Audit feature. In addition, an AMIE AUDIT SUMMARY BY OPTIO"
+54 WRITE !?1,"record will be created to allow accurate reports to be produced by "
+55 WRITE !
+56 WRITE !?1,"The following option's ENTRY ACTION code have been modified as prev"
+57 WRITE !?1,"described: "
+58 WRITE !
End DoDot:2
QUIT
End DoDot:1
QUIT
+59 ;
+60 ;
IF DVBENTRYPT="DELBLD"
Begin DoDot:1
+61 WRITE !
+62 WRITE !?1,"Modification of eligible OPTION(s) associated with KIDS Build "
+63 DO CENTER^DVBAUDPRT1(DVBXPDNM,1,IOM,0)
+64 WRITE !?1,"will now take place. The 'D AUDIT^DVBAUDOA' code for each of the Opti"
+65 WRITE !?1,"will be removed from the ENTRY ACTION to delete the audit feature fro"
+66 WRITE !?1,"Option."
+67 WRITE !
+68 WRITE !?1,"The following option's ENTRY ACTION code have been modified as previo"
+69 WRITE !?1,"described: "
+70 WRITE !
End DoDot:1
QUIT
+71 ;
+72 ;
IF DVBENTRYPT="DELSPC"
Begin DoDot:1
+73 WRITE !
+74 WRITE !?1,"Modification of eligible OPTION(s) for the namespace of '",DVBNAMESPC,"'"
+75 WRITE !?1,"will now take place. The 'D AUDIT^DVBAUDOA' code for each of the Opti"
+76 WRITE !?1,"will be removed from the ENTRY ACTION to delete the audit feature fro"
+77 WRITE !?1,"Option."
+78 WRITE !
+79 WRITE !?1,"The following option's ENTRY ACTION code have been modified as previo"
+80 WRITE !?1,"described: "
+81 WRITE !
End DoDot:1
QUIT
+82 ;
+83 ; Quit MESSAGE^DVBAUDU3S
QUIT
