BLRPRE22 ; IHS/ITSC/MKK - LAB PATCH 22 ENVIRONMENT/POST INSTALL ROUTINE; [ 03/31/2007 8:00 AM ]
;;5.2;LR;**1022**;September 20, 2007
;
PRECHK ; EP
D BMES^XPDUTL("Beginning of Pre Check.")
NEW CP ; Current Patch
NEW RPMS ; RPMS module being patched
NEW RPMSVER ; Version of RPMS module being patched
NEW STR ; String -- used as an array for messages.
NEW LASTPTCH ; Last Patch of Lab
NEW LRSTATUS ; Last Patch Install Status
NEW WOTERR ; Array of errors detected
;
; Must check for Cache environment before anything else
I $$UP^XLFSTR($$VERSION^%ZOSV(1))'["CACHE" D SORRY("NOT A CACHE ENVIRONMENT.") Q
;
S CP=$TR($P($T(+2),";",5),"*") ; Current Patch
S LASTPTCH=+$TR($P($T(+2),";",5),"*")-1 ; Last Patch
S RPMS=$P($T(+2),";",4) ; RPMS Module
S RPMSVER=$P($T(+2),";",3) ; Version of RPMS module being patched
;
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 ; KIDS install Flag
;
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 ; IO Defaults
D DTNOLF^DICRW ; Set DT variable without doing a Line Feed
;
S X=$P($G(^VA(200,DUZ,0)),U)
I $G(X) D SORRY("Installer cannot be identified!") Q
;
D OKAY("Pre Check complete.",5)
;
LETSGO ; USER IDENTIFIED -- LET'S GO
D BMES^XPDUTL("Hello, "_$P(X,",",2)_" "_$P(X,","))
;
D BMES^XPDUTL("Checking Environment for Patch "_CP_" of Version "_RPMSVER_" of "_RPMS_".")
;
FILEMAN ; CHECK FOR FILEMAN 22.0
D NEEDIT("DI","22.0")
;
KERNEL ; CHECK FOR KERNEL 8.0 & PATCH 1012
D NEEDIT("XU","8.0",1012)
;
LMIMAIL ; CHECK FOR LMI MAIL GROUP
I $$CHECKLMI<1 Q
;
OERR ; CHECK FOR OERR 2.5
D NEEDIT("OR","2.5")
;
PIMS ; CHECK FOR PIMS 5.3 & PATCH 1004
D NEEDIT("PIMS","5.3",1004)
;
APCD ; CHECK FOR APCD 2.0 & PATCH 8
D NEEDIT("APCD","2.0",8)
;
TIU ; CHECK FOR TIU 1.0 & PATCH 137
D NEEDIT("TIU","1.0",137)
;
USR ; CHECK FOR USR 1.0 & PATCH 23
D NEEDIT("USR","1.0",23)
;
LEXICON ; CHECK FOR LEXICON 2.0
D NEEDIT("LEX","2.0")
;
LABVER ; CHECK FOR LAB 5.2 & PREVIOUS PATCH
D NEEDIT("LR","5.2",LASTPTCH)
;
ENVOK ; ENVIRONMENT OK
I XPDABORT<1 D BMES^XPDUTL("ENVIRONMENT OK.")
;
I XPDABORT>0 D SORRYEND
;
Q
;
BACKUPS ; CHECK TO CONFIRM BACKUPS HAVE BEEN DONE
NEW CP ; Current Patch
;
S CP=$TR($P($T(+2),";",5),"*") ; Current Patch
;
D BMES^XPDUTL("BACKUPS Check Next.")
;
W !!
D ^XBFMK ; Clear all FileMan variables
S DIR(0)="Y"
S DIR("B")="NO"
S DIR("A")="Has a SUCCESSFUL system backup been performed??"
D ^DIR
;
; IF and ONLY IF backups not confirmed, send NONFATAL alert & e-mail.
I $D(DIRUT)!($G(Y)=0) D Q
. D SORRY("Please perform a successful backup before continuing!!","NONFATAL")
;
; User stated Backup has been done, so display message.
NEW DTT
S DTT=$$UP^XLFSTR($$HTE^XLFDT($H,"MZ"))
S STR="BACKUPS CONFIRMED BY "_$P($G(^VA(200,DUZ,0)),U)_" ON "
S STR=STR_$P(DTT,"@")_" AT "_$P(DTT,"@",2)
D BMES^XPDUTL(STR)
D MES^XPDUTL(" ")
;
; Store backup confirmation person & date/time
NEW BCKUPCNT ; Current Patch,Backup count
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,"5MZ")
;
Q
;
; Generic "Find RPMS Module's Version and (perhaps) Patch number"
;
; NOTE: The MODULE variable MUST be the PREFIX name
; from the PACKAGE file (9.4).
;
NEEDIT(MODULE,VERSION,PATCH) ; EP
NEW NAME ; NAME of RPMS Module
NEW PTR ; PoinTeR to PACKAGE file
NEW HEREYAGO ; Array to store returned values from FIND^DIC
;
; Use FileMan API to get information
D FIND^DIC(9.4,"","","",MODULE,"","C","","","HEREYAGO")
S PTR=$G(HEREYAGO("DILIST",2,1))
S NAME=$G(HEREYAGO("DILIST",1,1))
;
S X=$$VERSION^XPDUTL(MODULE) ; Get the Version
D BMES^XPDUTL("Need at least "_NAME_" "_VERSION)
I X<VERSION D Q
. D SORRY("Need "_NAME_" "_VERSION_" & "_NAME_" "_X_" found!")
. S WOTERR(MODULE,NAME,VERSION)=""
;
D OKAY(NAME_" "_X_" found.")
;
I $G(PATCH)="" Q ; If no Patch check, just exit
;
D BMES^XPDUTL(" Need "_NAME_" "_VERSION_" Patch "_PATCH_".")
S X=$$PATCH^XPDUTL(MODULE_"*"_VERSION_"*"_PATCH)
I X'=1 D Q
. D SORRY(NAME_" Patch "_PATCH_" WAS NOT installed!")
. S WOTERR(MODULE,NAME,VERSION)=$G(PATCH)
;
D OKAY(NAME_" "_VERSION_" Patch "_PATCH_" found.",10)
;
Q
;
; Error Message routine. It will send an ALERT and a MailMan message
; to the people who are assigned to the LMI Mail group.
; ;
; The output array is built so that the error/warning message will
; also appear on the INSTALL LOG via the D BMES^XPDUTL(.STR) call.
SORRY(MSG,MODE) ;
NEW MESSAGE
I $G(MODE)'["NONFATAL" D
. S MESSAGE="Install Aborting due to the following Systems Environment issue:"
. S XPDABORT=1 ; Fatal Error Flag Set
;
I $G(MODE)["NONFATAL" S MESSAGE="*** WARNING *** WARNING *** WARNING ***"
;
K DIFQ
;
NEW STR,LINECNT
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)=" "
;
I $G(MODE)["NONFATAL" D
. S STR(10)=$$CJ^XLFSTR(MESSAGE,65)
. S STR(11)=" "
. S LINECNT=12
;
I $G(MODE)'["NONFATAL" D
. 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 LINECNT=15
;
S STR(LINECNT)=$G(STR(2)) ; Row of asterisks
S LINECNT=LINECNT+1
S STR(LINECNT)=" "
;
D BMES^XPDUTL(.STR) ; Display the message
;
I $G(MODE)'="NONFATAL" D Q
. D SNDALERT("Laboratory Patch "_CP_" >> FATAL >> "_MSG)
. D SENDMAIL("IHS Lab Patch "_CP_" Install FATAL Error")
;
I $G(MODE)="NONFATAL" D
. D SNDALERT("Laboratory Patch "_CP_" - "_MODE_" - "_MSG)
. D SENDMAIL("IHS Lab Patch "_CP_" Install NONFATAL Error")
Q
;
; Send alert to LMI group
SNDALERT(ALERTMSG) ;
S XQAMSG=ALERTMSG
S XQA("G.LMI")=""
D SETUP^XQALERT
K XQA,XQAMSG
Q
;
; Send MailMan E-mail to LMI group -- message is in the STR array
SENDMAIL(MAILMSG) ;
K XMY
S XMY("G.LMI")="" ; Group
S %DT="T"
S X="NOW"
D ^%DT
D DD^LRX
S LRBLNOW=Y
;
S XMSUB=MAILMSG
S XMTEXT="STR("
S XMDUZ=$P($G(^VA(200,DUZ,0)),U)
;
D ^XMD ; Send the MailMan e-mail
;
K X,XMDUZ,XMSUB,XMTEXT,Y ; Cleanup
Q
;
; Output a listing of ALL the errors detected during
; the environment check.
SORRYEND ;
NEW STR,MODULE,NAME,VERSION,PATCH,LINECNT,TMP
;
D BMES^XPDUTL(" ")
;
S STR(1)=$TR($J("",65)," ","*")
S STR(2)=" "
S STR(3)=$$CJ^XLFSTR("Systems Environment Error Detected",65)
S STR(4)=$$CJ^XLFSTR("KIDS build will be deleted",65)
S STR(5)=" "
S STR(6)=$$CJ^XLFSTR("Modules with Version or Patch errors",65)
S STR(7)=" "
S LINECNT=8
;
; Continue building the STR array that will be displayed via the
; BMES^XPDUTL call.
S (MODULE,NAME,VERSION)=""
F S MODULE=$O(WOTERR(MODULE)) Q:MODULE="" D
. F S NAME=$O(WOTERR(MODULE,NAME)) Q:NAME="" D
.. F S VERSION=$O(WOTERR(MODULE,NAME,VERSION)) Q:VERSION="" D
... S PATCH=$G(WOTERR(MODULE,NAME,VERSION))
... S STR(LINECNT)=$$CJ^XLFSTR(NAME_" ("_MODULE_")",65)
... S LINECNT=LINECNT+1
... S TMP="Version:"_VERSION
... I $G(PATCH)'="" S TMP=TMP_" Patch:"_$G(PATCH)
... S STR(LINECNT)=$$CJ^XLFSTR(TMP,65)
... S LINECNT=LINECNT+1
... S STR(LINECNT)=" "
... S LINECNT=LINECNT+1
S STR(LINECNT)=$$CJ^XLFSTR("Re-Installation will be necessary.",65)
S LINECNT=LINECNT+1
S STR(LINECNT)=" "
S LINECNT=LINECNT+1
S STR(LINECNT)=$$CJ^XLFSTR("If assistance is needed, please call 1-999-999-9999.",65)
S LINECNT=LINECNT+1
S STR(LINECNT)=" "
S LINECNT=LINECNT+1
S STR(LINECNT)=$TR($J("",65)," ","*")
;
D BMES^XPDUTL(.STR) ; Display the message
;
Q
;
; Write out "OKAY" message
OKAY(MSG,TAB) ;
NEW MESSAGE
I $G(TAB)="" S TAB=5
S MESSAGE=$J("",TAB)_MSG_" OK."
D MES^XPDUTL(MESSAGE)
Q
;
;CHECK FOR LMI MAIL GROUP
CHECKLMI() ;
NEW OKAY
D BMES^XPDUTL("Must have 'LMI' mail group present.")
S DIC="^XMB(3.8,"
S X="LMI"
D ^DIC
S OKAY=+Y
I OKAY>0 D OKAY("'LMI' mail group found.")
I OKAY<1 D SORRY("'LMI' mail group NOT found!")
Q OKAY
;
; POST-INSTALL
; Just installs Menu items & changes size of RESULTS
; field in V MICRO and UNIT ID in BLOOD INVENTORY files.
;
; If anything goes wrong, it's NOT fatal -- just keep trucking.
POST ; EP
NEW CP ; Current Patch
S CP=$TR($P($T(+2),";",5),"*")
;
D BMES^XPDUTL("Laboratory Patch "_CP_" POST INSTALL...")
;
D ADDMENU
;
D CHVMICRO
;
D BMES^XPDUTL("Laboratory Patch "_CP_" POST INSTALL complete.")
;
S XQAMSG="Laboratory Patch "_CP_" INSTALL complete."
S XQA("G.LMI")=""
D SETUP^XQALERT
;
; 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),"*")
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
;
; Add OPTION(s) to MENU(s)
; Add option to purge HL7 error messages to BLRMENU
D ADDTMENU("BLRMENU","BLRETPUR","ETP")
;
; If Lab E-SIG menu exists, add new item
I $$LKOPT^XPDMENU("BLRA Lab E-SIG Menu") D ADDTMENU("BLRA Lab E-SIG Menu","BLRA LAB ES REPORTS","RPT")
;
Q
;
; Procedure that really adds the options --
; uses Kernel'S ADD^XPDMENU function
NEW CHKIT
;
D BMES^XPDUTL("Adding "_ADDEE_" to "_ADDER_".")
;
S CHKIT=$$ADD^XPDMENU(ADDER,ADDEE,ITM)
;
I CHKIT=1 D
. D OKAY(ADDEE_" added to "_ADDER_".",5)
. D MES^XPDUTL(" ")
;
I CHKIT'=1 D SORRY("Error in adding "_ADDEE_" to "_ADDER_".","NONFATAL")
;
Q
;
; Generic message output WITH blank line BEFORE messsage & TAB
TABMESG(MSG,TAB,TAIL) ;
NEW MESSAGE
I $G(TAB)="" S TAB=5
S MESSAGE=$J("",TAB)_MSG
I $G(TAIL)'="" S MESSAGE=MESSAGE_" "_TAIL
D BMES^XPDUTL(MESSAGE)
Q
;
; Generic message output WITHOUT blank line BEFORE messsage & TAB
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
;
; Change Maximum string length for the RESULT field in the V MICRO
; file to 80 characters. Permission granted by Lori Butcher.
CHVMICRO ;
NEW SPEC,STR,SUBSTR
NEW WOTDD
;
S STR=$G(^DD(9000010.25,.07,0))
S SUBSTR=$P(STR,"^",5)
;
D TABMESG("Changing RESULT field max string length & HELP in V MICRO file to 80.")
;
I +($P($P(STR,">",2),"!",1))>79 D Q
. D OKAY("RESULT field max string length in V MICRO file already > 79.")
;
I +$L(SUBSTR)<1!($L($P(STR,">",2))<1) D Q
. D SORRY("RESULT field in V MICRO file damaged: examine with FileMan.","NONFATAL")
;
S $P(STR,"^",5)="K:$L(X)>80!($L(X)<1) X"
S WOTDD="^DD(9000010.25,.07,0)"
S @WOTDD=STR
;
I $P($P($G(^DD(9000010.25,.07,0)),">",2),"!",1)'=80 D
. D SORRY("Could not change RESULT field max string length in V MICRO file","NONFATAL")
;
D OKAY("Changed RESULT field max string length in V MICRO file.",10)
;
S WOTDD="^DD(9000010.25,.07,3)"
S STR="Answer must be 1-80 characters in length."
S @WOTDD=STR
;
I $G(^DD(9000010.25,.07,3))'[80 D Q
. D SORRY("Could not change RESULT field HELP in V MICRO file","NONFATAL")
;
D OKAY("Changed RESULT field HELP in V MICRO file.",10)
;
D OKAY("Changed RESULT field max string length & HELP in V MICRO file.")
;
Q
BLRPRE22 ; IHS/ITSC/MKK - LAB PATCH 22 ENVIRONMENT/POST INSTALL ROUTINE; [ 03/31/2007 8:00 AM ]
+1 ;;5.2;LR;**1022**;September 20, 2007
+2 ;
PRECHK ; EP
+1 DO BMES^XPDUTL("Beginning of Pre Check.")
+2 ; Current Patch
NEW CP
+3 ; RPMS module being patched
NEW RPMS
+4 ; Version of RPMS module being patched
NEW RPMSVER
+5 ; String -- used as an array for messages.
NEW STR
+6 ; Last Patch of Lab
NEW LASTPTCH
+7 ; Last Patch Install Status
NEW LRSTATUS
+8 ; Array of errors detected
NEW WOTERR
+9 ;
+10 ; Must check for Cache environment before anything else
+11 IF $$UP^XLFSTR($$VERSION^%ZOSV(1))'["CACHE"
DO SORRY("NOT A CACHE ENVIRONMENT.")
QUIT
+12 ;
+13 ; Current Patch
SET CP=$TRANSLATE($PIECE($TEXT(+2),";",5),"*")
+14 ; Last Patch
SET LASTPTCH=+$TRANSLATE($PIECE($TEXT(+2),";",5),"*")-1
+15 ; RPMS Module
SET RPMS=$PIECE($TEXT(+2),";",4)
+16 ; Version of RPMS module being patched
SET RPMSVER=$PIECE($TEXT(+2),";",3)
+17 ;
+18 ; No Queuing Allowed
SET XPDNOQUE="NO QUE"
+19 ;
+20 ; DISABLE THE "Disable options..." and "Move routines..."
+21 ; questions from being asked during install
+22 SET (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
+23 ;
+24 ; DISABLE "Rebuild Menu Tree" question
SET XPDDIQ("XPO1")=0
+25 ;
+26 ; KIDS install Flag
SET XPDABORT=0
+27 ;
USERID ; CHECK FOR USER ID
+1 IF '$GET(DUZ)
DO SORRY("DUZ UNDEFINED OR 0.")
QUIT
+2 ;
+3 IF '$LENGTH($GET(DUZ(0)))
DO SORRY("DUZ(0) UNDEFINED OR NULL.")
QUIT
+4 ;
+5 ; IO Defaults
DO HOME^%ZIS
+6 ; Set DT variable without doing a Line Feed
DO DTNOLF^DICRW
+7 ;
+8 SET X=$PIECE($GET(^VA(200,DUZ,0)),U)
+9 IF $GET(X)
DO SORRY("Installer cannot be identified!")
QUIT
+10 ;
+11 DO OKAY("Pre Check complete.",5)
+12 ;
LETSGO ; USER IDENTIFIED -- LET'S GO
+1 DO BMES^XPDUTL("Hello, "_$PIECE(X,",",2)_" "_$PIECE(X,","))
+2 ;
+3 DO BMES^XPDUTL("Checking Environment for Patch "_CP_" of Version "_RPMSVER_" of "_RPMS_".")
+4 ;
FILEMAN ; CHECK FOR FILEMAN 22.0
+1 DO NEEDIT("DI","22.0")
+2 ;
KERNEL ; CHECK FOR KERNEL 8.0 & PATCH 1012
+1 DO NEEDIT("XU","8.0",1012)
+2 ;
LMIMAIL ; CHECK FOR LMI MAIL GROUP
+1 IF $$CHECKLMI<1
QUIT
+2 ;
OERR ; CHECK FOR OERR 2.5
+1 DO NEEDIT("OR","2.5")
+2 ;
PIMS ; CHECK FOR PIMS 5.3 & PATCH 1004
+1 DO NEEDIT("PIMS","5.3",1004)
+2 ;
APCD ; CHECK FOR APCD 2.0 & PATCH 8
+1 DO NEEDIT("APCD","2.0",8)
+2 ;
TIU ; CHECK FOR TIU 1.0 & PATCH 137
+1 DO NEEDIT("TIU","1.0",137)
+2 ;
USR ; CHECK FOR USR 1.0 & PATCH 23
+1 DO NEEDIT("USR","1.0",23)
+2 ;
LEXICON ; CHECK FOR LEXICON 2.0
+1 DO NEEDIT("LEX","2.0")
+2 ;
LABVER ; CHECK FOR LAB 5.2 & PREVIOUS PATCH
+1 DO NEEDIT("LR","5.2",LASTPTCH)
+2 ;
ENVOK ; ENVIRONMENT OK
+1 IF XPDABORT<1
DO BMES^XPDUTL("ENVIRONMENT OK.")
+2 ;
+3 IF XPDABORT>0
DO SORRYEND
+4 ;
+5 QUIT
+6 ;
BACKUPS ; CHECK TO CONFIRM BACKUPS HAVE BEEN DONE
+1 ; Current Patch
NEW CP
+2 ;
+3 ; Current Patch
SET CP=$TRANSLATE($PIECE($TEXT(+2),";",5),"*")
+4 ;
+5 DO BMES^XPDUTL("BACKUPS Check Next.")
+6 ;
+7 WRITE !!
+8 ; Clear all FileMan variables
DO ^XBFMK
+9 SET DIR(0)="Y"
+10 SET DIR("B")="NO"
+11 SET DIR("A")="Has a SUCCESSFUL system backup been performed??"
+12 DO ^DIR
+13 ;
+14 ; IF and ONLY IF backups not confirmed, send NONFATAL alert & e-mail.
+15 IF $DATA(DIRUT)!($GET(Y)=0)
Begin DoDot:1
+16 DO SORRY("Please perform a successful backup before continuing!!","NONFATAL")
End DoDot:1
QUIT
+17 ;
+18 ; User stated Backup has been done, so display message.
+19 NEW DTT
+20 SET DTT=$$UP^XLFSTR($$HTE^XLFDT($HOROLOG,"MZ"))
+21 SET STR="BACKUPS CONFIRMED BY "_$PIECE($GET(^VA(200,DUZ,0)),U)_" ON "
+22 SET STR=STR_$PIECE(DTT,"@")_" AT "_$PIECE(DTT,"@",2)
+23 DO BMES^XPDUTL(STR)
+24 DO MES^XPDUTL(" ")
+25 ;
+26 ; Store backup confirmation person & date/time
+27 ; Current Patch,Backup count
NEW BCKUPCNT
+28 SET BCKUPCNT=1+$ORDER(^BLRINSTL("LAB PATCH",CP,"BACKUP CONFIRMED BY",""),-1)
+29 SET ^BLRINSTL("LAB PATCH",CP,"BACKUP CONFIRMED BY",BCKUPCNT)=$PIECE($GET(^VA(200,DUZ,0)),U)
+30 SET ^BLRINSTL("LAB PATCH",CP,"BACKUP CONFIRMED BY",BCKUPCNT,"DATE/TIME")=$$HTE^XLFDT($HOROLOG,"5MZ")
+31 ;
+32 QUIT
+33 ;
+34 ; Generic "Find RPMS Module's Version and (perhaps) Patch number"
+35 ;
+36 ; NOTE: The MODULE variable MUST be the PREFIX name
+37 ; from the PACKAGE file (9.4).
+38 ;
NEEDIT(MODULE,VERSION,PATCH) ; EP
+1 ; NAME of RPMS Module
NEW NAME
+2 ; PoinTeR to PACKAGE file
NEW PTR
+3 ; Array to store returned values from FIND^DIC
NEW HEREYAGO
+4 ;
+5 ; Use FileMan API to get information
+6 DO FIND^DIC(9.4,"","","",MODULE,"","C","","","HEREYAGO")
+7 SET PTR=$GET(HEREYAGO("DILIST",2,1))
+8 SET NAME=$GET(HEREYAGO("DILIST",1,1))
+9 ;
+10 ; Get the Version
SET X=$$VERSION^XPDUTL(MODULE)
+11 DO BMES^XPDUTL("Need at least "_NAME_" "_VERSION)
+12 IF X<VERSION
Begin DoDot:1
+13 DO SORRY("Need "_NAME_" "_VERSION_" & "_NAME_" "_X_" found!")
+14 SET WOTERR(MODULE,NAME,VERSION)=""
End DoDot:1
QUIT
+15 ;
+16 DO OKAY(NAME_" "_X_" found.")
+17 ;
+18 ; If no Patch check, just exit
IF $GET(PATCH)=""
QUIT
+19 ;
+20 DO BMES^XPDUTL(" Need "_NAME_" "_VERSION_" Patch "_PATCH_".")
+21 SET X=$$PATCH^XPDUTL(MODULE_"*"_VERSION_"*"_PATCH)
+22 IF X'=1
Begin DoDot:1
+23 DO SORRY(NAME_" Patch "_PATCH_" WAS NOT installed!")
+24 SET WOTERR(MODULE,NAME,VERSION)=$GET(PATCH)
End DoDot:1
QUIT
+25 ;
+26 DO OKAY(NAME_" "_VERSION_" Patch "_PATCH_" found.",10)
+27 ;
+28 QUIT
+29 ;
+30 ; Error Message routine. It will send an ALERT and a MailMan message
+31 ; to the people who are assigned to the LMI Mail group.
+32 ; ;
+33 ; The output array is built so that the error/warning message will
+34 ; also appear on the INSTALL LOG via the D BMES^XPDUTL(.STR) call.
SORRY(MSG,MODE) ;
+1 NEW MESSAGE
+2 IF $GET(MODE)'["NONFATAL"
Begin DoDot:1
+3 SET MESSAGE="Install Aborting due to the following Systems Environment issue:"
+4 ; Fatal Error Flag Set
SET XPDABORT=1
End DoDot:1
+5 ;
+6 IF $GET(MODE)["NONFATAL"
SET MESSAGE="*** WARNING *** WARNING *** WARNING ***"
+7 ;
+8 KILL DIFQ
+9 ;
+10 NEW STR,LINECNT
+11 SET STR(1)=" "
+12 ; Row of asterisks
SET STR(2)=$TRANSLATE($JUSTIFY("",65)," ","*")
+13 SET STR(3)=" "
+14 SET STR(4)=$$CJ^XLFSTR("Site: "_$$LOC^XBFUNC,65)
+15 SET STR(5)=" "
+16 SET STR(6)=$$CJ^XLFSTR(MESSAGE,65)
+17 SET STR(7)=" "
+18 SET STR(8)=$$CJ^XLFSTR(">>> "_MSG_" <<<",65)
+19 SET STR(9)=" "
+20 ;
+21 IF $GET(MODE)["NONFATAL"
Begin DoDot:1
+22 SET STR(10)=$$CJ^XLFSTR(MESSAGE,65)
+23 SET STR(11)=" "
+24 SET LINECNT=12
End DoDot:1
+25 ;
+26 IF $GET(MODE)'["NONFATAL"
Begin DoDot:1
+27 SET STR(10)=$$CJ^XLFSTR("Please print/capture this screen and",65)
+28 SET STR(11)=$$CJ^XLFSTR("notify the Support Center at",65)
+29 SET STR(12)=" "
+30 SET STR(13)=$$CJ^XLFSTR("1-999-999-9999.",65)
+31 SET STR(14)=" "
+32 SET LINECNT=15
End DoDot:1
+33 ;
+34 ; Row of asterisks
SET STR(LINECNT)=$GET(STR(2))
+35 SET LINECNT=LINECNT+1
+36 SET STR(LINECNT)=" "
+37 ;
+38 ; Display the message
DO BMES^XPDUTL(.STR)
+39 ;
+40 IF $GET(MODE)'="NONFATAL"
Begin DoDot:1
+41 DO SNDALERT("Laboratory Patch "_CP_" >> FATAL >> "_MSG)
+42 DO SENDMAIL("IHS Lab Patch "_CP_" Install FATAL Error")
End DoDot:1
QUIT
+43 ;
+44 IF $GET(MODE)="NONFATAL"
Begin DoDot:1
+45 DO SNDALERT("Laboratory Patch "_CP_" - "_MODE_" - "_MSG)
+46 DO SENDMAIL("IHS Lab Patch "_CP_" Install NONFATAL Error")
End DoDot:1
+47 QUIT
+48 ;
+49 ; Send alert to LMI group
SNDALERT(ALERTMSG) ;
+1 SET XQAMSG=ALERTMSG
+2 SET XQA("G.LMI")=""
+3 DO SETUP^XQALERT
+4 KILL XQA,XQAMSG
+5 QUIT
+6 ;
+7 ; Send MailMan E-mail to LMI group -- message is in the STR array
SENDMAIL(MAILMSG) ;
+1 KILL XMY
+2 ; Group
SET XMY("G.LMI")=""
+3 SET %DT="T"
+4 SET X="NOW"
+5 DO ^%DT
+6 DO DD^LRX
+7 SET LRBLNOW=Y
+8 ;
+9 SET XMSUB=MAILMSG
+10 SET XMTEXT="STR("
+11 SET XMDUZ=$PIECE($GET(^VA(200,DUZ,0)),U)
+12 ;
+13 ; Send the MailMan e-mail
DO ^XMD
+14 ;
+15 ; Cleanup
KILL X,XMDUZ,XMSUB,XMTEXT,Y
+16 QUIT
+17 ;
+18 ; Output a listing of ALL the errors detected during
+19 ; the environment check.
SORRYEND ;
+1 NEW STR,MODULE,NAME,VERSION,PATCH,LINECNT,TMP
+2 ;
+3 DO BMES^XPDUTL(" ")
+4 ;
+5 SET STR(1)=$TRANSLATE($JUSTIFY("",65)," ","*")
+6 SET STR(2)=" "
+7 SET STR(3)=$$CJ^XLFSTR("Systems Environment Error Detected",65)
+8 SET STR(4)=$$CJ^XLFSTR("KIDS build will be deleted",65)
+9 SET STR(5)=" "
+10 SET STR(6)=$$CJ^XLFSTR("Modules with Version or Patch errors",65)
+11 SET STR(7)=" "
+12 SET LINECNT=8
+13 ;
+14 ; Continue building the STR array that will be displayed via the
+15 ; BMES^XPDUTL call.
+16 SET (MODULE,NAME,VERSION)=""
+17 FOR
SET MODULE=$ORDER(WOTERR(MODULE))
IF MODULE=""
QUIT
Begin DoDot:1
+18 FOR
SET NAME=$ORDER(WOTERR(MODULE,NAME))
IF NAME=""
QUIT
Begin DoDot:2
+19 FOR
SET VERSION=$ORDER(WOTERR(MODULE,NAME,VERSION))
IF VERSION=""
QUIT
Begin DoDot:3
+20 SET PATCH=$GET(WOTERR(MODULE,NAME,VERSION))
+21 SET STR(LINECNT)=$$CJ^XLFSTR(NAME_" ("_MODULE_")",65)
+22 SET LINECNT=LINECNT+1
+23 SET TMP="Version:"_VERSION
+24 IF $GET(PATCH)'=""
SET TMP=TMP_" Patch:"_$GET(PATCH)
+25 SET STR(LINECNT)=$$CJ^XLFSTR(TMP,65)
+26 SET LINECNT=LINECNT+1
+27 SET STR(LINECNT)=" "
+28 SET LINECNT=LINECNT+1
End DoDot:3
End DoDot:2
End DoDot:1
+29 SET STR(LINECNT)=$$CJ^XLFSTR("Re-Installation will be necessary.",65)
+30 SET LINECNT=LINECNT+1
+31 SET STR(LINECNT)=" "
+32 SET LINECNT=LINECNT+1
+33 SET STR(LINECNT)=$$CJ^XLFSTR("If assistance is needed, please call 1-999-999-9999.",65)
+34 SET LINECNT=LINECNT+1
+35 SET STR(LINECNT)=" "
+36 SET LINECNT=LINECNT+1
+37 SET STR(LINECNT)=$TRANSLATE($JUSTIFY("",65)," ","*")
+38 ;
+39 ; Display the message
DO BMES^XPDUTL(.STR)
+40 ;
+41 QUIT
+42 ;
+43 ; Write out "OKAY" message
OKAY(MSG,TAB) ;
+1 NEW MESSAGE
+2 IF $GET(TAB)=""
SET TAB=5
+3 SET MESSAGE=$JUSTIFY("",TAB)_MSG_" OK."
+4 DO MES^XPDUTL(MESSAGE)
+5 QUIT
+6 ;
+7 ;CHECK FOR LMI MAIL GROUP
CHECKLMI() ;
+1 NEW OKAY
+2 DO BMES^XPDUTL("Must have 'LMI' mail group present.")
+3 SET DIC="^XMB(3.8,"
+4 SET X="LMI"
+5 DO ^DIC
+6 SET OKAY=+Y
+7 IF OKAY>0
DO OKAY("'LMI' mail group found.")
+8 IF OKAY<1
DO SORRY("'LMI' mail group NOT found!")
+9 QUIT OKAY
+10 ;
+11 ; POST-INSTALL
+12 ; Just installs Menu items & changes size of RESULTS
+13 ; field in V MICRO and UNIT ID in BLOOD INVENTORY files.
+14 ;
+15 ; If anything goes wrong, it's NOT fatal -- just keep trucking.
POST ; EP
+1 ; Current Patch
NEW CP
+2 SET CP=$TRANSLATE($PIECE($TEXT(+2),";",5),"*")
+3 ;
+4 DO BMES^XPDUTL("Laboratory Patch "_CP_" POST INSTALL...")
+5 ;
+6 DO ADDMENU
+7 ;
+8 DO CHVMICRO
+9 ;
+10 DO BMES^XPDUTL("Laboratory Patch "_CP_" POST INSTALL complete.")
+11 ;
+12 SET XQAMSG="Laboratory Patch "_CP_" INSTALL complete."
+13 SET XQA("G.LMI")=""
+14 DO SETUP^XQALERT
+15 ;
+16 ; Store # of times instllation occurred as well as person & date/time
+17 ; Current Patch,Installation count
NEW CP,INSTCNT
+18 SET CP=$TRANSLATE($PIECE($TEXT(+2),";",5),"*")
+19 SET INSTCNT=1+$ORDER(^BLRINSTL("LAB PATCH",CP,"INSTALLED BY",""),-1)
+20 SET ^BLRINSTL("LAB PATCH",CP,"INSTALLED BY",INSTCNT)=$PIECE($GET(^VA(200,DUZ,0)),U)
+21 SET ^BLRINSTL("LAB PATCH",CP,"INSTALLED BY",INSTCNT,"DATE/TIME")=$$HTE^XLFDT($HOROLOG,"5Z")
+22 ;
+23 QUIT
+24 ;
+25 ; Add OPTION(s) to MENU(s)
+1 ; Add option to purge HL7 error messages to BLRMENU
+2 DO ADDTMENU("BLRMENU","BLRETPUR","ETP")
+3 ;
+4 ; If Lab E-SIG menu exists, add new item
+5 IF $$LKOPT^XPDMENU("BLRA Lab E-SIG Menu")
DO ADDTMENU("BLRA Lab E-SIG Menu","BLRA LAB ES REPORTS","RPT")
+6 ;
+7 QUIT
+8 ;
+9 ; Procedure that really adds the options --
+10 ; uses Kernel'S ADD^XPDMENU function
+1 NEW CHKIT
+2 ;
+3 DO BMES^XPDUTL("Adding "_ADDEE_" to "_ADDER_".")
+4 ;
+5 SET CHKIT=$$ADD^XPDMENU(ADDER,ADDEE,ITM)
+6 ;
+7 IF CHKIT=1
Begin DoDot:1
+8 DO OKAY(ADDEE_" added to "_ADDER_".",5)
+9 DO MES^XPDUTL(" ")
End DoDot:1
+10 ;
+11 IF CHKIT'=1
DO SORRY("Error in adding "_ADDEE_" to "_ADDER_".","NONFATAL")
+12 ;
+13 QUIT
+14 ;
+15 ; Generic message output WITH blank line BEFORE messsage & TAB
TABMESG(MSG,TAB,TAIL) ;
+1 NEW MESSAGE
+2 IF $GET(TAB)=""
SET TAB=5
+3 SET MESSAGE=$JUSTIFY("",TAB)_MSG
+4 IF $GET(TAIL)'=""
SET MESSAGE=MESSAGE_" "_TAIL
+5 DO BMES^XPDUTL(MESSAGE)
+6 QUIT
+7 ;
+8 ; Generic message output WITHOUT blank line BEFORE messsage & TAB
+1 NEW MESSAGE
+2 IF $GET(TAB)=""
SET TAB=5
+3 SET MESSAGE=$JUSTIFY("",TAB)_MSG
+4 IF $GET(TAIL)'=""
SET MESSAGE=MESSAGE_" "_TAIL
+5 DO MES^XPDUTL(MESSAGE)
+6 QUIT
+7 ;
+8 ; Change Maximum string length for the RESULT field in the V MICRO
+9 ; file to 80 characters. Permission granted by Lori Butcher.
CHVMICRO ;
+1 NEW SPEC,STR,SUBSTR
+2 NEW WOTDD
+3 ;
+4 SET STR=$GET(^DD(9000010.25,.07,0))
+5 SET SUBSTR=$PIECE(STR,"^",5)
+6 ;
+7 DO TABMESG("Changing RESULT field max string length & HELP in V MICRO file to 80.")
+8 ;
+9 IF +($PIECE($PIECE(STR,">",2),"!",1))>79
Begin DoDot:1
+10 DO OKAY("RESULT field max string length in V MICRO file already > 79.")
End DoDot:1
QUIT
+11 ;
+12 IF +$LENGTH(SUBSTR)<1!($LENGTH($PIECE(STR,">",2))<1)
Begin DoDot:1
+13 DO SORRY("RESULT field in V MICRO file damaged: examine with FileMan.","NONFATAL")
End DoDot:1
QUIT
+14 ;
+15 SET $PIECE(STR,"^",5)="K:$L(X)>80!($L(X)<1) X"
+16 SET WOTDD="^DD(9000010.25,.07,0)"
+17 SET @WOTDD=STR
+18 ;
+19 IF $PIECE($PIECE($GET(^DD(9000010.25,.07,0)),">",2),"!",1)'=80
Begin DoDot:1
+20 DO SORRY("Could not change RESULT field max string length in V MICRO file","NONFATAL")
End DoDot:1
+21 ;
+22 DO OKAY("Changed RESULT field max string length in V MICRO file.",10)
+23 ;
+24 SET WOTDD="^DD(9000010.25,.07,3)"
+25 SET STR="Answer must be 1-80 characters in length."
+26 SET @WOTDD=STR
+27 ;
+28 IF $GET(^DD(9000010.25,.07,3))'[80
Begin DoDot:1
+29 DO SORRY("Could not change RESULT field HELP in V MICRO file","NONFATAL")
End DoDot:1
QUIT
+30 ;
+31 DO OKAY("Changed RESULT field HELP in V MICRO file.",10)
+32 ;
+33 DO OKAY("Changed RESULT field max string length & HELP in V MICRO file.")
+34 ;
+35 QUIT
