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

BLRPRE24.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1. PRECHK ; EP
  1.  D BMES^XPDUTL("Beginning of Pre Check.")
  1.  NEW CP                   ; Current Patch
  1.  NEW LINE2                ; Second line of THIS Routine
  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.  S LINE2=$T(+2)
  1.  ;
  1.  ; Current Patch
  1.  S CP=$TR($P(LINE2,";",5),"*")
  1.  ;
  1.  ; Check for Cache environment
  1.  I $$UP^XLFSTR($$VERSION^%ZOSV(1))'["CACHE" D SORRY("NOT A CACHE ENVIRONMENT.",,,CP) Q
  1.  ;
  1.  ; Last Patch
  1.  S LASTPTCH=+$TR($P(LINE2,";",5),"*")-2
  1.  ;
  1.  ; RPMS Module
  1.  S RPMS=$P(LINE2,";",4)
  1.  ;
  1.  ; Version of RPMS module being patched
  1.  S RPMSVER=$P(LINE2,";",3)
  1.  ;
  1.  S XPDNOQUE="NO QUE"             ; No Queuing Allowed
  1.  ;
  1.  ; The following line prevents the "Disable Options..." and "Move
  1.  ; Routines..." questions from being asked during the install.
  1.  I $G(XPDENV)=1 S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
  1.  I $G(XPDENV)=1 S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
  1.  F X="XPO1","XPZ1","XPZ2","XPI1" S XPDDIQ(X)=0
  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.",,,CP)  Q
  1.  ;
  1.  I '$L($G(DUZ(0))) D SORRY("DUZ(0) UNDEFINED OR NULL.",,,CP)  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!",,,CP) 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",,.WOTERR,CP)
  1.  ;
  1. KERNEL ; CHECK FOR KERNEL 8.0 & PATCH 1013
  1.  D NEEDIT("XU","8.0",1013,.WOTERR,CP)
  1.  ;
  1. LABVER ; CHECK FOR LAB 5.2 & PREVIOUS PATCH
  1.  D NEEDIT("LR","5.2",LASTPTCH,.WOTERR,CP)
  1.  ;
  1. LMIMAIL ; CHECK FOR LMI MAIL GROUP
  1.  D CHECKLMI(.WOTERR,CP)
  1.  ;
  1. MAILMAN ; CHECK FOR MAILMAN 7.1
  1.  D NEEDIT("XM","7.1",,.WOTERR,CP)
  1.  ;
  1. ENVOK ; ENVIRONMENT OK
  1.  I XPDABORT<1 D BMES^XPDUTL("ENVIRONMENT OK.")
  1.   ;
  1.  I XPDABORT>0 D SORRYEND(.WOTERR,CP)
  1.  ;
  1.  Q
  1.  ;
  1. BACKUP ; EP
  1.  D BACKUPS(1024)
  1.  Q
  1.  ;
  1. POST ; EP -- POST INSTALL
  1.  NEW CP                      ; Current Patch
  1.  S CP=$TR($P($T(+2),";",5),"*")
  1.  ;
  1.  D MODBLRM(CP)                     ; Modify BLRMENU option(s)
  1.  ;
  1.  D ALLDONE(CP)                     ; Complete Message
  1.  ;
  1.  ; Store # of times installation occurred as well as person & date/time
  1.  D ENDINSTL(CP)
  1.  ;
  1.  Q
  1.  ;
  1. DEBUG ; Debugging Mode for environment checker
  1.  NEW DEBUG
  1.  S DEBUG="YES"
  1.  D PRECHK
  1.  Q
  1.  ;
  1.  ; Modify menu items on the BLRMENU option
  1. MODBLRM(CP) ;
  1.  ; Remove EDT from BLRMENU
  1.  D DELFMENU("BLRMENU","BLREPOLR","Edit Provider/Ordering Location",CP)
  1.  ;
  1.  ; Add option to run the new IHS LOINC reports to BLRMENU
  1.  D ADDTMENU("BLRMENU","BLRLOINC","LOI","IHS LOINC Percentage report",CP)
  1.  D ADDTMENU("BLRMENU","BLRNOLER","NLO","Lab Tests Without LOINC Entries Report",CP)
  1.  ;
  1.  ; Add option to clear ALL BLR errors from error log regardless
  1.  ; when the error occurred.
  1.  D ADDTMENU("BLRMENU","BLR CLEAR ALL LINK ERRORS","RBE",,CP)
  1.  Q
  1.  ;
  1. NEEDIT(MODULE,VERSION,PATCH,WOTERR,CP)      ; EP
  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.  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.  NEW STR1,STR2           ; Temporary Strings
  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.  . S WOTERR(MODULE,NAME,VERSION)=""
  1.  . S STR1="Need "_NAME_" "_VERSION_" & "_NAME_" "_X_" found!"
  1.  . I $L(STR1)<58 D SORRY(STR1,,,CP)
  1.  . I $L(STR1)>57 D
  1.  .. S STR1="Need "_NAME_" "_VERSION_" & "
  1.  .. S STR2=NAME_" "_X_" found!"
  1.  .. D SORRY(STR1,,STR2,CP)
  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.  . S WOTERR(MODULE,NAME,VERSION)=$G(PATCH)
  1.  . S STR1=NAME_" "_VERSION_" Patch "_PATCH_" WAS NOT installed!"
  1.  . I $L(STR1)<58 D SORRY(STR1,,,CP)
  1.  . I $L(STR1)>57 D
  1.  .. S STR1=NAME_" "_VERSION
  1.  .. S STR2="Patch "_PATCH_" WAS NOT installed!"
  1.  .. D SORRY(STR1,,STR2,CP)
  1.  ;
  1.  D OKAY(NAME_" "_VERSION_" Patch "_PATCH_" found.",10)
  1.  ;
  1.  Q
  1.  ;
  1. SORRY(MSG,MODE,MSG2,CP)       ; EP
  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 (if it exists).
  1.  ;
  1.  ; The STR 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.  ;
  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 LINECNT=1
  1.  D ADDLINE($TR($J("",65)," ","*"),.LINECNT)    ; Row of asterisks
  1.  D ADDLINE(" ",.LINECNT)
  1.  D ADDLINE($$CJ^XLFSTR("Site: "_$$LOC^XBFUNC,65),.LINECNT)
  1.  D ADDLINE(" ",.LINECNT)
  1.  D ADDLINE($$CJ^XLFSTR(MESSAGE,65),.LINECNT)
  1.  D ADDLINE(" ",.LINECNT)
  1.  D ADDLINE($$CJ^XLFSTR(">>> "_MSG_" <<<",65),.LINECNT)
  1.  I $D(MSG2) D ADDLINE($$CJ^XLFSTR(">>> "_MSG2_" <<<",65),.LINECNT)
  1.  D ADDLINE(" ",.LINECNT)
  1.  ;
  1.  I $G(MODE)["NONFATAL" D ADDLINE($$CJ^XLFSTR(MESSAGE,65),.LINECNT)
  1.  ;
  1.  I $G(MODE)'["NONFATAL" D
  1.  . D ADDLINE($$CJ^XLFSTR("Please print/capture this screen and",65),.LINECNT)
  1.  . D ADDLINE($$CJ^XLFSTR("notify the Support Center at",65),.LINECNT)
  1.  . D ADDLINE(" ",.LINECNT)
  1.  . D ADDLINE($$CJ^XLFSTR("1-999-999-9999.",65),.LINECNT)
  1.  . D ADDLINE(" ",.LINECNT)
  1.  ;
  1.  D ADDLINE($TR($J("",65)," ","*"),.LINECNT)    ; Row of asterisks
  1.  D ADDLINE(" ",.LINECNT)
  1.  ;
  1.  D BMES^XPDUTL(.STR)               ; Display the message
  1.  ;
  1.  ; If Debugging, just exit -- Don't send e-mail nor alert
  1.  I $G(DEBUG)="YES" Q
  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. SNDALERT(ALERTMSG) ; EP
  1.  ; Send alert to LMI group
  1.  S XQAMSG=ALERTMSG
  1.  S XQA("G.LMI")=""
  1.  D SETUP^XQALERT
  1.  K XQA,XQAMSG
  1.  Q
  1.  ;
  1. SENDMAIL(MAILMSG) ; EP
  1.  ; Send MailMan E-mail to LMI group -- message is in the STR array
  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. SORRYEND(WOTERR,CP) ; EP
  1.  ; Output a listing of ALL the errors detected during
  1.  ; the environment check.  The STR array will be
  1.  ; displayed by the BMES^XPDUTL call.
  1.  ; 
  1.  NEW STR,MODULE,NAME,VERSION,PATCH,LINECNT,TMP
  1.  ;
  1.  D SORRYHED
  1.  ;
  1.  ; Add ALL the errors detected to the STR array
  1.  S (MODULE,NAME,VERSION)=""
  1.  F  S MODULE=$O(WOTERR(MODULE))  Q:MODULE=""  D
  1.  . F  S NAME=$O(WOTERR(MODULE,NAME))  Q:NAME=""  D
  1.  .. F  S VERSION=$O(WOTERR(MODULE,NAME,VERSION))  Q:VERSION=""  D
  1.  ... D ADDMESG
  1.  ;
  1.  D SORRYFIN
  1.  ;
  1.  D BMES^XPDUTL(.STR)     ; Display the message in the STR array
  1.  ;
  1.  Q
  1.  ;
  1. SORRYHED ; EP
  1.  ; "Header" of Final Fatal Message
  1.  S LINECNT=1
  1.  D ADDLINE(" ",.LINECNT)
  1.  D ADDLINE($TR($J("",65)," ","*"),.LINECNT)
  1.  D ADDLINE(" ",.LINECNT)
  1.  D ADDLINE($$CJ^XLFSTR("Systems Environment Error Detected",65),.LINECNT)
  1.  D ADDLINE($$CJ^XLFSTR("KIDS build will be deleted",65),.LINECNT)
  1.  D ADDLINE(" ",.LINECNT)
  1.  D ADDLINE($$CJ^XLFSTR("Modules with Version or Patch errors",65),.LINECNT)
  1.  D ADDLINE(" ",.LINECNT)
  1.  Q
  1.  ;
  1. SORRYFIN ; EP
  1.  ; "Fin" of Final Fatal Message
  1.  D ADDLINE($$CJ^XLFSTR("Re-Installation will be necessary.",65),.LINECNT)
  1.  D ADDLINE(" ",.LINECNT)
  1.  D ADDLINE($$CJ^XLFSTR("If assistance is needed, please call 1-999-999-9999.",65),.LINECNT)
  1.  D ADDLINE(" ",.LINECNT)
  1.  D ADDLINE($TR($J("",65)," ","*"),.LINECNT)
  1.  D ADDLINE(" ",.LINECNT)
  1.  Q
  1.  ;
  1. ADDMESG ; EP
  1.  ; Add to the STR array
  1.  S PATCH=$G(WOTERR(MODULE,NAME,VERSION))
  1.  D ADDLINE($$CJ^XLFSTR(NAME_" ("_MODULE_")",65),.LINECNT)
  1.  ;
  1.  S TMP="Version:"_VERSION
  1.  I $G(PATCH)'="" S TMP=TMP_"  Patch:"_$G(PATCH)
  1.  ;
  1.  D ADDLINE($$CJ^XLFSTR(TMP,65),.LINECNT)
  1.  D ADDLINE(" ",.LINECNT)
  1.  Q
  1.  ;
  1. ADDLINE(ASTR,LC) ; EP
  1.  ; Add a line to the STR array
  1.  I $G(ASTR)="" S ASTR=" "
  1.  S STR(LC)=ASTR
  1.  S LC=LC+1
  1.  Q
  1.  ;
  1. OKAY(MSG,TAB)       ; EP
  1.  ; Write out "OKAY" message
  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. CHECKLMI(WOTERR,CP) ; EP
  1.  ;CHECK FOR LMI MAIL GROUP
  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
  1.  . D SORRY("'LMI' mail group NOT found!",,,CP)
  1.  . S WOTERR("XMB(3.8","Mail Group","3.8")="LMI Mail Group"
  1.  Q
  1.  ;
  1. BACKUPS(CP) ; EP - CHECK TO CONFIRM BACKUPS HAVE BEEN DONE
  1.  ; CP  = 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. TABMESG(MSG,TAB,TAIL) ; EP
  1.  ; Generic message output WITH blank line BEFORE messsage & TAB
  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. TABMENU(MSG,TAB,TAIL) ; EP
  1.  ; Generic message output WITHOUT blank line BEFORE messsage & TAB
  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. ADDTMENU(ADDER,ADDEE,ITM,IMSG,CP)    ; EP
  1.  ; Procedure that adds the options to Menus.
  1.  ; Uses Kernel's ADD^XPDMENU function
  1.  NEW ADDOPT,CHKIT,STR1,STR2,STR3
  1.  ;
  1.  ; ADDOPT String set to ADDEE string or Interactive MeSsaGe string
  1.  S ADDOPT=$S($D(IMSG):IMSG,1:ADDEE)
  1.  ;
  1.  D BMES^XPDUTL("Adding "_ADDOPT_" to "_ADDER_".")
  1.  ;
  1.  S CHKIT=$$ADD^XPDMENU(ADDER,ADDEE,ITM)
  1.  ;
  1.  I CHKIT=1 D  Q
  1.  . D OKAY(ADDOPT_" added to "_ADDER_".",5)
  1.  . D MES^XPDUTL(" ")
  1.  ;
  1.  I CHKIT'=1 D
  1.  . S STR1="Error in adding "_ADDOPT_" to "_ADDER_"."
  1.  . I $L(STR1)<58 D SORRY(STR1,"NONFATAL",,CP)
  1.  . I $L(STR1)>57 D
  1.  .. S STR1="Error in adding "_ADDOPT
  1.  .. S STR2="to "_ADDER
  1.  .. D SORRY(STR1,"NONFATAL",STR2,,CP)
  1.  ;
  1.  Q
  1.  ;
  1. DELFMENU(DMENU,DOPTION,IMSG,CP)    ; EP
  1.  ; Procedure that deletes from a Menu.
  1.  ; It is OKAY if the option doesn't exist on the Menu.
  1.  ; Uses Kernel's DELETE^XPDMENU function
  1.  NEW CHKIT,DELOPT,STR1,STR2
  1.  NEW DMENUIEN,HEREYAGO
  1.  ;
  1.  ; DELOPT String set to DOPTION string or Interactive MeSsaGe string
  1.  S DELOPT=$S($D(IMSG):IMSG,1:DOPTION)
  1.  ;
  1.  D BMES^XPDUTL("Removing "_DELOPT_" from "_DMENU_".")
  1.  ;
  1.  ; First, Find IEN of MENU from which option will be deleted
  1.  D FIND^DIC(19,,,,"BLRMENU",,,,,"HEREYAGO")
  1.  S DMENUIEN=+$G(HEREYAGO("DILIST",2,1))
  1.  ;
  1.  ; If MENU doesn't exist, just write a message and return
  1.  I DMENUIEN<1 D  Q
  1.  . D OKAY("MENU "_DMENU_" NOT Found in Option File.",5)
  1.  . D MES^XPDUTL(" ")
  1.  ;
  1.  ; Find out if Option still on the MENU from which it is to be deleted.
  1.  K HEREYAGO
  1.  D FIND^DIC(19.01,","_DMENUIEN_",",,,DOPTION,,,,,"HEREYAGO")
  1.  ;
  1.  ; If Option is not on MENU, then just write a message and return
  1.  I +$G(HEREYAGO("DILIST",2,1))<1  D  Q
  1.  . S STR1=DELOPT_" not found on "_DMENU_"."
  1.  . I $L(STR1)<58 D  Q
  1.  .. D OKAY(STR1,5)
  1.  .. D MES^XPDUTL(" ")
  1.  . ;
  1.  . S STR1=DELOPT_" not found"
  1.  . S STR2="on "_DMENU_"."
  1.  . D TABMESG(STR1,5)
  1.  . D OKAY(STR2,5)
  1.  . D MES^XPDUTL(" ")
  1.  ;
  1.  S CHKIT=$$DELETE^XPDMENU(DMENU,DOPTION)
  1.  ;
  1.  I CHKIT=1 D  Q
  1.  . D OKAY(DELOPT_" removed from "_DMENU_".",5)
  1.  . D MES^XPDUTL(" ")
  1.  ;
  1.  I CHKIT'=1 D
  1.  . S STR1="Error removing "_DELOPT_" from "_DMENU_"."
  1.  . I $L(STR1)<58 D SORRY(STR1,"NONFATAL",,CP)
  1.  . I $L(STR1)>57 D
  1.  .. S STR1="Error removing "_DELOPT
  1.  .. S STR2="from "_DMENU
  1.  .. D SORRY(STR1,"NONFATAL",STR2,CP)
  1.  ;
  1.  Q
  1.  ;
  1. ALLDONE(CURPATCH) ; EP
  1.  ; Complete Message
  1.  NEW STR,LINECNT,MSG
  1.  ;
  1.  S MSG="Laboratory Patch "_CURPATCH_" INSTALL complete."
  1.  ;
  1.  K STR
  1.  S LINECNT=1
  1.  D ADDLINE($TR($J("",65)," ","*"),.LINECNT)    ; Row of asterisks
  1.  D ADDLINE(" ",.LINECNT)
  1.  D ADDLINE($$CJ^XLFSTR("Site: "_$$LOC^XBFUNC,65),.LINECNT)
  1.  D ADDLINE(" ",.LINECNT)
  1.  D ADDLINE($$CJ^XLFSTR(MSG,65),.LINECNT)
  1.  D ADDLINE(" ",.LINECNT)
  1.  D ADDLINE($TR($J("",65)," ","*"),.LINECNT)
  1.  D ADDLINE(" ",.LINECNT)
  1.  ;
  1.  D BMES^XPDUTL(.STR)               ; Display the message
  1.  D SNDALERT(MSG)
  1.  D SENDMAIL(MSG)
  1.  ;
  1.  Q
  1.  ;
  1. ENDINSTL(CURPATCH)       ; EP
  1.  ; Procedure that stores information into the ^BLRINSTL global
  1.  ; regarding # of times instllation occurred as well as the
  1.  ; person who is installaing and the date/time of the install.
  1.  ; 
  1.  NEW INSTCNT                        ; Installation count
  1.  ;
  1.  S INSTCNT=1+$O(^BLRINSTL("LAB PATCH",CURPATCH,"INSTALLED BY",""),-1)
  1.  ;
  1.  S ^BLRINSTL("LAB PATCH",CURPATCH,"INSTALLED BY",INSTCNT)=$P($G(^VA(200,DUZ,0)),U)
  1.  S ^BLRINSTL("LAB PATCH",CURPATCH,"INSTALLED BY",INSTCNT,"DATE/TIME")=$$HTE^XLFDT($H,"5Z")
  1.  Q