BLRKIDSU ; IHS/OIT/MKK - LAB PATCH KIDS UTILITIES ; 22-Oct-2013 09:22 ; MKK
;;5.2;LR;**1024,1033**;Nov 1, 1997
;
NEEDIT(MODULE,VERSION,PATCH,WOTERR) ; 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)
. I $L(STR1)>57 D
.. S STR1="Need "_NAME_" "_VERSION_" & "
.. S STR2=NAME_" "_X_" found!"
.. D SORRY(STR1,,STR2)
;
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)
. I $L(STR1)>57 D
.. S STR1=NAME_" "_VERSION
.. S STR2="Patch "_PATCH_" WAS NOT installed!"
.. D SORRY(STR1,,STR2)
;
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-888-830-7280.",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-888-830-7280.",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) ; 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!")
. 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")
. I $L(STR1)>57 D
.. S STR1="Error in adding "_ADDOPT
.. S STR2="to "_ADDER
.. D SORRY(STR1,"NONFATAL",STR2)
;
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")
. I $L(STR1)>57 D
.. S STR1="Error removing "_DELOPT
.. S STR2="from "_DMENU
.. D SORRY(STR1,"NONFATAL",STR2)
;
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
;
; ----- BEGIN IHS/MSC/MKK - LR*5.2*1033
;
INSTLRPT ; EP - Report on the ^BLRINSTL Global
NEW BLRVERN,BLRVERN2,BYWHOM,CURPATCH,HEADER,INSTCNT,LINES,MAXLINES,PG,QFLG
;
S BLRVERN=$TR($P($T(+1),";")," ")
S HEADER(1)="Lab Patch Installs Report"
S HEADER(2)="^BLRINSTL Global"
S HEADER(3)=" "
S HEADER(4)="Installed"
S HEADER(5)="Patch"
S $E(HEADER(5),15)="By Whom"
S $E(HEADER(5),50)="When"
;
S MAXLINES=20,LINES=MAXLINES+10,QFLG="NO",PG=0
S CURPATCH=""
F S CURPATCH=$O(^BLRINSTL("LAB PATCH",CURPATCH)) Q:CURPATCH=""!(QFLG="Q") D
. S INSTCNT=0
. F S INSTCNT=$O(^BLRINSTL("LAB PATCH",CURPATCH,"INSTALLED BY",INSTCNT)) Q:INSTCNT=""!(QFLG="Q") D
.. I LINES>MAXLINES D HEADERPG^BLRGMENU(.PG,.QFLG,"NO") Q:QFLG="Q"
.. ;
.. W "LR*5.2*",CURPATCH
.. W ?14,$G(^BLRINSTL("LAB PATCH",CURPATCH,"INSTALLED BY",INSTCNT))
.. W ?49,$G(^BLRINSTL("LAB PATCH",CURPATCH,"INSTALLED BY",INSTCNT,"DATE/TIME"))
.. W !
.. S LINES=LINES+1
D PRESSKEY^BLRGMENU(9)
Q
;
; ----- END IHS/MSC/MKK - LR*5.2*1033
BLRKIDSU ; IHS/OIT/MKK - LAB PATCH KIDS UTILITIES ; 22-Oct-2013 09:22 ; MKK
+1 ;;5.2;LR;**1024,1033**;Nov 1, 1997
+2 ;
NEEDIT(MODULE,VERSION,PATCH,WOTERR) ; 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)
+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)
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)
+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)
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-888-830-7280.",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-888-830-7280.",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) ; 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!")
+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")
+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)
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")
+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)
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
+12 ;
+13 ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1033
+14 ;
INSTLRPT ; EP - Report on the ^BLRINSTL Global
+1 NEW BLRVERN,BLRVERN2,BYWHOM,CURPATCH,HEADER,INSTCNT,LINES,MAXLINES,PG,QFLG
+2 ;
+3 SET BLRVERN=$TRANSLATE($PIECE($TEXT(+1),";")," ")
+4 SET HEADER(1)="Lab Patch Installs Report"
+5 SET HEADER(2)="^BLRINSTL Global"
+6 SET HEADER(3)=" "
+7 SET HEADER(4)="Installed"
+8 SET HEADER(5)="Patch"
+9 SET $EXTRACT(HEADER(5),15)="By Whom"
+10 SET $EXTRACT(HEADER(5),50)="When"
+11 ;
+12 SET MAXLINES=20
SET LINES=MAXLINES+10
SET QFLG="NO"
SET PG=0
+13 SET CURPATCH=""
+14 FOR
SET CURPATCH=$ORDER(^BLRINSTL("LAB PATCH",CURPATCH))
IF CURPATCH=""!(QFLG="Q")
QUIT
Begin DoDot:1
+15 SET INSTCNT=0
+16 FOR
SET INSTCNT=$ORDER(^BLRINSTL("LAB PATCH",CURPATCH,"INSTALLED BY",INSTCNT))
IF INSTCNT=""!(QFLG="Q")
QUIT
Begin DoDot:2
+17 IF LINES>MAXLINES
DO HEADERPG^BLRGMENU(.PG,.QFLG,"NO")
IF QFLG="Q"
QUIT
+18 ;
+19 WRITE "LR*5.2*",CURPATCH
+20 WRITE ?14,$GET(^BLRINSTL("LAB PATCH",CURPATCH,"INSTALLED BY",INSTCNT))
+21 WRITE ?49,$GET(^BLRINSTL("LAB PATCH",CURPATCH,"INSTALLED BY",INSTCNT,"DATE/TIME"))
+22 WRITE !
+23 SET LINES=LINES+1
End DoDot:2
End DoDot:1
+24 DO PRESSKEY^BLRGMENU(9)
+25 QUIT
+26 ;
+27 ; ----- END IHS/MSC/MKK - LR*5.2*1033
