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

BLRPRE25.m

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