BLRPRE30 ; IHS/OIT/MKK - IHS Lab PATCH 1030 PRE/POST/Environment Routine ; [ JUNE 25, 2010 9:58 AM ]
;;5.2;IHS LABORATORY;**1030**;NOV 01, 1997
;
PRE ; EP
NEW CP,PREREQ,RPMS,RPMSVER,QFLG,ROWSTARS,STR
NEW ERRARRAY ; Errors array
;
D BMES^XPDUTL("Beginning of Pre Check.")
;
I $G(XPDNM)="" D Q
. S CP=$TR($P($T(+2),";",5),"*")
. D SORRY(CP,"XPDNM not defined or 0.")
;
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
;
S ROWSTARS=$TR($J("",65)," ","*") ; Row of asterisks
;
USERID ; EP - CHECK FOR USER ID
I +$G(DUZ)<1 D SORRY(CP,"DUZ UNDEFINED OR 0.") Q
;
I $P($G(^VA(200,DUZ,0)),U)="" D SORRY(CP,"Installer cannot be identified!") Q
;
GETREADY ; EP
S XPDNOQUE=1 ; 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,XPDDIQ(X,"B")="NO"
;
S XPDABORT=0 ; KIDS install Flag
;
D HOME^%ZIS ; Reset/Initialize IO variables
D DTNOLF^DICRW ; Set DT variable without a Line Feed
;
ENVICHEK ; Environment Checker
D ENVHEADR(CP,RPMSVER,RPMS)
;
D CHKMAILG(CP,"LMI",.ERRARRAY) ; Check for LMI Mail Group
D CHKMAILG(CP,"LAB MESSAGING",.ERRARRAY) ; Check for LAB MESSAGING Mail Group
;
D NEEDIT(CP,"LR","5.2","1029",.ERRARRAY) ; Lab Pre-Requisites
;
D NEEDIT(CP,"XM","8.0",,.ERRARRAY) ; MAILMAN 8.0
D NEEDIT(CP,"XU","8.0",1015,.ERRARRAY) ; XU*8.0*1015 (Kernel)
D NEEDIT(CP,"PIMS","5.3",,.ERRARRAY) ; PIMS 5.3
D NEEDIT(CP,"PXRM","1.5",1,.ERRARRAY) ; PXRM*1.5*1 (CLINICAL REMINDERS)
D NEEDIT(CP,"TIU","1.0",137,.ERRARRAY) ; TIU*1.0*137
D NEEDIT(CP,"USR","1.0",23,.ERRARRAY) ; USR*1.0*23 (AUTHORIZATION/SUBSCRIPTION)
;
I XPDABORT>0 D SORRYEND(.ERRARRAY,CP) Q ; ENVIRONMENT HAS ERROR(S)
;
D BOKAY("ENVIRONMENT")
;
Q
;
POST ; EP -- POST INSTALL
NEW CP,STR,TAB
;
S CP=$P($T(+2),"*",3) ; Current Patch
;
D NEWEAG^BLRPR30P
;
S TAB=$J("",5)
;
; Store # of times installation occurred as well as person & date/time
D ENDINSTL(CP)
;
D BMES^XPDUTL("Laboratory Patch "_CP_" INSTALL complete.")
;
D SNDALERT("Laboratory Patch "_CP_" INSTALL complete.")
;
S STR(1)=" "
S STR(2)=$J("",10)_"POST INSTALL of BLRPRE30 Routine."
S STR(3)=" "
S STR(4)=$J("",15)_"Laboratory Patch "_CP_" INSTALL completed."
S STR(5)=" "
D SENDMAIL("Laboratory Patch "_CP_" INSTALL complete.")
;
Q
;
DEBUG ; EP - Debugging Line Label for environment checker
NEW CP,RPMS,RPMSVER,QFLG,STR
W !!
W "Debug BLRPRE30.",!!
;
; Note -- DEBUG is a negative flag:
; YES="Don't Send Alerts"; NO="Send Alerts"
S DEBUG="YES"
D ^XBFMK
S DIR(0)="YO"
S DIR("B")="NO"
S DIR("A")="Send Alerts/E-Mails"
D ^DIR
S:+$G(Y)=1 DEBUG="NO"
;
W !
S XPDNM="LR*5.2*1030"
S XPDENV=0
;
D BACKUPS
D PRESSKEY^BLRGMENU(4)
;
D PRE
W !!!
;
D ^XBFMK
S DIR(0)="YO"
S DIR("B")="NO"
S DIR("A")="Test Post Install Code"
D ^DIR
;
D:+$G(Y)=1 POST
W !!!
;
Q
;
PRESSKEY(TAB,MSGSTR) ; EP
NEW TABSTR
S TABSTR=$J("",+$G(TAB))_$S(+$L($G(MSGSTR)):$G(MSGSTR),1:"Press RETURN Key")
;
W !
D ^XBFMK
S DIR(0)="E"
S DIR("A")=TABSTR
D ^DIR
I $G(DUOUT) S QFLG="Q" ; If Fileman quit, then set Quit Flag
;
Q
;
ENVHEADR(CP,RPMSVER,RPMS) ; EP -- Environment Header
NEW STARS,STR
S STARS=$TR($J("",IOM)," ","*")
;
S STR="@Checking@Environment@for@Patch@"
S STR=STR_CP_"@of@Version@"
S STR=STR_RPMSVER_"@of@"
S STR=STR_$TR(RPMS," ","@")_".@"
;
D ^XBCLS
W STARS,!
W $TR($$CJ^XLFSTR(STR,IOM)," @","* "),!
W STARS,!
Q
;
BOKAY(MSG,TAB) ; EP -- Write out Blank line, then "OKAY" message
D BMES^XPDUTL($J("",+$G(TAB))_MSG_" OK.")
Q
;
ENDINSTL(CURPATCH) ; EP
NEW INSTCNT ; Installation count
;
S INSTCNT=1+$O(^BLRINSTL("LAB PATCH",CURPATCH,"INSTALLED BY",""),-1)
;
S ^BLRINSTL("LAB PATCH",CURPATCH,"INSTALLED BY",INSTCNT)=$P($G(^VA(200,DUZ,0)),U)
S ^BLRINSTL("LAB PATCH",CURPATCH,"INSTALLED BY",INSTCNT,"DATE/TIME")=$$HTE^XLFDT($H,"5Z")
Q
;
; Error Message routine.
SORRY(CP,MSG,MODE,MSG2) ; EP
NEW MESSAGE,ROWSTARS
;
S ROWSTARS=$TR($J("",65)," ","*") ; Row of asterisks
;
S MODE=$G(MODE,"FATAL")
;
I $G(MODE)="FATAL" 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
;
; STR Array will be used to write to the screen, send E-Mail & Alert
NEW STR,LINECNT,MODESTR
S LINECNT=1
D ADDLINE(.LINECNT)
D ADDLINE(.LINECNT,ROWSTARS)
D ADDLINE(.LINECNT)
D ADDLINE(.LINECNT,"Site: "_$$LOC^XBFUNC,"YES")
D ADDLINE(.LINECNT)
D ADDLINE(.LINECNT,MESSAGE,"YES")
D ADDLINE(.LINECNT)
D BANNERL(.LINECNT,MSG)
D:$D(MSG2) BANNERL(.LINECNT,MSG2)
D ADDLINE(.LINECNT)
;
I $G(MODE)["NONFATAL" D ADDLINE(.LINECNT,MESSAGE,"YES")
;
I $G(MODE)="FATAL" D
. D ADDLINE(.LINECNT,"Please print/capture this screen and","YES")
. D ADDLINE(.LINECNT,"notify the Support Center at","YES")
. D ADDLINE(.LINECNT)
. D ADDLINE(.LINECNT,"1-888-830-7280.","YES")
. D ADDLINE(.LINECNT)
;
D ADDLINE(.LINECNT,ROWSTARS)
D ADDLINE(.LINECNT)
;
D BMES^XPDUTL(.STR)
;
I $G(DEBUG)="YES" Q
;
S MODESTR=$S(MODE="FATAL":" >> FATAL << ",1:" - NONFATAL - ")
D SNDALERT("Laboratory Patch "_CP_MODESTR_MSG)
D SENDMAIL("IHS Lab Patch "_CP_" Install "_MODE_" Error")
Q
;
SNDALERT(ALERTMSG) ; EP - Send alert to LMI group AND Installer
Q:$G(DEBUG)="YES"
;
S XQAMSG=ALERTMSG
S XQA("G.LMI")=""
;
; If installer not part of LMI Mail Group, send them alert also
S:$$NINLMI(DUZ) XQA(DUZ)=""
;
D SETUP^XQALERT
K XQA,XQAMSG
Q
;
NINLMI(CHKDUZ) ; EP -- Check to see if DUZ is NOT part of LMI Mail Group
NEW MGRPIEN,XMDUZ
;
; Get IEN of LMI MaiL Group
D CHKGROUP^XMBGRP("LMI",.MGRPIEN) ; VA DBIA 1146
Q:+(MGRPIEN)<1 1 ; If no Mail Group, return TRUE
;
; XMDUZ = DUZ of the user
; Y = IEN of the mail group
S XMDUZ=DUZ
S Y=MGRPIEN
D CHK^XMA21 ; VA DBIA 10067
;
Q $S($T=1:0,1:1)
;
SENDMAIL(SUBJECT) ; EP -- Send MailMan E-mail to LMI group AND Installer
Q:$G(DEBUG)="YES"
;
NEW DIFROM
;
K XMY
S XMY("G.LMI")=""
;
; If installer not part of LMI Mail Group, send them e-mail also
S:$$NINLMI(DUZ) XMY(DUZ)=""
;
S LRBLNOW=$E($$NOW^XLFDT,1,12)
;
S XMSUB=SUBJECT
S XMTEXT="STR("
S XMDUZ="Lab Patch "_$P($T(+2),"*",3) ; Current Patch
S XMZ="NOT OKAY"
D ^XMD
;
I $G(XMMG)'=""!(XMZ="NOT OKAY") D
. D BMES^XPDUTL($J("",5)_"MAILMAN ERROR.")
. D BMES^XPDUTL($J("",10)_"XMZ:"_XMZ)
. D BMES^XPDUTL($J("",10)_"XMMG:"_XMMG)
;
K X,XMDUZ,XMSUB,XMTEXT,XMY,XMZ,Y ; Cleanup
Q
;
ADDLINE(LC,ASTR,CENTER) ; EP -- Add a line to the STR array; CENTER if requested
I $G(ASTR)="" S ASTR=" "
S STR(LC)=$S($G(CENTER)="YES":$$CJ^XLFSTR(ASTR,65),1:$G(ASTR))
S LC=LC+1
Q
;
SORRYEND(WOTERR,CP) ; EP -- ALL the errors detected during the environment check.
NEW STR,MODULE,NAME,VERSION,PATCH,LINECNT,TMP
;
D SORRYHED
;
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
;
D SORRYFIN
;
D BMES^XPDUTL(.STR)
;
Q
;
SORRYHED ; EP -- "Header" of Final Fatal Message
S LINECNT=1
D ADDLINE(.LINECNT)
D ADDLINE(.LINECNT,ROWSTARS)
D ADDLINE(.LINECNT)
D ADDLINE(.LINECNT,"Systems Environment Error Detected","YES")
D ADDLINE(.LINECNT,"KIDS build will be deleted","YES")
D ADDLINE(.LINECNT)
D ADDLINE(.LINECNT,"Modules with Version or Patch errors","YES")
D ADDLINE(.LINECNT)
Q
;
ADDMESG ; EP
NEW WOT
;
D ADDLINE(.LINECNT,NAME_" ("_MODULE_")","YES")
;
S WOT=$G(WOTERR(MODULE,NAME,VERSION))
S TMP="Version:"_VERSION
I $P(WOT,"^",2)="VERSION" D
. S TMP="Needed Version:"_VERSION
. S TMP=TMP_" Found Version:"_$P(WOT,"^")
I $P(WOT,"^",2)="PATCH" D
. S TMP=TMP_" Needed Patch:"_$P(WOT,"^")
;
D ADDLINE(.LINECNT,TMP,"YES")
D ADDLINE(.LINECNT)
Q
;
SORRYFIN ; EP -- "Fin" of Final Fatal Message
D ADDLINE(.LINECNT,"Re-Installation will be necessary.","YES")
D ADDLINE(.LINECNT)
D ADDLINE(.LINECNT,"If assistance is needed, please call 1-888-830-7280.","YES")
D ADDLINE(.LINECNT)
D ADDLINE(.LINECNT,ROWSTARS)
D ADDLINE(.LINECNT)
Q
;
CHKMAILG(CP,MAILGRP,ERRARRAY) ; Determine if required Mail Group Exists
NEW MGRPIEN
D CHKGROUP^XMBGRP(MAILGRP,.MGRPIEN) ; VA DBIA 1146
I MGRPIEN D Q
. D OKAY^BLRKIDSU(MAILGRP_" Mail Group Exists.")
;
D BMES^XPDUTL("")
D SORRY(CP,MAILGRP_" Mail Group Does NOT Exist!")
S ERRARRAY("XMB","Mail Group","3.8")=MAILGRP_" Mail Group"
Q
;
BANNERL(LC,ASTR) ; EP -- Stores "Banner" Line in STR array
;
S STR(LC)=$$MKBANNRL(ASTR)
S LC=LC+1
Q
;
MKBANNRL(ASTR) ; EP - MaKe the BANNeR Line
NEW HALFLEN,J,RM,STRLEN,TMPSTR
;
S RM=65 ; Right Margin
;
S HALFLEN=(RM\2)-(($L(ASTR)+2)\2)
S TMPSTR=$TR($J("",HALFLEN)," ",">")
S TMPSTR=TMPSTR_" "_ASTR_" "
S STRLEN=$L(TMPSTR)
F J=STRLEN:1:(RM-1) S TMPSTR=TMPSTR_"<"
Q TMPSTR
;
; 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(CP,MODULE,VERSION,PATCH,ERRARRAY) ; EP
NEW NAME ; NAME of PACKAGE
NEW PTR ; PoinTeR to PACKAGE file
NEW HEREYAGO,STR1,STR2 ; Scratch variables/arrays
NEW SYSVER,SYSPATCH ; System Version & System Patch variables
NEW NAMEVER,NAMESYS
;
D FIND^DIC(9.4,"",,,MODULE,,"C",,,"HEREYAGO")
S PTR=$G(HEREYAGO("DILIST",2,1))
S NAME=$G(HEREYAGO("DILIST",1,1))
;
S SYSVER=+$$VERSION^XPDUTL(MODULE) ; Get Current Version #
;
S NAMEVER=NAME_" "_VERSION,NAMESYS=NAME_" "_SYSVER
;
; If Current Version < Needed Version, write message and quit
I SYSVER<VERSION D Q
. S ERRARRAY(MODULE,NAME,VERSION)=SYSVER_"^VERSION"
. D:SYSVER>0 NEEDMSG("Need "_NAMEVER_" & "_NAMESYS_" found!")
. D:SYSVER<1 NEEDMSG("Need "_MODULE_" & "_MODULE_" Not Installed!")
;
; If System Version > Needed Version, write message and quit
I VERSION<SYSVER D OKAY^BLRKIDSU("Need "_NAMEVER_" & "_NAMESYS_" found.",5) Q
;
I $G(PATCH)="" D Q ; If no Patch check, write message and quit
. D OKAY^BLRKIDSU(NAMEVER_" found.",5)
;
S SYSPATCH=$$PATCH^XPDUTL(MODULE_"*"_VERSION_"*"_PATCH)
I SYSPATCH'=1 D Q
. S ERRARRAY(MODULE,NAME,VERSION)=$G(PATCH)_"^PATCH"
. D NEEDMSG(NAMEVER_" & Patch "_PATCH_" WAS NOT installed!")
;
D OKAY^BLRKIDSU(NAMEVER_" Patch "_PATCH_" found.",5)
;
Q
;
NEEDMSG(MESSAGE) ; EP
NEW STR1,STR2
;
S STR1=MESSAGE
I $L(STR1)<58 D SORRY(CP,STR1) Q
;
S STR1=$P(MESSAGE,"&")_" &"
S STR2=$$TRIM^XLFSTR($P(MESSAGE,"&",2),"L"," ")
D SORRY(CP,STR1,,STR2)
Q
;
PASSMESG(WOT) ; EP -- Splash message
NEW MAXIT,AROUND
;
S MAXIT="@"
F J=1:1:$L(WOT) S MAXIT=MAXIT_$E(WOT,J,J)_"@"
S AROUND=$TR($J("",8+$L(MAXIT))," ","@")
S MAXIT="@@!!"_$TR(MAXIT," ","@")_"!!@@"
;
D ^XBCLS
W $TR($J("",IOM)," ","*"),!
W $TR($J("",IOM)," ","*"),!
W $TR($$CJ^XLFSTR(AROUND,IOM)," @","* "),!
W $TR($$CJ^XLFSTR(MAXIT,IOM)," @","* "),!
W $TR($$CJ^XLFSTR(AROUND,IOM)," @","* "),!
W $TR($J("",IOM)," ","*"),!
W $TR($J("",IOM)," ","*"),!
Q
;
BACKUPS ; EP -- Ask for confirmation of Backup
S CP=$P($T(+2),"*",3) ; Current Patch
D PASSMESG("ATTENTION")
W !
;
D ^XBFMK
S DIR(0)="Y"
S DIR("B")="NO"
S DIR("A")=$J("",10)_"Has a "_$C(27)_"[1;7;5m"_">> SUCCESSFUL <<"_$C(27)_"[0m"_" backup been performed?"
D ^DIR
W !
;
I +$G(Y)'=1 D Q
. S XPDABORT=1
. D PASSMESG("ATTENTION")
. D BMES^XPDUTL("")
. D BMES^XPDUTL("")
. D BMES^XPDUTL($J("",15)_"SUCCESSFUL system backup has >>> NOT <<< been confirmed.")
. D BMES^XPDUTL($J("",15)_"Install Aborting.")
;
; 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)=DUZ_"^"_$P($G(^VA(200,DUZ,0)),U)
S ^BLRINSTL("LAB PATCH",CP,"BACKUP CONFIRMED BY",BCKUPCNT,"DATE/TIME")=$$HTE^XLFDT($H,"5MZ")
;
D BMES^XPDUTL("")
D BMES^XPDUTL($J("",5)_"SUCCESSFUL system backup CONFIRMED by: "_$P($G(^VA(200,DUZ,0)),U))
Q
BLRPRE30 ; IHS/OIT/MKK - IHS Lab PATCH 1030 PRE/POST/Environment Routine ; [ JUNE 25, 2010 9:58 AM ]
+1 ;;5.2;IHS LABORATORY;**1030**;NOV 01, 1997
+2 ;
PRE ; EP
+1 NEW CP,PREREQ,RPMS,RPMSVER,QFLG,ROWSTARS,STR
+2 ; Errors array
NEW ERRARRAY
+3 ;
+4 DO BMES^XPDUTL("Beginning of Pre Check.")
+5 ;
+6 IF $GET(XPDNM)=""
Begin DoDot:1
+7 SET CP=$TRANSLATE($PIECE($TEXT(+2),";",5),"*")
+8 DO SORRY(CP,"XPDNM not defined or 0.")
End DoDot:1
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 ;
+14 ; Row of asterisks
SET ROWSTARS=$TRANSLATE($JUSTIFY("",65)," ","*")
+15 ;
USERID ; EP - CHECK FOR USER ID
+1 IF +$GET(DUZ)<1
DO SORRY(CP,"DUZ UNDEFINED OR 0.")
QUIT
+2 ;
+3 IF $PIECE($GET(^VA(200,DUZ,0)),U)=""
DO SORRY(CP,"Installer cannot be identified!")
QUIT
+4 ;
GETREADY ; EP
+1 ; No Queuing Allowed
SET XPDNOQUE=1
+2 ;
+3 ; The following line prevents the "Disable Options..." and "Move
+4 ; Routines..." questions from being asked during the install.
+5 FOR X="XPO1","XPZ1","XPZ2","XPI1"
SET XPDDIQ(X)=0
SET XPDDIQ(X,"B")="NO"
+6 ;
+7 ; KIDS install Flag
SET XPDABORT=0
+8 ;
+9 ; Reset/Initialize IO variables
DO HOME^%ZIS
+10 ; Set DT variable without a Line Feed
DO DTNOLF^DICRW
+11 ;
ENVICHEK ; Environment Checker
+1 DO ENVHEADR(CP,RPMSVER,RPMS)
+2 ;
+3 ; Check for LMI Mail Group
DO CHKMAILG(CP,"LMI",.ERRARRAY)
+4 ; Check for LAB MESSAGING Mail Group
DO CHKMAILG(CP,"LAB MESSAGING",.ERRARRAY)
+5 ;
+6 ; Lab Pre-Requisites
DO NEEDIT(CP,"LR","5.2","1029",.ERRARRAY)
+7 ;
+8 ; MAILMAN 8.0
DO NEEDIT(CP,"XM","8.0",,.ERRARRAY)
+9 ; XU*8.0*1015 (Kernel)
DO NEEDIT(CP,"XU","8.0",1015,.ERRARRAY)
+10 ; PIMS 5.3
DO NEEDIT(CP,"PIMS","5.3",,.ERRARRAY)
+11 ; PXRM*1.5*1 (CLINICAL REMINDERS)
DO NEEDIT(CP,"PXRM","1.5",1,.ERRARRAY)
+12 ; TIU*1.0*137
DO NEEDIT(CP,"TIU","1.0",137,.ERRARRAY)
+13 ; USR*1.0*23 (AUTHORIZATION/SUBSCRIPTION)
DO NEEDIT(CP,"USR","1.0",23,.ERRARRAY)
+14 ;
+15 ; ENVIRONMENT HAS ERROR(S)
IF XPDABORT>0
DO SORRYEND(.ERRARRAY,CP)
QUIT
+16 ;
+17 DO BOKAY("ENVIRONMENT")
+18 ;
+19 QUIT
+20 ;
POST ; EP -- POST INSTALL
+1 NEW CP,STR,TAB
+2 ;
+3 ; Current Patch
SET CP=$PIECE($TEXT(+2),"*",3)
+4 ;
+5 DO NEWEAG^BLRPR30P
+6 ;
+7 SET TAB=$JUSTIFY("",5)
+8 ;
+9 ; Store # of times installation occurred as well as person & date/time
+10 DO ENDINSTL(CP)
+11 ;
+12 DO BMES^XPDUTL("Laboratory Patch "_CP_" INSTALL complete.")
+13 ;
+14 DO SNDALERT("Laboratory Patch "_CP_" INSTALL complete.")
+15 ;
+16 SET STR(1)=" "
+17 SET STR(2)=$JUSTIFY("",10)_"POST INSTALL of BLRPRE30 Routine."
+18 SET STR(3)=" "
+19 SET STR(4)=$JUSTIFY("",15)_"Laboratory Patch "_CP_" INSTALL completed."
+20 SET STR(5)=" "
+21 DO SENDMAIL("Laboratory Patch "_CP_" INSTALL complete.")
+22 ;
+23 QUIT
+24 ;
DEBUG ; EP - Debugging Line Label for environment checker
+1 NEW CP,RPMS,RPMSVER,QFLG,STR
+2 WRITE !!
+3 WRITE "Debug BLRPRE30.",!!
+4 ;
+5 ; Note -- DEBUG is a negative flag:
+6 ; YES="Don't Send Alerts"; NO="Send Alerts"
+7 SET DEBUG="YES"
+8 DO ^XBFMK
+9 SET DIR(0)="YO"
+10 SET DIR("B")="NO"
+11 SET DIR("A")="Send Alerts/E-Mails"
+12 DO ^DIR
+13 IF +$GET(Y)=1
SET DEBUG="NO"
+14 ;
+15 WRITE !
+16 SET XPDNM="LR*5.2*1030"
+17 SET XPDENV=0
+18 ;
+19 DO BACKUPS
+20 DO PRESSKEY^BLRGMENU(4)
+21 ;
+22 DO PRE
+23 WRITE !!!
+24 ;
+25 DO ^XBFMK
+26 SET DIR(0)="YO"
+27 SET DIR("B")="NO"
+28 SET DIR("A")="Test Post Install Code"
+29 DO ^DIR
+30 ;
+31 IF +$GET(Y)=1
DO POST
+32 WRITE !!!
+33 ;
+34 QUIT
+35 ;
PRESSKEY(TAB,MSGSTR) ; EP
+1 NEW TABSTR
+2 SET TABSTR=$JUSTIFY("",+$GET(TAB))_$SELECT(+$LENGTH($GET(MSGSTR)):$GET(MSGSTR),1:"Press RETURN Key")
+3 ;
+4 WRITE !
+5 DO ^XBFMK
+6 SET DIR(0)="E"
+7 SET DIR("A")=TABSTR
+8 DO ^DIR
+9 ; If Fileman quit, then set Quit Flag
IF $GET(DUOUT)
SET QFLG="Q"
+10 ;
+11 QUIT
+12 ;
ENVHEADR(CP,RPMSVER,RPMS) ; EP -- Environment Header
+1 NEW STARS,STR
+2 SET STARS=$TRANSLATE($JUSTIFY("",IOM)," ","*")
+3 ;
+4 SET STR="@Checking@Environment@for@Patch@"
+5 SET STR=STR_CP_"@of@Version@"
+6 SET STR=STR_RPMSVER_"@of@"
+7 SET STR=STR_$TRANSLATE(RPMS," ","@")_".@"
+8 ;
+9 DO ^XBCLS
+10 WRITE STARS,!
+11 WRITE $TRANSLATE($$CJ^XLFSTR(STR,IOM)," @","* "),!
+12 WRITE STARS,!
+13 QUIT
+14 ;
BOKAY(MSG,TAB) ; EP -- Write out Blank line, then "OKAY" message
+1 DO BMES^XPDUTL($JUSTIFY("",+$GET(TAB))_MSG_" OK.")
+2 QUIT
+3 ;
ENDINSTL(CURPATCH) ; EP
+1 ; Installation count
NEW INSTCNT
+2 ;
+3 SET INSTCNT=1+$ORDER(^BLRINSTL("LAB PATCH",CURPATCH,"INSTALLED BY",""),-1)
+4 ;
+5 SET ^BLRINSTL("LAB PATCH",CURPATCH,"INSTALLED BY",INSTCNT)=$PIECE($GET(^VA(200,DUZ,0)),U)
+6 SET ^BLRINSTL("LAB PATCH",CURPATCH,"INSTALLED BY",INSTCNT,"DATE/TIME")=$$HTE^XLFDT($HOROLOG,"5Z")
+7 QUIT
+8 ;
+9 ; Error Message routine.
SORRY(CP,MSG,MODE,MSG2) ; EP
+1 NEW MESSAGE,ROWSTARS
+2 ;
+3 ; Row of asterisks
SET ROWSTARS=$TRANSLATE($JUSTIFY("",65)," ","*")
+4 ;
+5 SET MODE=$GET(MODE,"FATAL")
+6 ;
+7 IF $GET(MODE)="FATAL"
Begin DoDot:1
+8 SET MESSAGE="Install Aborting due to the following Systems Environment issue:"
+9 ; Fatal Error Flag Set
SET XPDABORT=1
End DoDot:1
+10 ;
+11 IF $GET(MODE)["NONFATAL"
SET MESSAGE="*** WARNING *** WARNING *** WARNING ***"
+12 ;
+13 KILL DIFQ
+14 ;
+15 ; STR Array will be used to write to the screen, send E-Mail & Alert
+16 NEW STR,LINECNT,MODESTR
+17 SET LINECNT=1
+18 DO ADDLINE(.LINECNT)
+19 DO ADDLINE(.LINECNT,ROWSTARS)
+20 DO ADDLINE(.LINECNT)
+21 DO ADDLINE(.LINECNT,"Site: "_$$LOC^XBFUNC,"YES")
+22 DO ADDLINE(.LINECNT)
+23 DO ADDLINE(.LINECNT,MESSAGE,"YES")
+24 DO ADDLINE(.LINECNT)
+25 DO BANNERL(.LINECNT,MSG)
+26 IF $DATA(MSG2)
DO BANNERL(.LINECNT,MSG2)
+27 DO ADDLINE(.LINECNT)
+28 ;
+29 IF $GET(MODE)["NONFATAL"
DO ADDLINE(.LINECNT,MESSAGE,"YES")
+30 ;
+31 IF $GET(MODE)="FATAL"
Begin DoDot:1
+32 DO ADDLINE(.LINECNT,"Please print/capture this screen and","YES")
+33 DO ADDLINE(.LINECNT,"notify the Support Center at","YES")
+34 DO ADDLINE(.LINECNT)
+35 DO ADDLINE(.LINECNT,"1-888-830-7280.","YES")
+36 DO ADDLINE(.LINECNT)
End DoDot:1
+37 ;
+38 DO ADDLINE(.LINECNT,ROWSTARS)
+39 DO ADDLINE(.LINECNT)
+40 ;
+41 DO BMES^XPDUTL(.STR)
+42 ;
+43 IF $GET(DEBUG)="YES"
QUIT
+44 ;
+45 SET MODESTR=$SELECT(MODE="FATAL":" >> FATAL << ",1:" - NONFATAL - ")
+46 DO SNDALERT("Laboratory Patch "_CP_MODESTR_MSG)
+47 DO SENDMAIL("IHS Lab Patch "_CP_" Install "_MODE_" Error")
+48 QUIT
+49 ;
SNDALERT(ALERTMSG) ; EP - Send alert to LMI group AND Installer
+1 IF $GET(DEBUG)="YES"
QUIT
+2 ;
+3 SET XQAMSG=ALERTMSG
+4 SET XQA("G.LMI")=""
+5 ;
+6 ; If installer not part of LMI Mail Group, send them alert also
+7 IF $$NINLMI(DUZ)
SET XQA(DUZ)=""
+8 ;
+9 DO SETUP^XQALERT
+10 KILL XQA,XQAMSG
+11 QUIT
+12 ;
NINLMI(CHKDUZ) ; EP -- Check to see if DUZ is NOT part of LMI Mail Group
+1 NEW MGRPIEN,XMDUZ
+2 ;
+3 ; Get IEN of LMI MaiL Group
+4 ; VA DBIA 1146
DO CHKGROUP^XMBGRP("LMI",.MGRPIEN)
+5 ; If no Mail Group, return TRUE
IF +(MGRPIEN)<1
QUIT 1
+6 ;
+7 ; XMDUZ = DUZ of the user
+8 ; Y = IEN of the mail group
+9 SET XMDUZ=DUZ
+10 SET Y=MGRPIEN
+11 ; VA DBIA 10067
DO CHK^XMA21
+12 ;
+13 QUIT $SELECT($TEST=1:0,1:1)
+14 ;
SENDMAIL(SUBJECT) ; EP -- Send MailMan E-mail to LMI group AND Installer
+1 IF $GET(DEBUG)="YES"
QUIT
+2 ;
+3 NEW DIFROM
+4 ;
+5 KILL XMY
+6 SET XMY("G.LMI")=""
+7 ;
+8 ; If installer not part of LMI Mail Group, send them e-mail also
+9 IF $$NINLMI(DUZ)
SET XMY(DUZ)=""
+10 ;
+11 SET LRBLNOW=$EXTRACT($$NOW^XLFDT,1,12)
+12 ;
+13 SET XMSUB=SUBJECT
+14 SET XMTEXT="STR("
+15 ; Current Patch
SET XMDUZ="Lab Patch "_$PIECE($TEXT(+2),"*",3)
+16 SET XMZ="NOT OKAY"
+17 DO ^XMD
+18 ;
+19 IF $GET(XMMG)'=""!(XMZ="NOT OKAY")
Begin DoDot:1
+20 DO BMES^XPDUTL($JUSTIFY("",5)_"MAILMAN ERROR.")
+21 DO BMES^XPDUTL($JUSTIFY("",10)_"XMZ:"_XMZ)
+22 DO BMES^XPDUTL($JUSTIFY("",10)_"XMMG:"_XMMG)
End DoDot:1
+23 ;
+24 ; Cleanup
KILL X,XMDUZ,XMSUB,XMTEXT,XMY,XMZ,Y
+25 QUIT
+26 ;
ADDLINE(LC,ASTR,CENTER) ; EP -- Add a line to the STR array; CENTER if requested
+1 IF $GET(ASTR)=""
SET ASTR=" "
+2 SET STR(LC)=$SELECT($GET(CENTER)="YES":$$CJ^XLFSTR(ASTR,65),1:$GET(ASTR))
+3 SET LC=LC+1
+4 QUIT
+5 ;
SORRYEND(WOTERR,CP) ; EP -- ALL the errors detected during the environment check.
+1 NEW STR,MODULE,NAME,VERSION,PATCH,LINECNT,TMP
+2 ;
+3 DO SORRYHED
+4 ;
+5 SET (MODULE,NAME,VERSION)=""
+6 FOR
SET MODULE=$ORDER(WOTERR(MODULE))
IF MODULE=""
QUIT
Begin DoDot:1
+7 FOR
SET NAME=$ORDER(WOTERR(MODULE,NAME))
IF NAME=""
QUIT
Begin DoDot:2
+8 FOR
SET VERSION=$ORDER(WOTERR(MODULE,NAME,VERSION))
IF VERSION=""
QUIT
Begin DoDot:3
+9 DO ADDMESG
End DoDot:3
End DoDot:2
End DoDot:1
+10 ;
+11 DO SORRYFIN
+12 ;
+13 DO BMES^XPDUTL(.STR)
+14 ;
+15 QUIT
+16 ;
SORRYHED ; EP -- "Header" of Final Fatal Message
+1 SET LINECNT=1
+2 DO ADDLINE(.LINECNT)
+3 DO ADDLINE(.LINECNT,ROWSTARS)
+4 DO ADDLINE(.LINECNT)
+5 DO ADDLINE(.LINECNT,"Systems Environment Error Detected","YES")
+6 DO ADDLINE(.LINECNT,"KIDS build will be deleted","YES")
+7 DO ADDLINE(.LINECNT)
+8 DO ADDLINE(.LINECNT,"Modules with Version or Patch errors","YES")
+9 DO ADDLINE(.LINECNT)
+10 QUIT
+11 ;
ADDMESG ; EP
+1 NEW WOT
+2 ;
+3 DO ADDLINE(.LINECNT,NAME_" ("_MODULE_")","YES")
+4 ;
+5 SET WOT=$GET(WOTERR(MODULE,NAME,VERSION))
+6 SET TMP="Version:"_VERSION
+7 IF $PIECE(WOT,"^",2)="VERSION"
Begin DoDot:1
+8 SET TMP="Needed Version:"_VERSION
+9 SET TMP=TMP_" Found Version:"_$PIECE(WOT,"^")
End DoDot:1
+10 IF $PIECE(WOT,"^",2)="PATCH"
Begin DoDot:1
+11 SET TMP=TMP_" Needed Patch:"_$PIECE(WOT,"^")
End DoDot:1
+12 ;
+13 DO ADDLINE(.LINECNT,TMP,"YES")
+14 DO ADDLINE(.LINECNT)
+15 QUIT
+16 ;
SORRYFIN ; EP -- "Fin" of Final Fatal Message
+1 DO ADDLINE(.LINECNT,"Re-Installation will be necessary.","YES")
+2 DO ADDLINE(.LINECNT)
+3 DO ADDLINE(.LINECNT,"If assistance is needed, please call 1-888-830-7280.","YES")
+4 DO ADDLINE(.LINECNT)
+5 DO ADDLINE(.LINECNT,ROWSTARS)
+6 DO ADDLINE(.LINECNT)
+7 QUIT
+8 ;
CHKMAILG(CP,MAILGRP,ERRARRAY) ; Determine if required Mail Group Exists
+1 NEW MGRPIEN
+2 ; VA DBIA 1146
DO CHKGROUP^XMBGRP(MAILGRP,.MGRPIEN)
+3 IF MGRPIEN
Begin DoDot:1
+4 DO OKAY^BLRKIDSU(MAILGRP_" Mail Group Exists.")
End DoDot:1
QUIT
+5 ;
+6 DO BMES^XPDUTL("")
+7 DO SORRY(CP,MAILGRP_" Mail Group Does NOT Exist!")
+8 SET ERRARRAY("XMB","Mail Group","3.8")=MAILGRP_" Mail Group"
+9 QUIT
+10 ;
BANNERL(LC,ASTR) ; EP -- Stores "Banner" Line in STR array
+1 ;
+2 SET STR(LC)=$$MKBANNRL(ASTR)
+3 SET LC=LC+1
+4 QUIT
+5 ;
MKBANNRL(ASTR) ; EP - MaKe the BANNeR Line
+1 NEW HALFLEN,J,RM,STRLEN,TMPSTR
+2 ;
+3 ; Right Margin
SET RM=65
+4 ;
+5 SET HALFLEN=(RM\2)-(($LENGTH(ASTR)+2)\2)
+6 SET TMPSTR=$TRANSLATE($JUSTIFY("",HALFLEN)," ",">")
+7 SET TMPSTR=TMPSTR_" "_ASTR_" "
+8 SET STRLEN=$LENGTH(TMPSTR)
+9 FOR J=STRLEN:1:(RM-1)
SET TMPSTR=TMPSTR_"<"
+10 QUIT TMPSTR
+11 ;
+12 ; Generic "Find RPMS Module's Version and (perhaps) Patch number"
+13 ; The MODULE variable MUST be the PREFIX name from the PACKAGE file (9.4).
NEEDIT(CP,MODULE,VERSION,PATCH,ERRARRAY) ; EP
+1 ; NAME of PACKAGE
NEW NAME
+2 ; PoinTeR to PACKAGE file
NEW PTR
+3 ; Scratch variables/arrays
NEW HEREYAGO,STR1,STR2
+4 ; System Version & System Patch variables
NEW SYSVER,SYSPATCH
+5 NEW NAMEVER,NAMESYS
+6 ;
+7 DO FIND^DIC(9.4,"",,,MODULE,,"C",,,"HEREYAGO")
+8 SET PTR=$GET(HEREYAGO("DILIST",2,1))
+9 SET NAME=$GET(HEREYAGO("DILIST",1,1))
+10 ;
+11 ; Get Current Version #
SET SYSVER=+$$VERSION^XPDUTL(MODULE)
+12 ;
+13 SET NAMEVER=NAME_" "_VERSION
SET NAMESYS=NAME_" "_SYSVER
+14 ;
+15 ; If Current Version < Needed Version, write message and quit
+16 IF SYSVER<VERSION
Begin DoDot:1
+17 SET ERRARRAY(MODULE,NAME,VERSION)=SYSVER_"^VERSION"
+18 IF SYSVER>0
DO NEEDMSG("Need "_NAMEVER_" & "_NAMESYS_" found!")
+19 IF SYSVER<1
DO NEEDMSG("Need "_MODULE_" & "_MODULE_" Not Installed!")
End DoDot:1
QUIT
+20 ;
+21 ; If System Version > Needed Version, write message and quit
+22 IF VERSION<SYSVER
DO OKAY^BLRKIDSU("Need "_NAMEVER_" & "_NAMESYS_" found.",5)
QUIT
+23 ;
+24 ; If no Patch check, write message and quit
IF $GET(PATCH)=""
Begin DoDot:1
+25 DO OKAY^BLRKIDSU(NAMEVER_" found.",5)
End DoDot:1
QUIT
+26 ;
+27 SET SYSPATCH=$$PATCH^XPDUTL(MODULE_"*"_VERSION_"*"_PATCH)
+28 IF SYSPATCH'=1
Begin DoDot:1
+29 SET ERRARRAY(MODULE,NAME,VERSION)=$GET(PATCH)_"^PATCH"
+30 DO NEEDMSG(NAMEVER_" & Patch "_PATCH_" WAS NOT installed!")
End DoDot:1
QUIT
+31 ;
+32 DO OKAY^BLRKIDSU(NAMEVER_" Patch "_PATCH_" found.",5)
+33 ;
+34 QUIT
+35 ;
NEEDMSG(MESSAGE) ; EP
+1 NEW STR1,STR2
+2 ;
+3 SET STR1=MESSAGE
+4 IF $LENGTH(STR1)<58
DO SORRY(CP,STR1)
QUIT
+5 ;
+6 SET STR1=$PIECE(MESSAGE,"&")_" &"
+7 SET STR2=$$TRIM^XLFSTR($PIECE(MESSAGE,"&",2),"L"," ")
+8 DO SORRY(CP,STR1,,STR2)
+9 QUIT
+10 ;
PASSMESG(WOT) ; EP -- Splash message
+1 NEW MAXIT,AROUND
+2 ;
+3 SET MAXIT="@"
+4 FOR J=1:1:$LENGTH(WOT)
SET MAXIT=MAXIT_$EXTRACT(WOT,J,J)_"@"
+5 SET AROUND=$TRANSLATE($JUSTIFY("",8+$LENGTH(MAXIT))," ","@")
+6 SET MAXIT="@@!!"_$TRANSLATE(MAXIT," ","@")_"!!@@"
+7 ;
+8 DO ^XBCLS
+9 WRITE $TRANSLATE($JUSTIFY("",IOM)," ","*"),!
+10 WRITE $TRANSLATE($JUSTIFY("",IOM)," ","*"),!
+11 WRITE $TRANSLATE($$CJ^XLFSTR(AROUND,IOM)," @","* "),!
+12 WRITE $TRANSLATE($$CJ^XLFSTR(MAXIT,IOM)," @","* "),!
+13 WRITE $TRANSLATE($$CJ^XLFSTR(AROUND,IOM)," @","* "),!
+14 WRITE $TRANSLATE($JUSTIFY("",IOM)," ","*"),!
+15 WRITE $TRANSLATE($JUSTIFY("",IOM)," ","*"),!
+16 QUIT
+17 ;
BACKUPS ; EP -- Ask for confirmation of Backup
+1 ; Current Patch
SET CP=$PIECE($TEXT(+2),"*",3)
+2 DO PASSMESG("ATTENTION")
+3 WRITE !
+4 ;
+5 DO ^XBFMK
+6 SET DIR(0)="Y"
+7 SET DIR("B")="NO"
+8 SET DIR("A")=$JUSTIFY("",10)_"Has a "_$CHAR(27)_"[1;7;5m"_">> SUCCESSFUL <<"_$CHAR(27)_"[0m"_" backup been performed?"
+9 DO ^DIR
+10 WRITE !
+11 ;
+12 IF +$GET(Y)'=1
Begin DoDot:1
+13 SET XPDABORT=1
+14 DO PASSMESG("ATTENTION")
+15 DO BMES^XPDUTL("")
+16 DO BMES^XPDUTL("")
+17 DO BMES^XPDUTL($JUSTIFY("",15)_"SUCCESSFUL system backup has >>> NOT <<< been confirmed.")
+18 DO BMES^XPDUTL($JUSTIFY("",15)_"Install Aborting.")
End DoDot:1
QUIT
+19 ;
+20 ; Store backup confirmation person & date/time
+21 ; Current Patch,Backup count
NEW BCKUPCNT
+22 SET BCKUPCNT=1+$ORDER(^BLRINSTL("LAB PATCH",CP,"BACKUP CONFIRMED BY",""),-1)
+23 SET ^BLRINSTL("LAB PATCH",CP,"BACKUP CONFIRMED BY",BCKUPCNT)=DUZ_"^"_$PIECE($GET(^VA(200,DUZ,0)),U)
+24 SET ^BLRINSTL("LAB PATCH",CP,"BACKUP CONFIRMED BY",BCKUPCNT,"DATE/TIME")=$$HTE^XLFDT($HOROLOG,"5MZ")
+25 ;
+26 DO BMES^XPDUTL("")
+27 DO BMES^XPDUTL($JUSTIFY("",5)_"SUCCESSFUL system backup CONFIRMED by: "_$PIECE($GET(^VA(200,DUZ,0)),U))
+28 QUIT
