BLRPRE26 ; IHS/OIT/MKK - IHS Lab PATCH 1026 Environment/Post Install Routine ;MAY 06, 2009 9:58 AM
;;5.2T1;IHS LABORATORY;**1026**;NOV 01, 1997
;
PRE ; EP
D BMES^XPDUTL("Beginning of Pre Check.")
NEW CP,RPMS,RPMSVER
NEW STR
NEW LASTPTCH ; Last Patch of Lab
NEW LSTPISTS ; Last Patch Install Status
NEW ERRARRAY ; Array of errors
;
I $G(XPDNM)="" D SORRY("XPDNM not defined or 0.") Q
;
S CP=$P(XPDNM,"*",3) ; Current Patch Number
S RPMS=$P(XPDNM,"*",1) ; RPMS Module
S RPMSVER=$P(XPDNM,"*",2) ; Version of RPMS module being patched
;
PTCHLAST ; EP - Check for previous patch
D MES^XPDUTL(" Need LR*5.2*1025 Patch Installed.")
I $$PATCH^XPDUTL("LR*5.2*1025")'=1 D SORRY("LR*5.2*1025 Patch Not Installed.") Q
;
D OKAY^BLRKIDSU("LR*5.2*1025 Patch Installed.",10)
;
S XPDNOQUE="NO QUE" ; No Queuing Allowed
;
; The following line prevents the "Disable Options..." and "Move
; Routines..." questions from being asked during the install.
F X="XPO1","XPZ1","XPZ2","XPI1" S XPDDIQ(X)=0
;
S XPDABORT=0 ; KIDS install Flag
;
USERID ; EP - 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
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^BLRKIDSU("Installer cannot be identified!",,,CP) Q
;
D MES^XPDUTL("Pre Check complete.")
;
LETSGO ; EP - 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_".")
;
D NEEDIT("DI","22.0",,.ERRARRAY) ; FILEMAN 22.0
D NEEDIT("XM","8.0",,.ERRARRAY) ; MAILMAN 8.0
D NEEDIT("XU","8.0",1013,.ERRARRAY) ; KERNEL 8.0 & PATCH 1013
;
D CHECKLMI(.ERRARRAY) ; LMI MAIL GROUP
;
I XPDABORT<1 D BMES^XPDUTL("ENVIRONMENT OK.")
;
I XPDABORT>0 D
. D SORRYEND(.ERRARRAY) ; Environment has error(s)
;
Q
;
BACKUP ; EP
NEW CP
S CP=$P($T(+2),"*",3)
;
D BACKUPS^BLRKIDSU(CP)
Q
;
POST ; EP -- POST INSTALL
NEW CP
;
S CP=$P($T(+2),"*",3)
;
; The following line prevents the "Disable Options..." and "Move
; Routines..." questions from being asked during the install.
F X="XPO1","XPZ1","XPZ2","XPI1" S XPDDIQ(X)=0
;
D LABTMOD ; Modify File # 60
D MOD90479 ; Modify File # 90479
;
D BMES^XPDUTL("Laboratory Patch "_CP_" INSTALL complete.")
;
NEW STR
S STR(1)="Laboratory Patch "_CP_" INSTALL completed at."
S STR(2)=$$CJ^XLFSTR($$UP^XLFSTR($TR($$HTE^XLFDT($H,"MP"),"@"," ")),43)
D SENDMAIL("IHS Lab Patch "_CP)
D SNDALERT("Laboratory Patch "_CP_" INSTALL complete.")
;
; Store # of times installation occurred as well as person & date/time
D ENDINSTL^BLRKIDSU(CP)
;
Q
;
DEBUG ; EP - Debugging Line Label for environment checker
NEW CP,DEBUG,XPDNM
S DEBUG="YES"
S XPDNM="LR*5.2*1026"
S CP=$P($T(+2),"*",3) ; Current Patch
D PRE
Q
;
; Error Message routine. It will send an ALERT and a MailMan message
; and it will also appear on the INSTALL LOG.
SORRY(MSG,MODE,MSG2) ; EP
S CP=$P($T(+2),"*",3)
;
NEW MESSAGE
I $G(MODE)=""!($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 LINECNT=1
D ADDLINE(" ",.LINECNT)
D ADDLINE($TR($J("",65)," ","*"),.LINECNT) ; Row of asterisks
D ADDLINE(" ",.LINECNT)
D ADDLINE($$CJ^XLFSTR("Site: "_$$LOC^XBFUNC,65),.LINECNT)
D ADDLINE(" ",.LINECNT)
D ADDLINE($$CJ^XLFSTR(MESSAGE,65),.LINECNT)
D ADDLINE(" ",.LINECNT)
D ADDLINE($$CJ^XLFSTR(">>> "_MSG_" <<<",65),.LINECNT)
I $D(MSG2) D ADDLINE($$CJ^XLFSTR(">>> "_MSG2_" <<<",65),.LINECNT)
D ADDLINE(" ",.LINECNT)
;
I $G(MODE)["NONFATAL" D ADDLINE($$CJ^XLFSTR(MESSAGE,65),.LINECNT)
;
I $G(MODE)'["NONFATAL" D
. D ADDLINE($$CJ^XLFSTR("Please print/capture this screen and",65),.LINECNT)
. D ADDLINE($$CJ^XLFSTR("notify the Support Center at",65),.LINECNT)
. D ADDLINE(" ",.LINECNT)
. D ADDLINE($$CJ^XLFSTR("1-888-830-7280.",65),.LINECNT)
. D ADDLINE(" ",.LINECNT)
;
D ADDLINE($TR($J("",65)," ","*"),.LINECNT) ; Row of asterisks
D ADDLINE(" ",.LINECNT)
;
D BMES^XPDUTL(.STR)
;
Q
;
ADDLINE(ASTR,LC) ; EP -- Add a line to the STR array
I $G(ASTR)="" S ASTR=" "
S STR(LC)=ASTR
S LC=LC+1
Q
;
SNDALERT(ALERTMSG) ; EP -- Send alert to LMI group & Installer
D SENDIT("G.LMI",ALERTMSG)
D SENDIT(DUZ,ALERTMSG)
Q
;
SENDIT(WHO,WOTMSG) ; EP - Send the Alert
S XQAMSG=WOTMSG
S XQA(WHO)=""
D SETUP^XQALERT
K XQA,XQAMSG
Q
;
SENDMAIL(MAILMSG) ; EP -- Send MailMan E-mail to LMI group & Installer
D MAILIT("G.LMI",MAILMSG)
D MAILIT(DUZ,MAILMSG)
Q
;
MAILIT(WHO,MSG) ; EP -- Send the MailMan Message
NEW CP,DIFROM,XMDUZ,XMMG,XMSUB,XMTEXT,XMY
;
S CP=$P($T(+2),"*",3)
;
S XMY(WHO)=""
S XMSUB=MSG
S XMTEXT="STR("
S XMDUZ="IHS "_XPDNM
D ^XMD
;
I $G(XMMG)="" Q ; Message sent
;
D BMES^XPDUTL("Error Sending MailMan Message.")
D TABMESG^BLRKIDSU("Error Message:"_XMMG,10)
;
Q
;
CHECKLMI(ERRARRAY) ; EP -- CHECK FOR LMI MAIL GROUP
NEW HEREYAGO
;
D BMES^XPDUTL("Must have 'LMI' mail group present.")
D FIND^DIC(3.8,"","","","LMI","","","","","HEREYAGO")
;
I $G(HEREYAGO("DILIST",1,1))="LMI" D Q
. D OKAY^BLRKIDSU("'LMI' mail group found.")
;
D SORRY("'LMI' mail group NOT found!","FATAL")
S ERRARRAY("XMB(3.8","Mail Group","3.8")="LMI Mail Group"
Q
;
; Generic "Find RPMS Module's Version and (perhaps) Patch number"
; The MODULE variable MUST be the PREFIX name from the PACKAGE file (9.4).
NEEDIT(MODULE,VERSION,PATCH,ERRARRAY) ; EP
NEW NAME ; Name of PACKAGE
NEW HEREYAGO,STR1,STR2 ; Scratch variables/arrays
NEW SYSVER,SYSPATCH ; System Version & System Patch variables
;
D FIND^DIC(9.4,"","","",MODULE,"","C","","","HEREYAGO")
S NAME=$G(HEREYAGO("DILIST",1,1))
;
D BMES^XPDUTL("Need at least "_NAME_" "_VERSION)
;
S SYSVER=$$VERSION^XPDUTL(MODULE) ; Get the System's Version
; If System Version < Needed Version, write message and quit
I SYSVER<VERSION D Q
. S ERRARRAY(MODULE,NAME,VERSION)=SYSVER
. D NEEDMSG("Need "_NAME_" "_VERSION_" & "_NAME_" "_SYSVER_" found!")
;
D OKAY^BLRKIDSU(NAME_" "_SYSVER_" found.")
I VERSION<SYSVER Q ; If Version needed is lower, skip Patch check
;
I $G(PATCH)="" Q ; If no Patch check, just exit
;
D BMES^XPDUTL(" Need "_NAME_" "_VERSION_" Patch "_PATCH_".")
S SYSPATCH=$$PATCH^XPDUTL(MODULE_"*"_VERSION_"*"_PATCH)
I SYSPATCH'=1 D Q
. S ERRARRAY(MODULE,NAME,VERSION)=$G(PATCH)
. D NEEDMSG(NAME_" "_VERSION_" & Patch "_PATCH_" WAS NOT installed!")
;
D OKAY^BLRKIDSU(NAME_" "_VERSION_" Patch "_PATCH_" found.",10)
;
Q
;
NEEDMSG(MESSAGE) ; EP
NEW STR1,STR2
;
S STR1=MESSAGE
I $L(STR1)<58 D SORRY^BLRKIDSU(STR1,,,CP) Q
;
S STR1=$P(MESSAGE,"&")_" &"
S STR2=$$TRIM^XLFSTR($P(MESSAGE,"&",2),"L"," ")
D SORRY^BLRKIDSU(STR1,,STR2,CP)
Q
;
LABTMOD ; EP - Lab Test File Modification -- Try to Stop Infinite Recursion
NEW CHNGSTR,MODSTR,SUBSTR
;
S CHNGSTR="IF $P(^LAB(60,DA(1),0),U,5)'=""""!(DA(1)=X) W !,""NO CAN DO"" K X"
;
S SUBSTR=$G(^DD(60.02,.01,0))
I $P(SUBSTR,"^",5,99)=CHNGSTR Q
;
D BMES^XPDUTL(" ")
D BMES^XPDUTL("POST INSTALL LABTMOD BEGINS")
D TABMESG^BLRKIDSU("Changing Input Transform of .01 sub-field of 60.02 field of File # 60.",5)
;
S MODSTR="^DD(60.02,.01,0)"
S $P(SUBSTR,"^",5,99)=CHNGSTR
S @MODSTR=SUBSTR
;
S SUBSTR=$G(^DD(60.02,.01,0))
;
I $P(SUBSTR,"^",5,99)=CHNGSTR D
. D OKAY^BLRKIDSU(".01 sub-field of 60.02 field of File # 60 changed.",10)
;
I $P(SUBSTR,"^",5,99)'=CHNGSTR D
. D TABMESG^BLRKIDSU(".01 sub-field of 60.02 field of File # 60 NOT changed.",10)
;
D BMES^XPDUTL("POST INSTALL LABTMOD ENDS")
Q
;
; Modify File 90479 so that the permissions are like all Lab Files
MOD90479 ; EP
NEW STR,WOT
;
I $D(^DIC(90479,0))<1 Q
;
D BMES^XPDUTL(" ")
D BMES^XPDUTL("POST INSTALL MODIFICATION OF FILE 90479 BEGINS")
S WOT="AUDIT"
S STR="^DIC(90479,0,"""_WOT_""")=""#"""
S @STR
;
S WOT="DD"
S STR="^DIC(90479,0,"""_WOT_""")=""@"""
S @STR
;
F WOT="DEL","LAYGO","RD","WR" D
. S STR="^DIC(90479,0,"""_WOT_""")=""L"""
. S @STR
D BMES^XPDUTL("POST INSTALL MODIFICATION OF FILE 90479 ENDS.")
Q
;
RESET ; EP - For debugging purposes
NEW CHNGSTR,SUBSTR
;
S CHNGSTR="IF $P(^LAB(60,DA(1),0),U,5)'="""" W !,""NO CAN DO"" K X"
;
S SUBSTR=$G(^DD(60.02,.01,0))
I $P(SUBSTR,"^",5,99)=CHNGSTR Q
;
D TABMESG^BLRKIDSU("Resetting Input Transform of .01 sub-field of 60.02 field of File # 60.",5)
;
S MODSTR="^DD(60.02,.01,0)"
S $P(SUBSTR,"^",5,99)=CHNGSTR
S @MODSTR=SUBSTR
;
S SUBSTR=$G(^DD(60.02,.01,0))
;
I $P(SUBSTR,"^",5,99)=CHNGSTR D Q
. D OKAY^BLRKIDSU(".01 sub-field of 60.02 field of File # 60 Reset.",10)
;
D TABMESG^BLRKIDSU(".01 sub-field of 60.02 field of File # 60 NOT Reset.",10)
Q
;
; Output a listing of ALL the errors detected during the environment check.
; Also, send ALERT & E-Mail
SORRYEND(WOTERR) ; EP
NEW STR,MODULE,NAME,VERSION,PATCH,LINECNT,TMP,WHATMSG
;
D SORRYHED^BLRKIDSU
;
; Add ALL the errors detected to the STR array
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
... D ADDMESG^BLRKIDSU
;
D SORRYFIN^BLRKIDSU
;
D BMES^XPDUTL(.STR) ; Display for INSTALL LOG
;
S WHATMSG=$G(XPDNM)_" Install FATAL Error(s)"
;
D SNDALERT(WHATMSG)
D SENDMAIL(WHATMSG)
;
D FATLSTOR(.WOTERR)
Q
;
FATLSTOR(WOTERR) ; Store Information concerning FATAL ERROR during Install
NEW MODULE,NAME,NOW,VERSION
;
; The following line should NEVER happen, but if it does, fix XPDNM variable
I $G(XPDNM)="" S XPDNM="LR*5.2*"_$P($T(+2),"*",3)
;
S NOW=$H
S ^BLRFATLI(XPDNM,NOW)=$$HTE^XLFDT(NOW,"2MZ")
;
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 ^BLRFATLI(XPDNM,NOW,MODULE,NAME,VERSION)=$G(WOTERR(MODULE,NAME,VERSION))
;
Q
BLRPRE26 ; IHS/OIT/MKK - IHS Lab PATCH 1026 Environment/Post Install Routine ;MAY 06, 2009 9:58 AM
+1 ;;5.2T1;IHS LABORATORY;**1026**;NOV 01, 1997
+2 ;
PRE ; EP
+1 DO BMES^XPDUTL("Beginning of Pre Check.")
+2 NEW CP,RPMS,RPMSVER
+3 NEW STR
+4 ; Last Patch of Lab
NEW LASTPTCH
+5 ; Last Patch Install Status
NEW LSTPISTS
+6 ; Array of errors
NEW ERRARRAY
+7 ;
+8 IF $GET(XPDNM)=""
DO SORRY("XPDNM not defined or 0.")
QUIT
+9 ;
+10 ; Current Patch Number
SET CP=$PIECE(XPDNM,"*",3)
+11 ; RPMS Module
SET RPMS=$PIECE(XPDNM,"*",1)
+12 ; Version of RPMS module being patched
SET RPMSVER=$PIECE(XPDNM,"*",2)
+13 ;
PTCHLAST ; EP - Check for previous patch
+1 DO MES^XPDUTL(" Need LR*5.2*1025 Patch Installed.")
+2 IF $$PATCH^XPDUTL("LR*5.2*1025")'=1
DO SORRY("LR*5.2*1025 Patch Not Installed.")
QUIT
+3 ;
+4 DO OKAY^BLRKIDSU("LR*5.2*1025 Patch Installed.",10)
+5 ;
+6 ; No Queuing Allowed
SET XPDNOQUE="NO QUE"
+7 ;
+8 ; The following line prevents the "Disable Options..." and "Move
+9 ; Routines..." questions from being asked during the install.
+10 FOR X="XPO1","XPZ1","XPZ2","XPI1"
SET XPDDIQ(X)=0
+11 ;
+12 ; KIDS install Flag
SET XPDABORT=0
+13 ;
USERID ; EP - 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 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^BLRKIDSU("Installer cannot be identified!",,,CP)
QUIT
+10 ;
+11 DO MES^XPDUTL("Pre Check complete.")
+12 ;
LETSGO ; EP - 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 ;
+5 ; FILEMAN 22.0
DO NEEDIT("DI","22.0",,.ERRARRAY)
+6 ; MAILMAN 8.0
DO NEEDIT("XM","8.0",,.ERRARRAY)
+7 ; KERNEL 8.0 & PATCH 1013
DO NEEDIT("XU","8.0",1013,.ERRARRAY)
+8 ;
+9 ; LMI MAIL GROUP
DO CHECKLMI(.ERRARRAY)
+10 ;
+11 IF XPDABORT<1
DO BMES^XPDUTL("ENVIRONMENT OK.")
+12 ;
+13 IF XPDABORT>0
Begin DoDot:1
+14 ; Environment has error(s)
DO SORRYEND(.ERRARRAY)
End DoDot:1
+15 ;
+16 QUIT
+17 ;
BACKUP ; EP
+1 NEW CP
+2 SET CP=$PIECE($TEXT(+2),"*",3)
+3 ;
+4 DO BACKUPS^BLRKIDSU(CP)
+5 QUIT
+6 ;
POST ; EP -- POST INSTALL
+1 NEW CP
+2 ;
+3 SET CP=$PIECE($TEXT(+2),"*",3)
+4 ;
+5 ; The following line prevents the "Disable Options..." and "Move
+6 ; Routines..." questions from being asked during the install.
+7 FOR X="XPO1","XPZ1","XPZ2","XPI1"
SET XPDDIQ(X)=0
+8 ;
+9 ; Modify File # 60
DO LABTMOD
+10 ; Modify File # 90479
DO MOD90479
+11 ;
+12 DO BMES^XPDUTL("Laboratory Patch "_CP_" INSTALL complete.")
+13 ;
+14 NEW STR
+15 SET STR(1)="Laboratory Patch "_CP_" INSTALL completed at."
+16 SET STR(2)=$$CJ^XLFSTR($$UP^XLFSTR($TRANSLATE($$HTE^XLFDT($HOROLOG,"MP"),"@"," ")),43)
+17 DO SENDMAIL("IHS Lab Patch "_CP)
+18 DO SNDALERT("Laboratory Patch "_CP_" INSTALL complete.")
+19 ;
+20 ; Store # of times installation occurred as well as person & date/time
+21 DO ENDINSTL^BLRKIDSU(CP)
+22 ;
+23 QUIT
+24 ;
DEBUG ; EP - Debugging Line Label for environment checker
+1 NEW CP,DEBUG,XPDNM
+2 SET DEBUG="YES"
+3 SET XPDNM="LR*5.2*1026"
+4 ; Current Patch
SET CP=$PIECE($TEXT(+2),"*",3)
+5 DO PRE
+6 QUIT
+7 ;
+8 ; Error Message routine. It will send an ALERT and a MailMan message
+9 ; and it will also appear on the INSTALL LOG.
SORRY(MSG,MODE,MSG2) ; EP
+1 SET CP=$PIECE($TEXT(+2),"*",3)
+2 ;
+3 NEW MESSAGE
+4 IF $GET(MODE)=""!($GET(MODE)'["NONFATAL")
Begin DoDot:1
+5 SET MESSAGE="Install Aborting due to the following Systems Environment issue:"
+6 ; Fatal Error Flag Set
SET XPDABORT=1
End DoDot:1
+7 ;
+8 IF $GET(MODE)["NONFATAL"
SET MESSAGE="*** WARNING *** WARNING *** WARNING ***"
+9 ;
+10 KILL DIFQ
+11 ;
+12 NEW STR,LINECNT
+13 SET LINECNT=1
+14 DO ADDLINE(" ",.LINECNT)
+15 ; Row of asterisks
DO ADDLINE($TRANSLATE($JUSTIFY("",65)," ","*"),.LINECNT)
+16 DO ADDLINE(" ",.LINECNT)
+17 DO ADDLINE($$CJ^XLFSTR("Site: "_$$LOC^XBFUNC,65),.LINECNT)
+18 DO ADDLINE(" ",.LINECNT)
+19 DO ADDLINE($$CJ^XLFSTR(MESSAGE,65),.LINECNT)
+20 DO ADDLINE(" ",.LINECNT)
+21 DO ADDLINE($$CJ^XLFSTR(">>> "_MSG_" <<<",65),.LINECNT)
+22 IF $DATA(MSG2)
DO ADDLINE($$CJ^XLFSTR(">>> "_MSG2_" <<<",65),.LINECNT)
+23 DO ADDLINE(" ",.LINECNT)
+24 ;
+25 IF $GET(MODE)["NONFATAL"
DO ADDLINE($$CJ^XLFSTR(MESSAGE,65),.LINECNT)
+26 ;
+27 IF $GET(MODE)'["NONFATAL"
Begin DoDot:1
+28 DO ADDLINE($$CJ^XLFSTR("Please print/capture this screen and",65),.LINECNT)
+29 DO ADDLINE($$CJ^XLFSTR("notify the Support Center at",65),.LINECNT)
+30 DO ADDLINE(" ",.LINECNT)
+31 DO ADDLINE($$CJ^XLFSTR("1-888-830-7280.",65),.LINECNT)
+32 DO ADDLINE(" ",.LINECNT)
End DoDot:1
+33 ;
+34 ; Row of asterisks
DO ADDLINE($TRANSLATE($JUSTIFY("",65)," ","*"),.LINECNT)
+35 DO ADDLINE(" ",.LINECNT)
+36 ;
+37 DO BMES^XPDUTL(.STR)
+38 ;
+39 QUIT
+40 ;
ADDLINE(ASTR,LC) ; EP -- Add a line to the STR array
+1 IF $GET(ASTR)=""
SET ASTR=" "
+2 SET STR(LC)=ASTR
+3 SET LC=LC+1
+4 QUIT
+5 ;
SNDALERT(ALERTMSG) ; EP -- Send alert to LMI group & Installer
+1 DO SENDIT("G.LMI",ALERTMSG)
+2 DO SENDIT(DUZ,ALERTMSG)
+3 QUIT
+4 ;
SENDIT(WHO,WOTMSG) ; EP - Send the Alert
+1 SET XQAMSG=WOTMSG
+2 SET XQA(WHO)=""
+3 DO SETUP^XQALERT
+4 KILL XQA,XQAMSG
+5 QUIT
+6 ;
SENDMAIL(MAILMSG) ; EP -- Send MailMan E-mail to LMI group & Installer
+1 DO MAILIT("G.LMI",MAILMSG)
+2 DO MAILIT(DUZ,MAILMSG)
+3 QUIT
+4 ;
MAILIT(WHO,MSG) ; EP -- Send the MailMan Message
+1 NEW CP,DIFROM,XMDUZ,XMMG,XMSUB,XMTEXT,XMY
+2 ;
+3 SET CP=$PIECE($TEXT(+2),"*",3)
+4 ;
+5 SET XMY(WHO)=""
+6 SET XMSUB=MSG
+7 SET XMTEXT="STR("
+8 SET XMDUZ="IHS "_XPDNM
+9 DO ^XMD
+10 ;
+11 ; Message sent
IF $GET(XMMG)=""
QUIT
+12 ;
+13 DO BMES^XPDUTL("Error Sending MailMan Message.")
+14 DO TABMESG^BLRKIDSU("Error Message:"_XMMG,10)
+15 ;
+16 QUIT
+17 ;
CHECKLMI(ERRARRAY) ; EP -- CHECK FOR LMI MAIL GROUP
+1 NEW HEREYAGO
+2 ;
+3 DO BMES^XPDUTL("Must have 'LMI' mail group present.")
+4 DO FIND^DIC(3.8,"","","","LMI","","","","","HEREYAGO")
+5 ;
+6 IF $GET(HEREYAGO("DILIST",1,1))="LMI"
Begin DoDot:1
+7 DO OKAY^BLRKIDSU("'LMI' mail group found.")
End DoDot:1
QUIT
+8 ;
+9 DO SORRY("'LMI' mail group NOT found!","FATAL")
+10 SET ERRARRAY("XMB(3.8","Mail Group","3.8")="LMI Mail Group"
+11 QUIT
+12 ;
+13 ; Generic "Find RPMS Module's Version and (perhaps) Patch number"
+14 ; The MODULE variable MUST be the PREFIX name from the PACKAGE file (9.4).
NEEDIT(MODULE,VERSION,PATCH,ERRARRAY) ; EP
+1 ; Name of PACKAGE
NEW NAME
+2 ; Scratch variables/arrays
NEW HEREYAGO,STR1,STR2
+3 ; System Version & System Patch variables
NEW SYSVER,SYSPATCH
+4 ;
+5 DO FIND^DIC(9.4,"","","",MODULE,"","C","","","HEREYAGO")
+6 SET NAME=$GET(HEREYAGO("DILIST",1,1))
+7 ;
+8 DO BMES^XPDUTL("Need at least "_NAME_" "_VERSION)
+9 ;
+10 ; Get the System's Version
SET SYSVER=$$VERSION^XPDUTL(MODULE)
+11 ; If System Version < Needed Version, write message and quit
+12 IF SYSVER<VERSION
Begin DoDot:1
+13 SET ERRARRAY(MODULE,NAME,VERSION)=SYSVER
+14 DO NEEDMSG("Need "_NAME_" "_VERSION_" & "_NAME_" "_SYSVER_" found!")
End DoDot:1
QUIT
+15 ;
+16 DO OKAY^BLRKIDSU(NAME_" "_SYSVER_" found.")
+17 ; If Version needed is lower, skip Patch check
IF VERSION<SYSVER
QUIT
+18 ;
+19 ; If no Patch check, just exit
IF $GET(PATCH)=""
QUIT
+20 ;
+21 DO BMES^XPDUTL(" Need "_NAME_" "_VERSION_" Patch "_PATCH_".")
+22 SET SYSPATCH=$$PATCH^XPDUTL(MODULE_"*"_VERSION_"*"_PATCH)
+23 IF SYSPATCH'=1
Begin DoDot:1
+24 SET ERRARRAY(MODULE,NAME,VERSION)=$GET(PATCH)
+25 DO NEEDMSG(NAME_" "_VERSION_" & Patch "_PATCH_" WAS NOT installed!")
End DoDot:1
QUIT
+26 ;
+27 DO OKAY^BLRKIDSU(NAME_" "_VERSION_" Patch "_PATCH_" found.",10)
+28 ;
+29 QUIT
+30 ;
NEEDMSG(MESSAGE) ; EP
+1 NEW STR1,STR2
+2 ;
+3 SET STR1=MESSAGE
+4 IF $LENGTH(STR1)<58
DO SORRY^BLRKIDSU(STR1,,,CP)
QUIT
+5 ;
+6 SET STR1=$PIECE(MESSAGE,"&")_" &"
+7 SET STR2=$$TRIM^XLFSTR($PIECE(MESSAGE,"&",2),"L"," ")
+8 DO SORRY^BLRKIDSU(STR1,,STR2,CP)
+9 QUIT
+10 ;
LABTMOD ; EP - Lab Test File Modification -- Try to Stop Infinite Recursion
+1 NEW CHNGSTR,MODSTR,SUBSTR
+2 ;
+3 SET CHNGSTR="IF $P(^LAB(60,DA(1),0),U,5)'=""""!(DA(1)=X) W !,""NO CAN DO"" K X"
+4 ;
+5 SET SUBSTR=$GET(^DD(60.02,.01,0))
+6 IF $PIECE(SUBSTR,"^",5,99)=CHNGSTR
QUIT
+7 ;
+8 DO BMES^XPDUTL(" ")
+9 DO BMES^XPDUTL("POST INSTALL LABTMOD BEGINS")
+10 DO TABMESG^BLRKIDSU("Changing Input Transform of .01 sub-field of 60.02 field of File # 60.",5)
+11 ;
+12 SET MODSTR="^DD(60.02,.01,0)"
+13 SET $PIECE(SUBSTR,"^",5,99)=CHNGSTR
+14 SET @MODSTR=SUBSTR
+15 ;
+16 SET SUBSTR=$GET(^DD(60.02,.01,0))
+17 ;
+18 IF $PIECE(SUBSTR,"^",5,99)=CHNGSTR
Begin DoDot:1
+19 DO OKAY^BLRKIDSU(".01 sub-field of 60.02 field of File # 60 changed.",10)
End DoDot:1
+20 ;
+21 IF $PIECE(SUBSTR,"^",5,99)'=CHNGSTR
Begin DoDot:1
+22 DO TABMESG^BLRKIDSU(".01 sub-field of 60.02 field of File # 60 NOT changed.",10)
End DoDot:1
+23 ;
+24 DO BMES^XPDUTL("POST INSTALL LABTMOD ENDS")
+25 QUIT
+26 ;
+27 ; Modify File 90479 so that the permissions are like all Lab Files
MOD90479 ; EP
+1 NEW STR,WOT
+2 ;
+3 IF $DATA(^DIC(90479,0))<1
QUIT
+4 ;
+5 DO BMES^XPDUTL(" ")
+6 DO BMES^XPDUTL("POST INSTALL MODIFICATION OF FILE 90479 BEGINS")
+7 SET WOT="AUDIT"
+8 SET STR="^DIC(90479,0,"""_WOT_""")=""#"""
+9 SET @STR
+10 ;
+11 SET WOT="DD"
+12 SET STR="^DIC(90479,0,"""_WOT_""")=""@"""
+13 SET @STR
+14 ;
+15 FOR WOT="DEL","LAYGO","RD","WR"
Begin DoDot:1
+16 SET STR="^DIC(90479,0,"""_WOT_""")=""L"""
+17 SET @STR
End DoDot:1
+18 DO BMES^XPDUTL("POST INSTALL MODIFICATION OF FILE 90479 ENDS.")
+19 QUIT
+20 ;
RESET ; EP - For debugging purposes
+1 NEW CHNGSTR,SUBSTR
+2 ;
+3 SET CHNGSTR="IF $P(^LAB(60,DA(1),0),U,5)'="""" W !,""NO CAN DO"" K X"
+4 ;
+5 SET SUBSTR=$GET(^DD(60.02,.01,0))
+6 IF $PIECE(SUBSTR,"^",5,99)=CHNGSTR
QUIT
+7 ;
+8 DO TABMESG^BLRKIDSU("Resetting Input Transform of .01 sub-field of 60.02 field of File # 60.",5)
+9 ;
+10 SET MODSTR="^DD(60.02,.01,0)"
+11 SET $PIECE(SUBSTR,"^",5,99)=CHNGSTR
+12 SET @MODSTR=SUBSTR
+13 ;
+14 SET SUBSTR=$GET(^DD(60.02,.01,0))
+15 ;
+16 IF $PIECE(SUBSTR,"^",5,99)=CHNGSTR
Begin DoDot:1
+17 DO OKAY^BLRKIDSU(".01 sub-field of 60.02 field of File # 60 Reset.",10)
End DoDot:1
QUIT
+18 ;
+19 DO TABMESG^BLRKIDSU(".01 sub-field of 60.02 field of File # 60 NOT Reset.",10)
+20 QUIT
+21 ;
+22 ; Output a listing of ALL the errors detected during the environment check.
+23 ; Also, send ALERT & E-Mail
SORRYEND(WOTERR) ; EP
+1 NEW STR,MODULE,NAME,VERSION,PATCH,LINECNT,TMP,WHATMSG
+2 ;
+3 DO SORRYHED^BLRKIDSU
+4 ;
+5 ; Add ALL the errors detected to the STR array
+6 SET (MODULE,NAME,VERSION)=""
+7 FOR
SET MODULE=$ORDER(WOTERR(MODULE))
IF MODULE=""
QUIT
Begin DoDot:1
+8 FOR
SET NAME=$ORDER(WOTERR(MODULE,NAME))
IF NAME=""
QUIT
Begin DoDot:2
+9 FOR
SET VERSION=$ORDER(WOTERR(MODULE,NAME,VERSION))
IF VERSION=""
QUIT
Begin DoDot:3
+10 DO ADDMESG^BLRKIDSU
End DoDot:3
End DoDot:2
End DoDot:1
+11 ;
+12 DO SORRYFIN^BLRKIDSU
+13 ;
+14 ; Display for INSTALL LOG
DO BMES^XPDUTL(.STR)
+15 ;
+16 SET WHATMSG=$GET(XPDNM)_" Install FATAL Error(s)"
+17 ;
+18 DO SNDALERT(WHATMSG)
+19 DO SENDMAIL(WHATMSG)
+20 ;
+21 DO FATLSTOR(.WOTERR)
+22 QUIT
+23 ;
FATLSTOR(WOTERR) ; Store Information concerning FATAL ERROR during Install
+1 NEW MODULE,NAME,NOW,VERSION
+2 ;
+3 ; The following line should NEVER happen, but if it does, fix XPDNM variable
+4 IF $GET(XPDNM)=""
SET XPDNM="LR*5.2*"_$PIECE($TEXT(+2),"*",3)
+5 ;
+6 SET NOW=$HOROLOG
+7 SET ^BLRFATLI(XPDNM,NOW)=$$HTE^XLFDT(NOW,"2MZ")
+8 ;
+9 SET (MODULE,NAME,VERSION)=""
+10 FOR
SET MODULE=$ORDER(WOTERR(MODULE))
IF MODULE=""
QUIT
Begin DoDot:1
+11 FOR
SET NAME=$ORDER(WOTERR(MODULE,NAME))
IF NAME=""
QUIT
Begin DoDot:2
+12 FOR
SET VERSION=$ORDER(WOTERR(MODULE,NAME,VERSION))
IF VERSION=""
QUIT
Begin DoDot:3
+13 SET ^BLRFATLI(XPDNM,NOW,MODULE,NAME,VERSION)=$GET(WOTERR(MODULE,NAME,VERSION))
End DoDot:3
End DoDot:2
End DoDot:1
+14 ;
+15 QUIT
