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

BLRPRE20.m

Go to the documentation of this file. 
  1. BLRPRE20 ; IHS/ITSC/MKK - ENVIRONMENT CHECK FOR PATCH 20; [ 07/22/2005 ]
  1.  ;;5.2;LR;**1020**;Sep 13, 2005
  1.  ;
  1.  NEW CP                      ; Current Patch
  1.  S CP=$TR($P($T(+2),";",5),"*")
  1.  ;
  1.  NEW LRSTATUS                ; Install Status
  1.  ;
  1.  S $P(LINE,"*",81)=""
  1.  S XPDNOQUE="NO QUE"  ;NO QUEUING ALLOWED
  1.  ; DISABLE THE "Disable options..." and "Move routines..."
  1.  ; questions from being asked during install     
  1.  S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
  1.  S XPDDIQ("XPO1")=0  ;DISABLE "Rebuild Menu Tree" question
  1.  S XPDABORT=0
  1.  ;
  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.  D BMES^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.  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.  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.  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.  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.  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.  ; First, make sure Lexicon, in some form, exists
  1.  S X=$O(^DIC(9.4,"C","LEX",0))
  1.  I $G(X)="" D  Q
  1.  . D BMES^XPDUTL("Must have Lexicon.")
  1.  . D SORRY("Need LEXICON and LEXICON NOT FOUND!")
  1.  ;
  1.  ; Now, check the Lexicon version number
  1.  S X=$G(^DIC(9.4,$O(^DIC(9.4,"C","LEX",0)),"VERSION"))
  1.  I X="" S X="Version Number NOT"
  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.  ; Check for the existance of the REPORTABLE LAB TESTS dictionary.
  1.  ; If it exists & current patch  has NOT installed successfully, quit
  1.  S LRSTATUS=""
  1.  S %=$O(^XPD(9.7,"B","LR*5.2*"_CP,""))     ; Check if 1020 already installed.
  1.  I %'="" S LRSTATUS=$P($G(^XPD(9.7,%,0)),U,9)
  1.  I $D(^DD(90475))>0&(LRSTATUS'=3) D SORRY("DD 90475 Exists Prior to Install.")  Q
  1.  ;
  1.  ; Check for the existance of the LAB PROV LOC CHANGE dictionary.
  1.  ; If it exists & current patch  has NOT installed successfully, quit
  1.  I $D(^DD(90475.2))>0&(LRSTATUS'=3) D SORRY("DD 90475.2 Exists Prior to Install.")  Q
  1.  ;
  1. VERSION ;
  1.  ;CHECK FOR PREVIOUS PATCH NEEDED
  1.  NEW LASTPTCH
  1.  S LASTPTCH=+$TR($P($T(+2),";",5),"*")-1
  1.  D BMES^XPDUTL("Need Lab Patch "_LASTPTCH_" to have been installed.")
  1.  I $D(^XPD(9.7,"B","LR*5.2*"_LASTPTCH))<1 D SORRY("Patch "_LASTPTCH_" WAS NOT installed!")  Q
  1.  ;
  1.  ;GET INSTALL STATUS
  1.  NEW LRSTATUS
  1.  S LRSTATUS=0
  1.  S %=$O(^XPD(9.7,"B","LR*5.2*"_LASTPTCH,""))
  1.  I %'="" S LRSTATUS=$P($G(^XPD(9.7,%,0)),U,9)
  1.  I LRSTATUS'=3 D  Q
  1.  . D SORRY("Install of Lab Patch "_LASTPTCH_" NOT complete.  Status: "_LRSTATUS_"!")
  1.  ;
  1.  D OKAY("Lab Patch "_LASTPTCH_" installed & Status complete.")
  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.  D ^XBFMK
  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 continuing!!") 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(CP,"INSTALLED BY")=$P($G(^VA(200,DUZ,0)),U)
  1.  ;
  1.  Q
  1.  ;
  1. SORRY(MSG,MODE)       ;
  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)," ","*")
  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))
  1.  S STR(16)=""
  1.  D BMES^XPDUTL(.STR)
  1.  ;
  1.  S XQAMSG="FATAL >> "_MSG
  1.  I $G(MODE)["NONFATAL" S XQAMSG=MODE_" - "_MSG
  1.  S XQA("G.LMI")=""
  1.  D SETUP^XQALERT
  1.  Q
  1.  ;
  1. OKAY(MSG,TAB)       ;
  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.  ;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-INSTALL
  1. POST ;
  1.  NEW CP                      ; Current Patch
  1.  S CP=$TR($P($T(+2),";",5),"*")
  1.  ;
  1.  NEW CRLF     ; Carriage-Return-Line-Feed
  1.  S CRLF=$C(13)_$C(10)
  1.  ;
  1.  D BMES^XPDUTL("Laboratory Patch "_CP_" POST INSTALL...")
  1.  ;
  1.  D LABFIXLU   ; Fix lookup in COMPUTED AGE field
  1.  ; 
  1.  D LAB60FIX   ; Fix File 60's invalid Urgency entries.
  1.  ;
  1.  ; Add Options to the BLRMENU
  1.  D BMES^XPDUTL("     Updating OPTIONS")
  1.  D ADDBMENU("BLREPOLR","EDT")     ; Change Provider/Location Menu
  1.  D ADDBMENU("BLRSHDRC","SHDR")    ; State Health Dept Report
  1.  D OKAY("Updating OPTIONS.",5)
  1.  ;
  1.  ; Change the Default maximum Max Order Freq of ordering tests to 365.
  1.  D CHNGMOFD
  1.  ; 
  1.  D BMES^XPDUTL("Laboratory Patch "_CP_" POST INSTALL complete."_CRLF_CRLF)
  1.  ;
  1.  S XQAMSG="Laboratory Patch "_CP_" INSTALL complete."
  1.  S XQA("G.LMI")=""
  1.  D SETUP^XQALERT
  1.  Q
  1.  ;
  1. LABFIXLU ;
  1.  ; Fix issue with strange things occurring when people use FileMan
  1.  ; to look up Lab Data and want computed values.  This is a flaw in the
  1.  ; lookup routine.  Need to change the "NMF" below to "INMF"
  1.  ; ^DD(63.04,999999901,9.3)=X ^DD(63.04,999999901,9.2) S Y=$P(Y(63.04,999999901,1),
  1.  ; VU,3) X:$D(^DD(63,.03,2)) ^(2) S X=Y K DIC S DIC="^AUPNPAT(",DIC(0)="NMF" D ^DIC
  1.  ; S (D,D0)=+Y
  1.  ;
  1.  I $D(^DD(63.04,999999901,9.3))<1 Q    ; If it doesn't exist, skip
  1.  ;
  1.  ; If field doesn't exist, skip
  1.  I $P($G(^DD(63.04,999999901,9.3)),$C(34),4)="" Q
  1.  ;
  1.  D BMES^XPDUTL("     Correcting ^DD(63.04,999999901,9.3) entry")
  1.  I $P($G(^DD(63.04,999999901,9.3)),$C(34),4)="INMF" D
  1.  . D OKAY("^DD(63.04,999999901,9.3) entry Already Corrected.",10)
  1.  I $P($G(^DD(63.04,999999901,9.3)),$C(34),4)'="INMF" D
  1.  . S $P(^DD(63.04,999999901,9.3),$C(34),4)="INMF"  ; Ignore special lookup
  1.  . D OKAY("^DD(63.04,999999901,9.3) entry Corrected.",10)
  1.  ;
  1.  Q
  1.  ;
  1. LAB60FIX ;
  1.  ; Fix File 60's invalid Urgency entries.  Left over from 
  1.  ; 5.1 to 5.2 Upgrade, I believe.
  1.  ;
  1.  D BMES^XPDUTL("     Checking File 60 (Laboratory Test) for invalid")
  1.  D MES^XPDUTL("     HIGHEST URGENCY ALLOWED entries.")
  1.  ;
  1.  NEW IEN,CNT
  1.  S IEN="",CNT=0
  1.  F  S IEN=$O(^LAB(60,IEN))  Q:IEN=""!(CNT>0)  D
  1.  . I $P($G(^LAB(60,IEN,0)),"^",16)'=2 Q     ; 2 is invalid.
  1.  . ;
  1.  . S $P(^LAB(60,IEN,0),"^",16)=9       ; Set to ROUTINE urgency
  1.  ;
  1.  I CNT<1 D OKAY("No invalid HIGHEST URGENCY ALLOWED entries detected.",10)
  1.  ;
  1.  I CNT=1 D       ; Single change verbage
  1.  . S STR="          In File 60 (Laboratory Test) there was "_CNT_CRLF
  1.  . S STR=STR_"          invalid HIGHEST URGENCY ALLOWED entry."_CRLF
  1.  . S STR=STR_"          This URGENCY has been changed to ROUTINE.  OK."_CRLF
  1.  ;
  1.  I CNT>1 D       ; Multiple change verbage
  1.  . S STR="          In File 60 (Laboratory Test) there were "_CNT_CRLF
  1.  . S STR=STR_"          invalid HIGHEST URGENCY ALLOWED entries."_CRLF
  1.  . S STR=STR_"          They have been changed to ROUTINE.  OK."_CRLF
  1.  ;
  1.  I CNT>0 D MES^XPDUTL(STR)
  1.  ;
  1.  Q
  1.  ;
  1.  ; Add item to BLRMENU
  1. ADDBMENU(ADDM,SYNM) ;
  1.  NEW FDA,ERR,HEREYAGO,MIEN,BLRIEN
  1.  ;
  1.  D MES^XPDUTL("          Adding "_ADDM_" to BLRMENU.")
  1.  ;
  1.  ; First, Get BLRMENU IEN
  1.  D FIND^DIC(19,"","","","BLRMENU","","","","","HEREYAGO")
  1.  S BLRIEN=$G(HEREYAGO("DILIST",2,1))
  1.  ;
  1.  ; Cleanup
  1.  D ^XBFMK
  1.  K HEREYAGO
  1.  ;
  1.  ; Next, get IEN for Option
  1.  D FIND^DIC(19,"","","",ADDM,"","","","","HEREYAGO")
  1.  S MIEN=$G(HEREYAGO("DILIST",2,1))
  1.  ;
  1.  ; Make sure OPTION exists
  1.  I $G(MIEN)="" D SORRY("Could not find "_ADDM_" Option","NONFATAL")  Q
  1.  ;
  1.  ; Now, check to see if Option already there -- if so, Quit
  1.  I $D(^DIC(19,BLRIEN,10,"B",MIEN)) D  Q
  1.  . D OKAY(ADDM_" already on BLRMENU.  No further processing.",15)
  1.  ;
  1.  S FDA(42,19,"?1,",.01)="BLRMENU"
  1.  S FDA(42,19.01,"+2,?1,",.01)=MIEN
  1.  S FDA(42,19.01,"+2,?1,",2)=SYNM       ; SYNONYM (1-4 Chars)
  1.  ;
  1.  D UPDATE^DIE("","FDA(42)",,"")
  1.  ;
  1.  I $D(^TMP("DIERR",$J))>0  D  Q
  1.  . D SORRY("Error in adding "_ADDM_" to BLRMENU.  $J="_$J_".","NONFATAL")
  1.  ;
  1.  D OKAY(ADDM_" added to BLRMENU.  $J="_$J_".",15)
  1.  ;
  1.  Q
  1.  ;
  1. CHNGMOFD ;
  1.  NEW SPEC,STR,SUBSTR
  1.  NEW WOTDD
  1.  ;
  1.  D BMES^XPDUTL("     Changing Max Order Freq Default for Lab Tests to 365.")
  1.  S STR=$G(^DD(60.03,4,0))
  1.  S SUBSTR=$P($P($P(STR,"^",5),">",2),")",1)
  1.  I $L(SUBSTR)'=3 D  Q
  1.  . D SORRY("Could not change Max Order Freq Default String","NONFATAL")
  1.  ;
  1.  I +SUBSTR=365 D  Q
  1.  . D OKAY("Max Order Freq Default already 365.",10)
  1.  ;
  1.  I +SUBSTR'=365  D
  1.  . S SPEC(SUBSTR)=365
  1.  . S STR=$$REPLACE^XLFSTR(STR,.SPEC)
  1.  . S WOTDD="^DD(60.03,4,0)"
  1.  . S @WOTDD=STR
  1.  . D OKAY("Changed Max Order Freq Default.",10)
  1.  ;
  1.  K SPEC
  1.  S STR=$G(^DD(60.03,4,3))
  1.  S SUBSTR=$RE($P($RE($P(STR,",",1))," ",1))
  1.  I $L(SUBSTR)'=3 D  Q
  1.  . D SORRY("Could not change Max Order Freq Default HELP String","NONFATAL")
  1.  ;
  1.  I +SUBSTR=365 D
  1.  . D OKAY("Max Order Freq Default HELP String already 365.",10)
  1.  ;
  1.  I +SUBSTR'=365  D
  1.  . S SPEC(SUBSTR)=365
  1.  . S STR=$$REPLACE^XLFSTR(STR,.SPEC)
  1.  . S WOTDD="^DD(60.03,4,3)"
  1.  . S @WOTDD=STR
  1.  . D OKAY("Changed Max Order Freq Default HELP.",10)
  1.  ;
  1.  D OKAY("Max Order Freq Default.")
  1.  ;
  1.  Q