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