BLRPRE25 ; IHS/OIT/MKK - IHS Lab PATCH 1025 Environment/Post Install Routine ;DEC 09, 2008 8:30 AM
;;5.2;IHS LABORATORY;**1025**;NOV 01, 1997
;
PRECHK ; EP
D BMES^XPDUTL("Beginning of Pre Check.")
NEW CP,LINE2,RPMS,RPMSVER
NEW STR ; String -- used as an array for messages.
NEW LASTPTCH ; Last Patch of Lab
NEW LSTPISTS ; Last Patch Install Status
NEW WOTERR ; Array of errors detected
;
S LINE2=$T(+2) ; Second line of THIS Routine
;
I $G(XPDNM)="" D SORRY("XPDNM not defined or 0.",,,1025) 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
;
PTCHLAST ; EP - Check for previous patch
D MES^XPDUTL(" Need LR*5.2*1024 Patch Installed.")
I $$PATCH^XPDUTL("LR*5.2*1024")'=1 D SORRY("LR*5.2*1024 Patch Not Installed.",,,1025) Q
;
D OKAY^BLRKIDSU("LR*5.2*1024 Patch Installed.",10)
; I $$LASTPTCH(1024)'="OK" Q ; Abort if Lab Patch 1024 NOT Installed
;
S XPDNOQUE="NO QUE" ; No Queuing Allowed
;
; The following line prevents the "Disable Options..." and "Move
; Routines..." questions from being asked during the install.
I $G(XPDENV)=1 S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
I $G(XPDENV)=1 S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
F X="XPO1","XPZ1","XPZ2","XPI1" S XPDDIQ(X)=0
;
S XPDABORT=0 ; KIDS install Flag
;
USERID ; EP - CHECK FOR USER ID
I '$G(DUZ) D SORRY("DUZ UNDEFINED OR 0.",,,CP) Q
;
I '$L($G(DUZ(0))) D SORRY("DUZ(0) UNDEFINED OR NULL.",,,CP) Q
;
D HOME^%ZIS ; IO Defaults
D DTNOLF^DICRW ; Set DT variable without Doing a Line Feed
;
S X=$P($G(^VA(200,DUZ,0)),U)
I $G(X) D SORRY^BLRKIDSU("Installer cannot be identified!",,,CP) Q
;
D MES^XPDUTL("Pre Check complete.")
; D MES^XPDUTL(" ")
;
LETSGO ; EP - USER IDENTIFIED -- LET'S GO
D BMES^XPDUTL("Hello, "_$P(X,",",2)_" "_$P(X,","))
;
D BMES^XPDUTL("Checking Environment for Patch "_CP_" of Version "_RPMSVER_" of "_RPMS_".")
;
D NEEDIT("DI","22.0",,.WOTERR,CP) ; CHECK FOR FILEMAN 22.0
;
D NEEDIT("XU","8.0",1013,.WOTERR,CP) ; CHECK FOR KERNEL 8.0 & PATCH 1013
;
D CHECKLMI(.WOTERR,CP) ; CHECK FOR LMI MAIL GROUP
;
D NEEDIT("XM","7.1",1005,.WOTERR,CP) ; CHECK FOR MAILMAN 7.1
;
I XPDABORT<1 D BMES^XPDUTL("ENVIRONMENT OK.") ; ENVIRONMENT OK
;
I XPDABORT>0 D SORRYEND^BLRKIDSU(.WOTERR,CP) ; ENVIRONMENT HAS ERROR(S)
;
Q
;
BACKUP ; EP
NEW CP ; Current Patch
S CP=$TR($P($T(+2),";",5),"*")
;
D BACKUPS^BLRKIDSU(CP)
Q
;
POST ; EP -- POST INSTALL
NEW CP ; Current Patch
S CP=$TR($P($T(+2),";",5),"*")
;
D MODBLRM ; Modify BLRMENU option(s)
;
D ADDDELTA ; Add 4 new Delta Checks
;
D BBMOD ; Blood Bank Modification
;
; I $$EXIST^%R("BEHOLPCI.INT") D
; . D POSTINIT^BEHOLPCI ; EHR Point-of-Care Initialization
;
D BMES^XPDUTL("Laboratory Patch "_CP_" INSTALL complete.")
;
; Store # of times installation occurred as well as person & date/time
D ENDINSTL^BLRKIDSU(CP)
;
; Complete Message
S XQAMSG="Laboratory Patch "_CP_" INSTALL complete."
S XQA("G.LMI")=""
D SETUP^XQALERT
;
Q
;
BBMOD ; Blood Bank Module Modification -- Change the length of the UNIT ID field.
NEW MAXSTR,OKAY,SPEC,STR,SUBSTR
NEW WOTDD
;
D TABMESG^BLRKIDSU("Changing UNIT ID & HELP field max length in BLOOD PRODUCT file.",5)
S MAXSTR=30
S OKAY=0
;
S STR=$G(^DD(65,.01,0))
S SUBSTR=$P($P($P($P(STR,"^",5),">",2),")",1),"!",1)
;
I +SUBSTR'<MAXSTR D Q
. D OKAY^BLRKIDSU("UNIT ID field max length already CHANGED.",10)
;
I +$L(SUBSTR)<1!($L($P(STR,">",2))<1) D Q
. D SORRY("UNIT ID field in BLOOD PRODUCT file damaged: examine with FileMan.","NONFATAL")
;
S SPEC(SUBSTR)=MAXSTR
S STR=$$REPLACE^XLFSTR(STR,.SPEC)
S WOTDD="^DD(65,.01,0)"
S @WOTDD=STR
;
S SUBSTR=$P($P($P($P($G(^DD(65,.01,0)),"^",5),">",2),")",1),"!",1)
;
I +SUBSTR'<MAXSTR D
. D OKAY^BLRKIDSU("UNIT ID field max length in BLOOD PRODUCT file changed.",10)
. S OKAY=OKAY+1
;
I +SUBSTR<MAXSTR D
. D TABMESG^BLRKIDSU("UNIT ID field max length in BLOOD PRODUCT file NOT changed.",10)
;
S STR=$G(^DD(65,.01,3))
S SUBSTR=$P($P(STR,"-",2)," ",1)
;
I +SUBSTR'<MAXSTR D Q
. D OKAY^BLRKIDSU("UNIT ID field HELP String in BLOOD PRODUCT file already >="_MAXSTR_".",10)
;
S SPEC(SUBSTR)=MAXSTR
S STR=$$REPLACE^XLFSTR(STR,.SPEC)
S WOTDD="^DD(65,.01,3)"
S @WOTDD=STR
;
S SUBSTR=$P($P($G(^DD(65,.01,3)),"-",2)," ",1)
;
I +SUBSTR'<MAXSTR D
. D OKAY^BLRKIDSU("UNIT ID field HELP String in BLOOD PRODUCT file Changed.",10)
. S OKAY=OKAY+1
;
I +SUBSTR<MAXSTR D Q
. D TABMESG^BLRKIDSU("UNIT ID field HELP String in BLOOD PRODUCT file NOT changed.",10)
;
D OKAY^BLRKIDSU("Changed UNIT ID & HELP field max length in BLOOD PRODUCT file.")
Q
;
DEBUG ; EP - Debugging Line Label for environment checker
NEW CP,DEBUG,LINE2,XPDNM
S DEBUG="YES"
S XPDNM="LR*5.2*1025"
D PRECHK
Q
;
MODBLRM ; EP
; Add Lab Version/Patch report option to the BLRMENU
D ADDTMENU^BLRKIDSU("BLRMENU","BLRVPTCH","LVP",,CP)
;
; Add "Busy Device" Report option to BLRMENU
D ADDTMENU^BLRKIDSU("BLRMENU","BLRPCCBD","BZY",,CP)
;
; Add Lab Description File Abbreviation Report to BLRMENU
D ADDTMENU^BLRKIDSU("BLRMENU","BLRLDFAR","MMR",,CP)
;
Q
;
ADDDELTA ; EP
NEW DESC,DESC1STR,DESC2STR,NAME,OVER1,OVER1STR,XCODE,XCODESTR
; Add 4 new Delta Checks to the Delta Check dictionary.
; This is to accomodate the Estimated GFR calculations required by
; the National Kidney Foundation:
; www.nkdep.nih.gov/resources/laboratory_reporting.htm
;
S DESC1STR="This delta check, when added to a test named CREATININE (NKDF), will calculate an"
S DESC2STR="estimated Glomerular Filtration Rate (GFR) using the standard MDRD Study"
S XCODESTR="S %X="""" X:$D(LRDEL(1)) LRDEL(1) W:$G(%X)'="""" "" Calculated GFR:"",%X S:LRVRM>10 LRSB($$GETDNAM^BLREXEC2(""EST GFR""))=%X K %,%X,%Y,%Z,%ZZ"
S OVER1STR="S %ZZ=$$GETDNAM^BLREXEC2(""CREATININE (NKDF)"") X:LRVRM>10 ""F %=%ZZ S %X(%)=$S(%=LRSB:X,$D(LRSB(%)):+LRSB(%),1:0)"" X:LRVRM>10 ""F %=%ZZ S %X(%)=$S($D(LRSB(%)):LRSB(%),1:0)"""
;
S NAME="GFRSE1CU"
S XCODE=XCODESTR
S OVER1=OVER1STR_" S %X=$$GFRSE1CU^BLREXEC2(X)"
S DESC(1)=DESC1STR
S DESC(2)=DESC2STR
S DESC(3)="Equation 1 with conventional Units and stuff the result into the test called"
S DESC(4)="EST GFR"
D DLTADICA(NAME,XCODE,OVER1,.DESC)
;
S NAME="GFRSE1SI"
S XCODE=XCODESTR
S OVER1=OVER1STR_" S %X=$$GFRSE1SI^BLREXEC2(X)"
K DESC(3),DESC(4)
S DESC(3)="Equation 1 with SI Units and stuff the result into the test called EST GFR"
D DLTADICA(NAME,XCODE,OVER1,.DESC)
;
S NAME="GFRSE2CU"
S XCODE=XCODESTR
S OVER1=OVER1STR_" S %X=$$GFRSE2CU^BLREXEC2(X)"
K DESC(3),DESC(4)
S DESC(3)="Equation 2 with conventional Units and stuff the result into the test called"
S DESC(4)="EST GFR"
D DLTADICA(NAME,XCODE,OVER1,.DESC)
;
S NAME="GFRSE2SI"
S XCODE=XCODESTR
S OVER1=OVER1STR_" S %X=$$GFRSE2SI^BLREXEC2(X)"
K DESC(3),DESC(4)
S DESC(3)="Equation 2 with SI Units and stuff the result into the test called EST GFR"
D DLTADICA(NAME,XCODE,OVER1,.DESC)
;
Q
;
DLTADICA(NAME,XCODE,OVER1,DESC) ; EP
NEW DICT0,DICT1,FDA,ERRS,PTR
NEW HEREYAGO
;
D BMES^XPDUTL("Adding "_NAME_" to Delta Check Dictionary")
;
D ^XBFMK
K ERRS,FDA,IENS,DIE
;
S DICT1="62.1"
S FDA(DICT1,"?+1,",.01)=NAME ; Find the Name node, or create it.
S FDA(DICT1,"?+1,",10)=XCODE ; Execute Code
S FDA(DICT1,"?+1,",20)=OVER1 ; Overflow 1
D UPDATE^DIE("S","FDA",,"ERRS")
;
I $D(ERRS("DIERR"))>0 D Q
. D SORRY^BLRKIDSU("Error in adding "_NAME_" to the Delta Check Dictionary.","NONFATAL",,CP)
;
D OKAY^BLRKIDSU(NAME_" Delta Check added to Delta Check Dictionary.",5)
;
; Now, add the Description
K ERRS
D FIND^DIC(62.1,"","","",NAME,"","","","","HEREYAGO") ; Get Pointer
S PTR=$G(HEREYAGO("DILIST",2,1))
M WPARRAY("WP")=DESC
D WP^DIE(62.1,PTR_",",30,"K","WPARRAY(""WP"")","ERRS")
;
I $D(ERRS("DIERR"))>0 D Q
. D SORRY^BLRKIDSU("Error in adding DESCRIPTION to "_NAME_" Delta Check in the Delta Check Dictionary.","NONFATAL",,CP)
;
D OKAY^BLRKIDSU(NAME_" Delta Check DESCRIPTION added to Delta Check Dictionary.",5)
;
; Now, add the SITE NOTES DATE
K ERRS,FDA
S FDA(62.131,"?+1,"_PTR_",",.01)=$P($$NOW^XLFDT,".",1)
D UPDATE^DIE("S","FDA",,"ERRS")
;
I $D(ERRS("DIERR"))>0 D Q
. D SORRY^BLRKIDSU("Error in adding SITES NOTES DATE to "_NAME_" Delta Check in the Delta Check Dictionary.","NONFATAL",,CP)
;
; Now, add the TEXT
K ERRS,WPARRAY
S WPARRAY("WP",1)="Created by IHS Lab Patch 1025"
D WP^DIE(62.131,"1,"_PTR_",",1,"K","WPARRAY(""WP"")","ERRS")
;
I $D(ERRS("DIERR"))>0 D Q
. D SORRY^BLRKIDSU("Error in adding TEXT to "_NAME_" Delta Check in the Delta Check Dictionary.","NONFATAL",,CP)
;
D OKAY^BLRKIDSU(NAME_" Delta Check TEXT added to Delta Check Dictionary.",5)
Q
;
LASTPTCH(CP) ; EP
NEW COMPFLAG,COMPPTCH,LASTPTCH,LRPATCH,LPIEN,STR
;
S LASTPTCH=CP-1
;
D BMES^XPDUTL("Need at least IHS Lab Patch "_LASTPTCH)
;
S LRPATCH="LR*5.2*1099",COMPFLAG="NO"
F S LRPATCH=$O(^XPD(9.7,"B",LRPATCH),-1) D Q:LRPATCH=""!(COMPFLAG="YES")!($E(LRPATCH,1,2)'="LR")!($P(LRPATCH,"*",3)<LASTPTCH)
. S LPIEN=$O(^XPD(9.7,"B",LRPATCH,""),-1)
. I $P($G(^XPD(9.7,+$G(LPIEN),0)),"^",9)=3 S COMPFLAG="YES",COMPPTCH=LRPATCH
;
I COMPFLAG'="YES"!($P(COMPPTCH,"*",3)<LASTPTCH) D Q "NOT OK"
. D SORRY("Need at least IHS Lab Patch "_LASTPTCH,,"Latest IHS Lab Patch Found is "_COMPPTCH_".",CP)
;
D OKAY^BLRKIDSU("IHS Lab Patch "_LASTPTCH_" Installed.",10)
;
Q "OK"
;
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(" ",.LINECNT)
D ADDLINE($TR($J("",65)," ","*"),.LINECNT) ; Row of asterisks
D ADDLINE(" ",.LINECNT)
D ADDLINE($$CJ^XLFSTR("Site: "_$$LOC^XBFUNC,65),.LINECNT)
D ADDLINE(" ",.LINECNT)
D ADDLINE($$CJ^XLFSTR(MESSAGE,65),.LINECNT)
D ADDLINE(" ",.LINECNT)
D ADDLINE($$CJ^XLFSTR(">>> "_MSG_" <<<",65),.LINECNT)
I $D(MSG2) D ADDLINE($$CJ^XLFSTR(">>> "_MSG2_" <<<",65),.LINECNT)
D ADDLINE(" ",.LINECNT)
;
I $G(MODE)["NONFATAL" D ADDLINE($$CJ^XLFSTR(MESSAGE,65),.LINECNT)
;
I $G(MODE)'["NONFATAL" D
. D ADDLINE($$CJ^XLFSTR("Please print/capture this screen and",65),.LINECNT)
. D ADDLINE($$CJ^XLFSTR("notify the Support Center at",65),.LINECNT)
. D ADDLINE(" ",.LINECNT)
. D ADDLINE($$CJ^XLFSTR("1-999-999-9999.",65),.LINECNT)
. D ADDLINE(" ",.LINECNT)
;
D ADDLINE($TR($J("",65)," ","*"),.LINECNT) ; Row of asterisks
D ADDLINE(" ",.LINECNT)
;
D BMES^XPDUTL(.STR) ; Display the message
;
; If Debugging, just exit -- Don't send e-mail nor alert
I $G(DEBUG)="YES" Q
;
; If no DUZ, it's impossible to send e-mail & alert, so just quit
I '$G(DUZ)!('$L($G(DUZ(0)))) 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
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
;
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
;
CHECKLMI(WOTERR,CP) ; EP -CHECK FOR LMI MAIL GROUP
NEW OKAY
D BMES^XPDUTL("Must have 'LMI' mail group present.")
S DIC="^XMB(3.8,"
S X="LMI"
D ^DIC
S OKAY=+Y
I OKAY>0 D OKAY^BLRKIDSU("'LMI' mail group found.")
I OKAY<1 D
. D SORRY^BLRKIDSU("'LMI' mail group NOT found!",,,CP)
. S WOTERR("XMB(3.8","Mail Group","3.8")="LMI Mail Group"
Q
;
NEEDIT(MODULE,VERSION,PATCH,WOTERR,CP) ; EP
; Generic "Find RPMS Module's Version and (perhaps) Patch number"
; NOTE: The MODULE variable MUST be the PREFIX name
; from the PACKAGE file (9.4).
NEW NAME ; NAME of RPMS Module
NEW PTR ; PoinTeR to PACKAGE file
NEW HEREYAGO ; Array to store returned values from FIND^DIC
NEW STR1,STR2 ; Temporary Strings
NEW SYSVER,SYSPATCH ; System Version & System Patch variables
;
; 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))
;
D BMES^XPDUTL("Need at least "_NAME_" "_VERSION)
;
S SYSVER=$$VERSION^XPDUTL(MODULE) ; Get the System's Version
; If System Version < Needed Version, write message and quit
I SYSVER<VERSION D Q
. S WOTERR(MODULE,NAME,VERSION)=""
. S STR1="Need "_NAME_" "_VERSION_" & "_NAME_" "_SYSVER_" found!"
. I $L(STR1)<58 D SORRY^BLRKIDSU(STR1,,,CP)
. I $L(STR1)>57 D
.. S STR1="Need "_NAME_" "_VERSION_" & "
.. S STR2=NAME_" "_SYSVER_" found!"
.. D SORRY^BLRKIDSU(STR1,,STR2,CP)
;
D OKAY^BLRKIDSU(NAME_" "_SYSVER_" found.")
I VERSION<SYSVER Q ; If Version needed is lower, skip Patch check
;
I $G(PATCH)="" Q ; If no Patch check, just exit
;
D BMES^XPDUTL(" Need "_NAME_" "_VERSION_" Patch "_PATCH_".")
S SYSPATCH=$$PATCH^XPDUTL(MODULE_"*"_VERSION_"*"_PATCH)
I SYSPATCH'=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^BLRKIDSU(STR1,,,CP)
. I $L(STR1)>57 D
.. S STR1=NAME_" "_VERSION
.. S STR2="Patch "_PATCH_" WAS NOT installed!"
.. D SORRY^BLRKIDSU(STR1,,STR2,CP)
;
D OKAY^BLRKIDSU(NAME_" "_VERSION_" Patch "_PATCH_" found.",10)
;
Q
BLRPRE25 ; IHS/OIT/MKK - IHS Lab PATCH 1025 Environment/Post Install Routine ;DEC 09, 2008 8:30 AM
+1 ;;5.2;IHS LABORATORY;**1025**;NOV 01, 1997
+2 ;
PRECHK ; EP
+1 DO BMES^XPDUTL("Beginning of Pre Check.")
+2 NEW CP,LINE2,RPMS,RPMSVER
+3 ; String -- used as an array for messages.
NEW STR
+4 ; Last Patch of Lab
NEW LASTPTCH
+5 ; Last Patch Install Status
NEW LSTPISTS
+6 ; Array of errors detected
NEW WOTERR
+7 ;
+8 ; Second line of THIS Routine
SET LINE2=$TEXT(+2)
+9 ;
+10 IF $GET(XPDNM)=""
DO SORRY("XPDNM not defined or 0.",,,1025)
QUIT
+11 ;
+12 ; Current Patch Number
SET CP=$PIECE(XPDNM,"*",3)
+13 ; RPMS Module
SET RPMS=$PIECE(XPDNM,"*",1)
+14 ; Version of RPMS module being patched
SET RPMSVER=$PIECE(XPDNM,"*",2)
+15 ;
PTCHLAST ; EP - Check for previous patch
+1 DO MES^XPDUTL(" Need LR*5.2*1024 Patch Installed.")
+2 IF $$PATCH^XPDUTL("LR*5.2*1024")'=1
DO SORRY("LR*5.2*1024 Patch Not Installed.",,,1025)
QUIT
+3 ;
+4 DO OKAY^BLRKIDSU("LR*5.2*1024 Patch Installed.",10)
+5 ; I $$LASTPTCH(1024)'="OK" Q ; Abort if Lab Patch 1024 NOT Installed
+6 ;
+7 ; No Queuing Allowed
SET XPDNOQUE="NO QUE"
+8 ;
+9 ; The following line prevents the "Disable Options..." and "Move
+10 ; Routines..." questions from being asked during the install.
+11 IF $GET(XPDENV)=1
SET (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
+12 IF $GET(XPDENV)=1
SET (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
+13 FOR X="XPO1","XPZ1","XPZ2","XPI1"
SET XPDDIQ(X)=0
+14 ;
+15 ; KIDS install Flag
SET XPDABORT=0
+16 ;
USERID ; EP - CHECK FOR USER ID
+1 IF '$GET(DUZ)
DO SORRY("DUZ UNDEFINED OR 0.",,,CP)
QUIT
+2 ;
+3 IF '$LENGTH($GET(DUZ(0)))
DO SORRY("DUZ(0) UNDEFINED OR NULL.",,,CP)
QUIT
+4 ;
+5 ; IO Defaults
DO HOME^%ZIS
+6 ; Set DT variable without Doing a Line Feed
DO DTNOLF^DICRW
+7 ;
+8 SET X=$PIECE($GET(^VA(200,DUZ,0)),U)
+9 IF $GET(X)
DO SORRY^BLRKIDSU("Installer cannot be identified!",,,CP)
QUIT
+10 ;
+11 DO MES^XPDUTL("Pre Check complete.")
+12 ; D MES^XPDUTL(" ")
+13 ;
LETSGO ; EP - USER IDENTIFIED -- LET'S GO
+1 DO BMES^XPDUTL("Hello, "_$PIECE(X,",",2)_" "_$PIECE(X,","))
+2 ;
+3 DO BMES^XPDUTL("Checking Environment for Patch "_CP_" of Version "_RPMSVER_" of "_RPMS_".")
+4 ;
+5 ; CHECK FOR FILEMAN 22.0
DO NEEDIT("DI","22.0",,.WOTERR,CP)
+6 ;
+7 ; CHECK FOR KERNEL 8.0 & PATCH 1013
DO NEEDIT("XU","8.0",1013,.WOTERR,CP)
+8 ;
+9 ; CHECK FOR LMI MAIL GROUP
DO CHECKLMI(.WOTERR,CP)
+10 ;
+11 ; CHECK FOR MAILMAN 7.1
DO NEEDIT("XM","7.1",1005,.WOTERR,CP)
+12 ;
+13 ; ENVIRONMENT OK
IF XPDABORT<1
DO BMES^XPDUTL("ENVIRONMENT OK.")
+14 ;
+15 ; ENVIRONMENT HAS ERROR(S)
IF XPDABORT>0
DO SORRYEND^BLRKIDSU(.WOTERR,CP)
+16 ;
+17 QUIT
+18 ;
BACKUP ; EP
+1 ; Current Patch
NEW CP
+2 SET CP=$TRANSLATE($PIECE($TEXT(+2),";",5),"*")
+3 ;
+4 DO BACKUPS^BLRKIDSU(CP)
+5 QUIT
+6 ;
POST ; EP -- POST INSTALL
+1 ; Current Patch
NEW CP
+2 SET CP=$TRANSLATE($PIECE($TEXT(+2),";",5),"*")
+3 ;
+4 ; Modify BLRMENU option(s)
DO MODBLRM
+5 ;
+6 ; Add 4 new Delta Checks
DO ADDDELTA
+7 ;
+8 ; Blood Bank Modification
DO BBMOD
+9 ;
+10 ; I $$EXIST^%R("BEHOLPCI.INT") D
+11 ; . D POSTINIT^BEHOLPCI ; EHR Point-of-Care Initialization
+12 ;
+13 DO BMES^XPDUTL("Laboratory Patch "_CP_" INSTALL complete.")
+14 ;
+15 ; Store # of times installation occurred as well as person & date/time
+16 DO ENDINSTL^BLRKIDSU(CP)
+17 ;
+18 ; Complete Message
+19 SET XQAMSG="Laboratory Patch "_CP_" INSTALL complete."
+20 SET XQA("G.LMI")=""
+21 DO SETUP^XQALERT
+22 ;
+23 QUIT
+24 ;
BBMOD ; Blood Bank Module Modification -- Change the length of the UNIT ID field.
+1 NEW MAXSTR,OKAY,SPEC,STR,SUBSTR
+2 NEW WOTDD
+3 ;
+4 DO TABMESG^BLRKIDSU("Changing UNIT ID & HELP field max length in BLOOD PRODUCT file.",5)
+5 SET MAXSTR=30
+6 SET OKAY=0
+7 ;
+8 SET STR=$GET(^DD(65,.01,0))
+9 SET SUBSTR=$PIECE($PIECE($PIECE($PIECE(STR,"^",5),">",2),")",1),"!",1)
+10 ;
+11 IF +SUBSTR'<MAXSTR
Begin DoDot:1
+12 DO OKAY^BLRKIDSU("UNIT ID field max length already CHANGED.",10)
End DoDot:1
QUIT
+13 ;
+14 IF +$LENGTH(SUBSTR)<1!($LENGTH($PIECE(STR,">",2))<1)
Begin DoDot:1
+15 DO SORRY("UNIT ID field in BLOOD PRODUCT file damaged: examine with FileMan.","NONFATAL")
End DoDot:1
QUIT
+16 ;
+17 SET SPEC(SUBSTR)=MAXSTR
+18 SET STR=$$REPLACE^XLFSTR(STR,.SPEC)
+19 SET WOTDD="^DD(65,.01,0)"
+20 SET @WOTDD=STR
+21 ;
+22 SET SUBSTR=$PIECE($PIECE($PIECE($PIECE($GET(^DD(65,.01,0)),"^",5),">",2),")",1),"!",1)
+23 ;
+24 IF +SUBSTR'<MAXSTR
Begin DoDot:1
+25 DO OKAY^BLRKIDSU("UNIT ID field max length in BLOOD PRODUCT file changed.",10)
+26 SET OKAY=OKAY+1
End DoDot:1
+27 ;
+28 IF +SUBSTR<MAXSTR
Begin DoDot:1
+29 DO TABMESG^BLRKIDSU("UNIT ID field max length in BLOOD PRODUCT file NOT changed.",10)
End DoDot:1
+30 ;
+31 SET STR=$GET(^DD(65,.01,3))
+32 SET SUBSTR=$PIECE($PIECE(STR,"-",2)," ",1)
+33 ;
+34 IF +SUBSTR'<MAXSTR
Begin DoDot:1
+35 DO OKAY^BLRKIDSU("UNIT ID field HELP String in BLOOD PRODUCT file already >="_MAXSTR_".",10)
End DoDot:1
QUIT
+36 ;
+37 SET SPEC(SUBSTR)=MAXSTR
+38 SET STR=$$REPLACE^XLFSTR(STR,.SPEC)
+39 SET WOTDD="^DD(65,.01,3)"
+40 SET @WOTDD=STR
+41 ;
+42 SET SUBSTR=$PIECE($PIECE($GET(^DD(65,.01,3)),"-",2)," ",1)
+43 ;
+44 IF +SUBSTR'<MAXSTR
Begin DoDot:1
+45 DO OKAY^BLRKIDSU("UNIT ID field HELP String in BLOOD PRODUCT file Changed.",10)
+46 SET OKAY=OKAY+1
End DoDot:1
+47 ;
+48 IF +SUBSTR<MAXSTR
Begin DoDot:1
+49 DO TABMESG^BLRKIDSU("UNIT ID field HELP String in BLOOD PRODUCT file NOT changed.",10)
End DoDot:1
QUIT
+50 ;
+51 DO OKAY^BLRKIDSU("Changed UNIT ID & HELP field max length in BLOOD PRODUCT file.")
+52 QUIT
+53 ;
DEBUG ; EP - Debugging Line Label for environment checker
+1 NEW CP,DEBUG,LINE2,XPDNM
+2 SET DEBUG="YES"
+3 SET XPDNM="LR*5.2*1025"
+4 DO PRECHK
+5 QUIT
+6 ;
MODBLRM ; EP
+1 ; Add Lab Version/Patch report option to the BLRMENU
+2 DO ADDTMENU^BLRKIDSU("BLRMENU","BLRVPTCH","LVP",,CP)
+3 ;
+4 ; Add "Busy Device" Report option to BLRMENU
+5 DO ADDTMENU^BLRKIDSU("BLRMENU","BLRPCCBD","BZY",,CP)
+6 ;
+7 ; Add Lab Description File Abbreviation Report to BLRMENU
+8 DO ADDTMENU^BLRKIDSU("BLRMENU","BLRLDFAR","MMR",,CP)
+9 ;
+10 QUIT
+11 ;
ADDDELTA ; EP
+1 NEW DESC,DESC1STR,DESC2STR,NAME,OVER1,OVER1STR,XCODE,XCODESTR
+2 ; Add 4 new Delta Checks to the Delta Check dictionary.
+3 ; This is to accomodate the Estimated GFR calculations required by
+4 ; the National Kidney Foundation:
+5 ; www.nkdep.nih.gov/resources/laboratory_reporting.htm
+6 ;
+7 SET DESC1STR="This delta check, when added to a test named CREATININE (NKDF), will calculate an"
+8 SET DESC2STR="estimated Glomerular Filtration Rate (GFR) using the standard MDRD Study"
+9 SET XCODESTR="S %X="""" X:$D(LRDEL(1)) LRDEL(1) W:$G(%X)'="""" "" Calculated GFR:"",%X S:LRVRM>10 LRSB($$GETDNAM^BLREXEC2(""EST GFR""))=%X K %,%X,%Y,%Z,%ZZ"
+10 SET OVER1STR="S %ZZ=$$GETDNAM^BLREXEC2(""CREATININE (NKDF)"") X:LRVRM>10 ""F %=%ZZ S %X(%)=$S(%=LRSB:X,$D(LRSB(%)):+LRSB(%),1:0)"" X:LRVRM>10 ""F %=%ZZ S %X(%)=$S($D(LRSB(%)):LRSB(%),1:0)"""
+11 ;
+12 SET NAME="GFRSE1CU"
+13 SET XCODE=XCODESTR
+14 SET OVER1=OVER1STR_" S %X=$$GFRSE1CU^BLREXEC2(X)"
+15 SET DESC(1)=DESC1STR
+16 SET DESC(2)=DESC2STR
+17 SET DESC(3)="Equation 1 with conventional Units and stuff the result into the test called"
+18 SET DESC(4)="EST GFR"
+19 DO DLTADICA(NAME,XCODE,OVER1,.DESC)
+20 ;
+21 SET NAME="GFRSE1SI"
+22 SET XCODE=XCODESTR
+23 SET OVER1=OVER1STR_" S %X=$$GFRSE1SI^BLREXEC2(X)"
+24 KILL DESC(3),DESC(4)
+25 SET DESC(3)="Equation 1 with SI Units and stuff the result into the test called EST GFR"
+26 DO DLTADICA(NAME,XCODE,OVER1,.DESC)
+27 ;
+28 SET NAME="GFRSE2CU"
+29 SET XCODE=XCODESTR
+30 SET OVER1=OVER1STR_" S %X=$$GFRSE2CU^BLREXEC2(X)"
+31 KILL DESC(3),DESC(4)
+32 SET DESC(3)="Equation 2 with conventional Units and stuff the result into the test called"
+33 SET DESC(4)="EST GFR"
+34 DO DLTADICA(NAME,XCODE,OVER1,.DESC)
+35 ;
+36 SET NAME="GFRSE2SI"
+37 SET XCODE=XCODESTR
+38 SET OVER1=OVER1STR_" S %X=$$GFRSE2SI^BLREXEC2(X)"
+39 KILL DESC(3),DESC(4)
+40 SET DESC(3)="Equation 2 with SI Units and stuff the result into the test called EST GFR"
+41 DO DLTADICA(NAME,XCODE,OVER1,.DESC)
+42 ;
+43 QUIT
+44 ;
DLTADICA(NAME,XCODE,OVER1,DESC) ; EP
+1 NEW DICT0,DICT1,FDA,ERRS,PTR
+2 NEW HEREYAGO
+3 ;
+4 DO BMES^XPDUTL("Adding "_NAME_" to Delta Check Dictionary")
+5 ;
+6 DO ^XBFMK
+7 KILL ERRS,FDA,IENS,DIE
+8 ;
+9 SET DICT1="62.1"
+10 ; Find the Name node, or create it.
SET FDA(DICT1,"?+1,",.01)=NAME
+11 ; Execute Code
SET FDA(DICT1,"?+1,",10)=XCODE
+12 ; Overflow 1
SET FDA(DICT1,"?+1,",20)=OVER1
+13 DO UPDATE^DIE("S","FDA",,"ERRS")
+14 ;
+15 IF $DATA(ERRS("DIERR"))>0
Begin DoDot:1
+16 DO SORRY^BLRKIDSU("Error in adding "_NAME_" to the Delta Check Dictionary.","NONFATAL",,CP)
End DoDot:1
QUIT
+17 ;
+18 DO OKAY^BLRKIDSU(NAME_" Delta Check added to Delta Check Dictionary.",5)
+19 ;
+20 ; Now, add the Description
+21 KILL ERRS
+22 ; Get Pointer
DO FIND^DIC(62.1,"","","",NAME,"","","","","HEREYAGO")
+23 SET PTR=$GET(HEREYAGO("DILIST",2,1))
+24 MERGE WPARRAY("WP")=DESC
+25 DO WP^DIE(62.1,PTR_",",30,"K","WPARRAY(""WP"")","ERRS")
+26 ;
+27 IF $DATA(ERRS("DIERR"))>0
Begin DoDot:1
+28 DO SORRY^BLRKIDSU("Error in adding DESCRIPTION to "_NAME_" Delta Check in the Delta Check Dictionary.","NONFATAL",,CP)
End DoDot:1
QUIT
+29 ;
+30 DO OKAY^BLRKIDSU(NAME_" Delta Check DESCRIPTION added to Delta Check Dictionary.",5)
+31 ;
+32 ; Now, add the SITE NOTES DATE
+33 KILL ERRS,FDA
+34 SET FDA(62.131,"?+1,"_PTR_",",.01)=$PIECE($$NOW^XLFDT,".",1)
+35 DO UPDATE^DIE("S","FDA",,"ERRS")
+36 ;
+37 IF $DATA(ERRS("DIERR"))>0
Begin DoDot:1
+38 DO SORRY^BLRKIDSU("Error in adding SITES NOTES DATE to "_NAME_" Delta Check in the Delta Check Dictionary.","NONFATAL",,CP)
End DoDot:1
QUIT
+39 ;
+40 ; Now, add the TEXT
+41 KILL ERRS,WPARRAY
+42 SET WPARRAY("WP",1)="Created by IHS Lab Patch 1025"
+43 DO WP^DIE(62.131,"1,"_PTR_",",1,"K","WPARRAY(""WP"")","ERRS")
+44 ;
+45 IF $DATA(ERRS("DIERR"))>0
Begin DoDot:1
+46 DO SORRY^BLRKIDSU("Error in adding TEXT to "_NAME_" Delta Check in the Delta Check Dictionary.","NONFATAL",,CP)
End DoDot:1
QUIT
+47 ;
+48 DO OKAY^BLRKIDSU(NAME_" Delta Check TEXT added to Delta Check Dictionary.",5)
+49 QUIT
+50 ;
LASTPTCH(CP) ; EP
+1 NEW COMPFLAG,COMPPTCH,LASTPTCH,LRPATCH,LPIEN,STR
+2 ;
+3 SET LASTPTCH=CP-1
+4 ;
+5 DO BMES^XPDUTL("Need at least IHS Lab Patch "_LASTPTCH)
+6 ;
+7 SET LRPATCH="LR*5.2*1099"
SET COMPFLAG="NO"
+8 FOR
SET LRPATCH=$ORDER(^XPD(9.7,"B",LRPATCH),-1)
Begin DoDot:1
+9 SET LPIEN=$ORDER(^XPD(9.7,"B",LRPATCH,""),-1)
+10 IF $PIECE($GET(^XPD(9.7,+$GET(LPIEN),0)),"^",9)=3
SET COMPFLAG="YES"
SET COMPPTCH=LRPATCH
End DoDot:1
IF LRPATCH=""!(COMPFLAG="YES")!($EXTRACT(LRPATCH,1,2)'="LR")!($PIECE(LRPATCH,"*",3)<LASTPTCH)
QUIT
+11 ;
+12 IF COMPFLAG'="YES"!($PIECE(COMPPTCH,"*",3)<LASTPTCH)
Begin DoDot:1
+13 DO SORRY("Need at least IHS Lab Patch "_LASTPTCH,,"Latest IHS Lab Patch Found is "_COMPPTCH_".",CP)
End DoDot:1
QUIT "NOT OK"
+14 ;
+15 DO OKAY^BLRKIDSU("IHS Lab Patch "_LASTPTCH_" Installed.",10)
+16 ;
+17 QUIT "OK"
+18 ;
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 DO ADDLINE(" ",.LINECNT)
+19 ; Row of asterisks
DO ADDLINE($TRANSLATE($JUSTIFY("",65)," ","*"),.LINECNT)
+20 DO ADDLINE(" ",.LINECNT)
+21 DO ADDLINE($$CJ^XLFSTR("Site: "_$$LOC^XBFUNC,65),.LINECNT)
+22 DO ADDLINE(" ",.LINECNT)
+23 DO ADDLINE($$CJ^XLFSTR(MESSAGE,65),.LINECNT)
+24 DO ADDLINE(" ",.LINECNT)
+25 DO ADDLINE($$CJ^XLFSTR(">>> "_MSG_" <<<",65),.LINECNT)
+26 IF $DATA(MSG2)
DO ADDLINE($$CJ^XLFSTR(">>> "_MSG2_" <<<",65),.LINECNT)
+27 DO ADDLINE(" ",.LINECNT)
+28 ;
+29 IF $GET(MODE)["NONFATAL"
DO ADDLINE($$CJ^XLFSTR(MESSAGE,65),.LINECNT)
+30 ;
+31 IF $GET(MODE)'["NONFATAL"
Begin DoDot:1
+32 DO ADDLINE($$CJ^XLFSTR("Please print/capture this screen and",65),.LINECNT)
+33 DO ADDLINE($$CJ^XLFSTR("notify the Support Center at",65),.LINECNT)
+34 DO ADDLINE(" ",.LINECNT)
+35 DO ADDLINE($$CJ^XLFSTR("1-999-999-9999.",65),.LINECNT)
+36 DO ADDLINE(" ",.LINECNT)
End DoDot:1
+37 ;
+38 ; Row of asterisks
DO ADDLINE($TRANSLATE($JUSTIFY("",65)," ","*"),.LINECNT)
+39 DO ADDLINE(" ",.LINECNT)
+40 ;
+41 ; Display the message
DO BMES^XPDUTL(.STR)
+42 ;
+43 ; If Debugging, just exit -- Don't send e-mail nor alert
+44 IF $GET(DEBUG)="YES"
QUIT
+45 ;
+46 ; If no DUZ, it's impossible to send e-mail & alert, so just quit
+47 IF '$GET(DUZ)!('$LENGTH($GET(DUZ(0))))
QUIT
+48 ;
+49 IF $GET(MODE)'="NONFATAL"
Begin DoDot:1
+50 DO SNDALERT("Laboratory Patch "_CP_" >> FATAL >> "_MSG)
+51 DO SENDMAIL("IHS Lab Patch "_CP_" Install FATAL Error")
End DoDot:1
QUIT
+52 ;
+53 IF $GET(MODE)="NONFATAL"
Begin DoDot:1
+54 DO SNDALERT("Laboratory Patch "_CP_" - "_MODE_" - "_MSG)
+55 DO SENDMAIL("IHS Lab Patch "_CP_" Install NONFATAL Error")
End DoDot:1
+56 QUIT
+57 ;
SNDALERT(ALERTMSG) ; EP -Send alert to LMI group
+1 SET XQAMSG=ALERTMSG
+2 SET XQA("G.LMI")=""
+3 DO SETUP^XQALERT
+4 KILL XQA,XQAMSG
+5 QUIT
+6 ;
SENDMAIL(MAILMSG) ; EP - Send MailMan E-mail to LMI group
+1 KILL XMY
+2 ; Group
SET XMY("G.LMI")=""
+3 SET %DT="T"
+4 SET X="NOW"
+5 DO ^%DT
+6 DO DD^LRX
+7 SET LRBLNOW=Y
+8 ;
+9 SET XMSUB=MAILMSG
+10 SET XMTEXT="STR("
+11 SET XMDUZ=$PIECE($GET(^VA(200,DUZ,0)),U)
+12 ; Send the MailMan e-mail
DO ^XMD
+13 ; Cleanup
KILL X,XMDUZ,XMSUB,XMTEXT,Y
+14 QUIT
+15 ;
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 ;
CHECKLMI(WOTERR,CP) ; EP -CHECK FOR LMI MAIL GROUP
+1 NEW OKAY
+2 DO BMES^XPDUTL("Must have 'LMI' mail group present.")
+3 SET DIC="^XMB(3.8,"
+4 SET X="LMI"
+5 DO ^DIC
+6 SET OKAY=+Y
+7 IF OKAY>0
DO OKAY^BLRKIDSU("'LMI' mail group found.")
+8 IF OKAY<1
Begin DoDot:1
+9 DO SORRY^BLRKIDSU("'LMI' mail group NOT found!",,,CP)
+10 SET WOTERR("XMB(3.8","Mail Group","3.8")="LMI Mail Group"
End DoDot:1
+11 QUIT
+12 ;
NEEDIT(MODULE,VERSION,PATCH,WOTERR,CP) ; EP
+1 ; Generic "Find RPMS Module's Version and (perhaps) Patch number"
+2 ; NOTE: The MODULE variable MUST be the PREFIX name
+3 ; from the PACKAGE file (9.4).
+4 ; NAME of RPMS Module
NEW NAME
+5 ; PoinTeR to PACKAGE file
NEW PTR
+6 ; Array to store returned values from FIND^DIC
NEW HEREYAGO
+7 ; Temporary Strings
NEW STR1,STR2
+8 ; System Version & System Patch variables
NEW SYSVER,SYSPATCH
+9 ;
+10 ; Use FileMan API to get information
+11 DO FIND^DIC(9.4,"","","",MODULE,"","C","","","HEREYAGO")
+12 SET PTR=$GET(HEREYAGO("DILIST",2,1))
+13 SET NAME=$GET(HEREYAGO("DILIST",1,1))
+14 ;
+15 DO BMES^XPDUTL("Need at least "_NAME_" "_VERSION)
+16 ;
+17 ; Get the System's Version
SET SYSVER=$$VERSION^XPDUTL(MODULE)
+18 ; If System Version < Needed Version, write message and quit
+19 IF SYSVER<VERSION
Begin DoDot:1
+20 SET WOTERR(MODULE,NAME,VERSION)=""
+21 SET STR1="Need "_NAME_" "_VERSION_" & "_NAME_" "_SYSVER_" found!"
+22 IF $LENGTH(STR1)<58
DO SORRY^BLRKIDSU(STR1,,,CP)
+23 IF $LENGTH(STR1)>57
Begin DoDot:2
+24 SET STR1="Need "_NAME_" "_VERSION_" & "
+25 SET STR2=NAME_" "_SYSVER_" found!"
+26 DO SORRY^BLRKIDSU(STR1,,STR2,CP)
End DoDot:2
End DoDot:1
QUIT
+27 ;
+28 DO OKAY^BLRKIDSU(NAME_" "_SYSVER_" found.")
+29 ; If Version needed is lower, skip Patch check
IF VERSION<SYSVER
QUIT
+30 ;
+31 ; If no Patch check, just exit
IF $GET(PATCH)=""
QUIT
+32 ;
+33 DO BMES^XPDUTL(" Need "_NAME_" "_VERSION_" Patch "_PATCH_".")
+34 SET SYSPATCH=$$PATCH^XPDUTL(MODULE_"*"_VERSION_"*"_PATCH)
+35 IF SYSPATCH'=1
Begin DoDot:1
+36 SET WOTERR(MODULE,NAME,VERSION)=$GET(PATCH)
+37 SET STR1=NAME_" "_VERSION_" Patch "_PATCH_" WAS NOT installed!"
+38 IF $LENGTH(STR1)<58
DO SORRY^BLRKIDSU(STR1,,,CP)
+39 IF $LENGTH(STR1)>57
Begin DoDot:2
+40 SET STR1=NAME_" "_VERSION
+41 SET STR2="Patch "_PATCH_" WAS NOT installed!"
+42 DO SORRY^BLRKIDSU(STR1,,STR2,CP)
End DoDot:2
End DoDot:1
QUIT
+43 ;
+44 DO OKAY^BLRKIDSU(NAME_" "_VERSION_" Patch "_PATCH_" found.",10)
+45 ;
+46 QUIT
