Routine: BLRPRE27

BLRPRE27 ;IHS/OIT/MKK - IHS Lab PATCH 1027 Environment Routine ;JUL 06, 2010 3:14 PM

 ;;5.2;IHS LABORATORY;**1027**;NOV 01, 1997

 ; TESTING ONE TWO THREE

PRE ; EP

 D BMES^XPDUTL("Beginning of Pre Check.")

 NEW CP,RPMS,RPMSVER,QFLG,STR

 NEW ERRARRAY                 ; Array of errors detected

 NEW ROWSTARS

 I $G(XPDNM)="" D SORRY("XPDNM not defined or 0.")  Q

 S CP=$P(XPDNM,"*",3)         ; Current Patch Number

 S RPMS=$P(XPDNM,"*",1)       ; RPMS Module

 S RPMSVER=$P(XPDNM,"*",2)    ; Version of RPMS module being patched

 S ROWSTARS=$TR($J("",65)," ","*")  ; Row of asterisks

USERID ; EP - CHECK FOR USER ID

 I +$G(DUZ)<1 D SORRY("DUZ UNDEFINED OR 0.")  Q

 I $P($G(^VA(200,DUZ,0)),U)="" D SORRY("Installer cannot be identified!")  Q

GETREADY ; EP

 S XPDNOQUE="NO QUE"          ; No Queuing Allowed

 ; The following line prevents the "Disable Options..." and "Move

 ; Routines..." questions from being asked during the install.

 F X="XPO1","XPZ1","XPZ2","XPI1" S XPDDIQ(X)=0

 S XPDABORT=0                    ; KIDS install Flag

 D HOME^%ZIS             ; Reset/Initialize IO variables

 D DTNOLF^DICRW          ; Set DT variable without Doing a Line Feed

ENVICHEK ; Environment Checker

 NEW CHKPATCH

 D CHKENHED                              ; Header

 F CHKPATCH=46,61,62,63,65  D NEEDIT("LA","5.2",CHKPATCH,.ERRARRAY)

 D MES^XPDUTL(" ")

 F CHKPATCH=1005,1006  D NEEDIT("HL","1.6",CHKPATCH,.ERRARRAY)

 D MES^XPDUTL(" ")

 F CHKPATCH=261,1013  D NEEDIT("XU","8.0",CHKPATCH,.ERRARRAY)

 D MES^XPDUTL(" ")

 F CHKPATCH=187,202,220,222,230,232,256,261,269,271,282,283,285,287,312,1026  D

 . D NEEDIT("LR","5.2",CHKPATCH,.ERRARRAY)

 D MES^XPDUTL(" ")

 D CHECKLMI(.ERRARRAY)                   ; CHECK FOR LMI MAIL GROUP

 D MES^XPDUTL(" ")

 D NEEDIT("XM","8.0",,.ERRARRAY)         ; MAILMAN 8.0

 D MES^XPDUTL(" ")

 D NEEDIT("PIMS","5.3",,.ERRARRAY)       ; PIMS 5.3

 D MES^XPDUTL(" ")

 D NEEDIT("AUT","98.1","22",.ERRARRAY)   ; AUT 98.1 & PATCH 22

 D MES^XPDUTL(" ")

 D NEEDIT("DI","22.0",,.ERRARRAY)        ; VA FILEMAN 22.0

 D MES^XPDUTL(" ")

 I XPDABORT>0 D SORRYEND(.ERRARRAY,CP)   Q    ; ENVIRONMENT HAS ERROR(S)

 D BMES^XPDUTL("ENVIRONMENT OK.")

POST ; EP -- POST INSTALL

 NEW CP,STR

 S CP=$P($T(+2),"*",3)              ; Current Patch

 D ADDEAGDC^BLRPR27P                ; EAG Delta Check Addition -- POST Install

 ; Store # of times installation occurred as well as person & date/time

 D ENDINSTL^BLRKIDSU(CP)

 D SNDALERT("Laboratory Patch "_CP_" INSTALL complete.")

 S STR(1)=" "

 S STR(2)=$J("",10)_"POST INSTALL of BLRPRE27 Routine."

 S STR(3)=" "

 S STR(4)=$J("",15)_"Laboratory Patch "_CP_" INSTALL completed."

 S STR(5)=" "

 D SENDMAIL("Laboratory Patch "_CP_" INSTALL complete.")

CHKENHED ; EP -- Header

 NEW STR

 S STR=$TR($J("",IOM)," ","*")

 D ^XBCLS

 W STR,!

 W $TR($$CJ^XLFSTR("@Checking@Environment@for@Patch@"_CP_"@of@Version@"_RPMSVER_"@of@"_RPMS_".@",IOM)," @","* "),!

 W STR,!

DEBUG ; EP - Debugging Line Label for environment checker

 NEW CP,DEBUG,XPDNM

 W !!

 D PASSMESG^BLRPRE27("DEBUGGING@BLRPRE27")

 S DEBUG="YES"

 D ^XBFMK

 S DIR(0)="YO"

 S DIR("B")="NO"

 S DIR("A")="Send Alerts/E-Mails"

 D ^DIR

 S:+$G(Y)=1 DEBUG="NO"

W !

 S XPDNM="LR*5.2*1027"

 S XPDENV=0

 D PRE

 W !!

 D ^XBFMK

 S DIR(0)="YO"

 S DIR("B")="NO"

 S DIR("A")="Debug POST Install Code"

 D ^DIR

 D:+$G(Y)=1 POST

 W !!,$TR($J("",IOM)," ","*"),!

 W $TR($$CJ^XLFSTR("@DEBUGGING@BLRPRE27@Complete.@",IOM)," @","* "),!

 W $TR($J("",IOM)," ","*"),!!

 ; Error Message routine.

