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