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

BLRPRE19.m

Go to the documentation of this file. 
  1. BLRPRE19 ; IHS/ITSC/MKK - ENVIRONMENT CHECK FOR PATCH 19; [ 08/20/2004  2:15 PM ]
  1.  ;;5.2;LR;**1019**;MAR 25, 2005
  1.  ;
  1.  S $P(LINE,"*",81)=""
  1.  S XPDNOQUE="NO QUE"  ;NO QUEUING ALLOWED
  1.  S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0  ;DISABLE THE "Disable options..." and "Move routines..." questions from being asked during install
  1.  S XPDDIQ("XPO1")=0  ;DISABLE "Rebuild Menu Tree" question
  1.  S XPDABORT=0
  1.  I '$G(DUZ) W !,"DUZ UNDEFINED OR 0." D SORRY Q
  1.  ;
  1.  I '$L($G(DUZ(0))) W !,"DUZ(0) UNDEFINED OR NULL." D SORRY Q
  1.  ;
  1.  D HOME^%ZIS,DT^DICRW
  1.  S X=$P($G(^VA(200,DUZ,0)),U)
  1.  I $G(X) D BMES^XPDUTL("Installer cannot be identified!") D SORRY Q
  1.  D BMES^XPDUTL("Hello, "_$P(X,",",2)_" "_$P(X,","))
  1.  D BMES^XPDUTL("Checking Environment for Patch "_$P($T(+2),";",5)_" of Version "_$P($T(+2),";",3)_" of "_$P($T(+2),";",4)_".")
  1.  ;
  1.  S X=$G(^DD("VERSION"))
  1.  D BMES^XPDUTL("Need at least FileMan 22.....FileMan "_X_" Present")
  1.  I X<22 D SORRY Q
  1.  ;
  1.  S X=$G(^DIC(9.4,$O(^DIC(9.4,"C","XU",0)),"VERSION"))
  1.  D BMES^XPDUTL("Need at least Kernel 8.0.....Kernel "_X_" Present")
  1.  I X<8.0 D SORRY Q
  1.  ;
  1.  D BMES^XPDUTL("Must have 'LMI' mail group present....")
  1.  I $$CHECKLMI<0 D SORRY Q
  1.  D BMES^XPDUTL("'LMI' mail group found. OK")
  1.  ;
  1.  S X=$G(^DIC(9.4,$O(^DIC(9.4,"C","OR",0)),"VERSION"))
  1.  D BMES^XPDUTL("Need at least ORDER ENTRY/RESULTS REPORTING (OERR) 2.5.....OERR "_X_" Present")
  1.  I X<2.5 D SORRY Q
  1.  ;
  1.  S X=$G(^DIC(9.4,$O(^DIC(9.4,"C","PIMS",0)),"VERSION"))
  1.  D BMES^XPDUTL("Need at least PIMS 5.3.....PIMS "_X_" Present")
  1.  I X<5.3 D SORRY Q
  1.  ;
  1.  S X=$G(^DIC(9.4,$O(^DIC(9.4,"C","LEX",0)),"VERSION"))
  1.  D BMES^XPDUTL("Need at least LEXICON 2.0.....LEXICON "_X_" Present")
  1.  I X<2.0 D SORRY Q
  1.  ;
  1. VERSION ;
  1.  ;CHECK FOR PREVIOUS PATCH NEEDED
  1.  S %=$D(^XPD("9.7","B","LR*5.2*1018"))
  1.  I '% D  Q
  1.  . NEW STR
  1.  . S STR="Patch 1019 of version 5.2 of the RPMS Laboratory Package"
  1.  . S STR=STR_" CANNOT be"_$C(13)_$C(10)
  1.  . S STR=STR_"installed unless Patch 1018 of version 5.2 has been previously"
  1.  . S STR=STR_" installed."_$C(13)_$C(10)
  1.  . D BMES^XPDUTL(STR)
  1.  . D SORRY
  1.  ;
  1.  ;GET INSTALL STATUS
  1.  S %=$O(^XPD("9.7","B","LR*5.2*1018",""))
  1.  S LRSTATUS=$P($G(^XPD(9.7,%,0)),U,9)
  1.  I LRSTATUS'=3 D  Q   ;IF INSTALL STATUS NOT COMPLETE QUIT
  1.  .D BMES^XPDUTL("Install of Patch 1018 not complete!")
  1.  .D SORRY
  1.  ;
  1.  D BMES^XPDUTL("Patch 1018 of version LR 5.2 Has Been Previously Installed......OK to continue")
  1.  ;
  1.  ;
  1.  ;
  1. ENVOK ; If this is just an environ check, end here.
  1.  D BMES^XPDUTL("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) D BMES^XPDUTL("Please perform a successful backup before contnuing!!") S XPDABORT=1 Q
  1.  S %DT="R",X="NOW" D ^%DT X ^DD("DD")
  1.  D BMES^XPDUTL("BACKUPS CONFIRMED BY "_$P($G(^VA(200,DUZ,0)),U)_" ON "_$P(Y,"@")_" AT "_$P(Y,"@",2))
  1.  S ^BLRINSTL("INSTALLED BY")=$P($G(^VA(200,DUZ,0)),U)
  1.  ;
  1.  Q
  1.  ;
  1. SORRY ;
  1.  K DIFQ
  1.  S XPDABORT=1
  1.  ; D BMES^XPDUTL("Sorry....something is wrong with your enviroment")
  1.  ; D BMES^XPDUTL("for a Lab 5.2 Patch 1019 install!")
  1.  NEW STR
  1.  S STR="Sorry....something is wrong with your enviroment for"
  1.  S STR=STR_" an install of"_$C(13)_$C(10)_$$CJ^XLFSTR("Lab 5.2 Patch 1019",65)
  1.  D BMES^XPDUTL(STR)
  1.  ; D BMES^XPDUTL("Please print/capture this screen and notify the Support Center at")
  1.  ; D BMES^XPDUTL($$CJ^XLFSTR("1-999-999-9999",65))
  1.  S STR="Please print/capture this screen and notify the Support Center"
  1.  S STR=STR_" at"_$C(13)_$C(10)_$$CJ^XLFSTR("1-999-999-9999",65)_$C(13)_$C(10)
  1.  D BMES^XPDUTL(STR)
  1.  Q
  1.  ;
  1.  ;CHECK FOR LMI MAIL GROUP
  1. CHECKLMI() ;
  1.  S DIC="^XMB(3.8,"
  1.  S X="LMI"
  1.  D ^DIC
  1.  Q +Y
  1.  ;
  1. POST ;
  1.  NEW STR
  1.  S STR=$$CJ^XLFSTR("Updating MODULE PCC LINK CONTROL failed",65)
  1.  S STR=$C(13)_$C(10)_"Please print/capture this screen and notify the Support Center"
  1.  S STR=STR_" at"_$C(13)_$C(10)_$$CJ^XLFSTR("1-999-999-9999",65)_$C(13)_$C(10)
  1.  ;
  1.  S STR=$$KILL^ZIBGCHAR("BLRENTRY")    ; Clear Tracking global
  1.  ;
  1.  ; The following code adds the correct PCC Merge code.  The original code
  1.  ; for LAB in the MODULE PCC LINK CONTROL dictionary is trying to call the
  1.  ; ALRLINK routine, which was deleted years ago.
  1.  ; 
  1.  S BLRX=$O(^APCDLINK("B","LABORATORY",0))  ;get ien of entry
  1.  I 'BLRX D ADD  ;if it doesn't exist add it
  1.  ;
  1.  ; Check to determine if valid routine (BZHELR) already exists in dictionary.
  1.  ; If it does exist, just quit
  1.  I $G(^APCDLINK(BLRX,1))["BZHELR" Q
  1.  ;
  1.  ;if not, now edit it
  1.  S DA=BLRX
  1.  S DIE="^APCDLINK("
  1.  S DR="1////S BLROSAV=$G(X),X=""BLRPCCVM"" X ^%ZOSF(""TEST"") S X=BLROSAV K BLROSAV I $T D ^BLRPCCVM"
  1.  D ^DIE
  1.  I $D(Y) D BMES^XPDUTL(STR)
  1.  K DIE,DA,DR,DIC,DLAYGO,DD,DO
  1.  Q
  1.  ;
  1. ADD ;
  1.  S X="LABORATORY",DIC="^APCDLINK(",DLAYGO=9001002,DIC(0)="E" K DD,D0 D FILE^DICN
  1.  S BLRX=+Y
  1.  Q