DVBC227P ;ALB/BG;PATCH 227 POST INSTALL ; 9/17/21 9:48am
;;2.7;AMIE;**227**;Apr 10, 1995;Build 21
;Per VHA Directive 6402 this routine should not be modified
;Updates Capri Minimum version
Q
;
PMAIN ;-- update DVBAB CAPRI MINIMUM VERSION Parameter.
;
N DVBERR
W !!,"*************************************************"
W !!,"Start DVBAB CAPRI Minimum Version Parameter Update"
W !,"-------------------------",!
S DVBERR=$$ENXPAR("PKG","DVBAB CAPRI MINIMUM VERSION","CAPRI GUI V2.7*227.2*1*A*3211230*1.3*1.3")
D UPDMSG("CAPRI Minimum Version",DVBERR)
;
W !!,"-------------------------"
W !,"End DVBAB CAPRI Minimum Version Parameter Updates"
W !,"****************************************************",!!
;
D STATUS ;add reroute status
D DIVUPD ;update capri division exam list (#396.15) file for ehrm 2507/7131 mod
;
Q
ENXPAR(DVBENT,DVBPAR,DVBVAL) ;
;
N DVBERR
D EN^XPAR(DVBENT,DVBPAR,1,DVBVAL,.DVBERR)
Q DVBERR
;
;
UPDMSG(DVBPAR,DVBERR) ;
;
I DVBERR D
. D MES^XPDUTL(DVBPAR_" update FAILURE.")
. D MES^XPDUTL(" Failure reason: "_DVBERR)
E D
. D MES^XPDUTL(DVBPAR_" Update Successful")
Q
;
STATUS ;adding new reroute status
N DVBFDA,DVBERR
D BMES^XPDUTL("Updating the CAPRI 2507 STATUS (396.33) file...")
S FIND="RE-ROUTED, PENDING AT TO SITE"
D FIND^DIC(396.33,"",.01,"X",.FIND,"","","","","OUT")
I $G(OUT("DILIST",2,1))'="" D BMES^XPDUTL("NEW RE-ROUTE STATUS HAS ALREADY ADDED") Q
S DVBFDA(396.33,"+1,",.01)=FIND
S DVBFDA(396.33,"+1,",.02)="RS"
D UPDATE^DIE("","DVBFDA","","DVBERR")
I $G(DVBERR)'="" D BMES^XPDUTL("NEW RE-ROUTE STATUS COULD NOT BE ADDED BY POST-INSTALL ROUTINE.")
I $G(DVBERR)="" D BMES^XPDUTL("NEW RE-ROUTE STATUS HAS BEEN ADDED.")
K DVBERR,DVBFDA
Q
;
DIVUPD ;add values to the new fields in the capri division exam list (#396.15) file
N DVBAIEN,DVBAVAL,DVBAFIVE,DVBASIX,DVBASEVN,DVBAFDA,DVBAERR
S DVBAIEN=0
D BMES^XPDUTL("Updating the CAPRI DIVISION EXAM LIST (396.15) file...")
F S DVBAIEN=$O(^DVB(396.15,DVBAIEN)) Q:'DVBAIEN D
.S DVBAVAL=^DVB(396.15,DVBAIEN,3)
.I $P(DVBAVAL,U)="Y" S DVBAFIVE="Y"
.E S DVBAFIVE="N"
.S (DVBASIX,DVBASEVN)="N"
.S DVBAFDA(396.15,DVBAIEN_",",5)=DVBAFIVE
.S DVBAFDA(396.15,DVBAIEN_",",6)=DVBASIX
.S DVBAFDA(396.15,DVBAIEN_",",7)=DVBASEVN
.K DVBAERR D FILE^DIE(,"DVBAFDA","DVBAERR")
.I '$D(DVBAERR) D BMES^XPDUTL(" >>Division "_$$GET1^DIQ(396.15,DVBAIEN_",",.01)_" (IEN #"_DVBAIEN_") updated successfully")
.I $D(DVBAERR) D BMES^XPDUTL(">>>....Error updating Division "_$$GET1^DIQ(396.15,DVBAIEN_",",.01)_" (IEN #"_DVBAIEN_")") D
..D MES^XPDUTL(" ERROR: "_DVBAERR("DIERR","1")) ;print error code to help identify filing issue
..D BMES^XPDUTL(" *** Please contact support for assistance. ***")
D BMES^XPDUTL("...CAPRI DIVISION EXAM LIST (396.15) file updates complete.")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBC227P 2879 printed Dec 13, 2024@01:43:09 Page 2
DVBC227P ;ALB/BG;PATCH 227 POST INSTALL ; 9/17/21 9:48am
+1 ;;2.7;AMIE;**227**;Apr 10, 1995;Build 21
+2 ;Per VHA Directive 6402 this routine should not be modified
+3 ;Updates Capri Minimum version
+4 QUIT
+5 ;
PMAIN ;-- update DVBAB CAPRI MINIMUM VERSION Parameter.
+1 ;
+2 NEW DVBERR
+3 WRITE !!,"*************************************************"
+4 WRITE !!,"Start DVBAB CAPRI Minimum Version Parameter Update"
+5 WRITE !,"-------------------------",!
+6 SET DVBERR=$$ENXPAR("PKG","DVBAB CAPRI MINIMUM VERSION","CAPRI GUI V2.7*227.2*1*A*3211230*1.3*1.3")
+7 DO UPDMSG("CAPRI Minimum Version",DVBERR)
+8 ;
+9 WRITE !!,"-------------------------"
+10 WRITE !,"End DVBAB CAPRI Minimum Version Parameter Updates"
+11 WRITE !,"****************************************************",!!
+12 ;
+13 ;add reroute status
DO STATUS
+14 ;update capri division exam list (#396.15) file for ehrm 2507/7131 mod
DO DIVUPD
+15 ;
+16 QUIT
ENXPAR(DVBENT,DVBPAR,DVBVAL) ;
+1 ;
+2 NEW DVBERR
+3 DO EN^XPAR(DVBENT,DVBPAR,1,DVBVAL,.DVBERR)
+4 QUIT DVBERR
+5 ;
+6 ;
UPDMSG(DVBPAR,DVBERR) ;
+1 ;
+2 IF DVBERR
Begin DoDot:1
+3 DO MES^XPDUTL(DVBPAR_" update FAILURE.")
+4 DO MES^XPDUTL(" Failure reason: "_DVBERR)
End DoDot:1
+5 IF '$TEST
Begin DoDot:1
+6 DO MES^XPDUTL(DVBPAR_" Update Successful")
End DoDot:1
+7 QUIT
+8 ;
STATUS ;adding new reroute status
+1 NEW DVBFDA,DVBERR
+2 DO BMES^XPDUTL("Updating the CAPRI 2507 STATUS (396.33) file...")
+3 SET FIND="RE-ROUTED, PENDING AT TO SITE"
+4 DO FIND^DIC(396.33,"",.01,"X",.FIND,"","","","","OUT")
+5 IF $GET(OUT("DILIST",2,1))'=""
DO BMES^XPDUTL("NEW RE-ROUTE STATUS HAS ALREADY ADDED")
QUIT
+6 SET DVBFDA(396.33,"+1,",.01)=FIND
+7 SET DVBFDA(396.33,"+1,",.02)="RS"
+8 DO UPDATE^DIE("","DVBFDA","","DVBERR")
+9 IF $GET(DVBERR)'=""
DO BMES^XPDUTL("NEW RE-ROUTE STATUS COULD NOT BE ADDED BY POST-INSTALL ROUTINE.")
+10 IF $GET(DVBERR)=""
DO BMES^XPDUTL("NEW RE-ROUTE STATUS HAS BEEN ADDED.")
+11 KILL DVBERR,DVBFDA
+12 QUIT
+13 ;
DIVUPD ;add values to the new fields in the capri division exam list (#396.15) file
+1 NEW DVBAIEN,DVBAVAL,DVBAFIVE,DVBASIX,DVBASEVN,DVBAFDA,DVBAERR
+2 SET DVBAIEN=0
+3 DO BMES^XPDUTL("Updating the CAPRI DIVISION EXAM LIST (396.15) file...")
+4 FOR
SET DVBAIEN=$ORDER(^DVB(396.15,DVBAIEN))
if 'DVBAIEN
QUIT
Begin DoDot:1
+5 SET DVBAVAL=^DVB(396.15,DVBAIEN,3)
+6 IF $PIECE(DVBAVAL,U)="Y"
SET DVBAFIVE="Y"
+7 IF '$TEST
SET DVBAFIVE="N"
+8 SET (DVBASIX,DVBASEVN)="N"
+9 SET DVBAFDA(396.15,DVBAIEN_",",5)=DVBAFIVE
+10 SET DVBAFDA(396.15,DVBAIEN_",",6)=DVBASIX
+11 SET DVBAFDA(396.15,DVBAIEN_",",7)=DVBASEVN
+12 KILL DVBAERR
DO FILE^DIE(,"DVBAFDA","DVBAERR")
+13 IF '$DATA(DVBAERR)
DO BMES^XPDUTL(" >>Division "_$$GET1^DIQ(396.15,DVBAIEN_",",.01)_" (IEN #"_DVBAIEN_") updated successfully")
+14 IF $DATA(DVBAERR)
DO BMES^XPDUTL(">>>....Error updating Division "_$$GET1^DIQ(396.15,DVBAIEN_",",.01)_" (IEN #"_DVBAIEN_")")
Begin DoDot:2
+15 ;print error code to help identify filing issue
DO MES^XPDUTL(" ERROR: "_DVBAERR("DIERR","1"))
+16 DO BMES^XPDUTL(" *** Please contact support for assistance. ***")
End DoDot:2
End DoDot:1
+17 DO BMES^XPDUTL("...CAPRI DIVISION EXAM LIST (396.15) file updates complete.")
+18 QUIT
