BLRPRE24 ; IHS/OIT/MKK - LAB PATCH 1024 ENVIRONMENT/POST INSTALL ROUTINE; [ 01/04/2008 8:00 AM ]
;;5.2;LR;**1024**;May 02, 2008
;
PRECHK ; EP
D BMES^XPDUTL("Beginning of Pre Check.")
NEW CP ; Current Patch
NEW LINE2 ; Second line of THIS Routine
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
;
S LINE2=$T(+2)
;
; Current Patch
S CP=$TR($P(LINE2,";",5),"*")
;
; Check for Cache environment
I $$UP^XLFSTR($$VERSION^%ZOSV(1))'["CACHE" D SORRY("NOT A CACHE ENVIRONMENT.",,,CP) Q
;
; Last Patch
S LASTPTCH=+$TR($P(LINE2,";",5),"*")-2
;
; RPMS Module
S RPMS=$P(LINE2,";",4)
;
; Version of RPMS module being patched
S RPMSVER=$P(LINE2,";",3)
;
S XPDNOQUE="NO QUE" ; No Queuing Allowed
;
; The following line prevents the "Disable Options..." and "Move
; Routines..." questions from being asked during the install.
I $G(XPDENV)=1 S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
I $G(XPDENV)=1 S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
F X="XPO1","XPZ1","XPZ2","XPI1" S XPDDIQ(X)=0
;
S XPDABORT=0 ; KIDS install Flag
;
USERID ; CHECK FOR USER ID
I '$G(DUZ) D SORRY("DUZ UNDEFINED OR 0.",,,CP) Q
;
I '$L($G(DUZ(0))) D SORRY("DUZ(0) UNDEFINED OR NULL.",,,CP) 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!",,,CP) 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",,.WOTERR,CP)
;
KERNEL ; CHECK FOR KERNEL 8.0 & PATCH 1013
D NEEDIT("XU","8.0",1013,.WOTERR,CP)
;
LABVER ; CHECK FOR LAB 5.2 & PREVIOUS PATCH
D NEEDIT("LR","5.2",LASTPTCH,.WOTERR,CP)
;
LMIMAIL ; CHECK FOR LMI MAIL GROUP
D CHECKLMI(.WOTERR,CP)
;
MAILMAN ; CHECK FOR MAILMAN 7.1
D NEEDIT("XM","7.1",,.WOTERR,CP)
;
ENVOK ; ENVIRONMENT OK
I XPDABORT<1 D BMES^XPDUTL("ENVIRONMENT OK.")
;
I XPDABORT>0 D SORRYEND(.WOTERR,CP)
;
Q
;
BACKUP ; EP
D BACKUPS(1024)
Q
;
POST ; EP -- POST INSTALL
NEW CP ; Current Patch
S CP=$TR($P($T(+2),";",5),"*")
;
D MODBLRM(CP) ; Modify BLRMENU option(s)
;
D ALLDONE(CP) ; Complete Message
;
; Store # of times installation occurred as well as person & date/time
D ENDINSTL(CP)
;
Q
;
DEBUG ; Debugging Mode for environment checker
NEW DEBUG
S DEBUG="YES"
D PRECHK
Q
;
; Modify menu items on the BLRMENU option
MODBLRM(CP) ;
; Remove EDT from BLRMENU
D DELFMENU("BLRMENU","BLREPOLR","Edit Provider/Ordering Location",CP)
;
; Add option to run the new IHS LOINC reports to BLRMENU
D ADDTMENU("BLRMENU","BLRLOINC","LOI","IHS LOINC Percentage report",CP)
D ADDTMENU("BLRMENU","BLRNOLER","NLO","Lab Tests Without LOINC Entries Report",CP)
;
; Add option to clear ALL BLR errors from error log regardless
; when the error occurred.
D ADDTMENU("BLRMENU","BLR CLEAR ALL LINK ERRORS","RBE",,CP)
Q
;
NEEDIT(MODULE,VERSION,PATCH,WOTERR,CP) ; EP
; 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).
;
NEW NAME ; NAME of RPMS Module
NEW PTR ; PoinTeR to PACKAGE file
NEW HEREYAGO ; Array to store returned values from FIND^DIC
NEW STR1,STR2 ; Temporary Strings
;
; 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
. S WOTERR(MODULE,NAME,VERSION)=""
. S STR1="Need "_NAME_" "_VERSION_" & "_NAME_" "_X_" found!"
. I $L(STR1)<58 D SORRY(STR1,,,CP)
. I $L(STR1)>57 D
.. S STR1="Need "_NAME_" "_VERSION_" & "
.. S STR2=NAME_" "_X_" found!"
.. D SORRY(STR1,,STR2,CP)
;
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
. S WOTERR(MODULE,NAME,VERSION)=$G(PATCH)
. S STR1=NAME_" "_VERSION_" Patch "_PATCH_" WAS NOT installed!"
. I $L(STR1)<58 D SORRY(STR1,,,CP)
. I $L(STR1)>57 D
.. S STR1=NAME_" "_VERSION
.. S STR2="Patch "_PATCH_" WAS NOT installed!"
.. D SORRY(STR1,,STR2,CP)
;
D OKAY(NAME_" "_VERSION_" Patch "_PATCH_" found.",10)
;
Q
;
SORRY(MSG,MODE,MSG2,CP) ; EP
; Error Message routine. It will send an ALERT and a MailMan message
; to the people who are assigned to the LMI Mail group (if it exists).
;
; The STR array is built so that the error/warning message will
; also appear on the INSTALL LOG via the D BMES^XPDUTL(.STR) call.
;
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 LINECNT=1
D ADDLINE($TR($J("",65)," ","*"),.LINECNT) ; Row of asterisks
D ADDLINE(" ",.LINECNT)
D ADDLINE($$CJ^XLFSTR("Site: "_$$LOC^XBFUNC,65),.LINECNT)
D ADDLINE(" ",.LINECNT)
D ADDLINE($$CJ^XLFSTR(MESSAGE,65),.LINECNT)
D ADDLINE(" ",.LINECNT)
D ADDLINE($$CJ^XLFSTR(">>> "_MSG_" <<<",65),.LINECNT)
I $D(MSG2) D ADDLINE($$CJ^XLFSTR(">>> "_MSG2_" <<<",65),.LINECNT)
D ADDLINE(" ",.LINECNT)
;
I $G(MODE)["NONFATAL" D ADDLINE($$CJ^XLFSTR(MESSAGE,65),.LINECNT)
;
I $G(MODE)'["NONFATAL" D
. D ADDLINE($$CJ^XLFSTR("Please print/capture this screen and",65),.LINECNT)
. D ADDLINE($$CJ^XLFSTR("notify the Support Center at",65),.LINECNT)
. D ADDLINE(" ",.LINECNT)
. D ADDLINE($$CJ^XLFSTR("1-999-999-9999.",65),.LINECNT)
. D ADDLINE(" ",.LINECNT)
;
D ADDLINE($TR($J("",65)," ","*"),.LINECNT) ; Row of asterisks
D ADDLINE(" ",.LINECNT)
;
D BMES^XPDUTL(.STR) ; Display the message
;
; If Debugging, just exit -- Don't send e-mail nor alert
I $G(DEBUG)="YES" Q
;
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
;
SNDALERT(ALERTMSG) ; EP
; Send alert to LMI group
S XQAMSG=ALERTMSG
S XQA("G.LMI")=""
D SETUP^XQALERT
K XQA,XQAMSG
Q
;
SENDMAIL(MAILMSG) ; EP
; Send MailMan E-mail to LMI group -- message is in the STR array
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
;
SORRYEND(WOTERR,CP) ; EP
; Output a listing of ALL the errors detected during
; the environment check. The STR array will be
; displayed by the BMES^XPDUTL call.
;
NEW STR,MODULE,NAME,VERSION,PATCH,LINECNT,TMP
;
D SORRYHED
;
; Add ALL the errors detected to the STR array
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) ; Display the message in the STR array
;
Q
;
SORRYHED ; EP
; "Header" of Final Fatal Message
S LINECNT=1
D ADDLINE(" ",.LINECNT)
D ADDLINE($TR($J("",65)," ","*"),.LINECNT)
D ADDLINE(" ",.LINECNT)
D ADDLINE($$CJ^XLFSTR("Systems Environment Error Detected",65),.LINECNT)
D ADDLINE($$CJ^XLFSTR("KIDS build will be deleted",65),.LINECNT)
D ADDLINE(" ",.LINECNT)
D ADDLINE($$CJ^XLFSTR("Modules with Version or Patch errors",65),.LINECNT)
D ADDLINE(" ",.LINECNT)
Q
;
SORRYFIN ; EP
; "Fin" of Final Fatal Message
D ADDLINE($$CJ^XLFSTR("Re-Installation will be necessary.",65),.LINECNT)
D ADDLINE(" ",.LINECNT)
D ADDLINE($$CJ^XLFSTR("If assistance is needed, please call 1-999-999-9999.",65),.LINECNT)
D ADDLINE(" ",.LINECNT)
D ADDLINE($TR($J("",65)," ","*"),.LINECNT)
D ADDLINE(" ",.LINECNT)
Q
;
ADDMESG ; EP
; Add to the STR array
S PATCH=$G(WOTERR(MODULE,NAME,VERSION))
D ADDLINE($$CJ^XLFSTR(NAME_" ("_MODULE_")",65),.LINECNT)
;
S TMP="Version:"_VERSION
I $G(PATCH)'="" S TMP=TMP_" Patch:"_$G(PATCH)
;
D ADDLINE($$CJ^XLFSTR(TMP,65),.LINECNT)
D ADDLINE(" ",.LINECNT)
Q
;
ADDLINE(ASTR,LC) ; EP
; Add a line to the STR array
I $G(ASTR)="" S ASTR=" "
S STR(LC)=ASTR
S LC=LC+1
Q
;
OKAY(MSG,TAB) ; EP
; Write out "OKAY" message
NEW MESSAGE
I $G(TAB)="" S TAB=5
S MESSAGE=$J("",TAB)_MSG_" OK."
D MES^XPDUTL(MESSAGE)
Q
;
CHECKLMI(WOTERR,CP) ; EP
;CHECK FOR LMI MAIL GROUP
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
. D SORRY("'LMI' mail group NOT found!",,,CP)
. S WOTERR("XMB(3.8","Mail Group","3.8")="LMI Mail Group"
Q
;
BACKUPS(CP) ; EP - CHECK TO CONFIRM BACKUPS HAVE BEEN DONE
; CP = 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
;
TABMESG(MSG,TAB,TAIL) ; EP
; Generic message output WITH 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 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
;
; Procedure that adds the options to Menus.
; Uses Kernel's ADD^XPDMENU function
NEW ADDOPT,CHKIT,STR1,STR2,STR3
;
; ADDOPT String set to ADDEE string or Interactive MeSsaGe string
S ADDOPT=$S($D(IMSG):IMSG,1:ADDEE)
;
D BMES^XPDUTL("Adding "_ADDOPT_" to "_ADDER_".")
;
S CHKIT=$$ADD^XPDMENU(ADDER,ADDEE,ITM)
;
I CHKIT=1 D Q
. D OKAY(ADDOPT_" added to "_ADDER_".",5)
. D MES^XPDUTL(" ")
;
I CHKIT'=1 D
. S STR1="Error in adding "_ADDOPT_" to "_ADDER_"."
. I $L(STR1)<58 D SORRY(STR1,"NONFATAL",,CP)
. I $L(STR1)>57 D
.. S STR1="Error in adding "_ADDOPT
.. S STR2="to "_ADDER
.. D SORRY(STR1,"NONFATAL",STR2,,CP)
;
Q
;
; Procedure that deletes from a Menu.
; It is OKAY if the option doesn't exist on the Menu.
; Uses Kernel's DELETE^XPDMENU function
NEW CHKIT,DELOPT,STR1,STR2
NEW DMENUIEN,HEREYAGO
;
; DELOPT String set to DOPTION string or Interactive MeSsaGe string
S DELOPT=$S($D(IMSG):IMSG,1:DOPTION)
;
D BMES^XPDUTL("Removing "_DELOPT_" from "_DMENU_".")
;
; First, Find IEN of MENU from which option will be deleted
D FIND^DIC(19,,,,"BLRMENU",,,,,"HEREYAGO")
S DMENUIEN=+$G(HEREYAGO("DILIST",2,1))
;
; If MENU doesn't exist, just write a message and return
I DMENUIEN<1 D Q
. D OKAY("MENU "_DMENU_" NOT Found in Option File.",5)
. D MES^XPDUTL(" ")
;
; Find out if Option still on the MENU from which it is to be deleted.
K HEREYAGO
D FIND^DIC(19.01,","_DMENUIEN_",",,,DOPTION,,,,,"HEREYAGO")
;
; If Option is not on MENU, then just write a message and return
I +$G(HEREYAGO("DILIST",2,1))<1 D Q
. S STR1=DELOPT_" not found on "_DMENU_"."
. I $L(STR1)<58 D Q
.. D OKAY(STR1,5)
.. D MES^XPDUTL(" ")
. ;
. S STR1=DELOPT_" not found"
. S STR2="on "_DMENU_"."
. D TABMESG(STR1,5)
. D OKAY(STR2,5)
. D MES^XPDUTL(" ")
;
S CHKIT=$$DELETE^XPDMENU(DMENU,DOPTION)
;
I CHKIT=1 D Q
. D OKAY(DELOPT_" removed from "_DMENU_".",5)
. D MES^XPDUTL(" ")
;
I CHKIT'=1 D
. S STR1="Error removing "_DELOPT_" from "_DMENU_"."
. I $L(STR1)<58 D SORRY(STR1,"NONFATAL",,CP)
. I $L(STR1)>57 D
.. S STR1="Error removing "_DELOPT
.. S STR2="from "_DMENU
.. D SORRY(STR1,"NONFATAL",STR2,CP)
;
Q
;
ALLDONE(CURPATCH) ; EP
; Complete Message
NEW STR,LINECNT,MSG
;
S MSG="Laboratory Patch "_CURPATCH_" INSTALL complete."
;
K STR
S LINECNT=1
D ADDLINE($TR($J("",65)," ","*"),.LINECNT) ; Row of asterisks
D ADDLINE(" ",.LINECNT)
D ADDLINE($$CJ^XLFSTR("Site: "_$$LOC^XBFUNC,65),.LINECNT)
D ADDLINE(" ",.LINECNT)
D ADDLINE($$CJ^XLFSTR(MSG,65),.LINECNT)
D ADDLINE(" ",.LINECNT)
D ADDLINE($TR($J("",65)," ","*"),.LINECNT)
D ADDLINE(" ",.LINECNT)
;
D BMES^XPDUTL(.STR) ; Display the message
D SNDALERT(MSG)
D SENDMAIL(MSG)
;
Q
;
ENDINSTL(CURPATCH) ; EP
; Procedure that stores information into the ^BLRINSTL global
; regarding # of times instllation occurred as well as the
; person who is installaing and the date/time of the install.
;
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
BLRPRE24 ; IHS/OIT/MKK - LAB PATCH 1024 ENVIRONMENT/POST INSTALL ROUTINE; [ 01/04/2008 8:00 AM ]
+1 ;;5.2;LR;**1024**;May 02, 2008
+2 ;
PRECHK ; EP
+1 DO BMES^XPDUTL("Beginning of Pre Check.")
+2 ; Current Patch
NEW CP
+3 ; Second line of THIS Routine
NEW LINE2
+4 ; RPMS module being patched
NEW RPMS
+5 ; Version of RPMS module being patched
NEW RPMSVER
+6 ; String -- used as an array for messages.
NEW STR
+7 ; Last Patch of Lab
NEW LASTPTCH
+8 ; Last Patch Install Status
NEW LRSTATUS
+9 ; Array of errors detected
NEW WOTERR
+10 ;
+11 SET LINE2=$TEXT(+2)
+12 ;
+13 ; Current Patch
+14 SET CP=$TRANSLATE($PIECE(LINE2,";",5),"*")
+15 ;
+16 ; Check for Cache environment
+17 IF $$UP^XLFSTR($$VERSION^%ZOSV(1))'["CACHE"
DO SORRY("NOT A CACHE ENVIRONMENT.",,,CP)
QUIT
+18 ;
+19 ; Last Patch
+20 SET LASTPTCH=+$TRANSLATE($PIECE(LINE2,";",5),"*")-2
+21 ;
+22 ; RPMS Module
+23 SET RPMS=$PIECE(LINE2,";",4)
+24 ;
+25 ; Version of RPMS module being patched
+26 SET RPMSVER=$PIECE(LINE2,";",3)
+27 ;
+28 ; No Queuing Allowed
SET XPDNOQUE="NO QUE"
+29 ;
+30 ; The following line prevents the "Disable Options..." and "Move
+31 ; Routines..." questions from being asked during the install.
+32 IF $GET(XPDENV)=1
SET (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
+33 IF $GET(XPDENV)=1
SET (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
+34 FOR X="XPO1","XPZ1","XPZ2","XPI1"
SET XPDDIQ(X)=0
+35 ;
+36 ; KIDS install Flag
SET XPDABORT=0
+37 ;
USERID ; CHECK FOR USER ID
+1 IF '$GET(DUZ)
DO SORRY("DUZ UNDEFINED OR 0.",,,CP)
QUIT
+2 ;
+3 IF '$LENGTH($GET(DUZ(0)))
DO SORRY("DUZ(0) UNDEFINED OR NULL.",,,CP)
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!",,,CP)
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",,.WOTERR,CP)
+2 ;
KERNEL ; CHECK FOR KERNEL 8.0 & PATCH 1013
+1 DO NEEDIT("XU","8.0",1013,.WOTERR,CP)
+2 ;
LABVER ; CHECK FOR LAB 5.2 & PREVIOUS PATCH
+1 DO NEEDIT("LR","5.2",LASTPTCH,.WOTERR,CP)
+2 ;
LMIMAIL ; CHECK FOR LMI MAIL GROUP
+1 DO CHECKLMI(.WOTERR,CP)
+2 ;
MAILMAN ; CHECK FOR MAILMAN 7.1
+1 DO NEEDIT("XM","7.1",,.WOTERR,CP)
+2 ;
ENVOK ; ENVIRONMENT OK
+1 IF XPDABORT<1
DO BMES^XPDUTL("ENVIRONMENT OK.")
+2 ;
+3 IF XPDABORT>0
DO SORRYEND(.WOTERR,CP)
+4 ;
+5 QUIT
+6 ;
BACKUP ; EP
+1 DO BACKUPS(1024)
+2 QUIT
+3 ;
POST ; EP -- POST INSTALL
+1 ; Current Patch
NEW CP
+2 SET CP=$TRANSLATE($PIECE($TEXT(+2),";",5),"*")
+3 ;
+4 ; Modify BLRMENU option(s)
DO MODBLRM(CP)
+5 ;
+6 ; Complete Message
DO ALLDONE(CP)
+7 ;
+8 ; Store # of times installation occurred as well as person & date/time
+9 DO ENDINSTL(CP)
+10 ;
+11 QUIT
+12 ;
DEBUG ; Debugging Mode for environment checker
+1 NEW DEBUG
+2 SET DEBUG="YES"
+3 DO PRECHK
+4 QUIT
+5 ;
+6 ; Modify menu items on the BLRMENU option
MODBLRM(CP) ;
+1 ; Remove EDT from BLRMENU
+2 DO DELFMENU("BLRMENU","BLREPOLR","Edit Provider/Ordering Location",CP)
+3 ;
+4 ; Add option to run the new IHS LOINC reports to BLRMENU
+5 DO ADDTMENU("BLRMENU","BLRLOINC","LOI","IHS LOINC Percentage report",CP)
+6 DO ADDTMENU("BLRMENU","BLRNOLER","NLO","Lab Tests Without LOINC Entries Report",CP)
+7 ;
+8 ; Add option to clear ALL BLR errors from error log regardless
+9 ; when the error occurred.
+10 DO ADDTMENU("BLRMENU","BLR CLEAR ALL LINK ERRORS","RBE",,CP)
+11 QUIT
+12 ;
NEEDIT(MODULE,VERSION,PATCH,WOTERR,CP) ; EP
+1 ; Generic "Find RPMS Module's Version and (perhaps) Patch number"
+2 ;
+3 ; NOTE: The MODULE variable MUST be the PREFIX name
+4 ; from the PACKAGE file (9.4).
+5 ;
+6 ; NAME of RPMS Module
NEW NAME
+7 ; PoinTeR to PACKAGE file
NEW PTR
+8 ; Array to store returned values from FIND^DIC
NEW HEREYAGO
+9 ; Temporary Strings
NEW STR1,STR2
+10 ;
+11 ; Use FileMan API to get information
+12 DO FIND^DIC(9.4,"","","",MODULE,"","C","","","HEREYAGO")
+13 SET PTR=$GET(HEREYAGO("DILIST",2,1))
+14 SET NAME=$GET(HEREYAGO("DILIST",1,1))
+15 ;
+16 ; Get the Version
SET X=$$VERSION^XPDUTL(MODULE)
+17 DO BMES^XPDUTL("Need at least "_NAME_" "_VERSION)
+18 IF X<VERSION
Begin DoDot:1
+19 SET WOTERR(MODULE,NAME,VERSION)=""
+20 SET STR1="Need "_NAME_" "_VERSION_" & "_NAME_" "_X_" found!"
+21 IF $LENGTH(STR1)<58
DO SORRY(STR1,,,CP)
+22 IF $LENGTH(STR1)>57
Begin DoDot:2
+23 SET STR1="Need "_NAME_" "_VERSION_" & "
+24 SET STR2=NAME_" "_X_" found!"
+25 DO SORRY(STR1,,STR2,CP)
End DoDot:2
End DoDot:1
QUIT
+26 ;
+27 DO OKAY(NAME_" "_X_" found.")
+28 ;
+29 ; If no Patch check, just exit
IF $GET(PATCH)=""
QUIT
+30 ;
+31 DO BMES^XPDUTL(" Need "_NAME_" "_VERSION_" Patch "_PATCH_".")
+32 SET X=$$PATCH^XPDUTL(MODULE_"*"_VERSION_"*"_PATCH)
+33 IF X'=1
Begin DoDot:1
+34 SET WOTERR(MODULE,NAME,VERSION)=$GET(PATCH)
+35 SET STR1=NAME_" "_VERSION_" Patch "_PATCH_" WAS NOT installed!"
+36 IF $LENGTH(STR1)<58
DO SORRY(STR1,,,CP)
+37 IF $LENGTH(STR1)>57
Begin DoDot:2
+38 SET STR1=NAME_" "_VERSION
+39 SET STR2="Patch "_PATCH_" WAS NOT installed!"
+40 DO SORRY(STR1,,STR2,CP)
End DoDot:2
End DoDot:1
QUIT
+41 ;
+42 DO OKAY(NAME_" "_VERSION_" Patch "_PATCH_" found.",10)
+43 ;
+44 QUIT
+45 ;
SORRY(MSG,MODE,MSG2,CP) ; EP
+1 ; Error Message routine. It will send an ALERT and a MailMan message
+2 ; to the people who are assigned to the LMI Mail group (if it exists).
+3 ;
+4 ; The STR array is built so that the error/warning message will
+5 ; also appear on the INSTALL LOG via the D BMES^XPDUTL(.STR) call.
+6 ;
+7 NEW MESSAGE
+8 IF $GET(MODE)'["NONFATAL"
Begin DoDot:1
+9 SET MESSAGE="Install Aborting due to the following Systems Environment issue:"
+10 ; Fatal Error Flag Set
SET XPDABORT=1
End DoDot:1
+11 ;
+12 IF $GET(MODE)["NONFATAL"
SET MESSAGE="*** WARNING *** WARNING *** WARNING ***"
+13 ;
+14 KILL DIFQ
+15 ;
+16 NEW STR,LINECNT
+17 SET LINECNT=1
+18 ; Row of asterisks
DO ADDLINE($TRANSLATE($JUSTIFY("",65)," ","*"),.LINECNT)
+19 DO ADDLINE(" ",.LINECNT)
+20 DO ADDLINE($$CJ^XLFSTR("Site: "_$$LOC^XBFUNC,65),.LINECNT)
+21 DO ADDLINE(" ",.LINECNT)
+22 DO ADDLINE($$CJ^XLFSTR(MESSAGE,65),.LINECNT)
+23 DO ADDLINE(" ",.LINECNT)
+24 DO ADDLINE($$CJ^XLFSTR(">>> "_MSG_" <<<",65),.LINECNT)
+25 IF $DATA(MSG2)
DO ADDLINE($$CJ^XLFSTR(">>> "_MSG2_" <<<",65),.LINECNT)
+26 DO ADDLINE(" ",.LINECNT)
+27 ;
+28 IF $GET(MODE)["NONFATAL"
DO ADDLINE($$CJ^XLFSTR(MESSAGE,65),.LINECNT)
+29 ;
+30 IF $GET(MODE)'["NONFATAL"
Begin DoDot:1
+31 DO ADDLINE($$CJ^XLFSTR("Please print/capture this screen and",65),.LINECNT)
+32 DO ADDLINE($$CJ^XLFSTR("notify the Support Center at",65),.LINECNT)
+33 DO ADDLINE(" ",.LINECNT)
+34 DO ADDLINE($$CJ^XLFSTR("1-999-999-9999.",65),.LINECNT)
+35 DO ADDLINE(" ",.LINECNT)
End DoDot:1
+36 ;
+37 ; Row of asterisks
DO ADDLINE($TRANSLATE($JUSTIFY("",65)," ","*"),.LINECNT)
+38 DO ADDLINE(" ",.LINECNT)
+39 ;
+40 ; Display the message
DO BMES^XPDUTL(.STR)
+41 ;
+42 ; If Debugging, just exit -- Don't send e-mail nor alert
+43 IF $GET(DEBUG)="YES"
QUIT
+44 ;
+45 IF $GET(MODE)'="NONFATAL"
Begin DoDot:1
+46 DO SNDALERT("Laboratory Patch "_CP_" >> FATAL >> "_MSG)
+47 DO SENDMAIL("IHS Lab Patch "_CP_" Install FATAL Error")
End DoDot:1
QUIT
+48 ;
+49 IF $GET(MODE)="NONFATAL"
Begin DoDot:1
+50 DO SNDALERT("Laboratory Patch "_CP_" - "_MODE_" - "_MSG)
+51 DO SENDMAIL("IHS Lab Patch "_CP_" Install NONFATAL Error")
End DoDot:1
+52 QUIT
+53 ;
SNDALERT(ALERTMSG) ; EP
+1 ; Send alert to LMI group
+2 SET XQAMSG=ALERTMSG
+3 SET XQA("G.LMI")=""
+4 DO SETUP^XQALERT
+5 KILL XQA,XQAMSG
+6 QUIT
+7 ;
SENDMAIL(MAILMSG) ; EP
+1 ; Send MailMan E-mail to LMI group -- message is in the STR array
+2 KILL XMY
+3 ; Group
SET XMY("G.LMI")=""
+4 SET %DT="T"
+5 SET X="NOW"
+6 DO ^%DT
+7 DO DD^LRX
+8 SET LRBLNOW=Y
+9 ;
+10 SET XMSUB=MAILMSG
+11 SET XMTEXT="STR("
+12 SET XMDUZ=$PIECE($GET(^VA(200,DUZ,0)),U)
+13 ;
+14 ; Send the MailMan e-mail
DO ^XMD
+15 ;
+16 ; Cleanup
KILL X,XMDUZ,XMSUB,XMTEXT,Y
+17 QUIT
+18 ;
SORRYEND(WOTERR,CP) ; EP
+1 ; Output a listing of ALL the errors detected during
+2 ; the environment check. The STR array will be
+3 ; displayed by the BMES^XPDUTL call.
+4 ;
+5 NEW STR,MODULE,NAME,VERSION,PATCH,LINECNT,TMP
+6 ;
+7 DO SORRYHED
+8 ;
+9 ; Add ALL the errors detected to the STR array
+10 SET (MODULE,NAME,VERSION)=""
+11 FOR
SET MODULE=$ORDER(WOTERR(MODULE))
IF MODULE=""
QUIT
Begin DoDot:1
+12 FOR
SET NAME=$ORDER(WOTERR(MODULE,NAME))
IF NAME=""
QUIT
Begin DoDot:2
+13 FOR
SET VERSION=$ORDER(WOTERR(MODULE,NAME,VERSION))
IF VERSION=""
QUIT
Begin DoDot:3
+14 DO ADDMESG
End DoDot:3
End DoDot:2
End DoDot:1
+15 ;
+16 DO SORRYFIN
+17 ;
+18 ; Display the message in the STR array
DO BMES^XPDUTL(.STR)
+19 ;
+20 QUIT
+21 ;
SORRYHED ; EP
+1 ; "Header" of Final Fatal Message
+2 SET LINECNT=1
+3 DO ADDLINE(" ",.LINECNT)
+4 DO ADDLINE($TRANSLATE($JUSTIFY("",65)," ","*"),.LINECNT)
+5 DO ADDLINE(" ",.LINECNT)
+6 DO ADDLINE($$CJ^XLFSTR("Systems Environment Error Detected",65),.LINECNT)
+7 DO ADDLINE($$CJ^XLFSTR("KIDS build will be deleted",65),.LINECNT)
+8 DO ADDLINE(" ",.LINECNT)
+9 DO ADDLINE($$CJ^XLFSTR("Modules with Version or Patch errors",65),.LINECNT)
+10 DO ADDLINE(" ",.LINECNT)
+11 QUIT
+12 ;
SORRYFIN ; EP
+1 ; "Fin" of Final Fatal Message
+2 DO ADDLINE($$CJ^XLFSTR("Re-Installation will be necessary.",65),.LINECNT)
+3 DO ADDLINE(" ",.LINECNT)
+4 DO ADDLINE($$CJ^XLFSTR("If assistance is needed, please call 1-999-999-9999.",65),.LINECNT)
+5 DO ADDLINE(" ",.LINECNT)
+6 DO ADDLINE($TRANSLATE($JUSTIFY("",65)," ","*"),.LINECNT)
+7 DO ADDLINE(" ",.LINECNT)
+8 QUIT
+9 ;
ADDMESG ; EP
+1 ; Add to the STR array
+2 SET PATCH=$GET(WOTERR(MODULE,NAME,VERSION))
+3 DO ADDLINE($$CJ^XLFSTR(NAME_" ("_MODULE_")",65),.LINECNT)
+4 ;
+5 SET TMP="Version:"_VERSION
+6 IF $GET(PATCH)'=""
SET TMP=TMP_" Patch:"_$GET(PATCH)
+7 ;
+8 DO ADDLINE($$CJ^XLFSTR(TMP,65),.LINECNT)
+9 DO ADDLINE(" ",.LINECNT)
+10 QUIT
+11 ;
ADDLINE(ASTR,LC) ; EP
+1 ; Add a line to the STR array
+2 IF $GET(ASTR)=""
SET ASTR=" "
+3 SET STR(LC)=ASTR
+4 SET LC=LC+1
+5 QUIT
+6 ;
OKAY(MSG,TAB) ; EP
+1 ; Write out "OKAY" message
+2 NEW MESSAGE
+3 IF $GET(TAB)=""
SET TAB=5
+4 SET MESSAGE=$JUSTIFY("",TAB)_MSG_" OK."
+5 DO MES^XPDUTL(MESSAGE)
+6 QUIT
+7 ;
CHECKLMI(WOTERR,CP) ; EP
+1 ;CHECK FOR LMI MAIL GROUP
+2 NEW OKAY
+3 DO BMES^XPDUTL("Must have 'LMI' mail group present.")
+4 SET DIC="^XMB(3.8,"
+5 SET X="LMI"
+6 DO ^DIC
+7 SET OKAY=+Y
+8 IF OKAY>0
DO OKAY("'LMI' mail group found.")
+9 IF OKAY<1
Begin DoDot:1
+10 DO SORRY("'LMI' mail group NOT found!",,,CP)
+11 SET WOTERR("XMB(3.8","Mail Group","3.8")="LMI Mail Group"
End DoDot:1
+12 QUIT
+13 ;
BACKUPS(CP) ; EP - CHECK TO CONFIRM BACKUPS HAVE BEEN DONE
+1 ; CP = Current Patch
+2 ;
+3 DO BMES^XPDUTL("BACKUPS Check Next.")
+4 ;
+5 WRITE !!
+6 ; Clear all FileMan variables
DO ^XBFMK
+7 SET DIR(0)="Y"
+8 SET DIR("B")="NO"
+9 SET DIR("A")="Has a SUCCESSFUL system backup been performed??"
+10 DO ^DIR
+11 ;
+12 ; IF and ONLY IF backups not confirmed, send NONFATAL alert & e-mail.
+13 IF $DATA(DIRUT)!($GET(Y)=0)
Begin DoDot:1
+14 DO SORRY("Please perform a successful backup before continuing!!","NONFATAL")
End DoDot:1
QUIT
+15 ;
+16 ; User stated Backup has been Done, so display message.
+17 NEW DTT
+18 SET DTT=$$UP^XLFSTR($$HTE^XLFDT($HOROLOG,"MZ"))
+19 SET STR="BACKUPS CONFIRMED BY "_$PIECE($GET(^VA(200,DUZ,0)),U)_" ON "
+20 SET STR=STR_$PIECE(DTT,"@")_" AT "_$PIECE(DTT,"@",2)
+21 DO BMES^XPDUTL(STR)
+22 DO MES^XPDUTL(" ")
+23 ;
+24 ; Store backup confirmation person & date/time
+25 ; Current Patch,Backup count
NEW BCKUPCNT
+26 SET BCKUPCNT=1+$ORDER(^BLRINSTL("LAB PATCH",CP,"BACKUP CONFIRMED BY",""),-1)
+27 SET ^BLRINSTL("LAB PATCH",CP,"BACKUP CONFIRMED BY",BCKUPCNT)=$PIECE($GET(^VA(200,DUZ,0)),U)
+28 SET ^BLRINSTL("LAB PATCH",CP,"BACKUP CONFIRMED BY",BCKUPCNT,"DATE/TIME")=$$HTE^XLFDT($HOROLOG,"5MZ")
+29 ;
+30 QUIT
+31 ;
TABMESG(MSG,TAB,TAIL) ; EP
+1 ; Generic message output WITH blank line BEFORE messsage & TAB
+2 NEW MESSAGE
+3 IF $GET(TAB)=""
SET TAB=5
+4 SET MESSAGE=$JUSTIFY("",TAB)_MSG
+5 IF $GET(TAIL)'=""
SET MESSAGE=MESSAGE_" "_TAIL
+6 DO BMES^XPDUTL(MESSAGE)
+7 QUIT
+8 ;
+1 ; Generic message output WITHOUT blank line BEFORE messsage & TAB
+2 NEW MESSAGE
+3 IF $GET(TAB)=""
SET TAB=5
+4 SET MESSAGE=$JUSTIFY("",TAB)_MSG
+5 IF $GET(TAIL)'=""
SET MESSAGE=MESSAGE_" "_TAIL
+6 DO MES^XPDUTL(MESSAGE)
+7 QUIT
+8 ;
+1 ; Procedure that adds the options to Menus.
+2 ; Uses Kernel's ADD^XPDMENU function
+3 NEW ADDOPT,CHKIT,STR1,STR2,STR3
+4 ;
+5 ; ADDOPT String set to ADDEE string or Interactive MeSsaGe string
+6 SET ADDOPT=$SELECT($DATA(IMSG):IMSG,1:ADDEE)
+7 ;
+8 DO BMES^XPDUTL("Adding "_ADDOPT_" to "_ADDER_".")
+9 ;
+10 SET CHKIT=$$ADD^XPDMENU(ADDER,ADDEE,ITM)
+11 ;
+12 IF CHKIT=1
Begin DoDot:1
+13 DO OKAY(ADDOPT_" added to "_ADDER_".",5)
+14 DO MES^XPDUTL(" ")
End DoDot:1
QUIT
+15 ;
+16 IF CHKIT'=1
Begin DoDot:1
+17 SET STR1="Error in adding "_ADDOPT_" to "_ADDER_"."
+18 IF $LENGTH(STR1)<58
DO SORRY(STR1,"NONFATAL",,CP)
+19 IF $LENGTH(STR1)>57
Begin DoDot:2
+20 SET STR1="Error in adding "_ADDOPT
+21 SET STR2="to "_ADDER
+22 DO SORRY(STR1,"NONFATAL",STR2,,CP)
End DoDot:2
End DoDot:1
+23 ;
+24 QUIT
+25 ;
+1 ; Procedure that deletes from a Menu.
+2 ; It is OKAY if the option doesn't exist on the Menu.
+3 ; Uses Kernel's DELETE^XPDMENU function
+4 NEW CHKIT,DELOPT,STR1,STR2
+5 NEW DMENUIEN,HEREYAGO
+6 ;
+7 ; DELOPT String set to DOPTION string or Interactive MeSsaGe string
+8 SET DELOPT=$SELECT($DATA(IMSG):IMSG,1:DOPTION)
+9 ;
+10 DO BMES^XPDUTL("Removing "_DELOPT_" from "_DMENU_".")
+11 ;
+12 ; First, Find IEN of MENU from which option will be deleted
+13 DO FIND^DIC(19,,,,"BLRMENU",,,,,"HEREYAGO")
+14 SET DMENUIEN=+$GET(HEREYAGO("DILIST",2,1))
+15 ;
+16 ; If MENU doesn't exist, just write a message and return
+17 IF DMENUIEN<1
Begin DoDot:1
+18 DO OKAY("MENU "_DMENU_" NOT Found in Option File.",5)
+19 DO MES^XPDUTL(" ")
End DoDot:1
QUIT
+20 ;
+21 ; Find out if Option still on the MENU from which it is to be deleted.
+22 KILL HEREYAGO
+23 DO FIND^DIC(19.01,","_DMENUIEN_",",,,DOPTION,,,,,"HEREYAGO")
+24 ;
+25 ; If Option is not on MENU, then just write a message and return
+26 IF +$GET(HEREYAGO("DILIST",2,1))<1
Begin DoDot:1
+27 SET STR1=DELOPT_" not found on "_DMENU_"."
+28 IF $LENGTH(STR1)<58
Begin DoDot:2
+29 DO OKAY(STR1,5)
+30 DO MES^XPDUTL(" ")
End DoDot:2
QUIT
+31 ;
+32 SET STR1=DELOPT_" not found"
+33 SET STR2="on "_DMENU_"."
+34 DO TABMESG(STR1,5)
+35 DO OKAY(STR2,5)
+36 DO MES^XPDUTL(" ")
End DoDot:1
QUIT
+37 ;
+38 SET CHKIT=$$DELETE^XPDMENU(DMENU,DOPTION)
+39 ;
+40 IF CHKIT=1
Begin DoDot:1
+41 DO OKAY(DELOPT_" removed from "_DMENU_".",5)
+42 DO MES^XPDUTL(" ")
End DoDot:1
QUIT
+43 ;
+44 IF CHKIT'=1
Begin DoDot:1
+45 SET STR1="Error removing "_DELOPT_" from "_DMENU_"."
+46 IF $LENGTH(STR1)<58
DO SORRY(STR1,"NONFATAL",,CP)
+47 IF $LENGTH(STR1)>57
Begin DoDot:2
+48 SET STR1="Error removing "_DELOPT
+49 SET STR2="from "_DMENU
+50 DO SORRY(STR1,"NONFATAL",STR2,CP)
End DoDot:2
End DoDot:1
+51 ;
+52 QUIT
+53 ;
ALLDONE(CURPATCH) ; EP
+1 ; Complete Message
+2 NEW STR,LINECNT,MSG
+3 ;
+4 SET MSG="Laboratory Patch "_CURPATCH_" INSTALL complete."
+5 ;
+6 KILL STR
+7 SET LINECNT=1
+8 ; Row of asterisks
DO ADDLINE($TRANSLATE($JUSTIFY("",65)," ","*"),.LINECNT)
+9 DO ADDLINE(" ",.LINECNT)
+10 DO ADDLINE($$CJ^XLFSTR("Site: "_$$LOC^XBFUNC,65),.LINECNT)
+11 DO ADDLINE(" ",.LINECNT)
+12 DO ADDLINE($$CJ^XLFSTR(MSG,65),.LINECNT)
+13 DO ADDLINE(" ",.LINECNT)
+14 DO ADDLINE($TRANSLATE($JUSTIFY("",65)," ","*"),.LINECNT)
+15 DO ADDLINE(" ",.LINECNT)
+16 ;
+17 ; Display the message
DO BMES^XPDUTL(.STR)
+18 DO SNDALERT(MSG)
+19 DO SENDMAIL(MSG)
+20 ;
+21 QUIT
+22 ;
ENDINSTL(CURPATCH) ; EP
+1 ; Procedure that stores information into the ^BLRINSTL global
+2 ; regarding # of times instllation occurred as well as the
+3 ; person who is installaing and the date/time of the install.
+4 ;
+5 ; Installation count
NEW INSTCNT
+6 ;
+7 SET INSTCNT=1+$ORDER(^BLRINSTL("LAB PATCH",CURPATCH,"INSTALLED BY",""),-1)
+8 ;
+9 SET ^BLRINSTL("LAB PATCH",CURPATCH,"INSTALLED BY",INSTCNT)=$PIECE($GET(^VA(200,DUZ,0)),U)
+10 SET ^BLRINSTL("LAB PATCH",CURPATCH,"INSTALLED BY",INSTCNT,"DATE/TIME")=$$HTE^XLFDT($HOROLOG,"5Z")
+11 QUIT