SORRY(MSG,MODE,MSG2)       ; EP

 NEW MESSAGE,ROWSTARS

 S CP=$P($T(+2),"*",3)              ; Current Patch

 S ROWSTARS=$TR($J("",65)," ","*")  ; Row of asterisks

 S MODE=$G(MODE,"FATAL")

 I $G(MODE)="FATAL" 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

 ; STR Array will be used to write to the screen, send E-Mail & Alert

 NEW STR,LINECNT

 S LINECNT=1

 D ADDLINE(" ",.LINECNT)

 D ADDLINE(ROWSTARS,.LINECNT)

 D ADDLINE(" ",.LINECNT)

 D ADDLINE("Site: "_$$LOC^XBFUNC,.LINECNT,"YES")

 D ADDLINE(" ",.LINECNT)

 D ADDLINE(MESSAGE,.LINECNT,"YES")

 D ADDLINE(" ",.LINECNT)

 D ADDLINE(">>> "_MSG_" <<<",.LINECNT,"YES")

 I $D(MSG2) D ADDLINE(">>> "_MSG2_" <<<",.LINECNT,"YES")

 D ADDLINE(" ",.LINECNT)

 I $G(MODE)["NONFATAL" D ADDLINE(MESSAGE,.LINECNT,"YES")

 I $G(MODE)="FATAL" D

 . D ADDLINE("Please print/capture this screen and",.LINECNT,"YES")

 . D ADDLINE("notify the Support Center at",.LINECNT,"YES")

 . D ADDLINE(" ",.LINECNT)

 . D ADDLINE("1-888-830-7280.",.LINECNT,"YES")

 . D ADDLINE(" ",.LINECNT)

 D ADDLINE(ROWSTARS,.LINECNT)    ; Row of asterisks

 D ADDLINE(" ",.LINECNT)

 D BMES^XPDUTL(.STR)

 I $G(DEBUG)="YES" Q

 I $G(MODE)="FATAL" D  Q

 . D SNDALERT("Laboratory Patch "_CP_" >> FATAL << "_MSG)

 . D SENDMAIL("IHS Lab Patch "_CP_" Install FATAL Error")

 D SNDALERT("Laboratory Patch "_CP_" - "_MODE_" - "_MSG)

 D SENDMAIL("IHS Lab Patch "_CP_" Install NONFATAL Error")

SNDALERT(ALERTMSG) ; EP - Send alert to LMI group AND Installer

 Q:$G(DEBUG)="YES"

 S XQAMSG=ALERTMSG

 S XQA("G.LMI")=""

 ; If installer not part of LMI Mail Group, send them alert also

 S:$$NINLMI(DUZ) XQA(DUZ)=""

 D SETUP^XQALERT

 K XQA,XQAMSG

NINLMI(CHKDUZ) ; EP -- Check to see if DUZ is NOT part of LMI Mail Group

 NEW MGRPIEN,XMDUZ

 ; Get IEN of LMI MaiL Group

 D CHKGROUP^XMBGRP("LMI",.MGRPIEN)  ; VA DBIA 1146

 Q:+(MGRPIEN)<1 1                   ; If no Mail Group, return TRUE

 ; XMDUZ = DUZ of the user

 ; Y     = IEN of the mail group

 S XMDUZ=DUZ

 S Y=MGRPIEN

 D CHK^XMA21                        ; VA DBIA 10067

 Q $S($T=1:0,1:1)

SENDMAIL(MAILMSG) ; EP -- Send MailMan E-mail to LMI group AND Installer

 Q:$G(DEBUG)="YES"

 NEW DIFROM

 K XMY

 S XMY("G.LMI")=""

 ; If installer not part of LMI Mail Group, send them e-mail also

 S:$$NINLMI(DUZ) XMY(DUZ)=""

 S LRBLNOW=$E($$NOW^XLFDT,1,12)

 S XMSUB=MAILMSG

 S XMTEXT="STR("

 S XMDUZ="Lab Patch 1027"

 S XMZ="NOT OKAY"

 D ^XMD

 I $G(XMMG)'=""!(XMZ="NOT OKAY") D

 . D BMES^XPDUTL($J("",5)_"MAILMAN ERROR.")

 . D BMES^XPDUTL($J("",10)_"XMZ:"_XMZ)

 . D BMES^XPDUTL($J("",10)_"XMMG:"_XMMG)

 K X,XMDUZ,XMSUB,XMTEXT,XMY,XMZ,Y   ; Cleanup

ADDLINE(ASTR,LC,CENTER) ; EP -- Add a line to the STR array; CENTER if requested

 I $G(ASTR)="" S ASTR=" "

 S:$G(CENTER)'="YES" STR(LC)=ASTR

 S:$G(CENTER)="YES" STR(LC)=$$CJ^XLFSTR(ASTR,65)

 S LC=LC+1

SORRYEND(WOTERR,CP) ; EP -- ALL the errors detected during the environment check.

 NEW STR,MODULE,NAME,VERSION,PATCH,LINECNT,TMP

 D SORRYHED

 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)

SORRYHED ; EP -- "Header" of Final Fatal Message

 S LINECNT=1

 D ADDLINE(" ",.LINECNT)

 D ADDLINE(ROWSTARS,.LINECNT)

 D ADDLINE(" ",.LINECNT)

 D ADDLINE("Systems Environment Error Detected",.LINECNT,"YES")

 D ADDLINE("KIDS build will be deleted",.LINECNT,"YES")

 D ADDLINE(" ",.LINECNT)

 D ADDLINE("Modules with Version or Patch errors",.LINECNT,"YES")

 D ADDLINE(" ",.LINECNT)

ADDMESG ; EP

 NEW WOT

 D ADDLINE(NAME_" ("_MODULE_")",.LINECNT,"YES")

 S WOT=$G(WOTERR(MODULE,NAME,VERSION))

 S TMP="Version:"_VERSION

 I $P(WOT,"^",2)="VERSION" D

 . S TMP="Needed Version:"_VERSION

 . S TMP=TMP_"  Found Version:"_$P(WOT,"^")

 I $P(WOT,"^",2)="PATCH" D

 . S TMP=TMP_"  Needed Patch:"_$P(WOT,"^")

 D ADDLINE(TMP,.LINECNT,"YES")

 D ADDLINE(" ",.LINECNT)

SORRYFIN ; EP -- "Fin" of Final Fatal Message

 D ADDLINE("Re-Installation will be necessary.",.LINECNT,"YES")

 D ADDLINE(" ",.LINECNT)

 D ADDLINE("If assistance is needed, please call 1-888-830-7280.",.LINECNT,"YES")

 D ADDLINE(" ",.LINECNT)

 D ADDLINE(ROWSTARS,.LINECNT)

 D ADDLINE(" ",.LINECNT)

CHECKLMI(ERRARRAY) ; EP  -- CHECK FOR LMI MAIL GROUP

 NEW MGRPIEN

 D CHKGROUP^XMBGRP("LMI",.MGRPIEN)       ; VA DBIA 1146

 I MGRPIEN D  Q

 . D OKAY^BLRKIDSU("LMI Mail Group Exists.")

 D BMES^XPDUTL("")

 D SORRY("LMI Mail Group Does NOT Exist!")

 S ERRARRAY("XMB","Mail Group","3.8")="LMI Mail Group"

 ; Generic "Find RPMS Module's Version and (perhaps) Patch number"

 ; The MODULE variable MUST be the PREFIX name from the PACKAGE file (9.4).

