Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DVBC220P

DVBC220P.m

Go to the documentation of this file.
  1. DVBC220P ;ALB/BG;PATCH 220 POST INSTALL ; 7/7/20 11:37am
  1. ;;2.7;AMIE;**220**;Apr 10, 1995 ;Build 9
  1. ;Per VHA Directive 6402 this routine should not be modified
  1. ;Updates Capri Minimum version
  1. Q
  1. ;
  1. ;special consideration adds
  1. SCADD ;
  1. N DVBAI,DVBLINE,FIND,OUT
  1. F DVBAI=1:1 S DVBLINE=$P($T(SCNEW+DVBAI),";;",2) Q:DVBLINE="QUIT" D
  1. .K FIND,OUT
  1. .S FIND=$TR(DVBLINE,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
  1. .D FIND^DIC(396.25,"",.01,"X",.FIND,"","","","","OUT")
  1. .I $G(OUT("DILIST",2,1))'="" D BMES^XPDUTL("SPECIAL CONSIDERATION: "_FIND_" HAS ALREADY BEEN ADDED.") Q
  1. .K FDA,ERR
  1. .S DVBLINE=$TR(DVBLINE,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
  1. .S FDA(396.25,"+1,",.01)=DVBLINE
  1. .D UPDATE^DIE("","FDA","","ERR")
  1. .I $G(ERR)'="" D BMES^XPDUTL("SPECIAL CONSIDERATION: "_DVBLINE_" COULD NOT BE ADDED BY POST-INSTALL ROUTINE.") Q
  1. .D BMES^XPDUTL("SPECIAL CONSIDERATION: "_DVBLINE_" HAS BEEN ADDED.") Q
  1. Q
  1. SCNEW ;
  1. ;;PURPLE HEART RECIPIENT
  1. ;;INCARCERATED
  1. ;;QUIT
  1. Q
  1. ;
  1. PMAIN ;-- update DVBAB CAPRI MINIMUM VERSION Parameter.
  1. ;
  1. D SCADD
  1. N DVBERR
  1. W !!,"*************************************************"
  1. W !!,"Start DVBAB CAPRI Minimum Version Parameter Update"
  1. W !,"-------------------------",!
  1. ;
  1. S DVBERR=$$ENXPAR("PKG","DVBAB CAPRI MINIMUM VERSION","CAPRI GUI V2.7*220.9*1*A*3200925")
  1. D UPDMSG("CAPRI Minimum Version",DVBERR)
  1. ;
  1. W !!,"-------------------------"
  1. W !,"End DVBAB CAPRI Minimum Version Parameter Updates"
  1. W !,"****************************************************",!!
  1. Q
  1. ENXPAR(DVBENT,DVBPAR,DVBVAL) ;
  1. ;
  1. N DVBERR
  1. D EN^XPAR(DVBENT,DVBPAR,1,DVBVAL,.DVBERR)
  1. Q DVBERR
  1. ;
  1. ;
  1. UPDMSG(DVBPAR,DVBERR) ;
  1. ;
  1. I DVBERR D
  1. . D MES^XPDUTL(DVBPAR_" update FAILURE.")
  1. . D MES^XPDUTL(" Failure reason: "_DVBERR)
  1. E D
  1. . D MES^XPDUTL(DVBPAR_" Update Successful")
  1. Q
  1. ;