DVBC255P ;ALB/GTR - PATCH DVBA*2.7*255 POST-INSTALL ROUTINE; Dec 16, 2024@16:00 ; 9/22/25 1:02pm
;;2.7;AMIE;**255**;Apr 10,1995;Build 21
;Per VHA Directive 6402 this routine should not be modified
;Reference to SUPPORTED PARAMETER TOOL ENTRY POINTS in ICR #2263
;Reference to File 19 in ICR #10075
;Reference to File 19.2 in ICR #4086
;Reference to ^DIE in ICR #10018
;
Q
;CAPRI-23256 TO ADD PARAMATER SUBTASK FOR RELEASE
VUPDATE ; MINIMUM AND PREVIOUS CAPRI VERSION UPDATES
N DVBVER,DVBIEN,DVBNAME
D MES^XPDUTL("Patch DVBA*2.7*255 post install started")
S DVBVER=$$ENXPAR("PKG","DVBAB CAPRI MINIMUM VERSION","CAPRI GUI V2.7*255.32*1*A*3260327*1.3*1.3")
D UPDMSG("CAPRI MINIMUM VERSION",DVBVER)
S DVBVER=$$ENXPAR("PKG","DVBAB CAPRI PREVIOUS VERSION","DVBA*2.7*254.24")
D UPDMSG("DVBAB CAPRI PREVIOUS VERSION",DVBVER)
S DVBVER=$$ENXPAR("PKG.AUTOMATED MED INFO EXCHANGE","DVBAB CAPRI SUPPORT MESSAGE","1-855-673-4357")
D UPDMSG("DVBAB CAPRI SUPPORT MESSAGE",DVBVER)
S DVBVER=$$ENXPAR("PKG.AUTOMATED MED INFO EXCHANGE","DVBAB CAPRI XML HEADER TOGGLE",1)
D UPDMSG("DVBAB CAPRI XML HEADER TOGGLE",DVBVER)
S DVBVER=$$ENXPAR("PKG.AUTOMATED MED INFO EXCHANGE","DVBAB CAPRI CMT SIGFLD NUM","3!_")
D UPDMSG("DVBAB CAPRI CMT SIGFLD NUM",DVBVER)
S DVBVER=$$ENXPAR("PKG.AUTOMATED MED INFO EXCHANGE","DVBAB CAPRI PROXY DATA","0CK24HCeOi3P7Dgj451+18jLOy6UG3uYWkzcUnDts+M=") ;PL CAPRI-7981
D UPDMSG("DVBAB CAPRI PROXY DATA",DVBVER)
S DVBVER=$$ENXPAR("PKG.AUTOMATED MED INFO EXCHANGE","DVBAB CAPRI CMT IEPD RESET","03/13/2026") ;CP for IEPD 10.3
D UPDMSG("DVBAB CAPRI CMT IEPD RESET",DVBVER)
;
D EXAMLISTFIX
D REMOVEDUP
;CAPRI-21773 : NGC - Start
S DVBVER=$$ENXPAR("PKG.AUTOMATED MED INFO EXCHANGE","DVBAB CAPRI NRE TOGGLE",1)
D UPDMSG("DVBAB CAPRI NRE TOGGLE",DVBVER)
S DVBVER=$$ENXPAR("PKG.AUTOMATED MED INFO EXCHANGE","DVBAB CAPRI NRE PURGE",30)
D UPDMSG("DVBAB CAPRI NRE PURGE",DVBVER)
D SKIPREMOVE
;
;Create Taskman entry - NRE Process - CAPRI-23170:NGC - updated
K DVBPARAMETERS
S DVBPARAMETERS(19.2,2)=$P($$FMTE^XLFDT($$FMADD^XLFDT($$NOW^XLFDT,0,0,5)),":",1,2)
S DVBPARAMETERS(19.2,6)="60S" ;every minute
S DVBVER=$$CREATETASKMAN^DVBLIBTM("DVBA CAPRI NRE PROCESS TM","D TMPROCESS^DVBANRE",.DVBPARAMETERS)
D BMES^XPDUTL("Taskman: DVBA CAPRI NRE PROCESS TM. "_$S(DVBVER<0:"Failed",1:"Success")_" ("_$P(DVBVER,"^",2,*)_")")
;
;Create Taskman entry - NRE Purge - CAPRI-23170:NGC - updated
K DVBPARAMETERS
S DVBPARAMETERS(19.2,2)=$$FMTE^XLFDT($$FMADD^XLFDT(DT,+1)_".0100")
S DVBPARAMETERS(19.2,6)="1D"
S DVBVER=$$CREATETASKMAN^DVBLIBTM("DVBA CAPRI NRE PURGE TM","D TMPURGE^DVBANRE",.DVBPARAMETERS)
D BMES^XPDUTL("Taskman: DVBA CAPRI NRE PURGE TM. "_$S(DVBVER<0:"Failed",1:"Success")_" ("_$P(DVBVER,"^",2,*)_")")
;
;Disable current 2507 AMIE Batch Printing
S DVBVER=$$DISABLETASKMAN("DVBA C PRINT NEW C&P REQ TM")
D BMES^XPDUTL("Disable Taskman: DVBA C PRINT NEW C&P REQ TM. "_$S(DVBVER<0:"Failed",1:"Success")_" ("_$P(DVBVER,"^",2,*)_")")
K DA,DIE,DR
;CAPRI-21773 : NGC - End
;
D BMES^XPDUTL("Patch DVBA*2.7*255 post install finished")
Q
;
ENXPAR(DVBENT,DVBPAR,DVBVAL) ;
N DVBVER
D EN^XPAR(DVBENT,DVBPAR,1,DVBVAL,.DVBVER)
Q DVBVER
;
UPDMSG(DVBPAR,DVBVER) ;
I (DVBVER) D
. D BMES^XPDUTL(DVBPAR_" Update FAILURE.")
. D MES^XPDUTL(" Failure reason: "_DVBVER)
E D
. D BMES^XPDUTL(DVBPAR_" Updated Successfully ")
Q
;
DISABLETASKMAN(DVBNAME) ;CAPRI-21773 : NGC
S DA=$$FINDIDBYNAME^DVBLIBTM(DVBNAME) Q:DA="" "-1^Not Found"
S DIE="^DIC(19.2,",DR="2///@;6///@" D ^DIE
K DA,DIE,DR
Q "1^Schedule Removed"
SKIPREMOVE ;
N DVBLIST,DVBTOT,DVBI,DVBDBQ,DVBUDLIST,DVBUDTOT,DVBI2,DVBERR,DVBINST
S (DVBUDLIST,DVBERR)=""
D GETLST^XPAR(.DVBLIST,"PKG","DVBAB CAPRI SKIP CONDFIELD","Q")
S DVBTOT=$G(DVBLIST)
F DVBI=1:1:DVBTOT D
.S DVBDBQ=$P($P($G(DVBLIST(DVBI)),U,2),"!",1)
.I ("DBQMUSCElbowandForearm_10.2_1237.json"=DVBDBQ) S DVBUDLIST=DVBUDLIST_","_DVBI
.Q
S DVBUDTOT=$L(DVBUDLIST,",")
F DVBI2=2:1:DVBUDTOT D
.S DVBINST=$P(DVBUDLIST,",",DVBI2)
.D DEL^XPAR("PKG","DVBAB CAPRI SKIP CONDFIELD",DVBINST,DVBERR)
.D UPDMSG("DVBAB CAPRI SKIP CONDFIELD"_DVBI2,DVBERR)
.Q
Q
EXAMLISTFIX ;
; 12-22-25 CP CAPRI-24103
N DVBIEN40,DVBIEN396,DVBCNT
K ^TMP("CAPRI396SAVE"),^TMP("CAPRI396LIST",$J),^TMP("CAPRIFIX",$J)
M ^TMP("CAPRI396SAVE")=^DVB(396.15)
S DVBIEN40=""
F S DVBIEN40=$O(^DVB(396.15,"B",DVBIEN40)) Q:DVBIEN40="" D
. S DVBIEN396="",DVBCNT=0 F S DVBIEN396=$O(^DVB(396.15,"B",DVBIEN40,DVBIEN396)) Q:DVBIEN396="" D
. . S DVBCNT=DVBCNT+1
. . I DVBCNT=1 S ^TMP("CAPRI396LIST",$J,DVBIEN40)=DVBIEN396
. . I DVBCNT>1 S ^TMP("CAPRIFIX",$J,DVBIEN396)="DUP TO REMOVE"
. . Q
. Q
Q
REMOVEDUP ;
N DVBDUP,DVBIEN396
K DIK,DA
S DVBDUP=$D(^TMP("CAPRIFIX",$J))
I DVBDUP<10 D BMES^XPDUTL("No Duplicates to clean up from CAPRI DIVISION EXAM LIST") Q
I DVBDUP>9 S DVBIEN396="" F S DVBIEN396=$O(^TMP("CAPRIFIX",$J,DVBIEN396)) Q:DVBIEN396="" D
. S DIK="^DVB(396.15," S DA=DVBIEN396 D ^DIK
. Q
K DIK,DA
D BMES^XPDUTL("Duplicates have been removed from CAPRI DIVISION EXAM LIST") Q
K ^TMP("CAPRI396SAVE")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBC255P 5189 printed Mar 25, 2026@15:07:44 Page 2
DVBC255P ;ALB/GTR - PATCH DVBA*2.7*255 POST-INSTALL ROUTINE; Dec 16, 2024@16:00 ; 9/22/25 1:02pm
+1 ;;2.7;AMIE;**255**;Apr 10,1995;Build 21
+2 ;Per VHA Directive 6402 this routine should not be modified
+3 ;Reference to SUPPORTED PARAMETER TOOL ENTRY POINTS in ICR #2263
+4 ;Reference to File 19 in ICR #10075
+5 ;Reference to File 19.2 in ICR #4086
+6 ;Reference to ^DIE in ICR #10018
+7 ;
+8 QUIT
+9 ;CAPRI-23256 TO ADD PARAMATER SUBTASK FOR RELEASE
VUPDATE ; MINIMUM AND PREVIOUS CAPRI VERSION UPDATES
+1 NEW DVBVER,DVBIEN,DVBNAME
+2 DO MES^XPDUTL("Patch DVBA*2.7*255 post install started")
+3 SET DVBVER=$$ENXPAR("PKG","DVBAB CAPRI MINIMUM VERSION","CAPRI GUI V2.7*255.32*1*A*3260327*1.3*1.3")
+4 DO UPDMSG("CAPRI MINIMUM VERSION",DVBVER)
+5 SET DVBVER=$$ENXPAR("PKG","DVBAB CAPRI PREVIOUS VERSION","DVBA*2.7*254.24")
+6 DO UPDMSG("DVBAB CAPRI PREVIOUS VERSION",DVBVER)
+7 SET DVBVER=$$ENXPAR("PKG.AUTOMATED MED INFO EXCHANGE","DVBAB CAPRI SUPPORT MESSAGE","1-855-673-4357")
+8 DO UPDMSG("DVBAB CAPRI SUPPORT MESSAGE",DVBVER)
+9 SET DVBVER=$$ENXPAR("PKG.AUTOMATED MED INFO EXCHANGE","DVBAB CAPRI XML HEADER TOGGLE",1)
+10 DO UPDMSG("DVBAB CAPRI XML HEADER TOGGLE",DVBVER)
+11 SET DVBVER=$$ENXPAR("PKG.AUTOMATED MED INFO EXCHANGE","DVBAB CAPRI CMT SIGFLD NUM","3!_")
+12 DO UPDMSG("DVBAB CAPRI CMT SIGFLD NUM",DVBVER)
+13 ;PL CAPRI-7981
SET DVBVER=$$ENXPAR("PKG.AUTOMATED MED INFO EXCHANGE","DVBAB CAPRI PROXY DATA","0CK24HCeOi3P7Dgj451+18jLOy6UG3uYWkzcUnDts+M=")
+14 DO UPDMSG("DVBAB CAPRI PROXY DATA",DVBVER)
+15 ;CP for IEPD 10.3
SET DVBVER=$$ENXPAR("PKG.AUTOMATED MED INFO EXCHANGE","DVBAB CAPRI CMT IEPD RESET","03/13/2026")
+16 DO UPDMSG("DVBAB CAPRI CMT IEPD RESET",DVBVER)
+17 ;
+18 DO EXAMLISTFIX
+19 DO REMOVEDUP
+20 ;CAPRI-21773 : NGC - Start
+21 SET DVBVER=$$ENXPAR("PKG.AUTOMATED MED INFO EXCHANGE","DVBAB CAPRI NRE TOGGLE",1)
+22 DO UPDMSG("DVBAB CAPRI NRE TOGGLE",DVBVER)
+23 SET DVBVER=$$ENXPAR("PKG.AUTOMATED MED INFO EXCHANGE","DVBAB CAPRI NRE PURGE",30)
+24 DO UPDMSG("DVBAB CAPRI NRE PURGE",DVBVER)
+25 DO SKIPREMOVE
+26 ;
+27 ;Create Taskman entry - NRE Process - CAPRI-23170:NGC - updated
+28 KILL DVBPARAMETERS
+29 SET DVBPARAMETERS(19.2,2)=$PIECE($$FMTE^XLFDT($$FMADD^XLFDT($$NOW^XLFDT,0,0,5)),":",1,2)
+30 ;every minute
SET DVBPARAMETERS(19.2,6)="60S"
+31 SET DVBVER=$$CREATETASKMAN^DVBLIBTM("DVBA CAPRI NRE PROCESS TM","D TMPROCESS^DVBANRE",.DVBPARAMETERS)
+32 DO BMES^XPDUTL("Taskman: DVBA CAPRI NRE PROCESS TM. "_$SELECT(DVBVER<0:"Failed",1:"Success")_" ("_$PIECE(DVBVER,"^",2,*)_")")
+33 ;
+34 ;Create Taskman entry - NRE Purge - CAPRI-23170:NGC - updated
+35 KILL DVBPARAMETERS
+36 SET DVBPARAMETERS(19.2,2)=$$FMTE^XLFDT($$FMADD^XLFDT(DT,+1)_".0100")
+37 SET DVBPARAMETERS(19.2,6)="1D"
+38 SET DVBVER=$$CREATETASKMAN^DVBLIBTM("DVBA CAPRI NRE PURGE TM","D TMPURGE^DVBANRE",.DVBPARAMETERS)
+39 DO BMES^XPDUTL("Taskman: DVBA CAPRI NRE PURGE TM. "_$SELECT(DVBVER<0:"Failed",1:"Success")_" ("_$PIECE(DVBVER,"^",2,*)_")")
+40 ;
+41 ;Disable current 2507 AMIE Batch Printing
+42 SET DVBVER=$$DISABLETASKMAN("DVBA C PRINT NEW C&P REQ TM")
+43 DO BMES^XPDUTL("Disable Taskman: DVBA C PRINT NEW C&P REQ TM. "_$SELECT(DVBVER<0:"Failed",1:"Success")_" ("_$PIECE(DVBVER,"^",2,*)_")")
+44 KILL DA,DIE,DR
+45 ;CAPRI-21773 : NGC - End
+46 ;
+47 DO BMES^XPDUTL("Patch DVBA*2.7*255 post install finished")
+48 QUIT
+49 ;
ENXPAR(DVBENT,DVBPAR,DVBVAL) ;
+1 NEW DVBVER
+2 DO EN^XPAR(DVBENT,DVBPAR,1,DVBVAL,.DVBVER)
+3 QUIT DVBVER
+4 ;
UPDMSG(DVBPAR,DVBVER) ;
+1 IF (DVBVER)
Begin DoDot:1
+2 DO BMES^XPDUTL(DVBPAR_" Update FAILURE.")
+3 DO MES^XPDUTL(" Failure reason: "_DVBVER)
End DoDot:1
+4 IF '$TEST
Begin DoDot:1
+5 DO BMES^XPDUTL(DVBPAR_" Updated Successfully ")
End DoDot:1
+6 QUIT
+7 ;
DISABLETASKMAN(DVBNAME) ;CAPRI-21773 : NGC
+1 SET DA=$$FINDIDBYNAME^DVBLIBTM(DVBNAME)
if DA=""
QUIT "-1^Not Found"
+2 SET DIE="^DIC(19.2,"
SET DR="2///@;6///@"
DO ^DIE
+3 KILL DA,DIE,DR
+4 QUIT "1^Schedule Removed"
SKIPREMOVE ;
+1 NEW DVBLIST,DVBTOT,DVBI,DVBDBQ,DVBUDLIST,DVBUDTOT,DVBI2,DVBERR,DVBINST
+2 SET (DVBUDLIST,DVBERR)=""
+3 DO GETLST^XPAR(.DVBLIST,"PKG","DVBAB CAPRI SKIP CONDFIELD","Q")
+4 SET DVBTOT=$GET(DVBLIST)
+5 FOR DVBI=1:1:DVBTOT
Begin DoDot:1
+6 SET DVBDBQ=$PIECE($PIECE($GET(DVBLIST(DVBI)),U,2),"!",1)
+7 IF ("DBQMUSCElbowandForearm_10.2_1237.json"=DVBDBQ)
SET DVBUDLIST=DVBUDLIST_","_DVBI
+8 QUIT
End DoDot:1
+9 SET DVBUDTOT=$LENGTH(DVBUDLIST,",")
+10 FOR DVBI2=2:1:DVBUDTOT
Begin DoDot:1
+11 SET DVBINST=$PIECE(DVBUDLIST,",",DVBI2)
+12 DO DEL^XPAR("PKG","DVBAB CAPRI SKIP CONDFIELD",DVBINST,DVBERR)
+13 DO UPDMSG("DVBAB CAPRI SKIP CONDFIELD"_DVBI2,DVBERR)
+14 QUIT
End DoDot:1
+15 QUIT
EXAMLISTFIX ;
+1 ; 12-22-25 CP CAPRI-24103
+2 NEW DVBIEN40,DVBIEN396,DVBCNT
+3 KILL ^TMP("CAPRI396SAVE"),^TMP("CAPRI396LIST",$JOB),^TMP("CAPRIFIX",$JOB)
+4 MERGE ^TMP("CAPRI396SAVE")=^DVB(396.15)
+5 SET DVBIEN40=""
+6 FOR
SET DVBIEN40=$ORDER(^DVB(396.15,"B",DVBIEN40))
if DVBIEN40=""
QUIT
Begin DoDot:1
+7 SET DVBIEN396=""
SET DVBCNT=0
FOR
SET DVBIEN396=$ORDER(^DVB(396.15,"B",DVBIEN40,DVBIEN396))
if DVBIEN396=""
QUIT
Begin DoDot:2
+8 SET DVBCNT=DVBCNT+1
+9 IF DVBCNT=1
SET ^TMP("CAPRI396LIST",$JOB,DVBIEN40)=DVBIEN396
+10 IF DVBCNT>1
SET ^TMP("CAPRIFIX",$JOB,DVBIEN396)="DUP TO REMOVE"
+11 QUIT
End DoDot:2
+12 QUIT
End DoDot:1
+13 QUIT
REMOVEDUP ;
+1 NEW DVBDUP,DVBIEN396
+2 KILL DIK,DA
+3 SET DVBDUP=$DATA(^TMP("CAPRIFIX",$JOB))
+4 IF DVBDUP<10
DO BMES^XPDUTL("No Duplicates to clean up from CAPRI DIVISION EXAM LIST")
QUIT
+5 IF DVBDUP>9
SET DVBIEN396=""
FOR
SET DVBIEN396=$ORDER(^TMP("CAPRIFIX",$JOB,DVBIEN396))
if DVBIEN396=""
QUIT
Begin DoDot:1
+6 SET DIK="^DVB(396.15,"
SET DA=DVBIEN396
DO ^DIK
+7 QUIT
End DoDot:1
+8 KILL DIK,DA
+9 DO BMES^XPDUTL("Duplicates have been removed from CAPRI DIVISION EXAM LIST")
QUIT
+10 KILL ^TMP("CAPRI396SAVE")
+11 QUIT