NEEDIT(MODULE,VERSION,PATCH,ERRARRAY)      ; EP

 NEW NAME                ; NAME of PACKAGE

 NEW PTR                 ; PoinTeR to PACKAGE file

 NEW HEREYAGO,STR1,STR2  ; Scratch variables/arrays

 NEW SYSVER,SYSPATCH     ; System Version & System Patch variables

 NEW NAMEVER,NAMESYS

 D FIND^DIC(9.4,"",,,MODULE,,"C",,,"HEREYAGO")

 S PTR=+$G(HEREYAGO("DILIST",2,1))

 I PTR<1 D  Q      ; Modlue not installed on system -- write message and quit

 . S ERRARRAY(MODULE,MODULE,VERSION)="0^VERSION"

 . D NEEDMSG("Needed Module "_MODULE_" not Found!")

 S NAME=$G(HEREYAGO("DILIST",1,1))

 S SYSVER=$$VERSION^XPDUTL(MODULE)     ; Get the System's Version

 S NAMEVER=NAME_" "_VERSION,NAMESYS=NAME_" "_SYSVER

 ; If System Version < Needed Version, write message and quit

 I SYSVER<VERSION D  Q

 . S ERRARRAY(MODULE,NAME,VERSION)=SYSVER_"^VERSION"

 . D NEEDMSG("Need "_NAMEVER_" & "_NAMESYS_" found!")

 ; If System Version > Needed Version, write message and quit

 I VERSION<SYSVER D OKAY^BLRKIDSU("Need "_NAMEVER_" & "_NAMESYS_" found.",5)  Q

 I $G(PATCH)="" D  Q   ; If no Patch check, write message and quit

 . D OKAY^BLRKIDSU(NAMEVER_" found.",5)

 S SYSPATCH=$$PATCH^XPDUTL(MODULE_"*"_VERSION_"*"_PATCH)

 I SYSPATCH'=1 D  Q

 . S ERRARRAY(MODULE,NAME,VERSION)=$G(PATCH)_"^PATCH"

 . D NEEDMSG(NAMEVER_" & Patch "_PATCH_" WAS NOT installed!")

 D OKAY^BLRKIDSU(NAMEVER_" Patch "_PATCH_" found.",5)

NEEDMSG(MESSAGE) ; EP

 NEW STR1,STR2

 S STR1=MESSAGE

 I $L(STR1)<58 D SORRY(STR1)  Q

 S STR1=$P(MESSAGE,"&")_" &"

 S STR2=$$TRIM^XLFSTR($P(MESSAGE,"&",2),"L"," ")

 D SORRY(STR1,,STR2)

MEGAWARN ; EP

 NEW CP

 S CP=$P($T(+2),"*",3)              ; Current Patch

 Q:$$BACKUPS="Q"

 Q:$$MAKESURE="Q"

 W !!

 D TEXTONGO

 D PRESSKEY(5)

 I $G(QFLG)="Q" D  Q

 . S XPDABORT=1

 . D BMES^XPDUTL("")

 . D BMES^XPDUTL($J("",15)_"Continue stopped.  Install Aborting.")

 . D BMES^XPDUTL("")

 D REALLYIN          ; Store info regarding person insisting on install

JUSTTXT() ; EP

 D PASSMESG("ATTENTION")

W !

 D COMPLEX

 W ?5,"It is also critical that all Laboratorians are prepared for this patch.",!!

 W ?5,"Verify with the Lab Supervisor.",!

 Q $$MAKESURE

COMPLEX ; EP

 W ?5,"Due to the complexities of this install, it is absolutely imperative",!!

 W $$CJ^XLFSTR(">>> A VALID BACKUP EXISTS <<<",IOM),!!

 W ?5,"because there is no recovery possible except restoring from backup.",!!!

PASSMESG(WOT) ; EP -- Splash message

 NEW MAXIT,AROUND

 S MAXIT="@"

 F J=1:1:$L(WOT) S MAXIT=MAXIT_$E(WOT,J,J)_"@"

 S AROUND=$TR($J("",8+$L(MAXIT))," ","@")

 S MAXIT="@@!!"_$TR(MAXIT," ","@")_"!!@@"

 D ^XBCLS

 W $TR($J("",IOM)," ","*"),!

 W $TR($J("",IOM)," ","*"),!

 W $TR($$CJ^XLFSTR(AROUND,IOM)," @","* "),!

 W $TR($$CJ^XLFSTR(MAXIT,IOM)," @","* "),!

 W $TR($$CJ^XLFSTR(AROUND,IOM)," @","* "),!

 W $TR($J("",IOM)," ","*"),!

 W $TR($J("",IOM)," ","*"),!

BACKUPS() ; EP -- Ask for confirmation of Backup

 D PASSMESG("ATTENTION")

W !

 D COMPLEX

 D ^XBFMK

 S DIR(0)="Y"

 S DIR("B")="NO"

 S DIR("A")=$J("",10)_"Has a SUCCESSFUL system backup been performed??"

 D ^DIR

W !

 I +$G(Y)'=1 D  Q "Q"

 . S XPDABORT=1

 . D PASSMESG("ATTENTION")

 . W !!

 . W ?15,"SUCCESSFUL system backup has >>> NOT <<< been confirmed.",!!

 . W ?15,"Install Aborting.",!!

 ; 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)=DUZ_"^"_$P($G(^VA(200,DUZ,0)),U)

 S ^BLRINSTL("LAB PATCH",CP,"BACKUP CONFIRMED BY",BCKUPCNT,"DATE/TIME")=$$HTE^XLFDT($H,"5MZ")

 Q "OK"

MAKESURE() ; EP

 D PASSMESG("PLEASE NOTE")

W !

 W ?5,"There are over 335 routines, multiple Data Dictionary changes as well as",!

 W ?5,"numerous new options and processes that are included in this patch.",!

W !

 S ANSWER=$$AREUSURE("CERTAIN")

 Q:ANSWER="Q" ANSWER

 D PASSMESG("SECOND CHANCE")

 S ANSWER=$$AREUSURE("REALLY certain")

 Q:ANSWER="Q" ANSWER

W !

 D PASSMESG("LAST CHANCE")

 Q $$AREUSURE("ABSOLUTELY certain")

