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

BLRPRE18.m

Go to the documentation of this file. 
  1. BLRPRE18 ; IHS/HQW/TPF - ENVIRONMENT CHECK FOR PATCH 18; [ 06/03/2003  8:35 AM ]
  1.  ;;5.2T8;LR;**1018**;Oct 27, 2004
  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.  D BMES^XPDUTL("Must have Order Entry/Results Reporting....")
  1.  I '$O(^DIC(9.4,"B","ORDER ENTRY/RESULTS REPORTING","")) D SORRY Q
  1.  D BMES^XPDUTL("Order Entry/Results Reporting found. OK")
  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.  ;CHECK FOR NLT VERSION LEVEL
  1.  ;S X=$O(^DIC(9.4,"B","NATIONAL LABORATORY TEST",0))
  1.  ;I X="" D SORRY Q
  1.  ;S X=$P($G(^DIC(9.4,X,"VERSION")),U)
  1.  ;D BMES^XPDUTL("Need at least 'NATIONAL LABORATORY TEST' Version 5.254 ...... "_X_" Present")
  1.  ;I X<"5.254" D SORRY Q
  1.  ;
  1.  ;CHECK FOR ICPT VERSION LEVEL
  1.  ;S X=$O(^DIC(9.4,"B","CPT/HCPCS CODES",0))
  1.  ;I X="" D SORRY Q
  1.  ;S X=$P($G(^DIC(9.4,X,"VERSION")),U)
  1.  ;D BMES^XPDUTL("Need at least 'ICPT' Version 6.0 ......"_X_" Present")
  1.  ;I X<"6.0" D SORRY Q
  1.  ;
  1. VERSION ;
  1.  ;CHECK FOR PREVIOUS PATCH NEEDED
  1.  S %=$D(^XPD("9.7","B","LR*5.2*1016"))
  1.  I '% D  Q
  1.  . D BMES^XPDUTL("Patch 1018 of version 5.2 of the RPMS Laboratory Package")
  1.  . D BMES^XPDUTL("Cannot Be Installed Unless")
  1.  . D BMES^XPDUTL("Patch 1016 of version 5.2 Has Been Previously Installed.")
  1.  . D SORRY
  1.  ;
  1.  ;GET INSTALL STATUS
  1.  S %=$O(^XPD("9.7","B","LR*5.2*1016",""))
  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 1016 not complete!")
  1.  .D SORRY
  1.  ;
  1.  D BMES^XPDUTL("Patch 1016 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. 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 1018 install!")
  1.  D BMES^XPDUTL("Please print/capture this screen and notify")
  1.  D BMES^XPDUTL("the Help Desk")
  1.  Q
  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.  ;RESET ^LR("BLRA" FOR NEW STRUCTURE -- IF AND ONLY IF Patch 18 has not been installed before.
  1.  ; E-SIG sites are the only ones effected by this.
  1. POST ;
  1.  NEW LAB18,LAB18C
  1.  ;
  1.  S LAB18=$O(^XPD("9.7","B","LR*5.2*1018",""))              ; Get Patch Pointer
  1.  ; Post Install Completion Date
  1.  I $G(LAB18) S LAB18C=$P($G(^XPD(9.7,LAB18,"INIT",1,0)),"^",2)
  1.  I $G(LAB18C) D  Q
  1.  . D BMES^XPDUTL("Post Install (LAB18C) -- Lab Patch 18 has been installed before.")
  1.  . D BMES^XPDUTL("BLRTEMP global not updated.")
  1.  ;
  1.  I $D(^BLRTEMP("BLRA"))>0 D  Q              ; If temp global exists, quit
  1.  . D BMES^XPDUTL("Post Install (BLRTEMP) -- Lab Patch 18 has been installed before.")
  1.  . D BMES^XPDUTL("BLRTEMP global not updated.")
  1.  ;
  1.  I $D(^LR("BLRA"))=0  D  Q
  1.  . D BMES^XPDUTL("Post Install (BLRA) -- There is no E-SIG data on this site.")
  1.  . D BMES^XPDUTL("BLRTEMP global not created.")
  1.  ;
  1.  D BMES^XPDUTL("Post Install -- Lab Patch 18 has not been installed before.")
  1.  D BMES^XPDUTL("BLRTEMP Global Being Created.")
  1.  ;
  1.  M ^BLRTEMP("BLRA")=^LR("BLRA")
  1.  K ^LR("BLRA")
  1.  S BLRAPRAC=""
  1.  F  S BLRAPRAC=$O(^BLRTEMP("BLRA",BLRAPRAC)) Q:BLRAPRAC=""  D
  1.  .S BLRASTAT=""
  1.  .F  S BLRASTAT=$O(^BLRTEMP("BLRA",BLRAPRAC,BLRASTAT)) Q:BLRASTAT=""  D
  1.  ..S BLRAIVDT=""
  1.  ..F  S BLRAIVDT=$O(^BLRTEMP("BLRA",BLRAPRAC,BLRASTAT,BLRAIVDT)) Q:BLRAIVDT=""  D
  1.  ...S BLRADFN=""
  1.  ...F  S BLRADFN=$O(^BLRTEMP("BLRA",BLRAPRAC,BLRASTAT,BLRAIVDT,BLRADFN)) Q:BLRADFN=""  D
  1.  ....S BLRASS=$G(^BLRTEMP("BLRA",BLRAPRAC,BLRASTAT,BLRAIVDT,BLRADFN))
  1.  ....Q:BLRASS=""
  1.  ....S ^LR("BLRA",BLRAPRAC,BLRASTAT,BLRAIVDT,BLRADFN,BLRASS)=BLRASS
  1.  ;DO NOT KILL ^BLRTEMP IN CASE SOMETHING HAPPENED AND WE NEED IT LATER TO RESTORE DATA
  1.  ;
  1.  Q