Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BLRPRE26

BLRPRE26.m

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