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

BLRPRE34.m

Go to the documentation of this file. 
  1. BLRPRE34 ; IHS/OIT/MKK - IHS Lab PATCH 1034 Environment/Pre/Post Install Routine ; 17-Oct-2014 09:22 ; MKK
  1.  ;;5.2;IHS LABORATORY;**1034**;NOV 01, 1997;Build 88
  1.  ;
  1. ENVCHK ; EP
  1.  D BMES^XPDUTL("Beginning of Pre Check.")
  1.  D MES^XPDUTL("")
  1.  NEW CP,LINE2,RPMS,RPMSVER,STR
  1.  NEW LASTPTCH                 ; Last Patch of Lab
  1.  NEW LSTPISTS                 ; Last Patch Install Status
  1.  NEW WOTERR                   ; Array of errors detected
  1.  ;
  1.  I $G(XPDNM)="" D SORRY("XPDNM not defined or 0.",,,1034)  Q
  1.  ;
  1.  S LINE2=$T(+2)               ; Second line of THIS Routine
  1.  ;
  1.  D OKAY^BLRKIDSU("XPDNM Defined.",5)
  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.  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  F X="XPO1","XPZ1","XPZ2","XPI1" S XPDDIQ(X)=0
  1.  ;
  1.  S XPDABORT=0                 ; Initialize ABORT flag to NO
  1.  ;
  1. USERID ; EP - CHECK FOR USER ID
  1.  NEW USERNAME
  1.  ;
  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.  S USERNAME=$$GET1^DIQ(200,DUZ,"NAME")
  1.  I $L(USERNAME)<1 D SORRY^BLRKIDSU("Installer [DUZ:"_DUZ_"] cannot be identified!",,,CP) Q
  1.  ;
  1.  D OKAY^BLRKIDSU("Installer: "_USERNAME_" ["_DUZ_"].",5)
  1.  ;
  1.  D HOME^%ZIS             ; IO Defaults
  1.  D DTNOLF^DICRW          ; Set DT variable without Doing a Line Feed
  1.  ;
  1.  D BMES^XPDUTL("Pre Check complete.")
  1.  ;
  1. LETSGO ; EP - USER IDENTIFIED -- LET'S GO
  1.  D BMES^XPDUTL("Checking Environment for Patch "_CP_" of Version "_RPMSVER_" of "_RPMS_".")
  1.  D MES^XPDUTL(" ")
  1.  ;
  1.  D NEEDIT^BLRPRE31(CP,"AICD","4.0",,.ERRARRY)         ; IHS ICD/CPT Lookup & Grouper ICD-10 Version
  1.  D NEEDIT^BLRPRE31(CP,"LR","5.2","1033",.ERRARRY)     ; Lab Patch Pre-Requisite
  1.  ;
  1.  I XPDABORT D SORRYEND^BLRKIDSU(.WOTERR,CP)
  1.  E  D BMES^XPDUTL("ENVIRONMENT OK.")  D MES^XPDUTL("")
  1.  ;
  1.  Q
  1.  ;
  1. BACKUP ; EP
  1.  NEW CP                       ; Current Patch
  1.  S CP=$TR($P($T(+2),";",5),"*")
  1.  ;
  1.  D PASSMESG^BLRPRE31("ATTENTION")
  1.  W !
  1.  ;
  1.  D ^XBFMK
  1.  S DIR(0)="Y"
  1.  S DIR("B")="NO"
  1.  S DIR("A")=$J("",10)_"Has a >> SUCCESSFUL << backup been performed?"
  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.  . H 1   ; Pause 1 second to let the user see the message.
  1.  ;
  1.  I +$G(DEBUG) D  Q
  1.  . D BOKAY^BLRPRE31("SUCCESSFUL system backup CONFIRMED by: "_$$GET1^DIQ(200,DUZ,"NAME")_".",5)
  1.  . D OKAY^BLRKIDSU("DEBUG in process.  No Data Stored.",10)
  1.  . H 1     ; Pause 1 second to let the user see the message.
  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.  Q
  1.  ;
  1. POST ; EP -- POST INSTALL
  1.  NEW BLRVERN,CP,STR
  1.  ;
  1.  S CP=$TR($P($T(+2),";",5),"*")        ; Current Patch
  1.  S BLRVERN=$TR($P($T(+1),";")," ")     ; Routine Name
  1.  ;
  1.  D CLEANSET^BLRICDO                    ; Creates BLRICDO global
  1.  ;
  1.  D ADDOPTS("BLRMENU","BLROTSCH","REPL")
  1.  D ADDOPTS("BLRMENU","BLRLROS","LROS")
  1.  D CHNGOPTT("LROE","Accessioning tests ordered by provider order entry")
  1.  D BMXPO                               ; Add RPCs to Option
  1.  D UPGIS                               ; Change Labcorp DG1.2 to @DG12LABO
  1.  ;
  1.  D LABJRNL                             ; Get rid of extraneous LAB JOURNAL pointers in file 61.2
  1.  ;
  1.  D BMES^XPDUTL("Need to Reset Ref Lab Accession X-Ref Global.")
  1.  K ^XTMP("BLRLINKU")
  1.  D REFLAB68^BLRLINKU                   ; Reset Ref Lab Accession X-Ref Global
  1.  D OKAY^BLRKIDSU("Ref Lab Accession X-Ref Global Reset.")
  1.  ;
  1.  D BMES^XPDUTL("Laboratory Patch "_CP_" INSTALL complete.")
  1.  ;
  1.  ; The VistA Lab's Emerging Pathogen Initiative module is not used
  1.  ; by IHS.  Inactivate the options so that users do not, inadvertantly,
  1.  ; go into any of the EPI menus.
  1.  D INACTOPT("LREP","Lab EPI Module Not Used by IHS","LREPILK")
  1.  ;
  1.  ; Store # of times installation occurred as well as person & date/time
  1.  D ENDINSTL^BLRKIDSU(CP)
  1.  ;
  1.  Q:+$G(DEBUG)
  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 Alert & E-Mail to LMI Mail Group & Installer
  1.  D MAILALMI^BLRUTIL3("Laboratory Patch "_CP_" INSTALL complete.",.STR,BLRVERN)
  1.  Q
  1.  ;
  1.  Q
  1.  ;
  1. ADDOPTS(TOMENU,OPTION,SYNONYM,TAB) ; EP - Add new OPTION to TOMENU with SYNONYM synonym
  1.  Q:$$DEONARDY(TOMENU,OPTION,SYNONYM)
  1.  ;
  1.  ; Add it
  1.  S TAB=$J(" ",$G(TAB,5))
  1.  S X="Adding '"_OPTION_"' option"
  1.  S:$D(SYNONYM) X=X_" with "_SYNONYM_" synonym"
  1.  S X=X_" to "_TOMENU_"."
  1.  D BMES^XPDUTL(X)
  1.  S X=$$ADD^XPDMENU(TOMENU,OPTION,SYNONYM)
  1.  D:X=1 BMES^XPDUTL(TAB_"'"_OPTION_"' added to "_TOMENU_". OK.")
  1.  I X'=1 D
  1.  . D BMES^XPDUTL(TAB_"Error in adding '"_OPTION_"' option to "_TOMENU_".")
  1.  . D MES^XPDUTL(TAB_TAB_"Error Message: "_$$UP^XLFSTR($P(X,"^",2)))
  1.  ;
  1.  D MES^XPDUTL("")
  1.  Q
  1.  ;
  1. BMXPO ;-- update the RPC file
  1.  N BLRRPC
  1.  S BLRRPC=$O(^DIC(19,"B","BLRRLRPC",0))
  1.  Q:'BLRRPC
  1.  D CLEAN(BLRRPC)
  1.  D GUIEP^BMXPO(.RETVAL,BLRRPC_"|BLR")
  1.  Q
  1.  ;
  1. CLEAN(APP) ;-- clean out the RPC multiple first
  1.  S DA(1)=APP
  1.  S DIK="^DIC(19,"_DA(1)_","_"""RPC"""_","
  1.  N BLRDA
  1.  S BLRDA=0 F  S BLRDA=$O(^DIC(19,APP,"RPC",BLRDA)) Q:'BLRDA  D
  1.  . S DA=BLRDA
  1.  . D ^DIK
  1.  K ^DIC(19,APP,"RPC","B")
  1.  Q
  1.  ;
  1. UPGIS ;-- update the GIS definition
  1.  N BLRX,BLRM
  1.  S BLRX=$O(^INTHL7F("B","HL IHS LAB ORM DG1-2 LC",0))
  1.  Q:'BLRX
  1.  S ^INTHL7F(BLRX,"C")="@DG12LABO"
  1.  S BLRM=$O(^INTHL7M("B","HL IHS LAB O01 LABCORP",0))
  1.  Q:'BLRM
  1.  D COMPILE^BHLU(BLRM)
  1.  Q
  1.  ;
  1. DEONARDY(TOMENU,OPTION,SYNONYM) ; EP
  1.  ; Returns 1 if TOMENU doesn't exist OR
  1.  ;           if OPTION doesn't exist OR
  1.  ;           if OPTION already on TOMENU with SYNONYM
  1.  ;
  1.  NEW OPTIEN,SYNIEN,TOIEN
  1.  S TOIEN=$$LKOPT^XPDMENU(TOMENU)
  1.  Q:TOIEN<1 1       ; Return 1 if TOMENU doesn't exist
  1.  ;
  1.  S OPTIEN=$$LKOPT^XPDMENU(OPTION)
  1.  Q:OPTIEN<1 1      ; Return 1 if OPTION doesn't exist
  1.  ;
  1.  S SYNIEN=+$O(^DIC(19,TOIEN,10,"C",$G(SYNONYM),0))
  1.  Q $S($G(^DIC(19,TOIEN,10,SYNIEN,0))=OPTIEN:1,1:0)
  1.  ;
  1. INACTOPT(SEED,OUTMSG,EXCPTION) ; EP - Inactivate/Activate options.
  1.  ; If the OUTMSG variable is NOT NULL, then the the OUT^XPDMENU routine
  1.  ; will put the string into the OUT OF ORDER MESSAGE field of the options.
  1.  ;
  1.  ; If the OUTMSG variable is NULL, then the OUT^XPDMENU routine will 
  1.  ; remove any text from the OUT OF ORDER field of the options.
  1.  ;
  1.  NEW OPTION,SEEDLEN
  1.  ;
  1.  S OPTION=SEED,SEEDLEN=$L(SEED)
  1.  F  S OPTION=$O(^DIC(19,"B",OPTION))  Q:OPTION=""!($E(OPTION,1,SEEDLEN)'=SEED)  D
  1.  . Q:OPTION=$G(EXCPTION)     ; Exception: Do not modify this option.
  1.  . Q:$D(EXCPTION(OPTION))    ; If EXCPTION is an array, Do not modify if option is in the array. 
  1.  . ;
  1.  . D OUT^XPDMENU(OPTION,$G(OUTMSG))
  1.  Q
  1.  ;
  1. LABJRNL ; EP - Get rid of pointers in file 61.2 that point to an empty File 95.
  1.  NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
  1.  ;
  1.  Q:+$O(^LAB(95,0))      ; If there is data in file 95, don't do anything
  1.  ;
  1.  S CNT=0,IEN=.9999999
  1.  F  S IEN=$O(^LAB(61.2,IEN))  Q:IEN<1  D
  1.  . S JOURN=0  F  S JOURN=$O(^LAB(61.2,IEN,"JR",JOURN))  Q:JOURN<1  D
  1.  .. S CNT=CNT+1
  1.  .. I CNT=1 D
  1.  ... S ^XTMP("LABJRNAL",0)=$$HTFM^XLFDT(+$H+365)_"^"_$$DT^XLFDT_"^Entries In File 61.2 that Pointed to (Empty) File 95"
  1.  ... D BMES^XPDUTL("There are entries In File 61.2 that Point to (Empty) LAB JOURNAL (#95) File.")
  1.  .. S ^XTMP("LABJRNAL","61.2","IEN",IEN)=""
  1.  .. M ^XTMP("LABJRNAL","61.2","IEN",IEN,"JOURN",JOURN)=^LAB(61.2,IEN,"JR",JOURN)
  1.  .. D TABMENU^BLRKIDSU("File 61.2 IEN:"_IEN_"; JOURN IEN:"_JOURN)
  1.  .. D TABMENU^BLRKIDSU("File 61.2 Journal Reference:"_$G(^LAB(61.2,IEN,"JR",JOURN,0)),10)
  1.  .. ;
  1.  .. K DA
  1.  .. S DA(1)=IEN,DA=JOURN
  1.  .. S DIK="^LAB(61.2,"_DA(1)_",""JR"","
  1.  .. D ^DIK
  1.  ;
  1.  S:CNT ^XTMP("LABJRNAL","61.2")=CNT
  1.  Q
  1.  ;
  1. DEBUG ; EP - Debugging Line Label for environment checker
  1.  NEW CP,DEBUG,LINE2,ROWPLUS,ROWSTARS,XPDNM
  1.  S DEBUG=1
  1.  S XPDNM="LR*5.2*1034"
  1.  ;
  1.  S ROWSTARS=$TR($J("",IOM)," ","*")
  1.  S ROWPLUS=$TR($J("",IOM)," ","+")
  1.  ;
  1.  D ^XBCLS,PASSMESG^BLRPRE31("DEBUG: ENVCHK Check")
  1.  ;
  1.  D ENVCHK^BLRPRE34
  1.  ;
  1.  W !!,"DEBUG: ENVCHK^BLRPRE34 Completed."
  1.  W !!,ROWPLUS
  1.  D PRESSKEY^BLRGMENU
  1.  ;
  1.  D ^XBCLS,PASSMESG^BLRPRE31("DEBUG: BACKUP Check.")
  1.  D BACKUP^BLRPRE34
  1.  W !!,"DEBUG: BACKUP^BLRPRE34 Completed.",!
  1.  W !,ROWPLUS
  1.  D PRESSKEY^BLRGMENU
  1.  ;
  1.  D ^XBCLS,PASSMESG^BLRPRE31("DEBUG: POST Check")
  1.  D POST^BLRPRE34
  1.  W !!,"DEBUG: POST^BLRPRE34 Completed."
  1.  W !!,ROWPLUS
  1.  D PRESSKEY^BLRGMENU
  1.  ;
  1.  D ^XBCLS,PASSMESG^BLRPRE31("DEBUG: COMPLETED")
  1.  D PRESSKEY^BLRGMENU
  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.
  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-888-830-7280.",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.  Q:+$G(DEBUG)                     ; Skip if DEBUG
  1.  ;
  1.  I '$G(DUZ)!('$L($G(DUZ(0)))) Q   ; Skip if no DUZ
  1.  ;
  1.  Q:$$FIND1^DIC(3.8,,,"LMI")<1     ; Skip if no LMI Mail group
  1.  ;
  1.  I $G(MODE)="FATAL" D MAILALMI^BLRUTIL3("IHS Lab Patch "_CP_" Install FATAL Error",.STR,"BLRPRE34")
  1.  I $G(MODE)="NONFATAL" D MAILALMI^BLRUTIL3("IHS Lab Patch "_CP_" Install NONFATAL Error",.STR,"BLRPRE34")
  1.  ;
  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. CHNGOPTT(OPTION,TEXT) ; EP - Change the MENU Text of an Option
  1.  NEW ERRS,FDA,OLDMTEXT,OPTIEN
  1.  ;
  1.  S OPTIEN=$$FIND1^DIC(19,,,OPTION)
  1.  Q:OPTIEN<1     ; Skip if cannot determine OPTION's IEN in file 19
  1.  ;
  1.  S OLDMTEXT=$$GET1^DIQ(19,OPTIEN,"MENU TEXT")
  1.  ;
  1.  D BMES^XPDUTL("Attempting to modify MENU TEXT on Option "_OPTION_" from")
  1.  D MES^XPDUTL($J("",10)_$E(OLDMTEXT,1,50))
  1.  D MES^XPDUTL("     to")
  1.  D MES^XPDUTL($J("",10)_$E(TEXT,1,50))
  1.  ;
  1.  S FDA(19,OPTIEN_",",1)=TEXT
  1.  D UPDATE^DIE("SE","FDA",,"ERRS")
  1.  D MES^XPDUTL("")
  1.  I $D(ERRS)<1 D OKAY^BLRKIDSU("MENU TEXT modified.")
  1.  I $D(ERRS) D MES^XPDUTL("     MENU TEXT was *NOT* modified.")
  1.  Q