DVBAUDOA ;ALB/CP - Option Audit Routine ; 10/15/18 1:38pm
;;2.7;AMIE;**256**;;Build 19
; Per VHA Directive 6402 this routine should not be modified
; $$FIND1^DIC ; # 2051 Find IEN of OPTION SCHEDULING entry
; YN^DICN ; #10009 Prompt for a YES/NO value
; $$GET1^DIQ ; # 2056 Retrieve a single value
; XQY ; # 167 To determine Option IEN
Q ; You must execute a supported entry point, listed above.
;
AUDIT ;
;
N DIERR,DVBERRMSG,DVBQUIT,DVBSAVDUZ,DVBUSERNAME
; ZEXCEPT: DUZ,DVBQUIT,XQJMP,XQY
;
S DVBQUIT=0 ; Initialize quit flag to successful (No, don't quit)
S DVBSAVDUZ=$G(^DISV(DUZ,"^VA(200,")) ; Save orig. DUZ **1**
;
S DVBUSERNAME=$$GET1^DIQ(200,+$G(DUZ),.01,"E",,"DVBERRMSG")
D DIERR^DVBAUDDILG1(60,5,"DVBERRMSG","AUDIT^"_$T(+0)) Q:DVBQUIT
Q:DVBUSERNAME="" Q:'$G(XQY)
;
D AUDEVENT^DVBAUDDIE(XQY,DUZ) ; AMIE OPTION AUDIT EVENT file
Q:DVBQUIT ; Problem found when adding a DETAIL file record
D SUMSTUB^DVBAUDDIE(+XQY) ; Init. the SUMMARY BY OPTION stub record
Q:DVBQUIT ; Problem found when creating the SUMMARY file record
I DVBSAVDUZ S ^DISV(DUZ,"^VA(200,")=DVBSAVDUZ ; Restore DUZ **1**
;
Q
;
EDITOPT(DVBEDIT,DVBTARGET) ; Present user with DVBTARGET(OPTION,IEN)=OptionType,
;
N DVBCNT,DVBDASHES,DVBMAXLEN,DVBOPTNAME,DVBQUIT,DVBSPACES,DVBSUB
; ZEXCEPT: IOM
;
; Note: 'PRE' = Presented & 'SEL' = Selected
F DVBSUB="PRE","SEL" S DVBCNT(DVBSUB)=0 ; Initialize Option counts
;
S DVBMAXLEN=229 ; Maximum DVBLENGTH of ENTRY ACTION and EXIT ACTION
S $P(DVBDASHES,".",IOM+1)="" ; Line of DVBDASHES ('-')
S $P(DVBSPACES," ",IOM+1)="" ; Line of DVBSPACES (' ')
;
S DVBQUIT=0
S DVBOPTNAME=""
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,DVBLENGTH,DVBMSG,DVBOPT,DVBERRMSG
. . D OPTION^DVBAUDDIQ(DVBIEN19)
. . S DVBENACTION("BEF")=DVBOPT("ENTRYACTION") ; Capture ENTRY ACTION
. . S DVBEXACTION("BEF")=DVBOPT("EXITACTION") ;. Capture EXIT ACTION
. . Q:DVBENACTION("BEF")["AUDIT^DVBAUDOA" ; Prevent adding mult. times
. . ;
. . ; Prevent ENTRY ACTION from exceeding maximum DVBLENGTH, display DVBMSG
. . I $L(DVBENACTION("BEF"))>DVBMAXLEN D Q ;
. . . D EDITWARN(DVBOPTNAME,"ENTRY",.DVBENACTION)
. . ; Prevent EXIT ACTION from exceeding max DVBLENGTH, display DVBMSG.
. . I $L(DVBEXACTION("BEF"))>DVBMAXLEN D Q ;
. . . D EDITWARN(DVBOPTNAME,"EXIT",.DVBEXACTION) Q
. . S DVBENACTION("AFT")="D AUDIT^DVBAUDOA"
. . I DVBENACTION("BEF")'="" D ;
. . . S DVBENACTION("AFT")="D AUDIT^DVBAUDOA "_DVBENACTION("BEF")
. . ;
. . S DVBEXACTION("AFT")=DVBEXACTION("BEF") ; Init the EXIT ACTION **2**
. . ;
. . S DVBCNT("PRE")=DVBCNT("PRE")+1 ; Number of eligible options presented
. . W !!,"------------------------------------------------------"
. . ;
. . S DVBMSG="Editing option "_DVBCNT("PRE")_": "
. . S DVBLENGTH=$L(DVBMSG) ;To be utilized as the 2nd parameter in $JUSTIFY
. . ;
. . W ! ; Display the Option's MENU TEXT
. . W $J(DVBMSG,DVBLENGTH) ; Display: Editing option n
. . W $$GET1^DIQ(19,DVBIEN19,1,"E",,"DVBERRMSG") ; Display the Menu Text
. . D DIERR^DVBAUDDILG1(60,5,"DVBERRMSG","EDITOPT^"_$T(+0)) Q:DVBQUIT
. . ;
. . W ! ; Display the DVBOPT NAME field in brackets under the menu text
. . W $E(DVBSPACES,1,DVBLENGTH) ; Tab over with DVBSPACES, line up the display
. . W "["_DVBOPT("NAME")_"]"
. . ;
. . W ! ; Display the Option DVBTYPE
. . W $E(DVBSPACES,1,DVBLENGTH) ; Tab over with DVBSPACES, line up the display
. . W "DVBTYPE: ",$$GET1^DIQ(19,DVBIEN19,4,"E",,"DVBERRMSG")
. . D DIERR^DVBAUDDILG1(60,5,"DVBERRMSG","EDITOPT^"_$T(+0)) Q:DVBQUIT
. . ;
. . D CENTER^DVBAUDPRT1("Proposed ENTRY ACTION Modification",2,IOM,1)
. . ;
. . W !!,$J("Change from: ",DVBLENGTH),DVBENACTION("BEF")
. . I DVBENACTION("BEF")="" D ;
. . . W "<Empty>" ;Let the user know the current ENTRY ACTION is null
. . ;
. . W !,$J("to: ",DVBLENGTH),DVBENACTION("AFT")
. . N DVBIENOSF ; DVBIENOSF=IEN of the OPTION SCHEDULING file #19.2
. . N DVBOPTSCH ; Array of Option Scheduling attributes
. . S DVBIENOSF=$$FIND1^DIC(19.2,"","BO",DVBOPTNAME)
. . ;
. . ; If the option is in the SCHEDULING OPTION file #19.2
. . ;
. . I DVBIENOSF,DVBEXACTION("BEF")'["D PTIME^DVBAUDOA" D ;
. . . D OPTSCH^DVBAUDDIQ(DVBIENOSF) ; Place #19.2 data in DVBOPTSCH(array)
. . . Q:'$$OPTSCHOK^DVBAUDU1($T(+0),.DVBOPTSCH) ; Option is screened
. . . ;
. . . S DVBMSG="Rescheduling Frequency: "_DVBOPTSCH("FREQ")
. . . I DVBOPTSCH("QTORUNTIME")]"" D ; Display next queued to run time
. . . . S DVBMSG=DVBMSG_" (queued to run "_DVBOPTSCH("QTORUNTIME")_")"
. . . W !,$J(DVBMSG,DVBLENGTH)
. . . ;
. . . S DVBMSG=" Task ID: "_DVBOPTSCH("TASKID")
. . . W !,$J(DVBMSG,DVBLENGTH)
. . . ;
. . . S DVBEXACTION("AFT")="D PTIME^DVBAUDOA" I DVBEXACTION("BEF")'="" D ;
. . . . S DVBEXACTION("AFT")="D PTIME^DVBAUDOA "_DVBEXACTION("BEF")
. . . ;
. . . D CENTER^DVBAUDPRT1("& Proposed EXIT ACTION Modification",2,IOM,1)
. . . ;
. . . S DVBMSG="Change from: "
. . . W !!,$J(DVBMSG,DVBLENGTH),DVBEXACTION("BEF")
. . . W:DVBEXACTION("BEF")="" "<Empty>"
. . . ;
. . . S DVBMSG="to: "
. . . W !,$J(DVBMSG,DVBLENGTH),DVBEXACTION("AFT")
. . . ;
. . S DVBMSG=" OK to edit"
. . W !!,$J(DVBMSG,DVBLENGTH)
. . ;
. . N @($$DICN^DVBAUDNEW1())
. . ; ZEXCEPT: %
. . S %=2 D YN^DICN ; Default to 'NO' response (%=2)
. . I %<1 S DVBQUIT=1 W " <Editing aborted>",! Q ; User entered '^'
. . I %=1 D ; If user entered 'YES'
. . . ; Update ENTRY ACTION
. . . D ENTRYACT^DVBAUDDIE(DVBIEN19,.DVBENACTION,.DVBEXACTION) Q:DVBQUIT
. . . W " [Edit completed]"
. . . S DVBCNT("SEL")=DVBCNT("SEL")+1 ; Number of options selected
. . . D SUMSTUB^DVBAUDDIE(DVBIEN19) ; Create the SUMMARY record stub
. . S DVBQUIT=0
W !
; If more than 1 eligible option was presented, display statistics
I DVBCNT("PRE")>1 D ;
. W !,"Number of options presented for auditing: ",DVBCNT("PRE")
. W !,"Number of options selected for auditing: ",DVBCNT("SEL"),!
;
W !,"Editing process completed."
;
D CONTINUE^DVBAUDPRT1(2,"R")
;
Q ; Quit EDITOPT
;
EDITWARN(DVBOPTNAME,DVBTYPE,DVBACTION) ; Entry action DVBLENGTH will exceed the maximum,
; display a warning message to the user
; ZEXCEPT: DTIME
;
W !,!,"------------------------------------------------------"
W !,">>> Editing the ",DVBTYPE," ACTION for option "_DVBOPTNAME_" will exceed the ma"
W !,">>> DVBLENGTH of 245 characters allowed for an M code string. No action tak",!
;
W:DVBTYPE="ENTRY" !,"Current ENTRY ACTION: ",!,DVBACTION("BEF")
W:DVBTYPE="EXIT" !,"Current EXIT ACTION: ",!,DVBACTION("BEF")
;
D CONTINUE^DVBAUDPRT1(2,"R")
;
Q ; Quit EDITWARN
;
PTIME ; Record the processing time for a OPTION SCHEDULING task by
;
N DVBEVENT,DVBIENEVENT,DVBJOB,DVBQUIT
;
S DVBJOB=$J
S DVBIENEVENT=$O(^DVB(396.999,"AJOB",DVBJOB,0)) Q:'DVBIENEVENT
S DVBQUIT=0 D EVENT^DVBAUDDIQ(DVBIENEVENT) Q:DVBQUIT
Q:DVBEVENT("TASKEDI")'=1 ; E-TASKED AUDIT? is not 1:YES
Q:DVBEVENT("DTENDED")]"" ; E-TASK END DATE/TIME already exists
D EVENTEND^DVBAUDDIE(DVBIENEVENT)
;
Q ; Quit PTIME^DVBAUDOA
;
STUFF ; Stuff programmer hooks into the OPTION file #19 entry
;
N DVBEDIT,DVBNAMSPC,DVBOPTION,DVBOPTYPE,DVBQUIT,DVBTARGET
; ZEXCEPT: DVBACTION,DUZ,IOF,IOM
;
STUFF1 ; Branch back to here from below
;
; Display DVBOPTION and prompt user for which OPTIONs to stuff
;
S DVBQUIT=0
S DVBOPTION="Add Audit Code to Option ENTRY ACTION"
W @IOF,!?1,"*** ",DVBOPTION," ***"
;
;D PGMACCSS^DVBAUDU1($T(+0),.DUZ) G:DVBQUIT STUFFX ; Check DUZ(0) for @
D SELEDIT^DVBAUDDIR($T(+0)) G:DVBQUIT STUFFX ; Get DVBEDIT
D MSGIGNOR^DVBAUDU1($T(+0)) ; Display educa. DVBMSG. on what is ignored
D SELTYPE^DVBAUDDIR($T(+0)) G:DVBQUIT STUFF1 ; Select OPTION TYPEs
;
; Select OPTIONS by OPTION NAME (DVBEDIT=1), build DVBTARGET(array)
D:DVBEDIT=1 OPTSIN^DVBAUDDIC($T(+0),DVBEDIT,DVBOPTYPE)
G:DVBQUIT STUFF1 ; Start over, user may not want to Exit yet
;
; DVBEDIT=2 Enter OPTION prefix with wildcard(*), store in DVBNAMSPC
I DVBEDIT=2 D G:DVBQUIT STUFF1 ; Start over, user may not want to Exit
. D SELWILD^DVBAUDU1(DVBEDIT) Q:DVBQUIT
. ;
. N DVBACTION S DVBACTION="BUILD"
. D OPTBUILD^DVBAUDU2($T(+0),DVBEDIT,DVBOPTYPE,DVBNAMSPC) ;DVBTARGETarray
;
; DVBEDIT=3 Build DVBTARGET(array) from OPTION SCHEDULING file (#19.2)
I DVBEDIT=3 D OPTSCH^DVBAUDU1($T(+0),DVBEDIT,DVBOPTYPE)
G:DVBQUIT STUFF1 ; Start over, user may not want to Exit quite yet
;
D EDITOPT(DVBEDIT,.DVBTARGET)
;
G STUFF1
;
STUFFX ; STUFF eXit
;
Q ; Quit STUFF^DVBAUDOA
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBAUDOA 8920 printed Sep 17, 2026@20:27:24 Page 2
DVBAUDOA ;ALB/CP - Option Audit Routine ; 10/15/18 1:38pm
+1 ;;2.7;AMIE;**256**;;Build 19
+2 ; Per VHA Directive 6402 this routine should not be modified
+3 ; $$FIND1^DIC ; # 2051 Find IEN of OPTION SCHEDULING entry
+4 ; YN^DICN ; #10009 Prompt for a YES/NO value
+5 ; $$GET1^DIQ ; # 2056 Retrieve a single value
+6 ; XQY ; # 167 To determine Option IEN
+7 ; You must execute a supported entry point, listed above.
QUIT
+8 ;
AUDIT ;
+1 ;
+2 NEW DIERR,DVBERRMSG,DVBQUIT,DVBSAVDUZ,DVBUSERNAME
+3 ; ZEXCEPT: DUZ,DVBQUIT,XQJMP,XQY
+4 ;
+5 ; Initialize quit flag to successful (No, don't quit)
SET DVBQUIT=0
+6 ; Save orig. DUZ **1**
SET DVBSAVDUZ=$GET(^DISV(DUZ,"^VA(200,"))
+7 ;
+8 SET DVBUSERNAME=$$GET1^DIQ(200,+$GET(DUZ),.01,"E",,"DVBERRMSG")
+9 DO DIERR^DVBAUDDILG1(60,5,"DVBERRMSG","AUDIT^"_$TEXT(+0))
if DVBQUIT
QUIT
+10 if DVBUSERNAME=""
QUIT
if '$GET(XQY)
QUIT
+11 ;
+12 ; AMIE OPTION AUDIT EVENT file
DO AUDEVENT^DVBAUDDIE(XQY,DUZ)
+13 ; Problem found when adding a DETAIL file record
if DVBQUIT
QUIT
+14 ; Init. the SUMMARY BY OPTION stub record
DO SUMSTUB^DVBAUDDIE(+XQY)
+15 ; Problem found when creating the SUMMARY file record
if DVBQUIT
QUIT
+16 ; Restore DUZ **1**
IF DVBSAVDUZ
SET ^DISV(DUZ,"^VA(200,")=DVBSAVDUZ
+17 ;
+18 QUIT
+19 ;
EDITOPT(DVBEDIT,DVBTARGET) ; Present user with DVBTARGET(OPTION,IEN)=OptionType,
+1 ;
+2 NEW DVBCNT,DVBDASHES,DVBMAXLEN,DVBOPTNAME,DVBQUIT,DVBSPACES,DVBSUB
+3 ; ZEXCEPT: IOM
+4 ;
+5 ; Note: 'PRE' = Presented & 'SEL' = Selected
+6 ; Initialize Option counts
FOR DVBSUB="PRE","SEL"
SET DVBCNT(DVBSUB)=0
+7 ;
+8 ; Maximum DVBLENGTH of ENTRY ACTION and EXIT ACTION
SET DVBMAXLEN=229
+9 ; Line of DVBDASHES ('-')
SET $PIECE(DVBDASHES,".",IOM+1)=""
+10 ; Line of DVBSPACES (' ')
SET $PIECE(DVBSPACES," ",IOM+1)=""
+11 ;
+12 SET DVBQUIT=0
+13 SET DVBOPTNAME=""
+14 ;
FOR
SET DVBOPTNAME=$ORDER(DVBTARGET(DVBOPTNAME))
if (DVBOPTNAME="")!DVBQUIT
QUIT
Begin DoDot:1
+15 NEW DVBIEN19
+16 SET DVBIEN19=0
+17 ;
FOR
SET DVBIEN19=$ORDER(DVBTARGET(DVBOPTNAME,DVBIEN19))
if 'DVBIEN19!DVBQUIT
QUIT
Begin DoDot:2
+18 NEW DIERR,DVBENACTION,DVBEXACTION,DVBLENGTH,DVBMSG,DVBOPT,DVBERRMSG
+19 DO OPTION^DVBAUDDIQ(DVBIEN19)
+20 ; Capture ENTRY ACTION
SET DVBENACTION("BEF")=DVBOPT("ENTRYACTION")
+21 ;. Capture EXIT ACTION
SET DVBEXACTION("BEF")=DVBOPT("EXITACTION")
+22 ; Prevent adding mult. times
if DVBENACTION("BEF")["AUDIT^DVBAUDOA"
QUIT
+23 ;
+24 ; Prevent ENTRY ACTION from exceeding maximum DVBLENGTH, display DVBMSG
+25 ;
IF $LENGTH(DVBENACTION("BEF"))>DVBMAXLEN
Begin DoDot:3
+26 DO EDITWARN(DVBOPTNAME,"ENTRY",.DVBENACTION)
End DoDot:3
QUIT
+27 ; Prevent EXIT ACTION from exceeding max DVBLENGTH, display DVBMSG.
+28 ;
IF $LENGTH(DVBEXACTION("BEF"))>DVBMAXLEN
Begin DoDot:3
+29 DO EDITWARN(DVBOPTNAME,"EXIT",.DVBEXACTION)
QUIT
End DoDot:3
QUIT
+30 SET DVBENACTION("AFT")="D AUDIT^DVBAUDOA"
+31 ;
IF DVBENACTION("BEF")'=""
Begin DoDot:3
+32 SET DVBENACTION("AFT")="D AUDIT^DVBAUDOA "_DVBENACTION("BEF")
End DoDot:3
+33 ;
+34 ; Init the EXIT ACTION **2**
SET DVBEXACTION("AFT")=DVBEXACTION("BEF")
+35 ;
+36 ; Number of eligible options presented
SET DVBCNT("PRE")=DVBCNT("PRE")+1
+37 WRITE !!,"------------------------------------------------------"
+38 ;
+39 SET DVBMSG="Editing option "_DVBCNT("PRE")_": "
+40 ;To be utilized as the 2nd parameter in $JUSTIFY
SET DVBLENGTH=$LENGTH(DVBMSG)
+41 ;
+42 ; Display the Option's MENU TEXT
WRITE !
+43 ; Display: Editing option n
WRITE $JUSTIFY(DVBMSG,DVBLENGTH)
+44 ; Display the Menu Text
WRITE $$GET1^DIQ(19,DVBIEN19,1,"E",,"DVBERRMSG")
+45 DO DIERR^DVBAUDDILG1(60,5,"DVBERRMSG","EDITOPT^"_$TEXT(+0))
if DVBQUIT
QUIT
+46 ;
+47 ; Display the DVBOPT NAME field in brackets under the menu text
WRITE !
+48 ; Tab over with DVBSPACES, line up the display
WRITE $EXTRACT(DVBSPACES,1,DVBLENGTH)
+49 WRITE "["_DVBOPT("NAME")_"]"
+50 ;
+51 ; Display the Option DVBTYPE
WRITE !
+52 ; Tab over with DVBSPACES, line up the display
WRITE $EXTRACT(DVBSPACES,1,DVBLENGTH)
+53 WRITE "DVBTYPE: ",$$GET1^DIQ(19,DVBIEN19,4,"E",,"DVBERRMSG")
+54 DO DIERR^DVBAUDDILG1(60,5,"DVBERRMSG","EDITOPT^"_$TEXT(+0))
if DVBQUIT
QUIT
+55 ;
+56 DO CENTER^DVBAUDPRT1("Proposed ENTRY ACTION Modification",2,IOM,1)
+57 ;
+58 WRITE !!,$JUSTIFY("Change from: ",DVBLENGTH),DVBENACTION("BEF")
+59 ;
IF DVBENACTION("BEF")=""
Begin DoDot:3
+60 ;Let the user know the current ENTRY ACTION is null
WRITE "<Empty>"
End DoDot:3
+61 ;
+62 WRITE !,$JUSTIFY("to: ",DVBLENGTH),DVBENACTION("AFT")
+63 ; DVBIENOSF=IEN of the OPTION SCHEDULING file #19.2
NEW DVBIENOSF
+64 ; Array of Option Scheduling attributes
NEW DVBOPTSCH
+65 SET DVBIENOSF=$$FIND1^DIC(19.2,"","BO",DVBOPTNAME)
+66 ;
+67 ; If the option is in the SCHEDULING OPTION file #19.2
+68 ;
+69 ;
IF DVBIENOSF
IF DVBEXACTION("BEF")'["D PTIME^DVBAUDOA"
Begin DoDot:3
+70 ; Place #19.2 data in DVBOPTSCH(array)
DO OPTSCH^DVBAUDDIQ(DVBIENOSF)
+71 ; Option is screened
if '$$OPTSCHOK^DVBAUDU1($TEXT(+0),.DVBOPTSCH)
QUIT
+72 ;
+73 SET DVBMSG="Rescheduling Frequency: "_DVBOPTSCH("FREQ")
+74 ; Display next queued to run time
IF DVBOPTSCH("QTORUNTIME")]""
Begin DoDot:4
+75 SET DVBMSG=DVBMSG_" (queued to run "_DVBOPTSCH("QTORUNTIME")_")"
End DoDot:4
+76 WRITE !,$JUSTIFY(DVBMSG,DVBLENGTH)
+77 ;
+78 SET DVBMSG=" Task ID: "_DVBOPTSCH("TASKID")
+79 WRITE !,$JUSTIFY(DVBMSG,DVBLENGTH)
+80 ;
+81 ;
SET DVBEXACTION("AFT")="D PTIME^DVBAUDOA"
IF DVBEXACTION("BEF")'=""
Begin DoDot:4
+82 SET DVBEXACTION("AFT")="D PTIME^DVBAUDOA "_DVBEXACTION("BEF")
End DoDot:4
+83 ;
+84 DO CENTER^DVBAUDPRT1("& Proposed EXIT ACTION Modification",2,IOM,1)
+85 ;
+86 SET DVBMSG="Change from: "
+87 WRITE !!,$JUSTIFY(DVBMSG,DVBLENGTH),DVBEXACTION("BEF")
+88 if DVBEXACTION("BEF")=""
WRITE "<Empty>"
+89 ;
+90 SET DVBMSG="to: "
+91 WRITE !,$JUSTIFY(DVBMSG,DVBLENGTH),DVBEXACTION("AFT")
+92 ;
End DoDot:3
+93 SET DVBMSG=" OK to edit"
+94 WRITE !!,$JUSTIFY(DVBMSG,DVBLENGTH)
+95 ;
+96 NEW @($$DICN^DVBAUDNEW1())
+97 ; ZEXCEPT: %
+98 ; Default to 'NO' response (%=2)
SET %=2
DO YN^DICN
+99 ; User entered '^'
IF %<1
SET DVBQUIT=1
WRITE " <Editing aborted>",!
QUIT
+100 ; If user entered 'YES'
IF %=1
Begin DoDot:3
+101 ; Update ENTRY ACTION
+102 DO ENTRYACT^DVBAUDDIE(DVBIEN19,.DVBENACTION,.DVBEXACTION)
if DVBQUIT
QUIT
+103 WRITE " [Edit completed]"
+104 ; Number of options selected
SET DVBCNT("SEL")=DVBCNT("SEL")+1
+105 ; Create the SUMMARY record stub
DO SUMSTUB^DVBAUDDIE(DVBIEN19)
End DoDot:3
+106 SET DVBQUIT=0
End DoDot:2
End DoDot:1
+107 WRITE !
+108 ; If more than 1 eligible option was presented, display statistics
+109 ;
IF DVBCNT("PRE")>1
Begin DoDot:1
+110 WRITE !,"Number of options presented for auditing: ",DVBCNT("PRE")
+111 WRITE !,"Number of options selected for auditing: ",DVBCNT("SEL"),!
End DoDot:1
+112 ;
+113 WRITE !,"Editing process completed."
+114 ;
+115 DO CONTINUE^DVBAUDPRT1(2,"R")
+116 ;
+117 ; Quit EDITOPT
QUIT
+118 ;
EDITWARN(DVBOPTNAME,DVBTYPE,DVBACTION) ; Entry action DVBLENGTH will exceed the maximum,
+1 ; display a warning message to the user
+2 ; ZEXCEPT: DTIME
+3 ;
+4 WRITE !,!,"------------------------------------------------------"
+5 WRITE !,">>> Editing the ",DVBTYPE," ACTION for option "_DVBOPTNAME_" will exceed the ma"
+6 WRITE !,">>> DVBLENGTH of 245 characters allowed for an M code string. No action tak",!
+7 ;
+8 if DVBTYPE="ENTRY"
WRITE !,"Current ENTRY ACTION: ",!,DVBACTION("BEF")
+9 if DVBTYPE="EXIT"
WRITE !,"Current EXIT ACTION: ",!,DVBACTION("BEF")
+10 ;
+11 DO CONTINUE^DVBAUDPRT1(2,"R")
+12 ;
+13 ; Quit EDITWARN
QUIT
+14 ;
PTIME ; Record the processing time for a OPTION SCHEDULING task by
+1 ;
+2 NEW DVBEVENT,DVBIENEVENT,DVBJOB,DVBQUIT
+3 ;
+4 SET DVBJOB=$JOB
+5 SET DVBIENEVENT=$ORDER(^DVB(396.999,"AJOB",DVBJOB,0))
if 'DVBIENEVENT
QUIT
+6 SET DVBQUIT=0
DO EVENT^DVBAUDDIQ(DVBIENEVENT)
if DVBQUIT
QUIT
+7 ; E-TASKED AUDIT? is not 1:YES
if DVBEVENT("TASKEDI")'=1
QUIT
+8 ; E-TASK END DATE/TIME already exists
if DVBEVENT("DTENDED")]""
QUIT
+9 DO EVENTEND^DVBAUDDIE(DVBIENEVENT)
+10 ;
+11 ; Quit PTIME^DVBAUDOA
QUIT
+12 ;
STUFF ; Stuff programmer hooks into the OPTION file #19 entry
+1 ;
+2 NEW DVBEDIT,DVBNAMSPC,DVBOPTION,DVBOPTYPE,DVBQUIT,DVBTARGET
+3 ; ZEXCEPT: DVBACTION,DUZ,IOF,IOM
+4 ;
STUFF1 ; Branch back to here from below
+1 ;
+2 ; Display DVBOPTION and prompt user for which OPTIONs to stuff
+3 ;
+4 SET DVBQUIT=0
+5 SET DVBOPTION="Add Audit Code to Option ENTRY ACTION"
+6 WRITE @IOF,!?1,"*** ",DVBOPTION," ***"
+7 ;
+8 ;D PGMACCSS^DVBAUDU1($T(+0),.DUZ) G:DVBQUIT STUFFX ; Check DUZ(0) for @
+9 ; Get DVBEDIT
DO SELEDIT^DVBAUDDIR($TEXT(+0))
if DVBQUIT
GOTO STUFFX
+10 ; Display educa. DVBMSG. on what is ignored
DO MSGIGNOR^DVBAUDU1($TEXT(+0))
+11 ; Select OPTION TYPEs
DO SELTYPE^DVBAUDDIR($TEXT(+0))
if DVBQUIT
GOTO STUFF1
+12 ;
+13 ; Select OPTIONS by OPTION NAME (DVBEDIT=1), build DVBTARGET(array)
+14 if DVBEDIT=1
DO OPTSIN^DVBAUDDIC($TEXT(+0),DVBEDIT,DVBOPTYPE)
+15 ; Start over, user may not want to Exit yet
if DVBQUIT
GOTO STUFF1
+16 ;
+17 ; DVBEDIT=2 Enter OPTION prefix with wildcard(*), store in DVBNAMSPC
+18 ; Start over, user may not want to Exit
IF DVBEDIT=2
Begin DoDot:1
+19 DO SELWILD^DVBAUDU1(DVBEDIT)
if DVBQUIT
QUIT
+20 ;
+21 NEW DVBACTION
SET DVBACTION="BUILD"
+22 ;DVBTARGETarray
DO OPTBUILD^DVBAUDU2($TEXT(+0),DVBEDIT,DVBOPTYPE,DVBNAMSPC)
End DoDot:1
if DVBQUIT
GOTO STUFF1
+23 ;
+24 ; DVBEDIT=3 Build DVBTARGET(array) from OPTION SCHEDULING file (#19.2)
+25 IF DVBEDIT=3
DO OPTSCH^DVBAUDU1($TEXT(+0),DVBEDIT,DVBOPTYPE)
+26 ; Start over, user may not want to Exit quite yet
if DVBQUIT
GOTO STUFF1
+27 ;
+28 DO EDITOPT(DVBEDIT,.DVBTARGET)
+29 ;
+30 GOTO STUFF1
+31 ;
STUFFX ; STUFF eXit
+1 ;
+2 ; Quit STUFF^DVBAUDOA
QUIT
