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

BLRPRE37.m

Go to the documentation of this file. 
  1. BLRPRE37 ; IHS/MSC/MKK - IHS Lab Patch LR*5.2*1037 Pre/Environment Routine ; 02-Nov-2015 13:44 ; MKK
  1.  ;;5.2;IHS LABORATORY;**1037**;NOV 01, 1997;Build 4
  1.  ;
  1. ENVICHEK ; EP - Environment Checker
  1.  NEW BLRVERN,CP,ERRARRAY,ROWSTARS,RPMS,RPMSVER,TODAY,WOTCNT
  1.  ;
  1.  Q:$$ENVIVARS()="Q"
  1.  ;
  1.  D ENVHEADR^BLRPRE31(CP,RPMSVER,RPMS),BLANK
  1.  ;
  1.  D NEEDIT^BLRPRE31(CP,"LR","5.2",1036,.ERRARRAY),BLANK  ; Lab Pre-Requisite
  1.  ;
  1.  I XPDABORT>0 D SORRYEND^BLRPRE33(.ERRARRAY,CP)   Q     ; ENVIRONMENT HAS ERROR(S)
  1.  ;
  1.  D BOKAY^BLRPRE31("ENVIRONMENT")
  1.  ;
  1.  Q
  1.  ;
  1. ENVIVARS() ; EP - Setup the Environment variables
  1.  D SETEVARS
  1.  ;
  1.  S TODAY=$$DT^XLFDT
  1.  S WOTCNT=$$WOTCNT(BLRVERN)
  1.  S ROWSTARS=$TR($J("",65)," ","*")     ; Row of asterisks
  1.  ;
  1.  S ^XTMP(BLRVERN,0)=$$HTFM^XLFDT(+$H+90)_"^"_$$DT^XLFDT_"^IHS Lab Patch "_CPSTR
  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 SORRY^BLRPRE31(CP,"XPDNM not defined or 0.")  Q "Q"
  1.  ;
  1.  S RPMS=$P(XPDNM,"*",1)      ; RPMS Module
  1.  S RPMSVER=$P(XPDNM,"*",2)   ; RPMS Version
  1.  ;
  1.  I +$G(DUZ)<1 D SORRY^BLRPRE31(CP,"DUZ UNDEFINED OR 0.")  Q "Q"
  1.  I $$GET1^DIQ(200,DUZ,"NAME")="" D SORRY^BLRPRE31(CP,"Installer cannot be identified!")  Q "Q"
  1.  ;
  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.  Q "OK"
  1.  ;
  1. PRE ; EP - Ask for confirmation of Backup
  1.  NEW BLRVERN,CNT,CP,CPSTR,CRTLINE,DIRASTR,FDAROOT,IEN,IENS,MSGROOT
  1.  NEW BCKUPCNT                   ; Current Patch,Backup count
  1.  ;
  1.  D SETEVARS
  1.  ;
  1.  S XUMF=1
  1.  ;
  1.  D INITSCR
  1.  D TITLE^XPDID(CPSTR)
  1.  D BLANK,BMES^XPDUTL("Pre-Install of "_BLRVERN_" Begins.")
  1.  ;
  1.  Q:$$BACKUP()="Q"
  1.  ;
  1.  D INITSCR
  1.  D TITLE^XPDID(CPSTR)
  1.  D BLANK,BMES^XPDUTL("Pre-Install of "_BLRVERN_" Continues.")
  1.  ;
  1.  ; Do Pre-install stuff here.
  1.  ;
  1.  D TABMESG^BLRKIDSU("Pre-Install Processing Ends at "_$$UP^XLFSTR($$HTE^XLFDT($H,"5MPZ"))_".",5)
  1.  H 2  ; Pause so user can see the message.
  1.  ;
  1.  D EXIT^XPDID
  1.  Q
  1.  ;
  1. BACKUP() ; EP - Confirm Backup
  1.  NEW BCKUPCNT,SUCCSTR
  1.  ;
  1.  D SHOWBOX^BLRGMENU("ATTENTION",10,70)
  1.  ;
  1.  D ^XBFMK
  1.  S DIR(0)="Y"
  1.  S DIR("B")="NO"
  1.  I $G(IOST)["C-VT" S SUCCSTR=$C(27)_"[1;7;5m"_">> SUCCESSFUL <<"_$C(27)_"[0m"
  1.  E  S SUCCSTR=">> SUCCESSFUL <<"
  1.  S DIR("A")=$J("",10)_"Has a "_SUCCSTR_" backup been performed?"
  1.  S DIR("?")="A *NO* answer will abort the install process."
  1.  D ^DIR
  1.  W !
  1.  ;
  1.  Q:+$G(Y)'=1 $$NOBACKUP()       ; If BACKUP not performed, then ABORT installation.
  1.  ;
  1.  Q:+$G(DEBUG) $$OKBACKUP()      ; DEBUG will *NOT* store Backup Confirmation data.
  1.  ;
  1.  ; Store backup confirmation person & date/time
  1.  S BCKUPCNT=1+$O(^BLRINSTL("LAB PATCH",CP,"BACKUP CONFIRMED BY",0),-1)
  1.  S ^BLRINSTL("LAB PATCH",CP,"BACKUP CONFIRMED BY",BCKUPCNT)=$P($G(^VA(200,DUZ,0)),U)
  1.  S ^BLRINSTL("LAB PATCH",CP,"BACKUP CONFIRMED BY",BCKUPCNT,"DUZ")=DUZ
  1.  S ^BLRINSTL("LAB PATCH",CP,"BACKUP CONFIRMED BY",BCKUPCNT,"DATE/TIME")=$$HTE^XLFDT($H,"5MZ")
  1.  ;
  1.  Q $$OKBACKUP()
  1.  ;
  1. OKBACKUP() ; EP - Backup Confirmed.
  1.  D MES^XPDUTL("")
  1.  D OKAY^BLRKIDSU("SUCCESSFUL system backup CONFIRMED by: "_$$GET1^DIQ(200,DUZ,"NAME")_".",5)
  1.  I +$G(DEBUG) D
  1.  . D MES^XPDUTL("")
  1.  . D TABMENU^BLRKIDSU("DEBUG will **NOT** Store Backup Confirmation.",10)
  1.  ;
  1.  H 2     ; Pause to let the user see the message.
  1.  Q "OK"
  1.  ;
  1. NOBACKUP() ; EP - No backup message
  1.  S XPDABORT=1
  1.  D PASSMESG^BLRPRE31("ATTENTION")
  1.  D TABMESG^BLRKIDSU("SUCCESSFUL system backup has >>> NOT <<< been confirmed.",15)
  1.  D TABMESG^BLRKIDSU("Installer: "_$$GET1^DIQ(200,DUZ,"NAME")_" ["_DUZ_"].",25)
  1.  D TABMESG^BLRKIDSU("Install Aborting.",15)
  1.  H 2     ; Pause to let the user see the message.
  1.  Q "Q"
  1.  ;
  1. DEBUG ; EP - Debugging Line Label for environment checker
  1.  NEW BEGTIME,BLRVERN,CP,CPSTR,DEBUG,ENDTIME,ERRARRAY,LASTLOGI
  1.  NEW LRBLNOW,PATCHNUM,PREREQ,QFLG,ROWSTARS,RPMS,RPMSVER,STR
  1.  NEW SUCCSTR,TODAY,WHATCNT,WOTCNT,XPDABORT,XPDENV,XPDNM
  1.  ;
  1.  ; NOTE: DEBUG will not store "Backup" data.
  1.  ;
  1.  D SETEVARS
  1.  ;
  1.  W !!
  1.  W "Debug Routine ",BLRVERN," Begins:",!!
  1.  ;
  1.  S DEBUG=1    ; Don't Send Alerts
  1.  ;
  1.  W !
  1.  S XPDNM=CPSTR
  1.  S XPDENV=0
  1.  ;
  1.  D PRE
  1.  Q:XPDABORT
  1.  ;
  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:+$G(Y)=1 POST
  1.  ;
  1.  W !!,"Debug Routine ",BLRVERN," Ends.",!!
  1.  Q
  1.  ;
  1. POST ; EP - Post-Install
  1.  NEW (DEBUG,DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
  1.  ;
  1.  D SETEVARS
  1.  ;
  1.  S TODAY=$$DT^XLFDT
  1.  S WOTCNT=$$WOTCNT(BLRVERN)
  1.  ;
  1.  D REFLABCH   ; Reference Lab Changes
  1.  ;
  1.  D BLANK,BMES^XPDUTL("Laboratory Patch "_CPSTR_" INSTALL complete."),BLANK
  1.  ;
  1.  Q:+$G(DEBUG)
  1.  ;
  1.  D POSTMAIL(BLRVERN,CPSTR)
  1.  ;
  1.  S ^XTMP(BLRVERN,TODAY,WOTCNT,"END")=$$NOW^XLFDT
  1.  Q
  1.  ;
  1. SAVEOFF ; EP - Save off all routines being updated by this patch into the ^rBACKUP global.
  1.  NEW (DEBUG,DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
  1.  ;
  1.  I +$G(DEBUG) D BLANK,OKAY^BLRKIDSU("DEBUG: SAVEOFF^BLRPRE37",4)  Q     ; If DEBUG, just print message & quit
  1.  ;
  1.  S PATCH=$P($T(+2),"*",3)
  1.  ;
  1.  F RTN="BLRLINK4","BLRRLEDI","BLRRLU","BLRSGNS3","LR7OF1"  D
  1.  . S RTNPATCH=$RE($P($RE($TR($P($G(^ROUTINE(RTN,0,2)),";",5),"*")),","))
  1.  . Q:RTNPATCH'<PATCH  ; Only versions < this patch
  1.  . ;
  1.  . K ERRS,RTNA
  1.  . F LN=0:1:$G(^ROUTINE(RTN,0,0))  S RTNA(LN)=$G(^ROUTINE(RTN,0,LN))
  1.  . S X=$$ROUTINE^%R(RTN_".INT",.RTNA,.ERRS,"CSB")
  1.  . S NOW=$H
  1.  . S ^BLRINSTL("LAB PATCH",PATCH,"SAVEOFF",NOW)=$$HTE^XLFDT(NOW,"5MZ")
  1.  . S ^BLRINSTL("LAB PATCH",PATCH,"SAVEOFF",NOW,RTN)=$S($D(ERRS)>1:"ERRORS",1:"OK")
  1.  Q
  1.  ;
  1.  ;
  1.  ; ========================= UTILITIES FOLLOW ==========================
  1.  ;
  1. SETEVARS ; EP - SET standard "Enviroment" VARiables.
  1.  S (CP,PATCHNUM)=$P($T(+2),"*",3)
  1.  S CPSTR="LR*5.2*"_CP
  1.  S BLRVERN=$TR($P($T(+1),";")," ")
  1.  Q
  1.  ;
  1. BLANK ; EP - Blank Line
  1.  D MES^XPDUTL("")
  1.  Q
  1.  ;
  1. MESCNTR(STR) ; EP - Center a line and use XPDUTL to display it
  1.  D MES^XPDUTL($$CJ^XLFSTR(STR,IOM))
  1.  Q
  1.  ;
  1. WOTCNT(BLRVERN) ; EP - Counter for ^XTMP
  1.  NEW CNT,TODAY
  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. INITSCR ; EP - Initialize screen. Cloned from INIT^XPDID
  1.  N X,XPDSTR
  1.  I IO'=IO(0)!(IOST'["C-VT") S XPDIDVT=0 Q
  1.  I $T(PREP^XGF)="" S XPDIDVT=0 Q
  1.  D PREP^XGF
  1.  S XPDIDVT=1,X="IOSTBM",XPDSTR=""
  1.  D ENDR^%ZISS
  1.  S IOTM=3,IOBM=IOSL-4
  1.  W @IOSTBM
  1.  D FRAME^XGF(IOTM-2,0,IOTM-2,IOM-1) ; Top line
  1.  ; D FRAME^XGF(IOBM+1,0,IOBM+1,IOM-1) ; Bottom line
  1.  D IOXY^XGF(IOTM-2,0)
  1.  Q
  1.  ;
  1.  ;
  1. POSTMAIL(BLRVERN,CPSTR) ; EP - Post Install MailMan Message
  1.  NEW STR
  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 "_CPSTR_" INSTALL completed."
  1.  S STR(5)=" "
  1.  ;
  1.  Q:+$G(DEBUG)   ; No MailMan messages during debugging
  1.  ;
  1.  ; Send E-Mail to LMI Mail Group & Installer
  1.  D MAILALMI^BLRUTIL3("Laboratory Patch "_CPSTR_" INSTALL complete.",.STR,BLRVERN)
  1.  ;
  1.  Q
  1.  ;
  1. REFLABCH ; EP - Post Install Reference Lab changes
  1.  NEW FDA,ERRORS
  1.  ;
  1.  D BMES^XPDUTL("IHS Reference Lab Changes.")
  1.  ;
  1.  ; Schedule BLR REFLAB PURGE QUE ORDER option to run every 30 days
  1.  D TABMESG^BLRKIDSU("Adding BLR REFLAB PURGE QUE ORDER option to OPTION SCHEDULING (#19.2) file.",5)
  1.  ; First, put into file 19.2
  1.  D ^XBFMK
  1.  K FDA,ERRORS
  1.  S FDA(19.2,"?+1,",.01)="BLR REFLAB PURGE QUE ORDER"
  1.  S FDA(19.2,"?+1,",5)=$NAMESPACE
  1.  S FDA(19.2,"?+1,",9)="P"
  1.  D UPDATE^DIE("ES","FDA",,"ERRORS")
  1.  ;
  1.  ; Now, put in the schedule - every 30 days at 2300, starting today
  1.  I $D(ERRORS)<1 D
  1.  . W !,?9
  1.  . D RESCH^XUTMOPT("BLR REFLAB PURGE QUE ORDER",DT_.2300,,"30D")
  1.  . D BLANK,OKAY^BLRKIDSU("Added to 19.2 and has been scheduled.",10)
  1.  ;
  1.  D TABMESG^BLRKIDSU("Adding options to the Reference Lab Main Menu",5)
  1.  D ADDOPTS^BLRKIDS2("BLRREFLABMENU","BLR REFLAB PURGE QUE ORDER","QPO")
  1.  D ADDOPTS^BLRKIDS2("BLRREFLABMENU","BLR REFLAB PURGE ORD ACC FILE","PO")
  1.  ;
  1.  D BMES^XPDUTL("IHS Reference Lab Changes. OK.")
  1.  Q