AREUSURE(MSG) ; EP

 NEW PROMPT

 S PROMPT=$J("",5)_"Are you "_MSG_" you want to continue loading this patch"

 D ^XBFMK

 S DIR(0)="YO"

 S DIR("B")="NO"

 S DIR("A")=PROMPT

 D ^DIR

 I $E($$UP^XLFSTR(X),1)'="Y" D  Q "Q"

 . S XPDABORT=1

 . W !!,?10,"YES was NOT entered.  Install Aborted.",!

 . D PRESSKEY(10)

 Q "OK"

TEXTONGO ; EP

 D PASSMESG("LOADING OF PATCH WILL COMMENCE")

W !

 D BMES^XPDUTL($$CJ^XLFSTR(">>>> IHS Lab Patch 1027 will now be loaded. <<<<",IOM))

 D BMES^XPDUTL($$CJ^XLFSTR("Once installed there is no recovery possible except",IOM))

 D MES^XPDUTL($$CJ^XLFSTR("restoring from BACKUP.",IOM))

 D BMES^XPDUTL("")

PRESSKEY(TAB,MSGSTR)                          ; EP

 NEW TABSTR

 S TABSTR=$J("",+$G(TAB))_$S(+$L($G(MSGSTR)):$G(MSGSTR),1:"Press RETURN Key")

W !

 D ^XBFMK

 S DIR(0)="E"

 S DIR("A")=TABSTR

 D ^DIR

 I $G(DUOUT) S QFLG="Q"      ; If Fileman quit, then set Quit Flag

REALLYIN       ; EP

 NEW CP,INSTCNT

 S CP=$P($T(+2),"*",3)

 S INSTCNT=1+$O(^BLRINSTL("LAB PATCH",CP,"REALLY INSTALL",""),-1)

 S ^BLRINSTL("LAB PATCH",CP,"REALLY INSTALL",INSTCNT)=DUZ_"^"_$P($G(^VA(200,DUZ,0)),"^")

 S ^BLRINSTL("LAB PATCH",CP,"REALLY INSTALL",INSTCNT,"DATE/TIME")=$$HTE^XLFDT($H,"5Z")

 ; TESTING FOUR FIVE SIX

BLRPRE27  ;IHS/OIT/MKK - IHS Lab PATCH 1027 Environment Routine ;JUL 06, 2010 3:14 PM

 +1       ;;5.2;IHS LABORATORY;**1027**;NOV 01, 1997

 +2       ;

 +3       ; TESTING ONE TWO THREE

 +4       ;

PRE       ; EP

 +1        DO BMES^XPDUTL("Beginning of Pre Check.")

 +2        NEW CP,RPMS,RPMSVER,QFLG,STR

 +3       ; Array of errors detected

           NEW ERRARRAY

 +4        NEW ROWSTARS

 +5       ;

 +6        IF $GET(XPDNM)=""

               DO SORRY("XPDNM not defined or 0.")

               QUIT

 +7       ;

 +8       ; Current Patch Number

           SET CP=$PIECE(XPDNM,"*",3)

 +9       ; RPMS Module

           SET RPMS=$PIECE(XPDNM,"*",1)

 +10      ; Version of RPMS module being patched

           SET RPMSVER=$PIECE(XPDNM,"*",2)

 +11      ;

 +12      ; Row of asterisks

           SET ROWSTARS=$TRANSLATE($JUSTIFY("",65)," ","*")

 +13      ;

USERID    ; EP - CHECK FOR USER ID

 +1        IF +$GET(DUZ)<1

               DO SORRY("DUZ UNDEFINED OR 0.")

               QUIT

 +2       ;

 +3        IF $PIECE($GET(^VA(200,DUZ,0)),U)=""

               DO SORRY("Installer cannot be identified!")

               QUIT

 +4       ;

GETREADY  ; EP

 +1       ; No Queuing Allowed

           SET XPDNOQUE="NO QUE"

 +2       ;

 +3       ; The following line prevents the "Disable Options..." and "Move

 +4       ; Routines..." questions from being asked during the install.

 +5        FOR X="XPO1","XPZ1","XPZ2","XPI1"

               SET XPDDIQ(X)=0

 +6       ;

 +7       ; KIDS install Flag

           SET XPDABORT=0

 +8       ;

 +9       ; Reset/Initialize IO variables

           DO HOME^%ZIS

 +10      ; Set DT variable without Doing a Line Feed

           DO DTNOLF^DICRW

 +11      ;

ENVICHEK  ; Environment Checker

 +1        NEW CHKPATCH

 +2       ;

 +3       ; Header

           DO CHKENHED

 +4       ;

 +5        FOR CHKPATCH=46,61,62,63,65

               DO NEEDIT("LA","5.2",CHKPATCH,.ERRARRAY)

 +6        DO MES^XPDUTL(" ")

 +7        FOR CHKPATCH=1005,1006

               DO NEEDIT("HL","1.6",CHKPATCH,.ERRARRAY)

 +8        DO MES^XPDUTL(" ")

 +9        FOR CHKPATCH=261,1013

               DO NEEDIT("XU","8.0",CHKPATCH,.ERRARRAY)

 +10       DO MES^XPDUTL(" ")

 +11       FOR CHKPATCH=187,202,220,222,230,232,256,261,269,271,282,283,285,287,312,1026

               Begin DoDot:1

 +12               DO NEEDIT("LR","5.2",CHKPATCH,.ERRARRAY)

               End DoDot:1

 +13       DO MES^XPDUTL(" ")

 +14      ; CHECK FOR LMI MAIL GROUP

           DO CHECKLMI(.ERRARRAY)

 +15       DO MES^XPDUTL(" ")

 +16      ; MAILMAN 8.0

           DO NEEDIT("XM","8.0",,.ERRARRAY)

 +17       DO MES^XPDUTL(" ")

 +18      ; PIMS 5.3

           DO NEEDIT("PIMS","5.3",,.ERRARRAY)

 +19       DO MES^XPDUTL(" ")

 +20      ; AUT 98.1 & PATCH 22

           DO NEEDIT("AUT","98.1","22",.ERRARRAY)

 +21       DO MES^XPDUTL(" ")

 +22      ; VA FILEMAN 22.0

           DO NEEDIT("DI","22.0",,.ERRARRAY)

 +23       DO MES^XPDUTL(" ")

 +24      ;

 +25      ; ENVIRONMENT HAS ERROR(S)

           IF XPDABORT>0

               DO SORRYEND(.ERRARRAY,CP)

               QUIT

 +26      ;

 +27       DO BMES^XPDUTL("ENVIRONMENT OK.")

 +28      ;

 +29       QUIT

 +30      ;

