- DVBC220P ;ALB/BG;PATCH 220 POST INSTALL ; 7/7/20 11:37am
- ;;2.7;AMIE;**220**;Apr 10, 1995 ;Build 9
- ;Per VHA Directive 6402 this routine should not be modified
- ;Updates Capri Minimum version
- Q
- ;
- ;special consideration adds
- SCADD ;
- N DVBAI,DVBLINE,FIND,OUT
- F DVBAI=1:1 S DVBLINE=$P($T(SCNEW+DVBAI),";;",2) Q:DVBLINE="QUIT" D
- .K FIND,OUT
- .S FIND=$TR(DVBLINE,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
- .D FIND^DIC(396.25,"",.01,"X",.FIND,"","","","","OUT")
- .I $G(OUT("DILIST",2,1))'="" D BMES^XPDUTL("SPECIAL CONSIDERATION: "_FIND_" HAS ALREADY BEEN ADDED.") Q
- .K FDA,ERR
- .S DVBLINE=$TR(DVBLINE,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
- .S FDA(396.25,"+1,",.01)=DVBLINE
- .D UPDATE^DIE("","FDA","","ERR")
- .I $G(ERR)'="" D BMES^XPDUTL("SPECIAL CONSIDERATION: "_DVBLINE_" COULD NOT BE ADDED BY POST-INSTALL ROUTINE.") Q
- .D BMES^XPDUTL("SPECIAL CONSIDERATION: "_DVBLINE_" HAS BEEN ADDED.") Q
- Q
- SCNEW ;
- ;;PURPLE HEART RECIPIENT
- ;;INCARCERATED
- ;;QUIT
- Q
- ;
- PMAIN ;-- update DVBAB CAPRI MINIMUM VERSION Parameter.
- ;
- D SCADD
- N DVBERR
- W !!,"*************************************************"
- W !!,"Start DVBAB CAPRI Minimum Version Parameter Update"
- W !,"-------------------------",!
- ;
- S DVBERR=$$ENXPAR("PKG","DVBAB CAPRI MINIMUM VERSION","CAPRI GUI V2.7*220.9*1*A*3200925")
- D UPDMSG("CAPRI Minimum Version",DVBERR)
- ;
- W !!,"-------------------------"
- W !,"End DVBAB CAPRI Minimum Version Parameter Updates"
- W !,"****************************************************",!!
- 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
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBC220P 1872 printed Feb 18, 2025@23:09:29 Page 2
- DVBC220P ;ALB/BG;PATCH 220 POST INSTALL ; 7/7/20 11:37am
- +1 ;;2.7;AMIE;**220**;Apr 10, 1995 ;Build 9
- +2 ;Per VHA Directive 6402 this routine should not be modified
- +3 ;Updates Capri Minimum version
- +4 QUIT
- +5 ;
- +6 ;special consideration adds
- SCADD ;
- +1 NEW DVBAI,DVBLINE,FIND,OUT
- +2 FOR DVBAI=1:1
- SET DVBLINE=$PIECE($TEXT(SCNEW+DVBAI),";;",2)
- if DVBLINE="QUIT"
- QUIT
- Begin DoDot:1
- +3 KILL FIND,OUT
- +4 SET FIND=$TRANSLATE(DVBLINE,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
- +5 DO FIND^DIC(396.25,"",.01,"X",.FIND,"","","","","OUT")
- +6 IF $GET(OUT("DILIST",2,1))'=""
- DO BMES^XPDUTL("SPECIAL CONSIDERATION: "_FIND_" HAS ALREADY BEEN ADDED.")
- QUIT
- +7 KILL FDA,ERR
- +8 SET DVBLINE=$TRANSLATE(DVBLINE,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
- +9 SET FDA(396.25,"+1,",.01)=DVBLINE
- +10 DO UPDATE^DIE("","FDA","","ERR")
- +11 IF $GET(ERR)'=""
- DO BMES^XPDUTL("SPECIAL CONSIDERATION: "_DVBLINE_" COULD NOT BE ADDED BY POST-INSTALL ROUTINE.")
- QUIT
- +12 DO BMES^XPDUTL("SPECIAL CONSIDERATION: "_DVBLINE_" HAS BEEN ADDED.")
- QUIT
- End DoDot:1
- +13 QUIT
- SCNEW ;
- +1 ;;PURPLE HEART RECIPIENT
- +2 ;;INCARCERATED
- +3 ;;QUIT
- +4 QUIT
- +5 ;
- PMAIN ;-- update DVBAB CAPRI MINIMUM VERSION Parameter.
- +1 ;
- +2 DO SCADD
- +3 NEW DVBERR
- +4 WRITE !!,"*************************************************"
- +5 WRITE !!,"Start DVBAB CAPRI Minimum Version Parameter Update"
- +6 WRITE !,"-------------------------",!
- +7 ;
- +8 SET DVBERR=$$ENXPAR("PKG","DVBAB CAPRI MINIMUM VERSION","CAPRI GUI V2.7*220.9*1*A*3200925")
- +9 DO UPDMSG("CAPRI Minimum Version",DVBERR)
- +10 ;
- +11 WRITE !!,"-------------------------"
- +12 WRITE !,"End DVBAB CAPRI Minimum Version Parameter Updates"
- +13 WRITE !,"****************************************************",!!
- +14 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 ;