DVBAUDDIE ;ALB/CP - FM DIE API Subroutine Calls ; 4/8/18 12:53pm
;;2.7;AMIE;**256**;;Build 19
; Per VHA Directive 6402 this routine should not be modified
; $$FIND1^DIC ; # 2051
; FILE^DIE ; # 2053
; UPDATE^DIE ; # 2053
; $$GET1^DIQ ; # 2056
; $$FMTE^XLFDT ; #10103
; $$NOW^XLFDT ; #10103
; $$ACTIVE^XUSER ; # 2343
; ENTRY & EXIT ACTION ; # 1282
;
Q
;
AUDEVENT(DVBIEN19,DVBIEN200) ; Create a AMIE OPTION AUDIT DVBEVENT file #396.999 entry.
; 'D AUDIT^DVBAUDOA'
; AUDIT^DVBAUDOA
;
N %DT,DVBDIALLVAL ; Left behind by UPDATE^DIE call during testing
N DIERR,DVBIENS,DVBOPTNAME,DVBERRMSG,DVBFDA,DVBFILE,DVBUSERNAME
; ZEXCEPT: DVBQUIT,ZTSK
;
S DVBQUIT=0 ; Indicates a successful database update
;
S DVBIENS=+$G(DVBIEN19)_",",DVBFILE=19
S DVBOPTNAME=$$GET1^DIQ(DVBFILE,DVBIENS,.01,"E",,"DVBERRMSG")
D DIERR^DVBAUDDILG1(60,5,"DVBERRMSG","AUDEVENT^"_$T(+0)) Q:DVBQUIT
I DVBOPTNAME']"" S DVBQUIT=1 Q
;
S DVBIENS=+$G(DVBIEN200)_",",DVBFILE=200
S DVBUSERNAME=$$GET1^DIQ(DVBFILE,DVBIENS,.01,"E",,"DVBERRMSG")
D DIERR^DVBAUDDILG1(60,5,"DVBERRMSG","AUDEVENT^"_$T(+0)) Q:DVBQUIT
I DVBUSERNAME']"" S DVBQUIT=1 Q
;I $P($$ACTIVE^XUSER(+$G(DVBIEN200)),U,2)'="ACTIVE" S DVBQUIT=1 Q
S DVBFILE=19
I $$GET1^DIQ(DVBFILE,DVBIEN19,20,"E",,"DVBERRMSG")'["D AUDIT^DVBAUDOA" S DVBQUIT=1 Q
D DIERR^DVBAUDDILG1(60,5,"DVBERRMSG","AUDEVENT^"_$T(+0)) Q:DVBQUIT
;
K DVBFDA ; Refresh FM data array (FDA)
;
S DVBIENS="+1,",DVBFILE=396.999
S DVBFDA(DVBFILE,DVBIENS,.01)=$$NOW^XLFDT() ; E-DATE/TIME [RD]
S DVBFDA(DVBFILE,DVBIENS,2)="`"_DVBIEN19 ;...... E-OPTION ACCESSED [RP19']
S DVBFDA(DVBFILE,DVBIENS,3)="`"_DVBIEN200 ;..... E-AUDITED USER [RP200']
I $G(ZTSK) D ; If the audited DVBEVENT was a tasked job
. 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) Q:DVBIENOSF'>0
. D OPTSCH^DVBAUDDIQ(DVBIENOSF) ; Get file #19.2 data, put DVBOPTSCH(array)
. Q:DVBQUIT ; Database server error detected.
. Q:'$$OPTSCHOK^DVBAUDU1($T(+0),.DVBOPTSCH) ; Option must be screened
. S DVBFDA(DVBFILE,DVBIENS,4)="YES" ;........ E-TASKED AUDIT? [S] (1:YES)
. S DVBFDA(DVBFILE,DVBIENS,5)=$JOB ; ........ E-TASKED JOB NUMBER [N]
;
D UPDATE^DIE("E","DVBFDA","","DVBERRMSG") ; Add an DVBEVENT file record
D DIERR^DVBAUDDILG1(60,5,"DVBERRMSG","AUDEVENT^"_$T(+0)) Q:DVBQUIT
;
Q ; Quit AUDEVENT
;
ENTRYACT(DVBIEN19,DVBENACTION,DVBEXACTION) ;
;
N DIERR,DVBERRMSG,DVBFDA,DVBFILE,DVBIENS
N %,DIC ; Variables left behind during testing
N DG,DICR,DIW ; Covers editing of audited fields
; ZEXCEPT: DVBQUIT
;
S DVBQUIT=0 ; Indicates a successful database update
;
S DVBIENS=DVBIEN19_",",DVBFILE=19
S DVBFDA(DVBFILE,DVBIENS,15)=DVBEXACTION("AFT") ; Option EXIT ACTION
S DVBFDA(DVBFILE,DVBIENS,20)=DVBENACTION("AFT") ; Option ENTRY ACTION
;
D FILE^DIE("E","DVBFDA","DVBERRMSG") ; ICR #1282
D DIERR^DVBAUDDILG1(60,5,"DVBERRMSG","ENTRYACT^"_$T(+0)) Q:DVBQUIT
;
Q ; Quit ENTRYACT
;
EVENTEND(DVBIENEVENT) ; Record a tasked job's E-TASK END DATE/TIME #6
; in the appropriate AMIE OPTION AUDIT DVBEVENT entry.
N DIERR,DVBIENS,DVBERRMSG,DVBFDA,DVBFILE
; ZEXCEPT: DVBQUIT
S DVBQUIT=0 ; Indicates a successful database update
S DVBIENS=DVBIENEVENT_",",DVBFILE="396.999"
S DVBFDA(DVBFILE,DVBIENS,6)=$$NOW^XLFDT()
;
D FILE^DIE("","DVBFDA","DVBERRMSG")
D DIERR^DVBAUDDILG1(60,5,"DVBERRMSG","EVENTEND^"_$T(+0)) Q:DVBQUIT
;
Q ; Quit EVENTEND
;
SETPFLAG(DVBIENEVENT) ; Set E-PURGE FLAG? #7 of the
; AMIE OPTION AUDIT DVBEVENT file #396.999 to YES
N DIERR,DVBIENS,DVBERRMSG,DVBFDA,DVBFILE
; ZEXCEPT: DVBQUIT
;
S DVBQUIT=0 ; Indicates a successful database update
;
S DVBIENS=DVBIENEVENT_",",DVBFILE=396.999
S DVBFDA(DVBFILE,DVBIENS,7)=1 ; E-PURGE FLAG? [S] 1:YES
;
; Set the DETAIL record to be purged after summarization
D FILE^DIE("","DVBFDA","DVBERRMSG")
D DIERR^DVBAUDDILG1(60,5,"DVBERRMSG","SETPFLAG^"_$T(+0)) Q:DVBQUIT
;
Q ; Quit SETPFLAG
;
SUMOPT(DVBEVENT,DVBMAXHIST) ;
N DIERR,DVBIENS,DVBERRMSG,DVBFDA,DVBFILE
; ZEXCEPT: DVBQUIT
;
S DVBQUIT=0 ; Indicates a successful database update
D SUMSTUB(DVBEVENT("DVBIEN19")) Q:DVBQUIT ; DVBQUIT=1 if DVBEVENT is invalid
;
; Quit if no SUMMARY rec. "B: x-ref
Q:'$D(^DVB(396.9991,"B",DVBEVENT("DVBIEN19"),DVBEVENT("DVBIEN19")))
; Quit, if no zeroith node in SUMMARY file for DVBIEN19
Q:'$D(^DVB(396.9991,DVBEVENT("DVBIEN19"),0))
;
I DVBEVENT("TASKEDI")=1 Q:'$$TASKDONE(DVBEVENT("DVBIENEVENT"))
;
S DVBIENS=DVBEVENT("DVBIEN19")_",",DVBFILE=396.9991
I $$GET1^DIQ(DVBFILE,DVBIENS,3,"E",,"DVBERRMSG")="" D ;
. S DVBFDA(DVBFILE,DVBIENS,3)=DVBEVENT("DTEVENTI")
. D DIERR^DVBAUDDILG1(60,5,"DVBERRMSG","SUMOPT^"_$T(+0))
Q:DVBQUIT
;
; OP-LATEST AUDIT DATE/TIME
S DVBFDA(DVBFILE,DVBIENS,4)=DVBEVENT("DTEVENTI") ; OP-LATEST AUDIT DATE/TIME
S DVBFDA(DVBFILE,DVBIENS,5)=DVBEVENT("DVBIEN200") ;.. OP-LAST USED BY
;
; Increment the OP-USAGE COUNT field #6 & check for error
S DVBFDA(DVBFILE,DVBIENS,6)=$$GET1^DIQ(DVBFILE,DVBIENS,6,"E",,"DVBERRMSG")+1
D DIERR^DVBAUDDILG1(60,5,"DVBERRMSG","SUMOPT^"_$T(+0)) Q:DVBQUIT
;
I DVBEVENT("TASKED")="YES",DVBEVENT("DTENDEDI") D ;
. S DVBFDA(DVBFILE,DVBIENS,21)=DVBEVENT("DTEVENTI") ; from E-DATE/TIME
. S DVBFDA(DVBFILE,DVBIENS,22)=DVBEVENT("DTENDEDI") ; from E-TASK END DATE/TIME
. S DVBFDA(DVBFILE,DVBIENS,23)=DVBEVENT("DVBIEN200") ;.. from E-AUDITED USER
;
D FILE^DIE("","DVBFDA","DVBERRMSG") ; Edit existing DVBIEN19 record
D DIERR^DVBAUDDILG1(60,5,"DVBERRMSG","SUMOPT^"_$T(+0)) Q:DVBQUIT
;
; Record the tasked DVBEVENT history in the OCCURANCE multiple
D TASKHIST(.DVBEVENT,DVBMAXHIST)
;
Q ; QUIT SUMOPT
;
SUMSTUB(DVBIEN19) ;
;
N %DT,DVBDIALLVAL ; Left behind by UPDATE^DIE call during testing
N DIERR,DVBIENS,DVBOPTNAME,DVBFDA,DVBFILE
; ZEXCEPT: DT,DVBQUIT
;
S DVBQUIT=0 ; Indicates a successful database update
;
S DVBFILE=396.9991
Q:$D(^DVB(DVBFILE,"B",DVBIEN19,DVBIEN19)) ;Record already exists, not needed
;
I $L($G(DT))'=7 S DVBQUIT=1 Q ; System var. DT is not defined or null
S DVBOPTNAME=$$GET1^DIQ(19,DVBIEN19,.01,"E",,"DVBERRMSG")
D DIERR^DVBAUDDILG1(60,5,"DVBERRMSG","SUMSTUB^"_$T(+0)) Q:DVBQUIT
Q:DVBOPTNAME=""
;
S DVBIENS="+"_DVBIEN19_","
S DVBFDA(DVBFILE,DVBIENS,.01)="`"_DVBIEN19 ;..... OP-NAME
S DVBFDA(DVBFILE,DVBIENS,2)=$$FMTE^XLFDT(DT) ; OP-AUDIT BEGIN DATE
S DVBFDA(DVBFILE,DVBIENS,6)=0 ;............... OP-USAGE COUNT (initialize)
S DVBFDA(DVBFILE,DVBIENS,7)=$$GET1^DIQ(200,DUZ,.01) ; OP-AUDIT TURNED-ON BY
;
D UPDATE^DIE("E","DVBFDA","","DVBERRMSG")
;D DIERR^DVBAUDDILG1(60,5,"DVBERRMSG","SUMSTUB^"_$T(+0)) Q:DVBQUIT
;
Q ; Quit SUMSTUB
;
SUMUSER(DVBEVENT) ;
;
S DVBQUIT=0 ; Indicates a successful database update
;
I '$D(^DVB(396.9992,"B",DVBEVENT("DVBIEN200"),DVBEVENT("DVBIEN200"))) D ;
. N %DT,DVBDIALLVAL ; Left behind by UPDATE^DIE call during testing
. N DIERR,DVBIENS,DVBERRMSG,DVBFDA,DVBFILE
. S DVBIENS="+"_DVBEVENT("DVBIEN200")_",",DVBFILE=396.9992
. S DVBFDA(DVBFILE,DVBIENS,.01)="`"_DVBEVENT("DVBIEN200")
. D UPDATE^DIE("E","DVBFDA","","DVBERRMSG")
. D DIERR^DVBAUDDILG1(60,5,"DVBERRMSG","SUMUSER^"_$T(+0)) Q:DVBQUIT
Q:DVBQUIT ; Database server error occured on add to #396.9992
;
N DVBFILE
S DVBFILE=396.9992201
I '$D(^DVB(396.9992,DVBEVENT("DVBIEN200"),"OPTION",DVBEVENT("DVBIEN19"),0)) D Q
. N %DT,DVBDIALLVAL ; Left behind by UPDATE^DIE call during testing
. N DIERR,DVBIENS,DVBERRMSG,DVBFDA
. S DVBIENS="+"_DVBEVENT("DVBIEN19")_","_DVBEVENT("DVBIEN200")_","
. S DVBFDA(DVBFILE,DVBIENS,.01)="`"_DVBEVENT("DVBIEN19") ; OP-NAME
. S DVBFDA(DVBFILE,DVBIENS,2)=DVBEVENT("DTEVENT") ;.. OP-FIRST USED DATE/TIME
. S DVBFDA(DVBFILE,DVBIENS,3)=DVBEVENT("DTEVENT") ;.. OP-LAST USED DATE/TIME
. S DVBFDA(DVBFILE,DVBIENS,4)=1 ; OP-USAGE COUNT (Set to 1)
. ;
. D UPDATE^DIE("E","DVBFDA","","DVBERRMSG")
. D DIERR^DVBAUDDILG1(60,5,"DVBERRMSG","SUMUSER^"_$T(+0)) Q:DVBQUIT
;
N DVBCOUNTER,DIERR,DVBIENS,DVBERRMSG,DVBFDA
;
S DVBIENS=DVBEVENT("DVBIEN19")_","_DVBEVENT("DVBIEN200")_","
;
; Update the OP-FIRST USED DATE/TIME sub-field #2
I $$GET1^DIQ(DVBFILE,DVBIENS,2,"E",,"DVBERRMSG")="" D ;
. S DVBFDA(DVBFILE,DVBIENS,2)=DVBEVENT("DTEVENTI") ; OP-FIRST USED DATE/TIME
D DIERR^DVBAUDDILG1(60,5,"DVBERRMSG","SUMUSER^"_$T(+0)) Q:DVBQUIT
;
S DVBFDA(DVBFILE,DVBIENS,3)=DVBEVENT("DTEVENTI") ;... OP-LAST USED DATE/TIME
S DVBCOUNTER=$$GET1^DIQ(DVBFILE,DVBIENS,4,"E",,"DVBERRMSG") ; OP-USAGE COUNT
D DIERR^DVBAUDDILG1(60,5,"DVBERRMSG","SUMUSER^"_$T(+0)) Q:DVBQUIT
S DVBCOUNTER=DVBCOUNTER+1 ;.................... Increment OP-USAGE COUNT
S DVBFDA(DVBFILE,DVBIENS,4)=DVBCOUNTER ;.... Update the OP-USAGE COUNT
;
D FILE^DIE("","DVBFDA","DVBERRMSG") ; Update OPTION NAME (multiple)
D DIERR^DVBAUDDILG1(60,5,"DVBERRMSG","SUMUSER^"_$T(+0)) Q:DVBQUIT
;
Q ; Quit SUMUSER
;
TASKDONE(DVBIENEVENT) ;
;
I DVBEVENT("TASKEDI")=1,DVBEVENT("DTENDEDI")]"" Q 1
;
Q 0 ; Quit TASKDONE extrinsic
;
TASKHIST(DVBEVENT,DVBMAXHIST) ;
;
N %DT,DVBDIALLVAL ; Left behind by UPDATE^DIE call during testing
N DIERR,DVBIENS,DVBLASTIEN,DVBNEWIEN,DVBNUMRECS
N DVBERRMSG,DVBFDA,DVBFIELD,DVBFILE
; ZEXCEPT: DVBQUIT
;
Q:'DVBEVENT("DTENDEDI") ; Quit if no E-TASK END DATE/TIME defined
;
S DVBFILE=396.9991
S DVBLASTIEN=$P($G(^DVB(DVBFILE,DVBEVENT("DVBIEN19"),"OCCUR",0)),U,3) ; Last IEN
S DVBNEWIEN=DVBLASTIEN+1
;
S DVBNUMRECS=$P($G(^DVB(DVBFILE,DVBEVENT("DVBIEN19"),"OCCUR",0)),U,4)
I DVBNUMRECS=DVBMAXHIST!(DVBNUMRECS>DVBMAXHIST) D ;
. F D Q:DVBNUMRECS=(DVBMAXHIST-1)!(DVBNUMRECS=0)
. . N DVBIEN1ST
. . S DVBIEN1ST=$O(^DVB(DVBFILE,DVBEVENT("DVBIEN19"),"OCCUR",0)) ; 1st OCCURENCE IEN
. . I $D(^DVB(DVBFILE,DVBEVENT("DVBIEN19"),"OCCUR",DVBIEN1ST,0)) D ;
. . . D OCCURENC^DVBAUDDIK(DVBEVENT("DVBIEN19"),DVBIEN1ST) ; Delete 1st occur.
. . S DVBNUMRECS=$P($G(^DVB(DVBFILE,DVBEVENT("DVBIEN19"),"OCCUR",0)),U,4)
;
S DVBIENS="+1,"_DVBEVENT("DVBIEN19")_","
S DVBFILE=396.9991201
S DVBFDA(DVBFILE,DVBIENS,.01)=DVBNEWIEN ; DINUM multp. occurance number
S DVBFDA(DVBFILE,DVBIENS,2)=DVBEVENT("DTEVENT") ;....E-DATE/TIME (started)
S DVBFDA(DVBFILE,DVBIENS,3)=DVBEVENT("DTENDED") ;....E-TASK END DATE/TIME
S DVBFDA(DVBFILE,DVBIENS,4)="`"_DVBEVENT("DVBIEN200") ; E-AUDITED USER
;
D UPDATE^DIE("E","DVBFDA","","DVBERRMSG")
D DIERR^DVBAUDDILG1(60,5,"DVBERRMSG","TASKHIST^"_$T(+0)) Q:DVBQUIT
;
Q ; Quit TASKHIST
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBAUDDIE 10728 printed Sep 17, 2026@20:27:16 Page 2
DVBAUDDIE ;ALB/CP - FM DIE API Subroutine Calls ; 4/8/18 12:53pm
+1 ;;2.7;AMIE;**256**;;Build 19
+2 ; Per VHA Directive 6402 this routine should not be modified
+3 ; $$FIND1^DIC ; # 2051
+4 ; FILE^DIE ; # 2053
+5 ; UPDATE^DIE ; # 2053
+6 ; $$GET1^DIQ ; # 2056
+7 ; $$FMTE^XLFDT ; #10103
+8 ; $$NOW^XLFDT ; #10103
+9 ; $$ACTIVE^XUSER ; # 2343
+10 ; ENTRY & EXIT ACTION ; # 1282
+11 ;
+12 QUIT
+13 ;
AUDEVENT(DVBIEN19,DVBIEN200) ; Create a AMIE OPTION AUDIT DVBEVENT file #396.999 entry.
+1 ; 'D AUDIT^DVBAUDOA'
+2 ; AUDIT^DVBAUDOA
+3 ;
+4 ; Left behind by UPDATE^DIE call during testing
NEW %DT,DVBDIALLVAL
+5 NEW DIERR,DVBIENS,DVBOPTNAME,DVBERRMSG,DVBFDA,DVBFILE,DVBUSERNAME
+6 ; ZEXCEPT: DVBQUIT,ZTSK
+7 ;
+8 ; Indicates a successful database update
SET DVBQUIT=0
+9 ;
+10 SET DVBIENS=+$GET(DVBIEN19)_","
SET DVBFILE=19
+11 SET DVBOPTNAME=$$GET1^DIQ(DVBFILE,DVBIENS,.01,"E",,"DVBERRMSG")
+12 DO DIERR^DVBAUDDILG1(60,5,"DVBERRMSG","AUDEVENT^"_$TEXT(+0))
if DVBQUIT
QUIT
+13 IF DVBOPTNAME']""
SET DVBQUIT=1
QUIT
+14 ;
+15 SET DVBIENS=+$GET(DVBIEN200)_","
SET DVBFILE=200
+16 SET DVBUSERNAME=$$GET1^DIQ(DVBFILE,DVBIENS,.01,"E",,"DVBERRMSG")
+17 DO DIERR^DVBAUDDILG1(60,5,"DVBERRMSG","AUDEVENT^"_$TEXT(+0))
if DVBQUIT
QUIT
+18 IF DVBUSERNAME']""
SET DVBQUIT=1
QUIT
+19 ;I $P($$ACTIVE^XUSER(+$G(DVBIEN200)),U,2)'="ACTIVE" S DVBQUIT=1 Q
+20 SET DVBFILE=19
+21 IF $$GET1^DIQ(DVBFILE,DVBIEN19,20,"E",,"DVBERRMSG")'["D AUDIT^DVBAUDOA"
SET DVBQUIT=1
QUIT
+22 DO DIERR^DVBAUDDILG1(60,5,"DVBERRMSG","AUDEVENT^"_$TEXT(+0))
if DVBQUIT
QUIT
+23 ;
+24 ; Refresh FM data array (FDA)
KILL DVBFDA
+25 ;
+26 SET DVBIENS="+1,"
SET DVBFILE=396.999
+27 ; E-DATE/TIME [RD]
SET DVBFDA(DVBFILE,DVBIENS,.01)=$$NOW^XLFDT()
+28 ;...... E-OPTION ACCESSED [RP19']
SET DVBFDA(DVBFILE,DVBIENS,2)="`"_DVBIEN19
+29 ;..... E-AUDITED USER [RP200']
SET DVBFDA(DVBFILE,DVBIENS,3)="`"_DVBIEN200
+30 ; If the audited DVBEVENT was a tasked job
IF $GET(ZTSK)
Begin DoDot:1
+31 ; DVBIENOSF=IEN of the OPTION SCHEDULING file #19.2
NEW DVBIENOSF
+32 ; Array of Option Scheduling attributes
NEW DVBOPTSCH
+33 SET DVBIENOSF=$$FIND1^DIC(19.2,"","BO",DVBOPTNAME)
if DVBIENOSF'>0
QUIT
+34 ; Get file #19.2 data, put DVBOPTSCH(array)
DO OPTSCH^DVBAUDDIQ(DVBIENOSF)
+35 ; Database server error detected.
if DVBQUIT
QUIT
+36 ; Option must be screened
if '$$OPTSCHOK^DVBAUDU1($TEXT(+0),.DVBOPTSCH)
QUIT
+37 ;........ E-TASKED AUDIT? [S] (1:YES)
SET DVBFDA(DVBFILE,DVBIENS,4)="YES"
+38 ; ........ E-TASKED JOB NUMBER [N]
SET DVBFDA(DVBFILE,DVBIENS,5)=$JOB
End DoDot:1
+39 ;
+40 ; Add an DVBEVENT file record
DO UPDATE^DIE("E","DVBFDA","","DVBERRMSG")
+41 DO DIERR^DVBAUDDILG1(60,5,"DVBERRMSG","AUDEVENT^"_$TEXT(+0))
if DVBQUIT
QUIT
+42 ;
+43 ; Quit AUDEVENT
QUIT
+44 ;
ENTRYACT(DVBIEN19,DVBENACTION,DVBEXACTION) ;
+1 ;
+2 NEW DIERR,DVBERRMSG,DVBFDA,DVBFILE,DVBIENS
+3 ; Variables left behind during testing
NEW %,DIC
+4 ; Covers editing of audited fields
NEW DG,DICR,DIW
+5 ; ZEXCEPT: DVBQUIT
+6 ;
+7 ; Indicates a successful database update
SET DVBQUIT=0
+8 ;
+9 SET DVBIENS=DVBIEN19_","
SET DVBFILE=19
+10 ; Option EXIT ACTION
SET DVBFDA(DVBFILE,DVBIENS,15)=DVBEXACTION("AFT")
+11 ; Option ENTRY ACTION
SET DVBFDA(DVBFILE,DVBIENS,20)=DVBENACTION("AFT")
+12 ;
+13 ; ICR #1282
DO FILE^DIE("E","DVBFDA","DVBERRMSG")
+14 DO DIERR^DVBAUDDILG1(60,5,"DVBERRMSG","ENTRYACT^"_$TEXT(+0))
if DVBQUIT
QUIT
+15 ;
+16 ; Quit ENTRYACT
QUIT
+17 ;
EVENTEND(DVBIENEVENT) ; Record a tasked job's E-TASK END DATE/TIME #6
+1 ; in the appropriate AMIE OPTION AUDIT DVBEVENT entry.
+2 NEW DIERR,DVBIENS,DVBERRMSG,DVBFDA,DVBFILE
+3 ; ZEXCEPT: DVBQUIT
+4 ; Indicates a successful database update
SET DVBQUIT=0
+5 SET DVBIENS=DVBIENEVENT_","
SET DVBFILE="396.999"
+6 SET DVBFDA(DVBFILE,DVBIENS,6)=$$NOW^XLFDT()
+7 ;
+8 DO FILE^DIE("","DVBFDA","DVBERRMSG")
+9 DO DIERR^DVBAUDDILG1(60,5,"DVBERRMSG","EVENTEND^"_$TEXT(+0))
if DVBQUIT
QUIT
+10 ;
+11 ; Quit EVENTEND
QUIT
+12 ;
SETPFLAG(DVBIENEVENT) ; Set E-PURGE FLAG? #7 of the
+1 ; AMIE OPTION AUDIT DVBEVENT file #396.999 to YES
+2 NEW DIERR,DVBIENS,DVBERRMSG,DVBFDA,DVBFILE
+3 ; ZEXCEPT: DVBQUIT
+4 ;
+5 ; Indicates a successful database update
SET DVBQUIT=0
+6 ;
+7 SET DVBIENS=DVBIENEVENT_","
SET DVBFILE=396.999
+8 ; E-PURGE FLAG? [S] 1:YES
SET DVBFDA(DVBFILE,DVBIENS,7)=1
+9 ;
+10 ; Set the DETAIL record to be purged after summarization
+11 DO FILE^DIE("","DVBFDA","DVBERRMSG")
+12 DO DIERR^DVBAUDDILG1(60,5,"DVBERRMSG","SETPFLAG^"_$TEXT(+0))
if DVBQUIT
QUIT
+13 ;
+14 ; Quit SETPFLAG
QUIT
+15 ;
SUMOPT(DVBEVENT,DVBMAXHIST) ;
+1 NEW DIERR,DVBIENS,DVBERRMSG,DVBFDA,DVBFILE
+2 ; ZEXCEPT: DVBQUIT
+3 ;
+4 ; Indicates a successful database update
SET DVBQUIT=0
+5 ; DVBQUIT=1 if DVBEVENT is invalid
DO SUMSTUB(DVBEVENT("DVBIEN19"))
if DVBQUIT
QUIT
+6 ;
+7 ; Quit if no SUMMARY rec. "B: x-ref
+8 if '$DATA(^DVB(396.9991,"B",DVBEVENT("DVBIEN19"),DVBEVENT("DVBIEN19")))
QUIT
+9 ; Quit, if no zeroith node in SUMMARY file for DVBIEN19
+10 if '$DATA(^DVB(396.9991,DVBEVENT("DVBIEN19"),0))
QUIT
+11 ;
+12 IF DVBEVENT("TASKEDI")=1
if '$$TASKDONE(DVBEVENT("DVBIENEVENT"))
QUIT
+13 ;
+14 SET DVBIENS=DVBEVENT("DVBIEN19")_","
SET DVBFILE=396.9991
+15 ;
IF $$GET1^DIQ(DVBFILE,DVBIENS,3,"E",,"DVBERRMSG")=""
Begin DoDot:1
+16 SET DVBFDA(DVBFILE,DVBIENS,3)=DVBEVENT("DTEVENTI")
+17 DO DIERR^DVBAUDDILG1(60,5,"DVBERRMSG","SUMOPT^"_$TEXT(+0))
End DoDot:1
+18 if DVBQUIT
QUIT
+19 ;
+20 ; OP-LATEST AUDIT DATE/TIME
+21 ; OP-LATEST AUDIT DATE/TIME
SET DVBFDA(DVBFILE,DVBIENS,4)=DVBEVENT("DTEVENTI")
+22 ;.. OP-LAST USED BY
SET DVBFDA(DVBFILE,DVBIENS,5)=DVBEVENT("DVBIEN200")
+23 ;
+24 ; Increment the OP-USAGE COUNT field #6 & check for error
+25 SET DVBFDA(DVBFILE,DVBIENS,6)=$$GET1^DIQ(DVBFILE,DVBIENS,6,"E",,"DVBERRMSG")+1
+26 DO DIERR^DVBAUDDILG1(60,5,"DVBERRMSG","SUMOPT^"_$TEXT(+0))
if DVBQUIT
QUIT
+27 ;
+28 ;
IF DVBEVENT("TASKED")="YES"
IF DVBEVENT("DTENDEDI")
Begin DoDot:1
+29 ; from E-DATE/TIME
SET DVBFDA(DVBFILE,DVBIENS,21)=DVBEVENT("DTEVENTI")
+30 ; from E-TASK END DATE/TIME
SET DVBFDA(DVBFILE,DVBIENS,22)=DVBEVENT("DTENDEDI")
+31 ;.. from E-AUDITED USER
SET DVBFDA(DVBFILE,DVBIENS,23)=DVBEVENT("DVBIEN200")
End DoDot:1
+32 ;
+33 ; Edit existing DVBIEN19 record
DO FILE^DIE("","DVBFDA","DVBERRMSG")
+34 DO DIERR^DVBAUDDILG1(60,5,"DVBERRMSG","SUMOPT^"_$TEXT(+0))
if DVBQUIT
QUIT
+35 ;
+36 ; Record the tasked DVBEVENT history in the OCCURANCE multiple
+37 DO TASKHIST(.DVBEVENT,DVBMAXHIST)
+38 ;
+39 ; QUIT SUMOPT
QUIT
+40 ;
SUMSTUB(DVBIEN19) ;
+1 ;
+2 ; Left behind by UPDATE^DIE call during testing
NEW %DT,DVBDIALLVAL
+3 NEW DIERR,DVBIENS,DVBOPTNAME,DVBFDA,DVBFILE
+4 ; ZEXCEPT: DT,DVBQUIT
+5 ;
+6 ; Indicates a successful database update
SET DVBQUIT=0
+7 ;
+8 SET DVBFILE=396.9991
+9 ;Record already exists, not needed
if $DATA(^DVB(DVBFILE,"B",DVBIEN19,DVBIEN19))
QUIT
+10 ;
+11 ; System var. DT is not defined or null
IF $LENGTH($GET(DT))'=7
SET DVBQUIT=1
QUIT
+12 SET DVBOPTNAME=$$GET1^DIQ(19,DVBIEN19,.01,"E",,"DVBERRMSG")
+13 DO DIERR^DVBAUDDILG1(60,5,"DVBERRMSG","SUMSTUB^"_$TEXT(+0))
if DVBQUIT
QUIT
+14 if DVBOPTNAME=""
QUIT
+15 ;
+16 SET DVBIENS="+"_DVBIEN19_","
+17 ;..... OP-NAME
SET DVBFDA(DVBFILE,DVBIENS,.01)="`"_DVBIEN19
+18 ; OP-AUDIT BEGIN DATE
SET DVBFDA(DVBFILE,DVBIENS,2)=$$FMTE^XLFDT(DT)
+19 ;............... OP-USAGE COUNT (initialize)
SET DVBFDA(DVBFILE,DVBIENS,6)=0
+20 ; OP-AUDIT TURNED-ON BY
SET DVBFDA(DVBFILE,DVBIENS,7)=$$GET1^DIQ(200,DUZ,.01)
+21 ;
+22 DO UPDATE^DIE("E","DVBFDA","","DVBERRMSG")
+23 ;D DIERR^DVBAUDDILG1(60,5,"DVBERRMSG","SUMSTUB^"_$T(+0)) Q:DVBQUIT
+24 ;
+25 ; Quit SUMSTUB
QUIT
+26 ;
SUMUSER(DVBEVENT) ;
+1 ;
+2 ; Indicates a successful database update
SET DVBQUIT=0
+3 ;
+4 ;
IF '$DATA(^DVB(396.9992,"B",DVBEVENT("DVBIEN200"),DVBEVENT("DVBIEN200")))
Begin DoDot:1
+5 ; Left behind by UPDATE^DIE call during testing
NEW %DT,DVBDIALLVAL
+6 NEW DIERR,DVBIENS,DVBERRMSG,DVBFDA,DVBFILE
+7 SET DVBIENS="+"_DVBEVENT("DVBIEN200")_","
SET DVBFILE=396.9992
+8 SET DVBFDA(DVBFILE,DVBIENS,.01)="`"_DVBEVENT("DVBIEN200")
+9 DO UPDATE^DIE("E","DVBFDA","","DVBERRMSG")
+10 DO DIERR^DVBAUDDILG1(60,5,"DVBERRMSG","SUMUSER^"_$TEXT(+0))
if DVBQUIT
QUIT
End DoDot:1
+11 ; Database server error occured on add to #396.9992
if DVBQUIT
QUIT
+12 ;
+13 NEW DVBFILE
+14 SET DVBFILE=396.9992201
+15 IF '$DATA(^DVB(396.9992,DVBEVENT("DVBIEN200"),"OPTION",DVBEVENT("DVBIEN19"),0))
Begin DoDot:1
+16 ; Left behind by UPDATE^DIE call during testing
NEW %DT,DVBDIALLVAL
+17 NEW DIERR,DVBIENS,DVBERRMSG,DVBFDA
+18 SET DVBIENS="+"_DVBEVENT("DVBIEN19")_","_DVBEVENT("DVBIEN200")_","
+19 ; OP-NAME
SET DVBFDA(DVBFILE,DVBIENS,.01)="`"_DVBEVENT("DVBIEN19")
+20 ;.. OP-FIRST USED DATE/TIME
SET DVBFDA(DVBFILE,DVBIENS,2)=DVBEVENT("DTEVENT")
+21 ;.. OP-LAST USED DATE/TIME
SET DVBFDA(DVBFILE,DVBIENS,3)=DVBEVENT("DTEVENT")
+22 ; OP-USAGE COUNT (Set to 1)
SET DVBFDA(DVBFILE,DVBIENS,4)=1
+23 ;
+24 DO UPDATE^DIE("E","DVBFDA","","DVBERRMSG")
+25 DO DIERR^DVBAUDDILG1(60,5,"DVBERRMSG","SUMUSER^"_$TEXT(+0))
if DVBQUIT
QUIT
End DoDot:1
QUIT
+26 ;
+27 NEW DVBCOUNTER,DIERR,DVBIENS,DVBERRMSG,DVBFDA
+28 ;
+29 SET DVBIENS=DVBEVENT("DVBIEN19")_","_DVBEVENT("DVBIEN200")_","
+30 ;
+31 ; Update the OP-FIRST USED DATE/TIME sub-field #2
+32 ;
IF $$GET1^DIQ(DVBFILE,DVBIENS,2,"E",,"DVBERRMSG")=""
Begin DoDot:1
+33 ; OP-FIRST USED DATE/TIME
SET DVBFDA(DVBFILE,DVBIENS,2)=DVBEVENT("DTEVENTI")
End DoDot:1
+34 DO DIERR^DVBAUDDILG1(60,5,"DVBERRMSG","SUMUSER^"_$TEXT(+0))
if DVBQUIT
QUIT
+35 ;
+36 ;... OP-LAST USED DATE/TIME
SET DVBFDA(DVBFILE,DVBIENS,3)=DVBEVENT("DTEVENTI")
+37 ; OP-USAGE COUNT
SET DVBCOUNTER=$$GET1^DIQ(DVBFILE,DVBIENS,4,"E",,"DVBERRMSG")
+38 DO DIERR^DVBAUDDILG1(60,5,"DVBERRMSG","SUMUSER^"_$TEXT(+0))
if DVBQUIT
QUIT
+39 ;.................... Increment OP-USAGE COUNT
SET DVBCOUNTER=DVBCOUNTER+1
+40 ;.... Update the OP-USAGE COUNT
SET DVBFDA(DVBFILE,DVBIENS,4)=DVBCOUNTER
+41 ;
+42 ; Update OPTION NAME (multiple)
DO FILE^DIE("","DVBFDA","DVBERRMSG")
+43 DO DIERR^DVBAUDDILG1(60,5,"DVBERRMSG","SUMUSER^"_$TEXT(+0))
if DVBQUIT
QUIT
+44 ;
+45 ; Quit SUMUSER
QUIT
+46 ;
TASKDONE(DVBIENEVENT) ;
+1 ;
+2 IF DVBEVENT("TASKEDI")=1
IF DVBEVENT("DTENDEDI")]""
QUIT 1
+3 ;
+4 ; Quit TASKDONE extrinsic
QUIT 0
+5 ;
TASKHIST(DVBEVENT,DVBMAXHIST) ;
+1 ;
+2 ; Left behind by UPDATE^DIE call during testing
NEW %DT,DVBDIALLVAL
+3 NEW DIERR,DVBIENS,DVBLASTIEN,DVBNEWIEN,DVBNUMRECS
+4 NEW DVBERRMSG,DVBFDA,DVBFIELD,DVBFILE
+5 ; ZEXCEPT: DVBQUIT
+6 ;
+7 ; Quit if no E-TASK END DATE/TIME defined
if 'DVBEVENT("DTENDEDI")
QUIT
+8 ;
+9 SET DVBFILE=396.9991
+10 ; Last IEN
SET DVBLASTIEN=$PIECE($GET(^DVB(DVBFILE,DVBEVENT("DVBIEN19"),"OCCUR",0)),U,3)
+11 SET DVBNEWIEN=DVBLASTIEN+1
+12 ;
+13 SET DVBNUMRECS=$PIECE($GET(^DVB(DVBFILE,DVBEVENT("DVBIEN19"),"OCCUR",0)),U,4)
+14 ;
IF DVBNUMRECS=DVBMAXHIST!(DVBNUMRECS>DVBMAXHIST)
Begin DoDot:1
+15 FOR
Begin DoDot:2
+16 NEW DVBIEN1ST
+17 ; 1st OCCURENCE IEN
SET DVBIEN1ST=$ORDER(^DVB(DVBFILE,DVBEVENT("DVBIEN19"),"OCCUR",0))
+18 ;
IF $DATA(^DVB(DVBFILE,DVBEVENT("DVBIEN19"),"OCCUR",DVBIEN1ST,0))
Begin DoDot:3
+19 ; Delete 1st occur.
DO OCCURENC^DVBAUDDIK(DVBEVENT("DVBIEN19"),DVBIEN1ST)
End DoDot:3
+20 SET DVBNUMRECS=$PIECE($GET(^DVB(DVBFILE,DVBEVENT("DVBIEN19"),"OCCUR",0)),U,4)
End DoDot:2
if DVBNUMRECS=(DVBMAXHIST-1)!(DVBNUMRECS=0)
QUIT
End DoDot:1
+21 ;
+22 SET DVBIENS="+1,"_DVBEVENT("DVBIEN19")_","
+23 SET DVBFILE=396.9991201
+24 ; DINUM multp. occurance number
SET DVBFDA(DVBFILE,DVBIENS,.01)=DVBNEWIEN
+25 ;....E-DATE/TIME (started)
SET DVBFDA(DVBFILE,DVBIENS,2)=DVBEVENT("DTEVENT")
+26 ;....E-TASK END DATE/TIME
SET DVBFDA(DVBFILE,DVBIENS,3)=DVBEVENT("DTENDED")
+27 ; E-AUDITED USER
SET DVBFDA(DVBFILE,DVBIENS,4)="`"_DVBEVENT("DVBIEN200")
+28 ;
+29 DO UPDATE^DIE("E","DVBFDA","","DVBERRMSG")
+30 DO DIERR^DVBAUDDILG1(60,5,"DVBERRMSG","TASKHIST^"_$TEXT(+0))
if DVBQUIT
QUIT
+31 ;
+32 ; Quit TASKHIST
QUIT
