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

BGU15E.m

Go to the documentation of this file. 
  1. BGU15E ; IHS/OIT/MJL - ENVIRONMENT CHECK FOR PATIENT CHART ; [ 04/14/2008  4:46 PM ]
  1.  ;;1.5;BGU;**4**;MAY 26, 2005
  1.  ;
  1.  S $P(LINE,"*",81)=""
  1.  S XPDNOQUE="NO QUE"  ;NO QUEUING ALLOWED
  1.  S XPDABORT=0
  1.  I '$G(DUZ) W !,"DUZ UNDEFINED OR 0." S XPX="DUZ" D SORRY Q
  1.  ;
  1.  I '$L($G(DUZ(0))) W !,"DUZ(0) UNDEFINED OR NULL." S XPX="DUZ" D SORRY Q
  1.  ;
  1.  D HOME^%ZIS,DT^DICRW
  1.  S X=$P($G(^VA(200,DUZ,0)),U)
  1.  I $G(X)="" W !,$$C^XBFUNC("Who are you????") S XPX="DUZ" D SORRY Q
  1.  W !,$$C^XBFUNC("Hello, "_$P(X,",",2)_" "_$P(X,","))
  1.  W !!,$$C^XBFUNC("Checking Environment for Beta Install of Version "_$P($T(+2),";",3)_" of "_$P($T(+2),";",4)_".")
  1.  ;
  1.  S X=$G(^DD("VERSION"))
  1.  W !!,$$C^XBFUNC("Need at least FileMan 22.....FileMan "_X_" Present")
  1.  I X<22 S XPX="FM" D SORRY Q
  1.  ;
  1.  S X=$G(^DIC(9.4,$O(^DIC(9.4,"C","XU",0)),"VERSION"))
  1.  W !!,$$C^XBFUNC("Need at least Kernel 8.0.....Kernel "_X_" Present")
  1.  I X<8.0 S XPX="KERNEL" D SORRY Q
  1.  ;
  1.  S XPX="IHS RPC BROKER",X=$$VERSION^XPDUTL(XPX)
  1.  S:X="" X="Is Not"
  1.  W !!,$$C^XBFUNC(XPX_" 1.5....."_XPX_" "_X_" Present")
  1.  I X<1.5 D SORRY Q
  1.  ;
  1. VERSION ;
  1.  ;CHECK FOR PREVIOUS PATCH NEEDED
  1.  S XPDBLD=$O(^XTMP("XPDI",XPDA,"BLD",0)),%=$P($G(^AUTTSITE(1,0)),U,22)
  1.  I '% D  Q
  1.  . W !,$$C^XBFUNC($P(^XTMP("XPDI",XPDST,"BLD",XPDBLD,0),U,1)_" "_$P(^XTMP("XPDI",XPDST,"BLD",XPDBLD,0),U,2)_" Cannot Be Installed Unless")
  1.  . W !,$$C^XBFUNC("File 200 PCC Conversion Has Been Previously Completed.")
  1.  . S XPX="PCC200" D SORRY
  1.  . I $$DIR^XBDIR("E","Press RETURN...")
  1.  ;
  1. OTHER ;
  1.  ;Other checks
  1.  W !!,"Checking for IHS RPC BROKER Patch..."
  1.  I ","_$P($T(+2^BGUXUSRB),"**",2)_","'[",1," W !!,$$C^XBFUNC("IHS RPC BROKER Version 1.5, Patch 1 Is Not Installed") S XPX="IHS RPC BROKER" D SORRY Q
  1.  I ","_$P($T(+2^BGUXUSRB),"**",2)_","'[",2," W !!,$$C^XBFUNC("IHS RPC BROKER Version 1.5, Patch 2 Is Not Installed") S XPX="IHS RPC BROKER" D SORRY Q
  1.  I ","_$P($T(+2^BGULIST2),"**",2)_","'[",3," W !!,$$C^XBFUNC("IHS RPC BROKER Version 1.5, Patch 3 Is Not Installed") S XPX="IHS RPC BROKER" D SORRY Q
  1.  ;
  1. ENVOK ; If this is just an environ check, end here.
  1.  W !!,$$C^XBFUNC("ENVIRONMENT OK.")
  1.  ;
  1.  ; The following line prevents the "Disable Options..." and "Move
  1.  ; Routines..." questions from being asked during the install.
  1.  I $G(XPDENV)=1 S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
  1.  ;
  1.  ;VERIFY BACKUPS HAVE BEEN DONE
  1.  W !!
  1.  S DIR(0)="Y"
  1.  S DIR("B")="NO"
  1.  S DIR("A")="Has a SUCCESSFUL system backup been performed??"
  1.  D ^DIR
  1.  I $D(DIRUT)!($G(Y)=0) S XPDABORT=1 S XPX="BACKUP" D SORRY Q
  1.  S ^TMP("BPCPRE",$J,"BACKUPS CONFIRMED BY "_DUZ)=$H
  1.  ;
  1.  Q
  1. SORRY ;
  1.  K DIFQ
  1.  S XPDABORT=1
  1.  W *7,!!!,$$C^XBFUNC("Sorry....something is wrong with your environment")
  1.  W !,$$C^XBFUNC("Aborting "_XPDNM_" install!")
  1.  W !,$$C^XBFUNC("Correct error and reinstall otherwise")
  1.  W !,$$C^XBFUNC("please print/capture this screen and notify")
  1.  W !,$$C^XBFUNC("the Help Desk")
  1.  W !!,LINE
  1.  D BMES^XPDUTL("Sorry....something is wrong with your environment")
  1.  D BMES^XPDUTL("Enviroment ERROR "_$G(XPX))
  1.  D BMES^XPDUTL("Aborting "_XPDNM_" install!")
  1.  D BMES^XPDUTL("Correct error and reinstall otherwise")
  1.  D BMES^XPDUTL("please print/capture this screen and notify")
  1.  D BMES^XPDUTL("the Help Desk")
  1.  Q
  1.  ;