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

BLRPRE33.m

Go to the documentation of this file. 
  1. BLRPRE33 ; IHS/MSC/MKK - IHS Lab Patch Pre/Post/Environment Routine ; 22-Oct-2013 09:22 ; MKK
  1.  ;;5.2;IHS LABORATORY;**1033**;NOV 01, 1997
  1.  ;
  1. ENVICHEK ; Environment Checker
  1.  NEW CP,PREREQ,RPMS,RPMSVER,QFLG,ROWSTARS,STR,TODAY,WOTCNT
  1.  NEW ERRARRAY                 ; Errors array
  1.  NEW BLRVERN,BEGTIME,ENDTIME,PATCHNUM,WHATCNT
  1.  ;
  1.  S PATCHNUM=$TR($P($T(+2),";",5),"*")
  1.  S BLRVERN=$TR($P($T(+1),";")," ")
  1.  S TODAY=$$DT^XLFDT
  1.  S WOTCNT=$$WOTCNT()
  1.  ;
  1.  S ^XTMP(BLRVERN,0)=$$HTFM^XLFDT(+$H+90)_"^IHS Lab Patch "_PATCHNUM_"^"_$$DT^XLFDT
  1.  M ^XTMP(BLRVERN,TODAY,WOTCNT,"DUZ")=DUZ
  1.  S ^XTMP(BLRVERN,TODAY,WOTCNT,"BEGIN")=$$NOW^XLFDT
  1.  ;
  1.  S XUMF=1
  1.  ;
  1.  I $G(XPDNM)="" D  Q
  1.  . S CP=$TR($P($T(+2),";",5),"*")
  1.  . D SORRY^BLRPRE31(CP,"XPDNM not defined or 0.")
  1.  ;
  1.  S CP=$P(XPDNM,"*",3)        ; Patch Number
  1.  S RPMS=$P(XPDNM,"*",1)      ; RPMS Module
  1.  S RPMSVER=$P(XPDNM,"*",2)   ; RPMS Version
  1.  ;
  1.  S ROWSTARS=$TR($J("",65)," ","*")     ; Row of asterisks
  1.  ;
  1. USERID ; EP - CHECK FOR USER ID
  1.  I +$G(DUZ)<1 D SORRY^BLRPRE31(CP,"DUZ UNDEFINED OR 0.")  Q
  1.  ;
  1.  I $L($$GET1^DIQ(200,DUZ,"NAME"))<1 D SORRY^BLRPRE31(CP,"Installer cannot be identified!")  Q
  1.  ;
  1. GETREADY ; EP
  1.  S XPDNOQUE=1           ; No Queuing Allowed
  1.  ;
  1.  ; The following line prevents the "Disable Options..." and "Move
  1.  ; Routines..." questions from being asked during the install.
  1.  F X="XPO1","XPZ1","XPZ2","XPI1" S XPDDIQ(X)=0,XPDDIQ(X,"B")="NO"
  1.  ;
  1.  S XPDABORT=0           ; KIDS install Flag
  1.  ;
  1.  D HOME^%ZIS            ; Reset/Initialize IO variables
  1.  D DTNOLF^DICRW         ; Set DT variable without a Line Feed
  1.  ;
  1.  D ENVHEADR^BLRPRE31(CP,RPMSVER,RPMS)
  1.  ;
  1.  D MES^XPDUTL
  1.  ;
  1.  D CHKLABMG                                        ; Check Lab Mail Groups
  1.  ;
  1.  D NEEDIT^BLRPRE31(CP,"BSTS","1.0",,.ERRARRY)      ; IHS Standard Terminology Pre-Requisite
  1.  D NEEDIT^BLRPRE31(CP,"BJPC","2.0",10,.ERRARRAY)   ; PCC Pre-Requisite
  1.  D NEEDIT^BLRPRE31(CP,"LR","5.2",1032,.ERRARRAY)   ; Lab Pre-Requisite
  1.  D NEEDIT^BLRPRE31(CP,"XU","8.0",1017,.ERRARRAY)   ; Kernel Pre-Requisite
  1.  ;
  1.  D MES^XPDUTL
  1.  ;
  1.  I XPDABORT>0 D SORRYEND(.ERRARRAY,CP)   Q   ; ENVIRONMENT HAS ERROR(S)
  1.  ;
  1.  D BOKAY^BLRPRE31("ENVIRONMENT")
  1.  ;
  1.  S XUMF=1
  1.  ;
  1.  Q
  1.  ;
  1. WOTCNT() ; EP - Counter for ^XTMP
  1.  NEW BLRVERN,CNT,TODAY
  1.  ;
  1.  S BLRVERN=$TR($P($T(+1),";")," ")
  1.  S TODAY=$$DT^XLFDT
  1.  ;
  1.  S CNT=1+$G(^XTMP(BLRVERN,0,TODAY))
  1.  S ^XTMP(BLRVERN,0,TODAY)=CNT
  1.  Q $TR($J(CNT,3)," ","0")
  1.  ;
  1. CHKLABMG ; EP - Check Lab Mail Groups
  1.  NEW FNAME,LNAME,USERNAME
  1.  ;
  1.  S USERNAME=$$UP^XLFSTR($$GET1^DIQ(200,DUZ,"NAME")),LNAME=$P(USERNAME,","),FNAME=$P(USERNAME,",",2)
  1.  ;
  1.  Q:LNAME["WALKER"&((FNAME["MIKE")!(FNAME["MICHAEL"))
  1.  ;
  1.  D CHKMAILG(CP,"LMI",.ERRARRAY)              ; Check for LMI Mail Group
  1.  D CHKMAILG(CP,"LAB MESSAGING",.ERRARRAY)    ; Check for LAB MESSAGING Mail Group
  1.  D CHKMAILG(CP,"BLRLINK",.ERRARRAY)          ; Check for BLRLINK Mail Group
  1.  Q
  1.  ;
  1.  ; Determine if required Mail Group Exists AND the Mail Group has at least
  1.  ; one member who has logged onto RPMS in the past year
  1. CHKMAILG(CP,MAILGRP,ERRARRAY)   ; EP
  1.  NEW MEM,MEMBER,MGRPIEN,MEMOKAY,VALIDMBR
  1.  ;
  1.  D CHKGROUP^XMBGRP(MAILGRP,.MGRPIEN)   ; VA DBIA 1146
  1.  ;
  1.  I +$G(MGRPIEN)<1 D  Q
  1.  . D SORRY^BLRPRE31(CP,MAILGRP_" Mail Group Does NOT Exist!")
  1.  . S ERRARRAY("XMB","Mail Group","3.8")=MAILGRP_" Mail Group Does NOT Exist!"
  1.  ;
  1.  D OKAY^BLRKIDSU(MAILGRP_" Mail Group Exists.")
  1.  ;
  1.  I $$VALIDMBR(MGRPIEN) D OKAY^BLRKIDSU(MAILGRP_" Mail Group Has a Valid Member.",10)  Q
  1.  ;
  1.  D SORRY^BLRPRE31(CP,"The "_MAILGRP_" Mail Group Exists but no Member of","FATAL",MAILGRP_" has logged onto RPMS within the past year!")
  1.  S ERRARRAY("XMB","Mail Group","3.8")=MAILGRP_" Mail Group Exists, but Does NOT have a Valid Member"
  1.  Q
  1.  ;
  1. VALIDMBR(MGRPIEN) ; EP - Determine if Mail Group has at least one valid member
  1.  S MEM=.9999999,VALIDMBR=0
  1.  ;
  1.  F  S MEM=$O(^XMB(3.8,MGRPIEN,1,MEM))  Q:MEM<1!(VALIDMBR)  D
  1.  . S MEMBER=+$$GET1^DIQ(3.81,MEM_","_MGRPIEN_",","MEMBER","I")
  1.  . Q:+$$GET1^DIQ(200,MEMBER,"DISUSER")                ; If DISUSERed, not a Valid Member
  1.  . Q:+$$GET1^DIQ(200,MEMBER,"TERMINATION DATE","I")   ; If Terminated, not a Valid Member
  1.  . S LASTLOGI=$$GET1^DIQ(200,MEMBER,202,"I")          ; Last Login Date
  1.  . Q:$$FMDIFF^XLFDT($$NOW^XLFDT,LASTLOGI)>364         ; If Last Login > 364 days ago, not a Valid Member
  1.  . ;
  1.  . S VALIDMBR=MEMBER      ; None of the above true, so valid member
  1.  ;
  1.  Q VALIDMBR
  1.  ;
  1. DEBUG ; EP - Debugging Line Label for environment checker
  1.  NEW CP,DEBUG,RPMS,RPMSVER,QFLG,STR
  1.  W !!
  1.  W "Debug Begins:",$$TRIM^XLFSTR($P($T(+1),";"),"LR"," "),!!
  1.  ;
  1.  ; Note -- DEBUG is a negative flag:
  1.  ;         YES="Don't Send Alerts"; NO="Send Alerts"
  1.  ;
  1.  S DEBUG="YES"     ; At this time, DO NOT send alerts
  1.  ;
  1.  ; D ^XBFMK
  1.  ; S DIR(0)="YO"
  1.  ; S DIR("B")="NO"
  1.  ; S DIR("A")="Send Alerts/E-Mails"
  1.  ; D ^DIR
  1.  ; S:+$G(Y)=1 DEBUG="NO"
  1.  ;
  1.  W !
  1.  S XPDNM="LR*5.2*"_$P($T(+2),"*",3)
  1.  S XPDENV=0
  1.  ;
  1.  D ENVICHEK
  1.  D PRESSKEY^BLRGMENU(4)
  1.  ;
  1.  Q:XPDABORT
  1.  ;
  1.  D PRE
  1.  W !!!
  1.  ;
  1.  D ^XBFMK
  1.  S DIR(0)="YO"
  1.  S DIR("B")="NO"
  1.  S DIR("A")="Test Post Install Code"
  1.  D ^DIR
  1.  ;
  1.  D EXIT^XPDID
  1.  ;
  1.  I +$G(Y)=1 D
  1.  . F MENUOPT="LRLIAISON","LR IHS LIAISON" S X=$$ADD^XPDMENU(MENUOPT,"LRLOINC")
  1.  . D POST
  1.  W !!!
  1.  ;
  1.  ; Delete DEBUG Backup confirmation
  1.  ; K ^BLRINSTL("LAB PATCH",$P(XPDNM,"*",3))
  1.  ;
  1.  W !!,"Debug Ends:",$$TRIM^XLFSTR($P($T(+1),";"),"LR"," ")
  1.  Q
  1.  ;
  1. PRE ; EP -- Ask for confirmation of Backup
  1.  NEW BLRVERN,CNT,CP,CRTLINE,DIRASTR,FDAROOT,IEN,IENS,MSGROOT
  1.  NEW BCKUPCNT                   ; Current Patch,Backup count
  1.  ;
  1.  S CP=$TR($P($T(+2),";",5),"*")
  1.  S BLRVERN=$TR($P($T(+1),";")," ")
  1.  ;
  1.  S XUMF=1
  1.  ;
  1.  D INIT^XPDID
  1.  D TITLE^XPDID("LR*5.2*1033")
  1.  W !!
  1.  D BMES^XPDUTL("Pre-Install of "_BLRVERN_" Begins.")
  1.  ;
  1.  D PASSMESG^BLRPRE31("ATTENTION")
  1.  W !
  1.  ;
  1.  D ^XBFMK
  1.  S DIR(0)="Y"
  1.  S DIR("B")="NO"
  1.  S:$G(IOST)["C-VT" DIRASTR=$J("",10)_"Has a "_$C(27)_"[1;7;5m"_">> SUCCESSFUL <<"_$C(27)_"[0m"_" backup been performed?"
  1.  S:$G(IOST)'["C-VT" DIRASTR=$J("",10)_"Has a >> SUCCESSFUL << backup been performed?"
  1.  S DIR("A")=DIRASTR
  1.  D ^DIR
  1.  W !
  1.  ;
  1.  I +$G(Y)'=1 D  Q    ; If BACKUP not performed, then ABORT installation.
  1.  . S XPDABORT=1
  1.  . D PASSMESG^BLRPRE31("ATTENTION")
  1.  . D BMES^XPDUTL($J("",15)_"SUCCESSFUL system backup has >>> NOT <<< been confirmed.")
  1.  . D BMES^XPDUTL($J("",25)_"Installer: "_$$GET1^DIQ(200,DUZ,"NAME")_" ["_DUZ_"].")
  1.  . D BMES^XPDUTL($J("",15)_"Install Aborting.")
  1.  ;
  1.  ; Store backup confirmation person & date/time
  1.  S BCKUPCNT=1+$O(^BLRINSTL("LAB PATCH",CP,"BACKUP CONFIRMED BY",""),-1)
  1.  S ^BLRINSTL("LAB PATCH",CP,"BACKUP CONFIRMED BY",BCKUPCNT)=DUZ_"^"_$P($G(^VA(200,DUZ,0)),U)
  1.  S ^BLRINSTL("LAB PATCH",CP,"BACKUP CONFIRMED BY",BCKUPCNT,"DATE/TIME")=$$HTE^XLFDT($H,"5MZ")
  1.  ;
  1.  D BOKAY^BLRPRE31("SUCCESSFUL system backup CONFIRMED by: "_$$GET1^DIQ(200,DUZ,"NAME")_".",5)
  1.  H 1     ; Pause 1 second to let the user see the message.
  1.  ;
  1.  D INIT^XPDID
  1.  D TITLE^XPDID("LR*5.2*1033")
  1.  W !!
  1.  D BMES^XPDUTL("Pre-Install of "_BLRVERN_" Continues.")
  1.  ;
  1.  D FILESDEL
  1.  ;
  1.  D COPYPROT
  1.  ;
  1.  D BMES^XPDUTL($J("",5)_"Pre-Install Processing Ends at "_$$UP^XLFSTR($$HTE^XLFDT($H,"5MPZ"))_".")
  1.  H 1     ; Pause 1 second to let the user see the message.
  1.  ;
  1.  Q
  1.  ;
  1. FILESDEL ; EP - The following deletions are necessatry in order to prevent errors during installation
  1.  NEW CNT,FILENUM,IEN
  1.  ;
  1.  S XUMF=1          ; Supposedly allows updating "locked down" dictionaries.  Doesn't appear to work.
  1.  ;
  1.  D DISABLE^%NOJRN            ; Disable Journaling prior to deletions
  1.  ;
  1.  ; Delete Files' entries
  1.  ;      95.3   = LOINC
  1.  ;      95.31  = LAB LOINC COMPONENT
  1.  ;      64.061 = LAB ELECTRONIC CODES
  1.  ;      64.2   = WKLD SUFFIX CODES
  1.  F FILENUM=95.3,95.31,64.061,64.2  D
  1.  . S IEN=.9999999,CNT=0
  1.  . W !,?4,FILENUM
  1.  . F  S IEN=$O(^LAB(FILENUM,IEN))  Q:IEN<1  D
  1.  .. I CNT#100=0  W "."  W:$X>75 !,?4
  1.  .. S CNT=CNT+1
  1.  .. D ^XBFMK
  1.  .. S DIK="^LAB("_FILENUM_",",DA=IEN
  1.  .. Q:$G(DEBUG)="YES"        ; If DEBUG set, don't delete anything
  1.  .. D ^DIK
  1.  ;
  1.  W !
  1.  ;
  1.  D ENABLE^%NOJRN             ; Restore Journaling
  1.  ;
  1.  Q
  1.  ;
  1. COPYPROT ; EP - Have to copy the entries for LR7O ALL EVSEND RESULTS Protocol
  1.  NEW ERRS,FOUND,IEN,PATCHNUM
  1.  D FIND^DIC(101,,,,"LR7O ALL EVSEND RESULTS",,,,,"FOUND","ERRS")
  1.  Q:$D(ERRS)
  1.  ;
  1.  S IEN=+$G(FOUND("DILIST",2,1))
  1.  Q:IEN<1
  1.  ;
  1.  S PATCHNUM=$TR($P($T(+2),";",5),"*")
  1.  ;
  1.  S ^XTMP("LR7O ALL EVSEND RESULTS",0)=$$HTFM^XLFDT(+$H+90)_"^"_$$DT^XLFDT_"^LR*5.2*"_PATCHNUM_" PRE-INSTALL SAVE"
  1.  M ^XTMP("LR7O ALL EVSEND RESULTS",IEN)=^ORD(101,IEN)
  1.  Q
  1.  ;
  1. POST ; EP -- POST INSTALL
  1.  NEW BLRVERN,CHKIT,CP,ERRS,FDA,IEN,MENUOPT,NEWOPT,NEWOPTM,PATCHNUM,STR,TAB,TODAY,WOTCNT
  1.  ;
  1.  S CP=$P($T(+2),"*",3)  ; Current Patch
  1.  ;
  1.  S PATCHNUM=$TR($P($T(+2),";",5),"*")
  1.  S BLRVERN=$TR($P($T(+1),";")," ")
  1.  S TODAY=$$DT^XLFDT
  1.  S WOTCNT=$$WOTCNT()
  1.  ;
  1.  D BMES^XPDUTL("LR*5.2*"_CP_" Post Install")
  1.  D MES^XPDUTL(" ")
  1.  ;
  1.  ; Get rid of LOINC option on LRLIAISON & LR IHS LIAISON menus since it's deactivated
  1.  F MENUOPT="LRLIAISON","LR IHS LIAISON"  D
  1.  . Q:$$DELETE^XPDMENU(MENUOPT,"LRLOINC")<1
  1.  . ;
  1.  . ; Deletion successful. Give feedback
  1.  . D OKAY^BLRKIDSU("Obsolete VA LOINC option removed from "_MENUOPT_" menu.",0)
  1.  . D MES^XPDUTL(" ")
  1.  ;
  1.  S TAB=$J("",5)
  1.  ;
  1.  D ADDOPTS    ; Add new options to BLRMENU
  1.  D ADDHLOPT   ; Add new option to BLRREFLABMENU
  1.  D TURNOFF    ; LA7HDR entry in file 62.48 must be set to INACTIVE
  1.  D NEWKEYON   ; Add new BLRZZ Security Key to BLRREFLABMENU option
  1.  D NEWKEYLA   ; Add LRSUPER Security Key to LA MI VERIFY AUTO option
  1.  D NOSNAPS    ; Make sure TAKE SNAPSHOTS field in BLR MASTER CONTROL is OFF
  1.  D GLUCACHE   ; Make sure GLUCOMETER is in the Terminolgoy Server Cache
  1.  ;
  1.  ; Run MAILMAN version of BLRLTRRR routine if DEBUG not YES
  1.  D:$G(DEBUG)'="YES" EMAIL^BLRLTRRR
  1.  ;
  1.  ; Setup Instance of new parameter.  Initially its value is NO.
  1.  D EN^XPAR("PKG","BLR CC DATA",,"NO",.ERRS)
  1.  D:+$G(ERRS)=0 MES^XPDUTL("Parameter 'BLR CC DATA' Instance set to NO.")
  1.  ;
  1.  D ENDINSTL^BLRPRE31(CP)
  1.  ;
  1.  D BMES^XPDUTL(" ")
  1.  ;
  1.  D BMES^XPDUTL("Laboratory Patch "_CP_" INSTALL complete.")
  1.  ;
  1.  I $G(DEBUG)="YES" S ^XTMP(BLRVERN,TODAY,WOTCNT,"END")=$$NOW^XLFDT  Q
  1.  ;
  1.  S STR(1)=" "
  1.  S STR(2)=$J("",10)_"POST INSTALL of "_BLRVERN_" Routine."
  1.  S STR(3)=" "
  1.  S STR(4)=$J("",15)_"Laboratory Patch "_CP_" INSTALL completed."
  1.  S STR(5)=" "
  1.  ;
  1.  ; Send E-Mail to LMI Mail Group & Installer
  1.  D MAILALMI^BLRUTIL3("Laboratory Patch "_CP_" INSTALL complete.",.STR,$TR($P($T(+1),";")," "))
  1.  ;
  1.  S ^XTMP(BLRVERN,TODAY,WOTCNT,"END")=$$NOW^XLFDT
  1.  Q
  1.  ;
  1. ADDOPTS ; EP - Add new options to the BLRMENU
  1.  F MENUOPT="BLR ADD COMPLETED DATE^DADD","BLR LAB TESTS REF RANGES^LTRR","BLR 62.49 HL7 SEGMENTS^6249","BLR LRAS MICRO REPORT^LRAS","BLR MU2 MICRO REPORT^IHSM","BLRSCRNTASKS^LABT"  D
  1.  . S NEWOPT=$P(MENUOPT,"^")
  1.  . S NEWOPTM=$P(MENUOPT,"^",2)
  1.  . D BMES^XPDUTL("Adding '"_NEWOPT_"' option to BLRMENU.")
  1.  . S X=$$ADD^XPDMENU("BLRMENU",NEWOPT,NEWOPTM)
  1.  . D:X=1 MES^XPDUTL(TAB_"'"_NEWOPT_"' added to BLRMENU. OK.")
  1.  . I X'=1 D
  1.  .. D MES^XPDUTL(TAB_"Error in adding '"_NEWOPT_"' option to BLRMENU.")
  1.  .. D MES^XPDUTL(TAB_TAB_"Error Message: "_$$UP^XLFSTR($P(X,"^",2)))
  1.  ;
  1.  D MES^XPDUTL(" ")
  1.  Q
  1.  ;
  1. ADDHLOPT ; EP - Add new option to the BLRREFLABMENU
  1.  F MENUOPT="BLR REFLAB HL7 TABLE LOOKUP^TBLL","BLR REFLAB MONITOR PARAMS^MON"  D
  1.  . S NEWOPT=$P(MENUOPT,"^")
  1.  . S NEWOPTM=$P(MENUOPT,"^",2)
  1.  . D BMES^XPDUTL("Adding '"_NEWOPT_"' option to BLRREFLABMENU.")
  1.  . S X=$$ADD^XPDMENU("BLRREFLABMENU",NEWOPT,NEWOPTM)
  1.  . D:X=1 MES^XPDUTL(TAB_"'"_NEWOPT_"' added to BLRREFLABMENU. OK.")
  1.  . I X'=1 D
  1.  .. D MES^XPDUTL(TAB_"Error in adding '"_NEWOPT_"' option to BLRMENU.")
  1.  .. D MES^XPDUTL(TAB_TAB_"Error Message: "_$$UP^XLFSTR($P(X,"^",2)))
  1.  ;
  1.  D MES^XPDUTL(" ")
  1.  Q
  1.  ;
  1. TURNOFF ; EP - LA7HDR entry in file 62.48 must be set to INACTIVE
  1.  NEW ERRS,FDA,IEN
  1.  ;
  1.  S IEN=+$$FIND1^DIC(62.48,,,"LA7HDR")
  1.  Q:IEN<1      ; Skip if LA7HDR parameter does not exist
  1.  ;
  1.  D BMES^XPDUTL("Inactivating 'LA7HDR' parameter in 62.48.")
  1.  ;
  1.  D ^XBFMK
  1.  K FDA
  1.  S FDA(62.48,IEN_",",2)=0         ; Setting STATUS field to INACTIVE
  1.  D FILE^DIE("KS","FDA","ERRS")
  1.  ;
  1.  I $D(ERRS)<1 D  Q
  1.  . D OKAY^BLRKIDSU("'LA7HDR' parameter in 62.48 Inactivated.",5)
  1.  . D MES^XPDUTL(" ")
  1.  ;
  1.  D NOTOKAY("'LA7HDR' parameter in 62.48 *NOT* Inactivated.",5)
  1.  D SNDALERT^BLRUTIL3("'LA7HDR' parameter in 62.48 *NOT* Inactivated.")
  1.  ;
  1.  Q
  1.  ;
  1. NEWKEYON ; EP - Make sure new BLRRLZ Security Key is added to BLRREFLABMENU option
  1.  NEW ERRS,FDA,IEN
  1.  S IEN=+$$LKOPT^XPDMENU("BLRREFLABMENU")
  1.  Q:IEN<1    ; Skip if cannot find Ref Lab Menu option
  1.  ;
  1.  D ^XBFMK
  1.  S FDA(19,IEN_",",3)="BLRRLZ"
  1.  D FILE^DIE(,"FDA","ERRS")
  1.  Q
  1.  ;
  1. NEWKEYLA ; EP - Add LRSUPER Security Key to LA MI VERIFY AUTO option
  1.  NEW ERRS,FDA,IEN
  1.  S IEN=+$$LKOPT^XPDMENU("LA MI VERIFY AUTO")
  1.  Q:IEN<1    ; Skip if cannot find Ref Lab Menu option
  1.  ;
  1.  D ^XBFMK
  1.  S FDA(19,IEN_",",3)="LRSUPER"
  1.  D FILE^DIE(,"FDA","ERRS")
  1.  Q
  1.  ;
  1. NOSNAPS ; EP - Make certain TAKE SNAPSHOTS field in BLR MASTER CONTROL file is OFF
  1.  NEW CNT,DESC,FDA,IEN
  1.  ;
  1.  S (CNT,IEN)=0
  1.  F  S IEN=$O(^BLRSITE(IEN))  Q:IEN<1  D
  1.  . Q:+$$GET1^DIQ(9009029,IEN,"TAKE SNAPSHOTS","I")<1
  1.  . ;
  1.  . S CNT=CNT+1,CNT(IEN)=""
  1.  . K FDA
  1.  . S FDA(9009029,IEN_",",1)=0
  1.  . D FILE^DIE(,"FDA","ERRS")
  1.  ;
  1.  Q:CNT<1   ; If no update, just return
  1.  ;
  1.  D BMES^XPDUTL("File 9009029 'TAKE SNAPSHOTS' Field Set to OFF for the following:")
  1.  S IEN=0
  1.  F  S IEN=$O(CNT(IEN))  Q:IEN<1  D TABMENU^BLRKIDSU($$GET1^DIQ(9009029,IEN,.01),5)
  1.  D BMES^XPDUTL
  1.  Q
  1.  ;
  1. NOTOKAY(MSG,TAB)       ; EP -- Write out Blank line, then "NOT OKAY" message
  1.  D BMES^XPDUTL($J("",+$G(TAB))_MSG_" NOT OK.")
  1.  Q
  1.  ;
  1. GLUCACHE ; EP - Make sure IHS Terminology Server has GLUCOMETER in its cache
  1.  NEW IN,OUT,VARS
  1.  S OUT="VARS",IN="GLUCOMETER^F^^ALL"
  1.  S X=$$SEARCH^BSTSAPI(OUT,IN)
  1.  Q
  1.  ;
  1. SORRYEND(WOTERR,CP) ; EP -- ALL the errors detected during the environment check.
  1.  NEW STR,MODULE,NAME,VERSION,PATCH,LINECNT,TMP
  1.  ;
  1.  D SORRYHED^BLRPRE31
  1.  ;
  1.  S (MODULE,NAME,VERSION)=""
  1.  F  S MODULE=$O(WOTERR(MODULE))  Q:MODULE=""  D
  1.  . F  S NAME=$O(WOTERR(MODULE,NAME))  Q:NAME=""  D
  1.  .. F  S VERSION=$O(WOTERR(MODULE,NAME,VERSION))  Q:VERSION=""  D ADDMESG
  1.  ;
  1.  D SORRYFIN^BLRPRE31
  1.  ;
  1.  D BMES^XPDUTL(.STR)
  1.  ;
  1.  Q
  1.  ;
  1. ADDMESG ; EP
  1.  NEW WOT,WOTWRONG
  1.  ;
  1.  D ADDLINE^BLRPRE31(.LINECNT,NAME_" ("_MODULE_")","YES")
  1.  ;
  1.  S WOT=$G(WOTERR(MODULE,NAME,VERSION))
  1.  S TMP="Version:"_VERSION
  1.  S WOTWRONG=$P(WOT,"^",2)
  1.  ;
  1.  I WOTWRONG="VERSION" D
  1.  . S TMP="Needed Version:"_VERSION
  1.  . S TMP=TMP_"  Found Version:"_$P(WOT,"^")
  1.  ;
  1.  I WOTWRONG="PATCH" D
  1.  . S TMP=TMP_"  Needed Patch:"_$P(WOT,"^")
  1.  ;
  1.  I WOTWRONG'="PATCH"&(WOTWRONG'="VERSION") D
  1.  . D ADDLINE^BLRPRE31(.LINECNT,TMP,"YES")
  1.  . S TMP=WOT
  1.  ;
  1.  D ADDLINE^BLRPRE31(.LINECNT,TMP,"YES")
  1.  D ADDLINE^BLRPRE31(.LINECNT)
  1.  Q