- 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