DVBC256P2 ;ALB/CP - PATCH DVBA*2.7*256 POST-INSTALL ROUTINE2; DEC 18, 2024@16:00 ; 9/24/25 12:00pm
;;2.7;AMIE;**256**;Apr 10, 1995;Build 19
; Per VHA Directive 6402 this routine should not be modified
; Reference to File #18.12 in ICR #7204
; Reference to File #18.02 in ICR #7205
; Reference to File 19.2 ^DIC(19.2) in ICR #4078
; Reference to File 19 in ICR #10075
; Reference to FILE^DICN in ICR #10009
; Reference to XPDUTL in ICR #10141
; Reference to ^DIC in ICR #10006
; Reference to UPDATE^DIE in ICR #2053
; Reference to REGREST^XOBWLIB in ICR #5421
;
Q
;
SCHED ; Schedule the DVBA SUMMARIZE AUDIT RECS-AT option in DVBFILE #19.2
; the OPTION SCHEDULING DVBFILE.
;
N DVBERRMSG,DVBFDA,DVBFILE,DVBIENS
S (DVBERRMSG,DVBFDA,DVBFILE,DVBIENS)=""
; See ICR # 742 & 4497
;
; Quit if the option is already scheduled, is case of multiple runs
Q:$$FIND1^DIC(19.2,"","BO","DVBA SUMMARIZE AUDIT RECS-AT")
;
S DVBIENS="+1,",DVBFILE=19.2
S DVBFDA(DVBFILE,DVBIENS,.01)="DVBA SUMMARIZE AUDIT RECS-AT"
S DVBFDA(DVBFILE,DVBIENS,2)=$$FMADD^XLFDT(DT,1)_".133" ; TODAY+1@1:30AM
S DVBFDA(DVBFILE,DVBIENS,6)="1D"
D UPDATE^DIE("E","DVBFDA","","DVBERRMSG") ; Add an EVENT DVBFILE record
I DVBERRMSG'="" D UPDMSG^DVBC256P("Scheduling AutoReports",DVBERRMSG) Q
;
D UPDMSG^DVBC256P("DVBA SUMMARIZE AUDIT RECS-AT","scheduled to run daily at 1:30 am")
;
Q ; Quit SCHED
;
ADDAUDIT ; CAPRI-28984 CP 8/4/26
N X,DVBACTION,DVBOPTYPES,DVBCNT,DVBMAXLEN,DVBOPTNAME,DVBQUIT,DVBENACTION,DVBEXACTION,DVBDATA
S X="DVBAUDOA" X ^%ZOSF("TEST") Q:'$T
;
; Validate that the following files exist:
Q:'$$FIND1^DIC(1,"","BO","AMIE OPTION AUDIT EVENT")
Q:'$$FIND1^DIC(1,"","BO","AMIE AUDIT SUMMARY BY OPTION")
;
S DVBACTION="CREATE"
S DVBOPTYPES="AEIPRXSC"
;
S DVBCNT("SEL")=0 ; Number of options selected for auditing
S DVBCNT("CRE")=0 ; Number of options where audits were created
S DVBQUIT=0
S DVBMAXLEN=229 ;.. Maximum length of ENTRY ACTION and EXIT ACTION
N DVBI
F DVBI=1:1 S DVBOPTNAME=$P($T(OPTLIST+DVBI),";;",2) Q:(DVBOPTNAME["$EXIT") D
. N DVBIEN19,DVBDATA
. S DVBIEN19=""
. S DVBIEN19=$O(^DIC(19,"B",DVBOPTNAME,DVBIEN19))
. I DVBIEN19="" D UPDMSG^DVBC256P(DVBOPTNAME,"OPTION not found, could not add auditing") Q
. S DVBEXACTION("BEF")=$$GET1^DIQ(19,DVBIEN19,"15","E") ;.OPTION EXIT ACTION
. S DVBENACTION("BEF")=$$GET1^DIQ(19,DVBIEN19,"20","E") ;OPTION ENTRY ACTION
. ; Prevent ENTRY ACTION from exceeding maximum length, display msg
. I $L(DVBENACTION("BEF"))>DVBMAXLEN D UPDMSG^DVBC256P(DVBOPTNAME,"OPTION's Entry Action length over MAX") Q
. ; Prevent EXIT ACTION from exceeding maximum length, display msg.
. I $L(DVBEXACTION("BEF"))>DVBMAXLEN D UPDMSG^DVBC256P(DVBOPTNAME,"OPTION's Exit Action length over MAX") Q
. ;
. I DVBENACTION("BEF")="" S DVBENACTION("AFT")="D AUDIT^DVBAUDOA"
. I DVBENACTION("BEF")'="" S DVBENACTION("AFT")="D AUDIT^DVBAUDOA "_DVBENACTION("BEF")
. I DVBEXACTION("BEF")="" S DVBEXACTION("AFT")="D PTIME^DVBAUDOA"
. I DVBEXACTION("BEF")'="" S DVBEXACTION("AFT")="D PTIME^DVBAUDOA "_DVBEXACTION("BEF")
. S DVBCNT("SEL")=DVBCNT("SEL")+1 ; Number of options selected for audit
. D ENTRYACT^DVBAUDDIE(DVBIEN19,.DVBENACTION,.DVBEXACTION)
. D SUMSTUB^DVBAUDDIE(DVBIEN19) ; Create the SUMMARY record stub
. S DVBCNT("CRE")=DVBCNT("CRE")+1 ; Number of option audits created
;
D UPDMSG^DVBC256P("AMIE Auditing","Number selected for update: "_$G(DVBCNT("SEL"))_" number updated: "_$G(DVBCNT("CRE")))
Q
;
OPTLIST ; CAPRI-28984 CP 8/4/26
;;DVBA 7131 DIVISIONAL TRANSFER
;;DVBA 7132 TASKMAN
;;DVBA AUTO FINALIZE 7131 TASK
;;DVBA C C&P LINK MANAGEMENT
;;DVBA C C&P MASTER MENU
;;DVBA C CHECK 2507 INTEGRITY
;;DVBA C CHECK 2507 INTEGRITY TM
;;DVBA C MANUAL C&P XFER RETURN
;;DVBA C NOT SCHEDULED IN 3 DAYS
;;DVBA C PRINT BLANK C&P WORKSHE
;;DVBA C PRINT FEE COVER SHEET
;;DVBA C PRINT NEW C&P REQ TM
;;DVBA C PROCESS MAIL MESSAGE
;;DVBA C REGIONAL OFF RPT MENU
;;DVBA C REGIONAL OFFICE MENU
;;DVBA C RO AMIS 290
;;DVBA C SCHEDULE EXAMS
;;DVBA C TRANSCRIBE REQUEST DATA
;;DVBA COMPETENCY EDIT
;;DVBA CONTRACTED 2507 EXAM GUI
;;DVBA DGPRE PRE-REGISTER OPTION
;;DVBA GENERATE 21-DAY CERTIF
;;DVBA HRC MENU
;;DVBA HRC MENU ISO
;;DVBA MANUAL NOTIFY
;;DVBA RADIOLOGY VARO
;;DVBA RE-ADMISSION REPORT
;;DVBA RE-GENERATE 21-DAY CERTIF
;;DVBA REG OFF PATIENT INQ
;;DVBA REGIONAL 7132 MENU
;;DVBA REGIONAL OFFICE MENU
;;DVBA REGIONAL PURGING PROGRAM
;;DVBA REGIONAL TASK
;;DVBA RELEASE 21-DAY CERT
;;DVBA REPORT PENSION/A&A
;;DVBA REPRINT NOTICE/DISCHARGE
;;DVBA RO PRINT 21-DAY CERT
;;DVBA RO REPRINT 21-DAY CERT
;;DVBA VARO REMOTE
;;DVBA VR BACKGROUND
;;$EXIT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBC256P2 4780 printed Sep 17, 2026@20:28:47 Page 2
DVBC256P2 ;ALB/CP - PATCH DVBA*2.7*256 POST-INSTALL ROUTINE2; DEC 18, 2024@16:00 ; 9/24/25 12:00pm
+1 ;;2.7;AMIE;**256**;Apr 10, 1995;Build 19
+2 ; Per VHA Directive 6402 this routine should not be modified
+3 ; Reference to File #18.12 in ICR #7204
+4 ; Reference to File #18.02 in ICR #7205
+5 ; Reference to File 19.2 ^DIC(19.2) in ICR #4078
+6 ; Reference to File 19 in ICR #10075
+7 ; Reference to FILE^DICN in ICR #10009
+8 ; Reference to XPDUTL in ICR #10141
+9 ; Reference to ^DIC in ICR #10006
+10 ; Reference to UPDATE^DIE in ICR #2053
+11 ; Reference to REGREST^XOBWLIB in ICR #5421
+12 ;
+13 QUIT
+14 ;
SCHED ; Schedule the DVBA SUMMARIZE AUDIT RECS-AT option in DVBFILE #19.2
+1 ; the OPTION SCHEDULING DVBFILE.
+2 ;
+3 NEW DVBERRMSG,DVBFDA,DVBFILE,DVBIENS
+4 SET (DVBERRMSG,DVBFDA,DVBFILE,DVBIENS)=""
+5 ; See ICR # 742 & 4497
+6 ;
+7 ; Quit if the option is already scheduled, is case of multiple runs
+8 if $$FIND1^DIC(19.2,"","BO","DVBA SUMMARIZE AUDIT RECS-AT")
QUIT
+9 ;
+10 SET DVBIENS="+1,"
SET DVBFILE=19.2
+11 SET DVBFDA(DVBFILE,DVBIENS,.01)="DVBA SUMMARIZE AUDIT RECS-AT"
+12 ; TODAY+1@1:30AM
SET DVBFDA(DVBFILE,DVBIENS,2)=$$FMADD^XLFDT(DT,1)_".133"
+13 SET DVBFDA(DVBFILE,DVBIENS,6)="1D"
+14 ; Add an EVENT DVBFILE record
DO UPDATE^DIE("E","DVBFDA","","DVBERRMSG")
+15 IF DVBERRMSG'=""
DO UPDMSG^DVBC256P("Scheduling AutoReports",DVBERRMSG)
QUIT
+16 ;
+17 DO UPDMSG^DVBC256P("DVBA SUMMARIZE AUDIT RECS-AT","scheduled to run daily at 1:30 am")
+18 ;
+19 ; Quit SCHED
QUIT
+20 ;
ADDAUDIT ; CAPRI-28984 CP 8/4/26
+1 NEW X,DVBACTION,DVBOPTYPES,DVBCNT,DVBMAXLEN,DVBOPTNAME,DVBQUIT,DVBENACTION,DVBEXACTION,DVBDATA
+2 SET X="DVBAUDOA"
XECUTE ^%ZOSF("TEST")
if '$TEST
QUIT
+3 ;
+4 ; Validate that the following files exist:
+5 if '$$FIND1^DIC(1,"","BO","AMIE OPTION AUDIT EVENT")
QUIT
+6 if '$$FIND1^DIC(1,"","BO","AMIE AUDIT SUMMARY BY OPTION")
QUIT
+7 ;
+8 SET DVBACTION="CREATE"
+9 SET DVBOPTYPES="AEIPRXSC"
+10 ;
+11 ; Number of options selected for auditing
SET DVBCNT("SEL")=0
+12 ; Number of options where audits were created
SET DVBCNT("CRE")=0
+13 SET DVBQUIT=0
+14 ;.. Maximum length of ENTRY ACTION and EXIT ACTION
SET DVBMAXLEN=229
+15 NEW DVBI
+16 FOR DVBI=1:1
SET DVBOPTNAME=$PIECE($TEXT(OPTLIST+DVBI),";;",2)
if (DVBOPTNAME["$EXIT")
QUIT
Begin DoDot:1
+17 NEW DVBIEN19,DVBDATA
+18 SET DVBIEN19=""
+19 SET DVBIEN19=$ORDER(^DIC(19,"B",DVBOPTNAME,DVBIEN19))
+20 IF DVBIEN19=""
DO UPDMSG^DVBC256P(DVBOPTNAME,"OPTION not found, could not add auditing")
QUIT
+21 ;.OPTION EXIT ACTION
SET DVBEXACTION("BEF")=$$GET1^DIQ(19,DVBIEN19,"15","E")
+22 ;OPTION ENTRY ACTION
SET DVBENACTION("BEF")=$$GET1^DIQ(19,DVBIEN19,"20","E")
+23 ; Prevent ENTRY ACTION from exceeding maximum length, display msg
+24 IF $LENGTH(DVBENACTION("BEF"))>DVBMAXLEN
DO UPDMSG^DVBC256P(DVBOPTNAME,"OPTION's Entry Action length over MAX")
QUIT
+25 ; Prevent EXIT ACTION from exceeding maximum length, display msg.
+26 IF $LENGTH(DVBEXACTION("BEF"))>DVBMAXLEN
DO UPDMSG^DVBC256P(DVBOPTNAME,"OPTION's Exit Action length over MAX")
QUIT
+27 ;
+28 IF DVBENACTION("BEF")=""
SET DVBENACTION("AFT")="D AUDIT^DVBAUDOA"
+29 IF DVBENACTION("BEF")'=""
SET DVBENACTION("AFT")="D AUDIT^DVBAUDOA "_DVBENACTION("BEF")
+30 IF DVBEXACTION("BEF")=""
SET DVBEXACTION("AFT")="D PTIME^DVBAUDOA"
+31 IF DVBEXACTION("BEF")'=""
SET DVBEXACTION("AFT")="D PTIME^DVBAUDOA "_DVBEXACTION("BEF")
+32 ; Number of options selected for audit
SET DVBCNT("SEL")=DVBCNT("SEL")+1
+33 DO ENTRYACT^DVBAUDDIE(DVBIEN19,.DVBENACTION,.DVBEXACTION)
+34 ; Create the SUMMARY record stub
DO SUMSTUB^DVBAUDDIE(DVBIEN19)
+35 ; Number of option audits created
SET DVBCNT("CRE")=DVBCNT("CRE")+1
End DoDot:1
+36 ;
+37 DO UPDMSG^DVBC256P("AMIE Auditing","Number selected for update: "_$GET(DVBCNT("SEL"))_" number updated: "_$GET(DVBCNT("CRE")))
+38 QUIT
+39 ;
OPTLIST ; CAPRI-28984 CP 8/4/26
+1 ;;DVBA 7131 DIVISIONAL TRANSFER
+2 ;;DVBA 7132 TASKMAN
+3 ;;DVBA AUTO FINALIZE 7131 TASK
+4 ;;DVBA C C&P LINK MANAGEMENT
+5 ;;DVBA C C&P MASTER MENU
+6 ;;DVBA C CHECK 2507 INTEGRITY
+7 ;;DVBA C CHECK 2507 INTEGRITY TM
+8 ;;DVBA C MANUAL C&P XFER RETURN
+9 ;;DVBA C NOT SCHEDULED IN 3 DAYS
+10 ;;DVBA C PRINT BLANK C&P WORKSHE
+11 ;;DVBA C PRINT FEE COVER SHEET
+12 ;;DVBA C PRINT NEW C&P REQ TM
+13 ;;DVBA C PROCESS MAIL MESSAGE
+14 ;;DVBA C REGIONAL OFF RPT MENU
+15 ;;DVBA C REGIONAL OFFICE MENU
+16 ;;DVBA C RO AMIS 290
+17 ;;DVBA C SCHEDULE EXAMS
+18 ;;DVBA C TRANSCRIBE REQUEST DATA
+19 ;;DVBA COMPETENCY EDIT
+20 ;;DVBA CONTRACTED 2507 EXAM GUI
+21 ;;DVBA DGPRE PRE-REGISTER OPTION
+22 ;;DVBA GENERATE 21-DAY CERTIF
+23 ;;DVBA HRC MENU
+24 ;;DVBA HRC MENU ISO
+25 ;;DVBA MANUAL NOTIFY
+26 ;;DVBA RADIOLOGY VARO
+27 ;;DVBA RE-ADMISSION REPORT
+28 ;;DVBA RE-GENERATE 21-DAY CERTIF
+29 ;;DVBA REG OFF PATIENT INQ
+30 ;;DVBA REGIONAL 7132 MENU
+31 ;;DVBA REGIONAL OFFICE MENU
+32 ;;DVBA REGIONAL PURGING PROGRAM
+33 ;;DVBA REGIONAL TASK
+34 ;;DVBA RELEASE 21-DAY CERT
+35 ;;DVBA REPORT PENSION/A&A
+36 ;;DVBA REPRINT NOTICE/DISCHARGE
+37 ;;DVBA RO PRINT 21-DAY CERT
+38 ;;DVBA RO REPRINT 21-DAY CERT
+39 ;;DVBA VARO REMOTE
+40 ;;DVBA VR BACKGROUND
+41 ;;$EXIT
+42 QUIT