POST      ; EP -- POST INSTALL

 +1        NEW CP,STR

 +2       ;

 +3       ; Current Patch

           SET CP=$PIECE($TEXT(+2),"*",3)

 +4       ;

 +5       ; EAG Delta Check Addition -- POST Install

           DO ADDEAGDC^BLRPR27P

 +6       ;

 +7       ; Store # of times installation occurred as well as person & date/time

 +8        DO ENDINSTL^BLRKIDSU(CP)

 +9       ;

 +10       DO SNDALERT("Laboratory Patch "_CP_" INSTALL complete.")

 +11      ;

 +12       SET STR(1)=" "

 +13       SET STR(2)=$JUSTIFY("",10)_"POST INSTALL of BLRPRE27 Routine."

 +14       SET STR(3)=" "

 +15       SET STR(4)=$JUSTIFY("",15)_"Laboratory Patch "_CP_" INSTALL completed."

 +16       SET STR(5)=" "

 +17       DO SENDMAIL("Laboratory Patch "_CP_" INSTALL complete.")

 +18      ;

 +19       QUIT

 +20      ;

CHKENHED  ; EP -- Header

 +1        NEW STR

 +2        SET STR=$TRANSLATE($JUSTIFY("",IOM)," ","*")

 +3       ;

 +4        DO ^XBCLS

 +5        WRITE STR,!

 +6        WRITE $TRANSLATE($$CJ^XLFSTR("@Checking@Environment@for@Patch@"_CP_"@of@Version@"_RPMSVER_"@of@"_RPMS_".@",IOM)," @","* "),!

 +7        WRITE STR,!

 +8        QUIT

 +9       ;

DEBUG     ; EP - Debugging Line Label for environment checker

 +1        NEW CP,DEBUG,XPDNM

 +2        WRITE !!

 +3        DO PASSMESG^BLRPRE27("DEBUGGING@BLRPRE27")

 +4       ;

 +5        SET DEBUG="YES"

 +6       ;

 +7        DO ^XBFMK

 +8        SET DIR(0)="YO"

 +9        SET DIR("B")="NO"

 +10       SET DIR("A")="Send Alerts/E-Mails"

 +11       DO ^DIR

 +12       IF +$GET(Y)=1

               SET DEBUG="NO"

 +13      ;

 +14       WRITE !

 +15       SET XPDNM="LR*5.2*1027"

 +16       SET XPDENV=0

 +17       DO PRE

 +18      ;

 +19       WRITE !!

 +20       DO ^XBFMK

 +21       SET DIR(0)="YO"

 +22       SET DIR("B")="NO"

 +23       SET DIR("A")="Debug POST Install Code"

 +24       DO ^DIR

 +25      ;

 +26       IF +$GET(Y)=1

               DO POST

 +27      ;

 +28       WRITE !!,$TRANSLATE($JUSTIFY("",IOM)," ","*"),!

 +29       WRITE $TRANSLATE($$CJ^XLFSTR("@DEBUGGING@BLRPRE27@Complete.@",IOM)," @","* "),!

 +30       WRITE $TRANSLATE($JUSTIFY("",IOM)," ","*"),!!

 +31      ;

 +32       QUIT

 +33      ;

 +34      ; Error Message routine.

