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.")
;
Q
;
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.")
;
Q
;
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,!
Q
;
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)," ","*"),!!
;
Q
;
; 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")
Q
;
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
Q
;
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
Q
;
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
Q
;
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)
;
Q
;
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)
Q
;
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)
Q
;
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)
Q
;
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"
Q
;
; 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)
;
Q
;
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)
Q
;
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
Q
;
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.",!!!
Q
;
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)," ","*"),!
Q
;
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("")
;
Q
;
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
;
Q
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")
Q
;
; 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
