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

BLRPRE21.m

Go to the documentation of this file. 
  1. BLRPRE21 ; IHS/OIT/MKK - LAB PATCH 21 ENVIRONMENT/POST INSTALL ROUTINE ; [11/03/2005 9:30 PM]
  1.  ;;5.2;LR;**1021**;Jul 27, 2006
  1.  ;;1.0;BLR REFERENCE LAB;;MAR 14, 2005
  1.  ;
  1.  ;
  1. PRECHK ; EP
  1.  D BMES^XPDUTL("Beginning of Pre Check.")
  1.  NEW STR      ; String variable -- used for messages.
  1.  ;
  1.  S $P(LINE,"*",81)=""
  1.  S XPDNOQUE="NO QUE"  ;NO QUEUING ALLOWED
  1.  ;
  1.  ; DISABLE THE "Disable options..." and "Move routines..."
  1.  ; questions from being asked during install
  1.  S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
  1.  ;
  1.  S XPDDIQ("XPO1")=0  ;DISABLE "Rebuild Menu Tree" question
  1.  S XPDABORT=0
  1.  ;
  1. USERID ;
  1.  ; CHECK FOR USER ID
  1.  I '$G(DUZ) D SORRY("DUZ UNDEFINED OR 0!")  Q
  1.  ;
  1.  I '$L($G(DUZ(0))) D SORRY("DUZ(0) UNDEFINED OR NULL!")  Q
  1.  ;
  1.  D HOME^%ZIS,DT^DICRW
  1.  S X=$P($G(^VA(200,DUZ,0)),U)
  1.  I $G(X) D SORRY("Installer cannot be identified!")  Q
  1.  ;
  1. LETSGO ;
  1.  ; USER IDENTIFIED -- LET'S GO
  1.  D MES^XPDUTL("Hello, "_$P(X,",",2)_" "_$P(X,","))
  1.  ;
  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. FILEMAN ;
  1.  ; CHECK FOR FILEMAN 22.0
  1.  S X=$G(^DD("VERSION"))
  1.  D BMES^XPDUTL("Need at least FileMan 22.0")
  1.  I X<22 D SORRY("Need FileMan 22.0 & FileMan "_X_" found!")  Q
  1.  D OKAY("FileMan "_X_" found.")
  1.  ;
  1. KERNEL ;
  1.  ; CHECK FOR KERNEL 8.0
  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.")
  1.  I X<8.0 D SORRY("Need Kernel 8.0 & Kernel "_X_" found!")  Q
  1.  D OKAY("Kernel "_X_" found.")
  1.  ;
  1. LMIMAIL ;
  1.  ; CHECK FOR LMI MAIL GROUP
  1.  D BMES^XPDUTL("Must have 'LMI' mail group present.")
  1.  I $$CHECKLMI<0 D SORRY("'LMI' mail group NOT found!")  Q
  1.  D OKAY("'LMI' mail group found.")
  1.  ;
  1. OERR ;
  1.  ; CHECK FOR OERR
  1.  D BMES^XPDUTL("Must have Order Entry/Results Reporting.")
  1.  I '$O(^DIC(9.4,"B","ORDER ENTRY/RESULTS REPORTING","")) D  Q
  1.  . D SORRY("Order Entry/Results Reporting NOT found!")
  1.  D OKAY("Order Entry/Results Reporting found.")
  1.  ;
  1. PIMS ;
  1.  ; CHECK FOR PIMS 5.3
  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.")
  1.  I X<5.3 D SORRY("Need PIMS 5.3 & PIMS "_X_" found!") Q
  1.  D OKAY("PIMS "_X_" found.")
  1.  ;
  1. LEXICON ;
  1.  ; CHECK FOR LEXICON 2.0
  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.")
  1.  I X<2.0 D SORRY("Need LEXICON 2.0 & LEXICON "_X_" found!") Q
  1.  D OKAY("LEXICON "_X_" found.")
  1.  ;
  1. GIS ;
  1.  ; CHECK FOR GIS 3.01
  1.  S X=$G(^DIC(9.4,$O(^DIC(9.4,"C","GIS",0)),"VERSION"))
  1.  D BMES^XPDUTL("Need at least GIS 3.01.")
  1.  I X<3.01 D SORRY("Need GIS 3.01 & GIS "_X_" found!") Q
  1.  D OKAY("GIS "_X_" found.")
  1.  ;
  1. GIS11 ;
  1.  ; CHECK FOR GIS 3.01 Patch 11
  1.  I $$GISPATCH(11)'["Y" D SORRY("GIS 3.01 Patch 11 IS NOT installed!")  Q
  1.  D OKAY("GIS 3.01 Patch 11 found.")
  1.  ;
  1. GIS13 ;
  1.  ; CHECK FOR GIS 3.01 Patch 13
  1.  I $$GISPATCH(13)'["Y" D SORRY("GIS 3.01 Patch 13 IS NOT installed!")  Q
  1.  D OKAY("GIS 3.01 Patch 13 found.")
  1.  ;
  1. GIS14 ;
  1.  ; CHECK FOR GIS 3.01 Patch 14
  1.  I $$GISPATCH(14)'["Y" D SORRY("GIS 3.01 Patch 14 IS NOT installed!")  Q
  1.  D OKAY("GIS 3.01 Patch 14 found.")
  1.  ;
  1. LABVER ;
  1.  ;CHECK FOR PREVIOUS LAB PATCH NEEDED
  1.  D BMES^XPDUTL("Need Lab Patch LR*5.2*1020 installed.")
  1.  I $$LABPATCH(1020)'["Y" D SORRY("Patch 1020 WAS NOT installed!")  Q
  1.  D OKAY("Lab Patch 1020 found.")
  1.  ;
  1. ENVOK ;
  1.  ; ENVIRONMENT OK
  1.  D BMES^XPDUTL("ENVIRONMENT OK.")
  1.  ;
  1. BACKUPS ;
  1.  ; CHECK TO CONFIRM BACKUPS HAVE BEEN DONE
  1.  D BMES^XPDUTL("BACKUPS Check Next.")
  1.  ;
  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  Q
  1.  . D SORRY("Please perform a successful backup before continuing!!")
  1.  ;
  1.  S %DT="R",X="NOW" D ^%DT X ^DD("DD")
  1.  S STR="BACKUPS CONFIRMED BY "_$P($G(^VA(200,DUZ,0)),U)_" ON "
  1.  S STR=STR_$P(Y,"@")_" AT "_$P(Y,"@",2)
  1.  D BMES^XPDUTL(STR)
  1.  D MES^XPDUTL(" ")
  1.  ;
  1.  ; Store backup confirmation person & date/time
  1.  NEW CP,BCKUPCNT                  ; Current Patch,Backup count
  1.  S CP=$TR($P($T(+2),";",5),"*")   ; Current Patch
  1.  S BCKUPCNT=1+$O(^BLRINSTL("LAB PATCH",CP,"BACKUP CONFIRMED BY",""),-1)
  1.  S ^BLRINSTL("LAB PATCH",CP,"BACKUP CONFIRMED BY",BCKUPCNT)=$P($G(^VA(200,DUZ,0)),U)
  1.  S ^BLRINSTL("LAB PATCH",CP,"BACKUP CONFIRMED BY",BCKUPCNT,"DATE/TIME")=$$HTE^XLFDT($H,"5Z")
  1.  Q
  1.  ;
  1. SORRY(MSG,MODE) ;
  1.  ; MESSAGE TO DISPLAY WHEN SOMETHING GOES WRONG
  1.  NEW MESSAGE
  1.  I $G(MODE)'["NONFATAL" D
  1.  . S MESSAGE="Install Aborting due to the following Systems Environment issue:"
  1.  . S XPDABORT=1
  1.  ;
  1.  I $G(MODE)["NONFATAL" S MESSAGE="*** WARNING *** WARNING *** WARNING ***"
  1.  ;
  1.  K DIFQ
  1.  ;
  1.  NEW STR
  1.  S STR(1)=""
  1.  S STR(2)=$TR($J("",65)," ","*")    ; Row of asterisks
  1.  S STR(3)=" "
  1.  S STR(4)=$$CJ^XLFSTR("Site: "_$$LOC^XBFUNC,65)
  1.  S STR(5)=" "
  1.  S STR(6)=$$CJ^XLFSTR(MESSAGE,65)
  1.  S STR(7)=" "
  1.  S STR(8)=$$CJ^XLFSTR(">>> "_MSG_" <<<",65)
  1.  S STR(9)=" "
  1.  S STR(10)=$$CJ^XLFSTR("Please print/capture this screen and",65)
  1.  S STR(11)=$$CJ^XLFSTR("notify the Support Center at",65)
  1.  S STR(12)=""
  1.  S STR(13)=$$CJ^XLFSTR("1-999-999-9999.",65)
  1.  S STR(14)=" "
  1.  S STR(15)=$G(STR(2))               ; Row of asterisks
  1.  S STR(16)=""
  1.  D BMES^XPDUTL(.STR)
  1.  ;
  1.  ; Send alert to LMI MAIL GROUP
  1.  I $G(MODE)["NONFATAL" S XQAMSG="Lab Patch 21 "_MODE_" - "_MSG
  1.  I $G(MODE)'["NONFATAL" S XQAMSG="Lab Patch 21 >> FATAL >> "_MSG
  1.  S XQA("G.LMI")=""
  1.  D SETUP^XQALERT
  1.  Q
  1.  ;
  1. OKAY(MSG,TAB) ;
  1.  ; MESSAGE WITH "OK" AT THE END
  1.  NEW MESSAGE
  1.  I $G(TAB)="" S TAB=5
  1.  S MESSAGE=$J("",TAB)_MSG_" OK."
  1.  D MES^XPDUTL(MESSAGE)
  1.  Q
  1.  ;
  1. CHECKLMI() ;
  1.  ; CHECK FOR LMI MAIL GROUP
  1.  S DIC="^XMB(3.8,"
  1.  S X="LMI"
  1.  D ^DIC
  1.  Q +Y
  1.  ;
  1. POSTCHK ; cmi/anch/maw - BLR Reference Lab Post Init ;
  1. POST     ; PEP - Main Routine Driver
  1.  ; POST INSTALL
  1.  D BMES^XPDUTL("Beginning Lab Patch 1021 POST INSTALL.")
  1.  D MES^XPDUTL(" ")
  1.  ;
  1.  D ADDMENU                   ; Add BLREFLABLMENU to BLRMENU
  1.  ;
  1.  ; D REFLGLOI                ; Will NOT be needed after Beta testing
  1.  ;
  1.  D CHNGAUTO                  ; Change AUTO INSTRUMENT File
  1.  ;
  1.  ; Give User instructions on how to enter Reference Lab parameters.
  1.  ; D BMES^XPDUTL(" ")
  1.  ; D BMES^XPDUTL($$CJ^XLFSTR("***--->>> NOTICE <<<---***",70))
  1.  ; D BMES^XPDUTL("Use the Reference Lab Site Parameter Add/Edit menu to Set Up Ref Lab.")
  1.  ; D BMES^XPDUTL(" ")
  1.  D POSTDONE
  1.  D BMES^XPDUTL("End of Lab Patch 1021 POST INSTALL.")
  1.  D BMES^XPDUTL(" ")
  1.  ;
  1.  ; Store # of times instllation occurred as well as person & date/time
  1.  NEW CP,INSTCNT                   ; Current Patch,Installation count
  1.  S CP=$TR($P($T(+2),";",5),"*")   ; Current Patch
  1.  S INSTCNT=1+$O(^BLRINSTL("LAB PATCH",CP,"INSTALLED BY",""),-1)
  1.  S ^BLRINSTL("LAB PATCH",CP,"INSTALLED BY",INSTCNT)=$P($G(^VA(200,DUZ,0)),U)
  1.  S ^BLRINSTL("LAB PATCH",CP,"INSTALLED BY",INSTCNT,"DATE/TIME")=$$HTE^XLFDT($H,"5Z")
  1.  ;	
  1.  Q
  1.  ;
  1. CHNGAUTO ;
  1.  ; IHS Modifications to the AUTO INSTRUMENT file
  1.  ; 
  1.  ; Delete Programmer only access to FILE BUILD ENTRY field
  1.  I $G(^DD(62.4,93,0))["K:$L(X)>8!($L(X)<1)!'(X?1A.7AN) X" D
  1.  . S STR="^DD(62.4,93,9)"
  1.  . S @STR=""
  1.  ;
  1.  ; If FILE BUILD ENTRY field damaged by previous Patch 21 install, correct it
  1.  I $G(^DD(62.4,93,0))'["K:$L(X)>8!($L(X)<1)!'(X?1A.7AN) X" D
  1.  . S STR="^DD(62.4,93,0)"
  1.  . S @STR="FILE BUILD ENTRY^F^^9;3^K:$L(X)>8!($L(X)<1)!'(X?1A.7AN) X"
  1.  ;
  1.  ; Delete Programmer only access on FILE BUILD ROUTINE field
  1.  I $G(^DD(62.4,94,0))["K:$L(X)>8!($L(X)<1)!'(X?1A.7AN) X" D
  1.  . S STR="^DD(62.4,94,9)"
  1.  . S @STR=""
  1.  ;
  1.  ; If FILE BUILD ROUTINE field damaged by previous Patch 21 install, correct it
  1.  I $G(^DD(62.4,94,0))'["K:$L(X)>8!($L(X)<1)!'(X?1A.7AN) X" D
  1.  . S STR="^DD(62.4,94,0)"
  1.  . S @STR="FILE BUILD ROUTINE^F^^9;4^K:$L(X)>8!($L(X)<1)!'(X?1A.7AN) X"
  1.  ;
  1.  ; Delete Programmer only acces on PARAM 1 field
  1.  I $G(^DD(62.41,2,0))["K:$L(X)>100!($L(X)<2)!(X[U) X D:$D(X) ^DIM" D
  1.  . S STR="^DD(62.41,2,9)"
  1.  . S @STR=""
  1.  ;
  1.  ; If PARAM 1 field damaged by previous Patch 21 install, correct it
  1.  I $G(^DD(62.41,2,0))'["K:$L(X)>100!($L(X)<2)!(X[U) X D:$D(X) ^DIM" D
  1.  . S STR="^DD(62.41,2,0)"
  1.  . S @STR="PARAM 1^FX^^0;2^K:$L(X)>100!($L(X)<2)!(X[U) X D:$D(X) ^DIM"
  1.  ;
  1.  Q
  1.  ;
  1. POSTDONE ;
  1.  ; POST INSTALL COMPLETE
  1.  X ^%ZOSF("EOFF")
  1.  D EN^XBVK("BLR")
  1.  ;
  1.  ; Send alert
  1.  ; S XQAMSG="Use the Reference Lab Site Parameter Add/Edit menu to Set Up Ref Lab."
  1.  ; S XQA("G.LMI")=""
  1.  ; D SETUP^XQALERT
  1.  ;
  1.  ; Send alert
  1.  S XQAMSG="Lab Patch 21 Install Completed"
  1.  S XQA("G.LMI")=""
  1.  D SETUP^XQALERT
  1.  ;
  1.  Q
  1.  ;
  1. ADDMENU ;
  1.  ; ADD REFERENCE LAB MEN TO BLRMENU
  1.  NEW HEREYAGO
  1.  ;
  1.  D BMES^XPDUTL("Adding BLRREFLABMENU to BLRMENU.")
  1.  ;
  1.  S HEREYAGO=$$ADD^XPDMENU("BLRMENU","BLRREFLABMENU","REFL")
  1.  ;
  1.  I HEREYAGO=1 D
  1.  . D OKAY("BLRREFLABMENU added to BLRMENU.")
  1.  ;
  1.  I HEREYAGO'=1 D
  1.  . S HEREYAGO=$P($$UP^XLFSTR(HEREYAGO),"^",2)      ; Uppercase Error Message
  1.  . D TABMENU("Error in adding BLRREFLABMENU to BLRMENU.")
  1.  . I $L(HEREYAGO)>0 D TABMENU("Error Message: "_$P(HERYAGO,"^",2),10)
  1.  ;
  1.  D BMES^XPDUTL("Adding BLR REFLAB REPRINT SHIP MAN to BLRREFLABMENU.")
  1.  S HEREYAGO=$$ADD^XPDMENU("BLRREFLABMENU","BLR REFLAB REPRINT SHIP MAN","REP")
  1.  ;
  1.  I HEREYAGO=1 D
  1.  . D OKAY("BLR REFLAB REPRINT SHIP MAN added to BLRREFLABMENU.")
  1.  ;
  1.  I HEREYAGO'=1 D
  1.  . S HEREYAGO=$P($$UP^XLFSTR(HEREYAGO),"^",2)      ; Uppercase Error Message
  1.  . D TABMENU("Error in adding BLR REFLAB REPRINT SHIP MAN to BLRREFLABMENU.")
  1.  . I $L(HEREYAGO)>0 D TABMENU("Error Message: "_$P(HERYAGO,"^",2),10)
  1.  ;
  1.  D BMES^XPDUTL("Adding BLR EDIT LABORATORY TEST FILE to BLRREFLABMENU.")
  1.  S HEREYAGO=$$ADD^XPDMENU("BLRREFLABMENU","BLR EDIT LABORATORY TEST FILE","E60")
  1.  ;
  1.  I HEREYAGO=1 D
  1.  . D OKAY("BLR EDIT LABORATORY TEST FILE added to BLRREFLABMENU.")
  1.  ;
  1.  I HEREYAGO'=1 D
  1.  . S HEREYAGO=$P($$UP^XLFSTR(HEREYAGO),"^",2)      ; Uppercase Error Message
  1.  . D TABMENU("Error in adding BLR EDIT LABORATORY TEST FILE to BLRREFLABMENU.")
  1.  . I $L(HEREYAGO)>0 D TABMENU("Error Message: "_$P(HERYAGO,"^",2),10)
  1.  ;
  1.  D MES^XPDUTL(" ")
  1.  ;
  1.  Q
  1.  ;
  1. TABMENU(MSG,TAB,TAIL) ;
  1.  ; GENERIC MESSAGE OUTPUT
  1.  NEW MESSAGE
  1.  I $G(TAB)="" S TAB=5
  1.  S MESSAGE=$J("",TAB)_MSG
  1.  I $G(TAIL)'="" S MESSAGE=MESSAGE_" "_TAIL
  1.  D MES^XPDUTL(MESSAGE)
  1.  Q
  1.  ;
  1.  ; CHECK FOR GIS Patches
  1. GISPATCH(CHK) ;
  1.  NEW PAT,PATCH,GISPTR,OKGIS,OKPATCH
  1.  S GISPTR=$O(^DIC(9.4,"C","GIS",0))
  1.  S PAT="",OKPATCH="NO"
  1.  F  S PAT=$O(^DIC(9.4,GISPTR,22,PAT))  Q:PAT=""!(OKPATCH["Y")  D
  1.  . S PATCH=""
  1.  . F  S PATCH=$O(^DIC(9.4,GISPTR,22,PAT,"PAH",PATCH))  Q:PATCH=""!(OKPATCH["Y")  D
  1.  .. I +$G(^DIC(9.4,GISPTR,22,PAT,"PAH",PATCH,0))[CHK S OKPATCH="YES"
  1.  Q OKPATCH
  1.  ;
  1.  ; CHECK FOR LAB Patches
  1. LABPATCH(CHK) ;
  1.  NEW PAT,PATCH,LABPTR,OKLAB,OKPATCH
  1.  S LABPTR=$O(^DIC(9.4,"C","LR",0))
  1.  S PAT="",OKPATCH="NO"
  1.  F  S PAT=$O(^DIC(9.4,LABPTR,22,PAT))  Q:PAT=""!(OKPATCH["Y")  D
  1.  . S PATCH=""
  1.  . F  S PATCH=$O(^DIC(9.4,LABPTR,22,PAT,"PAH",PATCH))  Q:PATCH=""!(OKPATCH["Y")  D
  1.  .. I $G(^DIC(9.4,LABPTR,22,PAT,"PAH",PATCH,0))[CHK S OKPATCH="YES"
  1.  Q OKPATCH