SORRY(MSG,MODE,MSG2) ; EP

 +1        NEW MESSAGE,ROWSTARS

 +2       ;

 +3       ; Current Patch

           SET CP=$PIECE($TEXT(+2),"*",3)

 +4       ; Row of asterisks

           SET ROWSTARS=$TRANSLATE($JUSTIFY("",65)," ","*")

 +5       ;

 +6        SET MODE=$GET(MODE,"FATAL")

 +7       ;

 +8        IF $GET(MODE)="FATAL"

               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      ; STR Array will be used to write to the screen, send E-Mail & Alert

 +17       NEW STR,LINECNT

 +18       SET LINECNT=1

 +19       DO ADDLINE(" ",.LINECNT)

 +20       DO ADDLINE(ROWSTARS,.LINECNT)

 +21       DO ADDLINE(" ",.LINECNT)

 +22       DO ADDLINE("Site: "_$$LOC^XBFUNC,.LINECNT,"YES")

 +23       DO ADDLINE(" ",.LINECNT)

 +24       DO ADDLINE(MESSAGE,.LINECNT,"YES")

 +25       DO ADDLINE(" ",.LINECNT)

 +26       DO ADDLINE(">>> "_MSG_" <<<",.LINECNT,"YES")

 +27       IF $DATA(MSG2)

               DO ADDLINE(">>> "_MSG2_" <<<",.LINECNT,"YES")

 +28       DO ADDLINE(" ",.LINECNT)

 +29      ;

 +30       IF $GET(MODE)["NONFATAL"

               DO ADDLINE(MESSAGE,.LINECNT,"YES")

 +31      ;

 +32       IF $GET(MODE)="FATAL"

               Begin DoDot:1

 +33               DO ADDLINE("Please print/capture this screen and",.LINECNT,"YES")

 +34               DO ADDLINE("notify the Support Center at",.LINECNT,"YES")

 +35               DO ADDLINE(" ",.LINECNT)

 +36               DO ADDLINE("1-888-830-7280.",.LINECNT,"YES")

 +37               DO ADDLINE(" ",.LINECNT)

               End DoDot:1

 +38      ;

 +39      ; Row of asterisks

           DO ADDLINE(ROWSTARS,.LINECNT)

 +40       DO ADDLINE(" ",.LINECNT)

 +41      ;

 +42       DO BMES^XPDUTL(.STR)

 +43      ;

 +44       IF $GET(DEBUG)="YES"

               QUIT

 +45      ;

 +46       IF $GET(MODE)="FATAL"

               Begin DoDot:1

 +47               DO SNDALERT("Laboratory Patch "_CP_" >> FATAL << "_MSG)

 +48               DO SENDMAIL("IHS Lab Patch "_CP_" Install FATAL Error")

               End DoDot:1

               QUIT

 +49      ;

 +50       DO SNDALERT("Laboratory Patch "_CP_" - "_MODE_" - "_MSG)

 +51       DO SENDMAIL("IHS Lab Patch "_CP_" Install NONFATAL Error")

 +52       QUIT

 +53      ;

SNDALERT(ALERTMSG) ; EP - Send alert to LMI group AND Installer

 +1        IF $GET(DEBUG)="YES"

               QUIT

 +2       ;

 +3        SET XQAMSG=ALERTMSG

 +4        SET XQA("G.LMI")=""

 +5       ;

 +6       ; If installer not part of LMI Mail Group, send them alert also

 +7        IF $$NINLMI(DUZ)

               SET XQA(DUZ)=""

 +8       ;

 +9        DO SETUP^XQALERT

 +10       KILL XQA,XQAMSG

 +11       QUIT

 +12      ;

NINLMI(CHKDUZ) ; EP -- Check to see if DUZ is NOT part of LMI Mail Group

 +1        NEW MGRPIEN,XMDUZ

 +2       ;

 +3       ; Get IEN of LMI MaiL Group

 +4       ; VA DBIA 1146

           DO CHKGROUP^XMBGRP("LMI",.MGRPIEN)

 +5       ; If no Mail Group, return TRUE

           IF +(MGRPIEN)<1

               QUIT 1

 +6       ;

 +7       ; XMDUZ = DUZ of the user

 +8       ; Y     = IEN of the mail group

 +9        SET XMDUZ=DUZ

 +10       SET Y=MGRPIEN

 +11      ; VA DBIA 10067

           DO CHK^XMA21

 +12      ;

 +13       QUIT $SELECT($TEST=1:0,1:1)

 +14      ;

SENDMAIL(MAILMSG) ; EP -- Send MailMan E-mail to LMI group AND Installer

 +1        IF $GET(DEBUG)="YES"

               QUIT

 +2       ;

 +3        NEW DIFROM

 +4       ;

 +5        KILL XMY

 +6        SET XMY("G.LMI")=""

 +7       ;

 +8       ; If installer not part of LMI Mail Group, send them e-mail also

 +9        IF $$NINLMI(DUZ)

               SET XMY(DUZ)=""

 +10      ;

 +11       SET LRBLNOW=$EXTRACT($$NOW^XLFDT,1,12)

 +12      ;

 +13       SET XMSUB=MAILMSG

 +14       SET XMTEXT="STR("

 +15       SET XMDUZ="Lab Patch 1027"

 +16       SET XMZ="NOT OKAY"

 +17       DO ^XMD

 +18      ;

 +19       IF $GET(XMMG)'=""!(XMZ="NOT OKAY")

               Begin DoDot:1

 +20               DO BMES^XPDUTL($JUSTIFY("",5)_"MAILMAN ERROR.")

 +21               DO BMES^XPDUTL($JUSTIFY("",10)_"XMZ:"_XMZ)

 +22               DO BMES^XPDUTL($JUSTIFY("",10)_"XMMG:"_XMMG)

               End DoDot:1

 +23      ;

 +24      ; Cleanup

           KILL X,XMDUZ,XMSUB,XMTEXT,XMY,XMZ,Y

 +25       QUIT

 +26      ;

ADDLINE(ASTR,LC,CENTER) ; EP -- Add a line to the STR array; CENTER if requested

 +1        IF $GET(ASTR)=""

               SET ASTR=" "

 +2        IF $GET(CENTER)'="YES"

               SET STR(LC)=ASTR

 +3        IF $GET(CENTER)="YES"

               SET STR(LC)=$$CJ^XLFSTR(ASTR,65)

 +4        SET LC=LC+1

 +5        QUIT

 +6       ;

SORRYEND(WOTERR,CP) ; EP -- ALL the errors detected during the environment check.

 +1        NEW STR,MODULE,NAME,VERSION,PATCH,LINECNT,TMP

 +2       ;

 +3        DO SORRYHED

 +4       ;

 +5        SET (MODULE,NAME,VERSION)=""

 +6        FOR

               SET MODULE=$ORDER(WOTERR(MODULE))

               IF MODULE=""

                   QUIT

               Begin DoDot:1

 +7                FOR

                       SET NAME=$ORDER(WOTERR(MODULE,NAME))

                       IF NAME=""

                           QUIT

                       Begin DoDot:2

 +8                        FOR

                               SET VERSION=$ORDER(WOTERR(MODULE,NAME,VERSION))

                               IF VERSION=""

                                   QUIT

                               Begin DoDot:3

 +9                                DO ADDMESG

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +10      ;

 +11       DO SORRYFIN

 +12      ;

 +13       DO BMES^XPDUTL(.STR)

 +14      ;

 +15       QUIT

 +16      ;

SORRYHED  ; EP -- "Header" of Final Fatal Message

 +1        SET LINECNT=1

 +2        DO ADDLINE(" ",.LINECNT)

 +3        DO ADDLINE(ROWSTARS,.LINECNT)

 +4        DO ADDLINE(" ",.LINECNT)

 +5        DO ADDLINE("Systems Environment Error Detected",.LINECNT,"YES")

 +6        DO ADDLINE("KIDS build will be deleted",.LINECNT,"YES")

 +7        DO ADDLINE(" ",.LINECNT)

 +8        DO ADDLINE("Modules with Version or Patch errors",.LINECNT,"YES")

 +9        DO ADDLINE(" ",.LINECNT)

 +10       QUIT

 +11      ;

ADDMESG   ; EP

 +1        NEW WOT

 +2       ;

 +3        DO ADDLINE(NAME_" ("_MODULE_")",.LINECNT,"YES")

 +4       ;

 +5        SET WOT=$GET(WOTERR(MODULE,NAME,VERSION))

 +6        SET TMP="Version:"_VERSION

 +7        IF $PIECE(WOT,"^",2)="VERSION"

               Begin DoDot:1

 +8                SET TMP="Needed Version:"_VERSION

 +9                SET TMP=TMP_"  Found Version:"_$PIECE(WOT,"^")

               End DoDot:1

 +10       IF $PIECE(WOT,"^",2)="PATCH"

               Begin DoDot:1

 +11               SET TMP=TMP_"  Needed Patch:"_$PIECE(WOT,"^")

               End DoDot:1

 +12      ;

 +13       DO ADDLINE(TMP,.LINECNT,"YES")

 +14       DO ADDLINE(" ",.LINECNT)

 +15       QUIT

 +16      ;

SORRYFIN  ; EP -- "Fin" of Final Fatal Message

 +1        DO ADDLINE("Re-Installation will be necessary.",.LINECNT,"YES")

 +2        DO ADDLINE(" ",.LINECNT)

 +3        DO ADDLINE("If assistance is needed, please call 1-888-830-7280.",.LINECNT,"YES")

 +4        DO ADDLINE(" ",.LINECNT)

 +5        DO ADDLINE(ROWSTARS,.LINECNT)

 +6        DO ADDLINE(" ",.LINECNT)

 +7        QUIT

 +8       ;

CHECKLMI(ERRARRAY) ; EP  -- CHECK FOR LMI MAIL GROUP

 +1        NEW MGRPIEN

 +2       ; VA DBIA 1146

           DO CHKGROUP^XMBGRP("LMI",.MGRPIEN)

 +3        IF MGRPIEN

               Begin DoDot:1

 +4                DO OKAY^BLRKIDSU("LMI Mail Group Exists.")

               End DoDot:1

               QUIT

 +5       ;

 +6        DO BMES^XPDUTL("")

 +7        DO SORRY("LMI Mail Group Does NOT Exist!")

 +8        SET ERRARRAY("XMB","Mail Group","3.8")="LMI Mail Group"

 +9        QUIT

 +10      ;

 +11      ; Generic "Find RPMS Module's Version and (perhaps) Patch number"

 +12      ; The MODULE variable MUST be the PREFIX name from the PACKAGE file (9.4).

NEEDIT(MODULE,VERSION,PATCH,ERRARRAY) ; EP

 +1       ; NAME of PACKAGE

           NEW NAME

 +2       ; PoinTeR to PACKAGE file

           NEW PTR

 +3       ; Scratch variables/arrays

           NEW HEREYAGO,STR1,STR2

 +4       ; System Version & System Patch variables

           NEW SYSVER,SYSPATCH

 +5        NEW NAMEVER,NAMESYS

 +6       ;

 +7        DO FIND^DIC(9.4,"",,,MODULE,,"C",,,"HEREYAGO")

 +8        SET PTR=+$GET(HEREYAGO("DILIST",2,1))

 +9       ;

 +10      ; Modlue not installed on system -- write message and quit

           IF PTR<1

               Begin DoDot:1

 +11               SET ERRARRAY(MODULE,MODULE,VERSION)="0^VERSION"

 +12               DO NEEDMSG("Needed Module "_MODULE_" not Found!")

               End DoDot:1

               QUIT

 +13      ;

 +14       SET NAME=$GET(HEREYAGO("DILIST",1,1))

 +15      ;

 +16      ; Get the System's Version

           SET SYSVER=$$VERSION^XPDUTL(MODULE)

 +17      ;

 +18       SET NAMEVER=NAME_" "_VERSION

           SET NAMESYS=NAME_" "_SYSVER

 +19      ;

 +20      ; If System Version < Needed Version, write message and quit

 +21       IF SYSVER<VERSION

               Begin DoDot:1

 +22               SET ERRARRAY(MODULE,NAME,VERSION)=SYSVER_"^VERSION"

 +23               DO NEEDMSG("Need "_NAMEVER_" & "_NAMESYS_" found!")

               End DoDot:1

               QUIT

 +24      ;

 +25      ; If System Version > Needed Version, write message and quit

 +26       IF VERSION<SYSVER

               DO OKAY^BLRKIDSU("Need "_NAMEVER_" & "_NAMESYS_" found.",5)

               QUIT

 +27      ;

 +28      ; If no Patch check, write message and quit

           IF $GET(PATCH)=""

               Begin DoDot:1

 +29               DO OKAY^BLRKIDSU(NAMEVER_" found.",5)

               End DoDot:1

               QUIT

 +30      ;

 +31       SET SYSPATCH=$$PATCH^XPDUTL(MODULE_"*"_VERSION_"*"_PATCH)

 +32       IF SYSPATCH'=1

               Begin DoDot:1

 +33               SET ERRARRAY(MODULE,NAME,VERSION)=$GET(PATCH)_"^PATCH"

 +34               DO NEEDMSG(NAMEVER_" & Patch "_PATCH_" WAS NOT installed!")

               End DoDot:1

               QUIT

 +35      ;

 +36       DO OKAY^BLRKIDSU(NAMEVER_" Patch "_PATCH_" found.",5)

 +37      ;

 +38       QUIT

 +39      ;

NEEDMSG(MESSAGE) ; EP

 +1        NEW STR1,STR2

 +2       ;

 +3        SET STR1=MESSAGE

 +4        IF $LENGTH(STR1)<58

               DO SORRY(STR1)

               QUIT

 +5       ;

 +6        SET STR1=$PIECE(MESSAGE,"&")_" &"

 +7        SET STR2=$$TRIM^XLFSTR($PIECE(MESSAGE,"&",2),"L"," ")

 +8        DO SORRY(STR1,,STR2)

 +9        QUIT

 +10      ;

MEGAWARN  ; EP

 +1        NEW CP

 +2       ;

 +3       ; Current Patch

           SET CP=$PIECE($TEXT(+2),"*",3)

 +4       ;

 +5        IF $$BACKUPS="Q"

               QUIT

 +6       ;

 +7        IF $$MAKESURE="Q"

               QUIT

 +8       ;

 +9        WRITE !!

 +10       DO TEXTONGO

 +11       DO PRESSKEY(5)

 +12       IF $GET(QFLG)="Q"

               Begin DoDot:1

 +13               SET XPDABORT=1

 +14               DO BMES^XPDUTL("")

 +15               DO BMES^XPDUTL($JUSTIFY("",15)_"Continue stopped.  Install Aborting.")

 +16               DO BMES^XPDUTL("")

               End DoDot:1

               QUIT

 +17      ;

 +18      ; Store info regarding person insisting on install

           DO REALLYIN

 +19       QUIT

 +20      ;

JUSTTXT() ; EP

 +1        DO PASSMESG("ATTENTION")

 +2        WRITE !

 +3        DO COMPLEX

 +4        WRITE ?5,"It is also critical that all Laboratorians are prepared for this patch.",!!

 +5        WRITE ?5,"Verify with the Lab Supervisor.",!

 +6        QUIT $$MAKESURE

 +7       ;

COMPLEX   ; EP

 +1        WRITE ?5,"Due to the complexities of this install, it is absolutely imperative",!!

 +2        WRITE $$CJ^XLFSTR(">>> A VALID BACKUP EXISTS <<<",IOM),!!

 +3        WRITE ?5,"because there is no recovery possible except restoring from backup.",!!!

 +4        QUIT

 +5       ;

PASSMESG(WOT) ; EP -- Splash message

 +1        NEW MAXIT,AROUND

 +2       ;

 +3        SET MAXIT="@"

 +4        FOR J=1:1:$LENGTH(WOT)

               SET MAXIT=MAXIT_$EXTRACT(WOT,J,J)_"@"

 +5        SET AROUND=$TRANSLATE($JUSTIFY("",8+$LENGTH(MAXIT))," ","@")

 +6        SET MAXIT="@@!!"_$TRANSLATE(MAXIT," ","@")_"!!@@"

 +7       ;

 +8        DO ^XBCLS

 +9        WRITE $TRANSLATE($JUSTIFY("",IOM)," ","*"),!

 +10       WRITE $TRANSLATE($JUSTIFY("",IOM)," ","*"),!

 +11       WRITE $TRANSLATE($$CJ^XLFSTR(AROUND,IOM)," @","* "),!

 +12       WRITE $TRANSLATE($$CJ^XLFSTR(MAXIT,IOM)," @","* "),!

 +13       WRITE $TRANSLATE($$CJ^XLFSTR(AROUND,IOM)," @","* "),!

 +14       WRITE $TRANSLATE($JUSTIFY("",IOM)," ","*"),!

 +15       WRITE $TRANSLATE($JUSTIFY("",IOM)," ","*"),!

 +16       QUIT

 +17      ;

BACKUPS() ; EP -- Ask for confirmation of Backup

 +1        DO PASSMESG("ATTENTION")

 +2        WRITE !

 +3        DO COMPLEX

 +4       ;

 +5        DO ^XBFMK

 +6        SET DIR(0)="Y"

 +7        SET DIR("B")="NO"

 +8        SET DIR("A")=$JUSTIFY("",10)_"Has a SUCCESSFUL system backup been performed??"

 +9        DO ^DIR

 +10       WRITE !

 +11      ;

 +12       IF +$GET(Y)'=1

               Begin DoDot:1

 +13               SET XPDABORT=1

 +14               DO PASSMESG("ATTENTION")

 +15               WRITE !!

 +16               WRITE ?15,"SUCCESSFUL system backup has >>> NOT <<< been confirmed.",!!

 +17               WRITE ?15,"Install Aborting.",!!

               End DoDot:1

               QUIT "Q"

 +18      ;

 +19      ; Store backup confirmation person & date/time

 +20      ; Current Patch,Backup count

           NEW BCKUPCNT

 +21       SET BCKUPCNT=1+$ORDER(^BLRINSTL("LAB PATCH",CP,"BACKUP CONFIRMED BY",""),-1)

 +22       SET ^BLRINSTL("LAB PATCH",CP,"BACKUP CONFIRMED BY",BCKUPCNT)=DUZ_"^"_$PIECE($GET(^VA(200,DUZ,0)),U)

 +23       SET ^BLRINSTL("LAB PATCH",CP,"BACKUP CONFIRMED BY",BCKUPCNT,"DATE/TIME")=$$HTE^XLFDT($HOROLOG,"5MZ")

 +24      ;

 +25       QUIT "OK"

 +26      ;

MAKESURE() ; EP

 +1        DO PASSMESG("PLEASE NOTE")

 +2        WRITE !

 +3       ;

 +4        WRITE ?5,"There are over 335 routines, multiple Data Dictionary changes as well as",!

 +5        WRITE ?5,"numerous new options and processes that are included in this patch.",!

 +6        WRITE !

 +7        SET ANSWER=$$AREUSURE("CERTAIN")

 +8        IF ANSWER="Q"

               QUIT ANSWER

 +9       ;

 +10       DO PASSMESG("SECOND CHANCE")

 +11       SET ANSWER=$$AREUSURE("REALLY certain")

 +12       IF ANSWER="Q"

               QUIT ANSWER

 +13       WRITE !

 +14      ;

 +15       DO PASSMESG("LAST CHANCE")

 +16       QUIT $$AREUSURE("ABSOLUTELY certain")

 +17      ;

AREUSURE(MSG) ; EP

 +1        NEW PROMPT

 +2        SET PROMPT=$JUSTIFY("",5)_"Are you "_MSG_" you want to continue loading this patch"

 +3        DO ^XBFMK

 +4        SET DIR(0)="YO"

 +5        SET DIR("B")="NO"

 +6        SET DIR("A")=PROMPT

 +7        DO ^DIR

 +8        IF $EXTRACT($$UP^XLFSTR(X),1)'="Y"

               Begin DoDot:1

 +9                SET XPDABORT=1

 +10               WRITE !!,?10,"YES was NOT entered.  Install Aborted.",!

 +11               DO PRESSKEY(10)

               End DoDot:1

               QUIT "Q"

 +12      ;

 +13       QUIT "OK"

 +14      ;

TEXTONGO  ; EP

 +1        DO PASSMESG("LOADING OF PATCH WILL COMMENCE")

 +2        WRITE !

 +3        DO BMES^XPDUTL($$CJ^XLFSTR(">>>> IHS Lab Patch 1027 will now be loaded. <<<<",IOM))

 +4        DO BMES^XPDUTL($$CJ^XLFSTR("Once installed there is no recovery possible except",IOM))

 +5        DO MES^XPDUTL($$CJ^XLFSTR("restoring from BACKUP.",IOM))

 +6        DO BMES^XPDUTL("")

 +7       ;

 +8        QUIT

 +9       ;

PRESSKEY(TAB,MSGSTR) ; EP

 +1        NEW TABSTR

 +2        SET TABSTR=$JUSTIFY("",+$GET(TAB))_$SELECT(+$LENGTH($GET(MSGSTR)):$GET(MSGSTR),1:"Press RETURN Key")

 +3       ;

 +4        WRITE !

 +5        DO ^XBFMK

 +6        SET DIR(0)="E"

 +7        SET DIR("A")=TABSTR

 +8        DO ^DIR

 +9       ; If Fileman quit, then set Quit Flag

           IF $GET(DUOUT)

               SET QFLG="Q"

 +10      ;

 +11       QUIT

REALLYIN  ; EP

 +1        NEW CP,INSTCNT

 +2       ;

 +3        SET CP=$PIECE($TEXT(+2),"*",3)

 +4        SET INSTCNT=1+$ORDER(^BLRINSTL("LAB PATCH",CP,"REALLY INSTALL",""),-1)

 +5       ;

 +6        SET ^BLRINSTL("LAB PATCH",CP,"REALLY INSTALL",INSTCNT)=DUZ_"^"_$PIECE($GET(^VA(200,DUZ,0)),"^")

 +7        SET ^BLRINSTL("LAB PATCH",CP,"REALLY INSTALL",INSTCNT,"DATE/TIME")=$$HTE^XLFDT($HOROLOG,"5Z")

 +8        QUIT

 +9       ;

 +10      ; TESTING FOUR FIVE SIX

BLRPRE27.m