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

BLRPRE22.m

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