BLRPRE41.m

BLRPRE41 ; IHS/MSC/MKK - RPMS Lab Patch LR*5.2*1041 Pre/Install/Post Routine ; 13-Oct-2017 14:04 ;  MKK

 ;;5.2;IHS LABORATORY;**1041**;NOV 01, 1997;Build 23

 ;

ENVICHEK ; EP - Environment Checker

 NEW BLRVERN,BLRVERN2,CP,ERRARRAY,ROWSTARS,RPMS,RPMSVER,TODAY,WOTCNT

 ;

 Q:$$ENVIVARS()="Q"

 ;

 D ENVHEADR^BLRKIDS2(CP,RPMSVER,RPMS),BLANK

 ;

 D NEEDIT^BLRKIDS2(CP,"LR","5.2",1040,.ERRARRAY),BLANK  ; Lab Pre-Requisite

 ;

 I XPDABORT>0 D SORRYEND^BLRKIDS2(.ERRARRAY,CP)   Q     ; ENVIRONMENT HAS ERROR(S)

 ;

 D BOKAY^BLRKIDS2("ENVIRONMENT")

 ;

 Q

 ;

ENVIVARS() ; EP - Setup the Environment variables

 D SETEVARS

 ;

 S TODAY=$$DT^XLFDT

 S WOTCNT=$$WOTCNT(BLRVERN)

 S ROWSTARS=$TR($J("",65)," ","*")     ; Row of asterisks

 ;

 S ^XTMP(BLRVERN,0)=$$HTFM^XLFDT(+$H+90)_"^"_$$DT^XLFDT_"^IHS Lab Patch "_CPSTR

 M ^XTMP(BLRVERN,TODAY,WOTCNT,"DUZ")=DUZ

 S ^XTMP(BLRVERN,TODAY,WOTCNT,"BEGIN")=$$NOW^XLFDT

 ;

 S XUMF=1

 ;

 I $G(XPDNM)="" D SORRY^BLRKIDS2(CP,"XPDNM not defined or 0.")  Q "Q"

 ;

 S RPMS=$P(XPDNM,"*",1)      ; RPMS Module

 S RPMSVER=$P(XPDNM,"*",2)   ; RPMS Version

 ;

 I +$G(DUZ)<1 D SORRY^BLRKIDS2(CP,"DUZ UNDEFINED OR 0.")  Q "Q"

 I $$GET1^DIQ(200,DUZ,"NAME")="" D SORRY^BLRKIDS2(CP,"Installer cannot be identified!")  Q "Q"

 ;

 S XPDNOQUE=1        ; No Queuing Allowed

 ;

 ; The following line prevents the "Disable Options..." and "Move

 ; Routines..." questions from being asked during the install.

 F X="XPO1","XPZ1","XPZ2","XPI1" S XPDDIQ(X)=0,XPDDIQ(X,"B")="NO"

 ;

 S XPDABORT=0        ; KIDS install Flag

 ;

 D HOME^%ZIS         ; Reset/Initialize IO variables

 D DTNOLF^DICRW      ; Set DT variable without a Line Feed

 ;

 Q "OK"

 ;

PRE ; EP - Ask for confirmation of Backup

 NEW BLRVERN,BLRVERN2,CNT,CP,CPSTR,CRTLINE,DIRASTR,FDAROOT,IEN,IENS,MSGROOT

 NEW BCKUPCNT                   ; Current Patch,Backup count

 ;

 D SETEVARS

 ;

 S XUMF=1

 ;

 D INITSCR

 D TITLE^XPDID(CPSTR)

 D BLANK,BMES^XPDUTL("Pre-Install begins "_$$UP^XLFSTR($$HTE^XLFDT($H,"5MPZ"))_".")

 ;

 Q:$$BACKUP()="Q"

 ;

 D INITSCR

 D TITLE^XPDID(CPSTR)

 D BLANK,BMES^XPDUTL("Pre-Install of "_BLRVERN_" Continues.")

 ;

 ; Do Pre-install stuff here.

 D SAVEOFF

 ;

 D BMES^XPDUTL("Pre-Install ends "_$$UP^XLFSTR($$HTE^XLFDT($H,"5MPZ"))_".")

 H 2  ; Pause so user can see the message.

 ;

 ; D EXIT^XPDID

 Q

 ;

BACKUP() ; EP - Confirm Backup

 NEW BCKUPCNT,SUCCSTR

 ;

 D SHOWBOX^BLRGMENU("ATTENTION",10,70)

 ;

 D ^XBFMK

 S DIR(0)="Y"

 S DIR("B")="NO"

 I $G(IOST)["C-VT" S SUCCSTR=$C(27)_"[1;7;5m"_">> SUCCESSFUL <<"_$C(27)_"[0m"

 E  S SUCCSTR=">> SUCCESSFUL <<"

 S DIR("A")=$J("",10)_"Has a "_SUCCSTR_" backup been performed?"

 S DIR("?")="A *NO* answer will abort the install process."

 D ^DIR

 W !

 ;

 Q:+$G(Y)'=1 $$NOBACKUP()       ; If BACKUP not performed, then ABORT installation.

 ;

 Q:+$G(DEBUG) $$OKBACKUP()      ; DEBUG will *NOT* store Backup Confirmation data.

 ;

 ; Store backup confirmation person & date/time

 S BCKUPCNT=1+$O(^BLRINSTL("LAB PATCH",CP,"BACKUP CONFIRMED BY",0),-1)

 S ^BLRINSTL("LAB PATCH",CP,"BACKUP CONFIRMED BY",BCKUPCNT)=$P($G(^VA(200,DUZ,0)),U)

 S ^BLRINSTL("LAB PATCH",CP,"BACKUP CONFIRMED BY",BCKUPCNT,"DUZ")=DUZ

 S ^BLRINSTL("LAB PATCH",CP,"BACKUP CONFIRMED BY",BCKUPCNT,"DATE/TIME")=$$HTE^XLFDT($H,"5MZ")

 ;

 Q $$OKBACKUP()

 ;

OKBACKUP() ; EP - Backup Confirmed.

 D BLANK

 D OKAY^BLRKIDSU("SUCCESSFUL system backup CONFIRMED by: "_$$GET1^DIQ(200,DUZ,"NAME")_".",5)

 I +$G(DEBUG) D

 . D BLANK

 . D TABMENU^BLRKIDSU("DEBUG will **NOT** Store Backup Confirmation.",10)

 ;

 H 2     ; Pause to let the user see the message.

 Q "OK"

 ;

NOBACKUP() ; EP - No backup message

 S XPDABORT=1

 D PASSMESG^BLRKIDS2("ATTENTION")

 D TABMESG^BLRKIDSU("SUCCESSFUL system backup has >>> NOT <<< been confirmed.",15)

 D TABMESG^BLRKIDSU("Installer: "_$$GET1^DIQ(200,DUZ,"NAME")_" ["_DUZ_"].",25)

 D TABMESG^BLRKIDSU("Install Aborting.",15)

 H 2     ; Pause to let the user see the message.

 Q "Q"

 ;

DEBUG ; EP - Debugging Line Label for environment checker

 NEW BEGTIME,BLRVERN,CP,CPSTR,DEBUG,ENDTIME,ERRARRAY,LASTLOGI

 NEW LRBLNOW,PATCHNUM,PREREQ,QFLG,ROWSTARS,RPMS,RPMSVER,STR

 NEW SUCCSTR,TODAY,WHATCNT,WOTCNT,XPDABORT,XPDENV,XPDNM

 ;

 ; NOTE: DEBUG will not store "Backup" data.

 ;

 D SETEVARS

 ;

 W !!

 W "Debug Routine ",BLRVERN," Begins:",!!

 ;

 S DEBUG=1    ; Don't Send Alerts

 ;

 W !

 S XPDNM=CPSTR

 S (XPDENV,XPDABORT)=0

 ;

 D PRE

 Q:XPDABORT

 ;

 W !!!

 ;

 D ^XBFMK

 S DIR(0)="YO"

 S DIR("B")="NO"

 S DIR("A")="Test Post Install Code"

 D ^DIR

 ;

 D:+$G(Y)=1 POST

 ;

 W !!,"Debug Routine ",BLRVERN," Ends.",!!

 Q

 ;

POST ; EP - Post-Install

 NEW BLRVERN,BLRVERN2,CP,CPSTR,PATCHNUM,TODAY,WOTCNT

 ;

 D SETEVARS

 ;

 D BLANK

 D BMES^XPDUTL("Laboratory Patch "_CPSTR_" POST INSTALL begins at "_$$UP^XLFSTR($$HTE^XLFDT($H,"5MPZ"))_".")

 D BLANK

 ;

 S TODAY=$$DT^XLFDT

 S WOTCNT=$$WOTCNT(BLRVERN)

 ;

 D ADDOPTS    ; Add new options to BLRMENU

 ;

 D VBECSUPD   ; VBECS Update

 ;

 D FORCENO    ; Force new parameters to NO

 ;

 D ADDDESC    ; Add Descriptions to 3 Mail Groups

 ;

 I $L($G(^DD(90475.8,0,"VR")))<1 D

 . S FORCEDD="^DD(90475.8,0,""VR"")"

 . S @FORCEDD=5.2   ; Force Version Number into Data Dictionary.

 . S FORCEDD="^DD(90475.8,0,""VRPK"")"

 . S @FORCEDD="LR"   ; Force Lab Link into Data Dictionary.

 ;

 D BLANK

 D BMES^XPDUTL("Laboratory Patch "_CPSTR_" POST INSTALL ends at "_$$UP^XLFSTR($$HTE^XLFDT($H,"5MPZ"))_".")

 D BLANK

 ;

 D POSTMAIL(BLRVERN,CPSTR)

 ;

 S ^XTMP(BLRVERN,TODAY,WOTCNT,"END")=$$NOW^XLFDT

 Q

 ;

ADDOPTS ; EP - Add new options

 D ADDOPTS^BLRKIDS2("BLRMENU","BLR PARMETERS AND MAIL GROUPS","PAMG")

 D ADDOPTS^BLRKIDS2("BLRMENU","BLROLOR","ORDO")

 ; D ADDOPTS^BLRKIDS2("BLRMENU","BLRPURGU","PURG")

 D ADDOPTS^BLRKIDS2("LRSUPERVISOR","BLRPURGU","PURR")

 D ADDOPTS^BLRKIDS2("BLRMENU","BLR PATIENT REMINDER DOCUMENT","PDOC")

 D ADDOPTS^BLRKIDS2("BLRMENU","BLRERRTR","ERRT")

 Q

 ;

FORCENO ; EP - Force new parameters to be NO

 NEW (DEBUG,DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)

 ;

 D SETBLRVS

 Q:'$$GETPARS(.PARSLIST)

 ;

 I +$G(DEBUG) D  Q      ; If DEBUG, just print messages & quit

 . S TAB=$J("",10)

 . D BLANK,OKAY^BLRKIDSU("DEBUG: FORCENO^"_BLRVERN,4)

 . S PARAMETER=""

 . F  S PARAMETER=$O(PARSLIST(PARAMETER))  Q:PARAMETER=""  D

 .. D MES^XPDUTL(TAB_"DEBUG will *NOT* modify "_PARAMETER_" parameter.")

 ;

 S PARAMETER=""

 F  S PARAMETER=$O(PARSLIST(PARAMETER))  Q:PARAMETER=""  D

 . K ERRS

 . D EN^XPAR("PKG",PARAMETER,,"NO",.ERRS)

 . I +$G(ERRS) D

 .. D BLANK,MES^XPDUTL(PARAMETER_" parameter not modified."),BLANK

 .. D STORERRS^BLREMERA(ERRS,PARAMETER)

 Q

 ;

GETPARS(PARSLIST) ; EP - Function to get Parameters from BUILD file

 NEW (DEBUG,DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,PARSLIST,U,XPARSYS,XQXFLG)

 ;

 D SETEVARS

 ;

 S BUILDIEN=$$FIND1^DIC(9.6,,,CPSTR)

 Q:BUILDIEN<1 0

 ;

 S PARAMTRS="",CNT=0

 F  S PARAMTRS=$O(^XPD(9.6,BUILDIEN,"KRN",8989.51,"NM","B",PARAMTRS))  Q:PARAMTRS=""  D

 . S PARSLIST(PARAMTRS)="",CNT=CNT+1

 ;

 Q CNT

 ;

 ;

SAVEOFF ; EP - Save off all routines being updated by this patch into the ^rBACKUP global.

 NEW (DEBUG,DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)

 ;

 Q:$G(^%ZOSF("OS"))'["OpenM"      ; If not Cache, cannot use ^%R

 ;

 S BLRVERN=$TR($P($T(+1),";")," ")

 ;

 I +$G(DEBUG) D  Q      ; If DEBUG, just print messages & quit

 . S TAB=$J("",10)

 . D BLANK,OKAY^BLRKIDSU("DEBUG: SAVEOFF^"_BLRVERN,4)

 . D BMES^XPDUTL(TAB_"DEBUG does *NOT* Save off routines.")

 ;

 S PATCH=$P($T(+2),"*",3)

 S BUILD="LR*5.2*"_PATCH

 S PATCHIEN=+$O(^XPD(9.6,"B",BUILD,"A"),-1)      ; Get the most current Patch IEN

 Q:PATCHIEN<1      ; If not in BUILD file, skip

 ;

 D BMES^XPDUTL("Backing up routines.")

 S RTN="",(CNT,RTNCNT)=0

 F  S RTN=$O(^XPD(9.6,PATCHIEN,"KRN",9.8,"NM","B",RTN))  Q:RTN=""  D

 . S RTNPATCH=+$RE($P($RE($TR($P($G(^ROUTINE(RTN,0,2)),";",5),"*")),","))

 . Q:RTNPATCH<1         ; If RTN not in the ^ROUTINE global, skip

 . Q:RTNPATCH'<PATCH    ; Only versions < this patch

 . ;

 . S RTNCNT=RTNCNT+1

 . K ERRS,RTNA

 . F LN=0:1:$G(^ROUTINE(RTN,0,0))  S RTNA(LN)=$G(^ROUTINE(RTN,0,LN))

 . S X=$$ROUTINE^%R(RTN_".INT",.RTNA,.ERRS,"CSB")

 . S NOW=$H

 . S ^BLRINSTL("LAB PATCH",PATCH,"SAVEOFF",NOW)=$$HTE^XLFDT(NOW,"5MZ")

 . S ^BLRINSTL("LAB PATCH",PATCH,"SAVEOFF",NOW,RTN)=$S($D(ERRS)>1:"ERRORS",1:"OK")

 . I $D(ERRS)'>1 D

 .. D OKAY^BLRKIDSU("Routine "_RTN_" backed up.",4)

 .. S CNT=CNT+1

 ;

 I RTNCNT D

 . S TAB=$J("",5)

 . D BMES^XPDUTL(TAB_RTNCNT_" routines analyzed.")

 . D BMES^XPDUTL(TAB_TAB_CNT_" routines backed up.")

 Q

 ;

 ;

VBECSUPD ; EP - VBECS Update

 NEW (DEBUG,DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)

 ;

 Q:$G(^%ZOSF("OS"))'["OpenM"      ; If not Cache, cannot use ^%R

 ;

 D SETBLRVS

 ;

 S RTN="VB",CNT=0

 F  S RTN=$O(^ROUTINE(RTN))  Q:RTN=""!($E(RTN,1,2)'="VB")  D

 . S X=$$DEL^%R(RTN_".INT")

 . S X=$$DEL^%R(RTN_".OBJ")

 . S CNT=CNT+1

 ;

 Q:CNT<1

 ;

 D:$D(^XTMP(BLRVERN,0))<1 XTMPHEAD

 S ^XTMP(BLRVERN,$J,"VBECSUPD")=CNT_" VBECS routines removed during Post Install."

 Q

 ;

ADDDESC ; EP - Add Descriptons to 3 Mail Groups, if and only if they are currently blank

 NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)

 ;

 D ADDLMI

 D ADDBLRL

 D ADDLABT

 Q

 ;

ADDLMI ; EP - Add description to LMI Mail Group

 NEW WPARRAY

 ;

 S WPARRAY("WP")=""

 S WPARRAY("WP",1)="Laboratory Management Mail Group to receive anomalous and/or descriptive"

 S WPARRAY("WP",2)="messages from the Lab subsystem."

 ;

 D STORDESC("LMI",.WPARRAY)

 Q

 ;

ADDBLRL ; EP - Add Description to BLRLINK Mail Group

 NEW WPARRAY

 ;

 S WPARRAY("WP")=""

 S WPARRAY("WP",1)="Mail Group to receive Lab to PCC linker issues and/or"

 S WPARRAY("WP",2)="descriptive messages."

 ;

 D STORDESC("BLRLINK",.WPARRAY)

 Q

 ;

ADDLABT ; EP - Add Description to LAB TECHS Mail Group

 NEW WPARRAY

 ;

 S WPARRAY("WP")=""

 S WPARRAY("WP",1)="Laboratory Techs."

 ;

 D STORDESC("LAB TECHS",.WPARRAY)

 Q

 ;

STORDESC(MGRP,WPARRAY) ; EP - Store description into Mail Group file

 NEW LMGIEN

 ;

 D ^XBFMK

 S LMGIEN=+$$FIND1^DIC(3.8,,"O",MGRP)       ; Skip if cannot determine Mail Group IEN

 ;

 Q:$L($$GET1^DIQ(3.801,"1,"_LMGIEN,.01))    ; Skip if description already exists

 ;

 D ^XBFMK

 K ERRS

 D WP^DIE(3.8,LMGIEN_",",3,"K","WPARRAY(""WP"")","ERRS")

 I '$D(ERRS) D OKAY^BLRKIDSU("Added Description to "_MGRP_" Mail Group.",5)  Q

 ;

 D TABMESG^BLRKIDSU("Could Not Add Description to "_MGRP_" Mail Group.",10)

 Q

 ;

 ; 

 ; ========================= UTILITIES FOLLOW ==========================

 ;

SETEVARS ; EP - SET standard "Enviroment" VARiables.

 S (CP,PATCHNUM)=$P($T(+2),"*",3)

 S CPSTR="LR*5.2*"_CP

 D SETBLRVS

 Q

 ;

SETBLRVS(TWO) ; EP - Set the BLRVERN variable(s)

 K BLRVERN,BLRVERN2

 ;

 S BLRVERN=$P($P($T(+1),";")," ")

 S:$L($G(TWO)) BLRVERN2=$G(TWO)

 Q

 ;

XTMPHEAD ; EP - Initialize XTMP for this patch

 NEW BLRVERN,BLRVERN2,PTCHNAME

 D SETBLRVS

 S PTCHNAME=$$TRIM^XLFSTR($P($P($P($T(+1),";",2),"-",2),"Pre"),"LR"," ")

 S ^XTMP(BLRVERN,0)=$$FMADD^XLFDT($$DT^XLFDT,30)_U_$$DT^XLFDT_U_PTCHNAME

 Q

 ;

BLANK ; EP - Blank Line

 D MES^XPDUTL("")

 Q

 ;

MESCNTR(STR) ; EP - Center a line and use XPDUTL to display it

 D MES^XPDUTL($$CJ^XLFSTR(STR,IOM))

 Q

 ;

WOTCNT(BLRVERN) ; EP - Counter for ^XTMP

 NEW CNT,TODAY

 ;

 S TODAY=$$DT^XLFDT

 ;

 S CNT=1+$G(^XTMP(BLRVERN,0,TODAY))

 S ^XTMP(BLRVERN,0,TODAY)=CNT

 Q $TR($J(CNT,3)," ","0")

 ;

INITSCR ; EP - Initialize screen. Cloned from INIT^XPDID

 N X,XPDSTR

 I IO'=IO(0)!(IOST'["C-VT") S XPDIDVT=0 Q

 I $T(PREP^XGF)="" S XPDIDVT=0 Q

 D PREP^XGF

 S XPDIDVT=1,X="IOSTBM",XPDSTR=""

 D ENDR^%ZISS

 S IOTM=3,IOBM=IOSL-4

 W @IOSTBM

 D FRAME^XGF(IOTM-2,0,IOTM-2,IOM-1) ; Top line

 ; D FRAME^XGF(IOBM+1,0,IOBM+1,IOM-1) ; Bottom line

 D IOXY^XGF(IOTM-2,0)

 Q

 ;

POSTMAIL(BLRVERN,CPSTR) ; EP - Post Install MailMan Message

 Q:+$G(DEBUG)   ; No MailMan messages during debugging

 ;

 NEW STR

 ;

 S STR(1)=" "

 S STR(2)=$J("",10)_"POST INSTALL of "_BLRVERN_" Routine."

 S STR(3)=" "

 S STR(4)=$J("",15)_"Laboratory Patch "_CPSTR_" INSTALL completed."

 S STR(5)=" "

 ;

 ; Send E-Mail to LMI Mail Group & Installer

 D MAILALMI^BLRUTIL3("Laboratory Patch "_CPSTR_" INSTALL complete.",.STR,BLRVERN)

 ;

 Q

BLRPRE41  ; IHS/MSC/MKK - RPMS Lab Patch LR*5.2*1041 Pre/Install/Post Routine ; 13-Oct-2017 14:04 ;  MKK

 +1       ;;5.2;IHS LABORATORY;**1041**;NOV 01, 1997;Build 23

 +2       ;

ENVICHEK  ; EP - Environment Checker

 +1        NEW BLRVERN,BLRVERN2,CP,ERRARRAY,ROWSTARS,RPMS,RPMSVER,TODAY,WOTCNT

 +2       ;

 +3        IF $$ENVIVARS()="Q"

               QUIT 

 +4       ;

 +5        DO ENVHEADR^BLRKIDS2(CP,RPMSVER,RPMS)

           DO BLANK

 +6       ;

 +7       ; Lab Pre-Requisite

           DO NEEDIT^BLRKIDS2(CP,"LR","5.2",1040,.ERRARRAY)

           DO BLANK

 +8       ;

 +9       ; ENVIRONMENT HAS ERROR(S)

           IF XPDABORT>0

               DO SORRYEND^BLRKIDS2(.ERRARRAY,CP)

               QUIT 

 +10      ;

 +11       DO BOKAY^BLRKIDS2("ENVIRONMENT")

 +12      ;

 +13       QUIT 

 +14      ;

ENVIVARS() ; EP - Setup the Environment variables

 +1        DO SETEVARS

 +2       ;

 +3        SET TODAY=$$DT^XLFDT

 +4        SET WOTCNT=$$WOTCNT(BLRVERN)

 +5       ; Row of asterisks

           SET ROWSTARS=$TRANSLATE($JUSTIFY("",65)," ","*")

 +6       ;

 +7        SET ^XTMP(BLRVERN,0)=$$HTFM^XLFDT(+$HOROLOG+90)_"^"_$$DT^XLFDT_"^IHS Lab Patch "_CPSTR

 +8        MERGE ^XTMP(BLRVERN,TODAY,WOTCNT,"DUZ")=DUZ

 +9        SET ^XTMP(BLRVERN,TODAY,WOTCNT,"BEGIN")=$$NOW^XLFDT

 +10      ;

 +11       SET XUMF=1

 +12      ;

 +13       IF $GET(XPDNM)=""

               DO SORRY^BLRKIDS2(CP,"XPDNM not defined or 0.")

               QUIT "Q"

 +14      ;

 +15      ; RPMS Module

           SET RPMS=$PIECE(XPDNM,"*",1)

 +16      ; RPMS Version

           SET RPMSVER=$PIECE(XPDNM,"*",2)

 +17      ;

 +18       IF +$GET(DUZ)<1

               DO SORRY^BLRKIDS2(CP,"DUZ UNDEFINED OR 0.")

               QUIT "Q"

 +19       IF $$GET1^DIQ(200,DUZ,"NAME")=""

               DO SORRY^BLRKIDS2(CP,"Installer cannot be identified!")

               QUIT "Q"

 +20      ;

 +21      ; No Queuing Allowed

           SET XPDNOQUE=1

 +22      ;

 +23      ; The following line prevents the "Disable Options..." and "Move

 +24      ; Routines..." questions from being asked during the install.

 +25       FOR X="XPO1","XPZ1","XPZ2","XPI1"

               SET XPDDIQ(X)=0

               SET XPDDIQ(X,"B")="NO"

 +26      ;

 +27      ; KIDS install Flag

           SET XPDABORT=0

 +28      ;

 +29      ; Reset/Initialize IO variables

           DO HOME^%ZIS

 +30      ; Set DT variable without a Line Feed

           DO DTNOLF^DICRW

 +31      ;

 +32       QUIT "OK"

 +33      ;

PRE       ; EP - Ask for confirmation of Backup

 +1        NEW BLRVERN,BLRVERN2,CNT,CP,CPSTR,CRTLINE,DIRASTR,FDAROOT,IEN,IENS,MSGROOT

 +2       ; Current Patch,Backup count

           NEW BCKUPCNT

 +3       ;

 +4        DO SETEVARS

 +5       ;

 +6        SET XUMF=1

 +7       ;

 +8        DO INITSCR

 +9        DO TITLE^XPDID(CPSTR)

 +10       DO BLANK

           DO BMES^XPDUTL("Pre-Install begins "_$$UP^XLFSTR($$HTE^XLFDT($HOROLOG,"5MPZ"))_".")

 +11      ;

 +12       IF $$BACKUP()="Q"

               QUIT 

 +13      ;

 +14       DO INITSCR

 +15       DO TITLE^XPDID(CPSTR)

 +16       DO BLANK

           DO BMES^XPDUTL("Pre-Install of "_BLRVERN_" Continues.")

 +17      ;

 +18      ; Do Pre-install stuff here.

 +19       DO SAVEOFF

 +20      ;

 +21       DO BMES^XPDUTL("Pre-Install ends "_$$UP^XLFSTR($$HTE^XLFDT($HOROLOG,"5MPZ"))_".")

 +22      ; Pause so user can see the message.

           HANG 2

 +23      ;

 +24      ; D EXIT^XPDID

 +25       QUIT 

 +26      ;

BACKUP()  ; EP - Confirm Backup

 +1        NEW BCKUPCNT,SUCCSTR

 +2       ;

 +3        DO SHOWBOX^BLRGMENU("ATTENTION",10,70)

 +4       ;

 +5        DO ^XBFMK

 +6        SET DIR(0)="Y"

 +7        SET DIR("B")="NO"

 +8        IF $GET(IOST)["C-VT"

               SET SUCCSTR=$CHAR(27)_"[1;7;5m"_">> SUCCESSFUL <<"_$CHAR(27)_"[0m"

 +9       IF '$TEST

               SET SUCCSTR=">> SUCCESSFUL <<"

 +10       SET DIR("A")=$JUSTIFY("",10)_"Has a "_SUCCSTR_" backup been performed?"

 +11       SET DIR("?")="A *NO* answer will abort the install process."

 +12       DO ^DIR

 +13       WRITE !

 +14      ;

 +15      ; If BACKUP not performed, then ABORT installation.

           IF +$GET(Y)'=1

               QUIT $$NOBACKUP()

 +16      ;

 +17      ; DEBUG will *NOT* store Backup Confirmation data.

           IF +$GET(DEBUG)

               QUIT $$OKBACKUP()

 +18      ;

 +19      ; Store backup confirmation person & date/time

 +20       SET BCKUPCNT=1+$ORDER(^BLRINSTL("LAB PATCH",CP,"BACKUP CONFIRMED BY",0),-1)

 +21       SET ^BLRINSTL("LAB PATCH",CP,"BACKUP CONFIRMED BY",BCKUPCNT)=$PIECE($GET(^VA(200,DUZ,0)),U)

 +22       SET ^BLRINSTL("LAB PATCH",CP,"BACKUP CONFIRMED BY",BCKUPCNT,"DUZ")=DUZ

 +23       SET ^BLRINSTL("LAB PATCH",CP,"BACKUP CONFIRMED BY",BCKUPCNT,"DATE/TIME")=$$HTE^XLFDT($HOROLOG,"5MZ")

 +24      ;

 +25       QUIT $$OKBACKUP()

 +26      ;

OKBACKUP() ; EP - Backup Confirmed.

 +1        DO BLANK

 +2        DO OKAY^BLRKIDSU("SUCCESSFUL system backup CONFIRMED by: "_$$GET1^DIQ(200,DUZ,"NAME")_".",5)

 +3        IF +$GET(DEBUG)

               Begin DoDot:1

 +4                DO BLANK

 +5                DO TABMENU^BLRKIDSU("DEBUG will **NOT** Store Backup Confirmation.",10)

               End DoDot:1

 +6       ;

 +7       ; Pause to let the user see the message.

           HANG 2

 +8        QUIT "OK"

 +9       ;

NOBACKUP() ; EP - No backup message

 +1        SET XPDABORT=1

 +2        DO PASSMESG^BLRKIDS2("ATTENTION")

 +3        DO TABMESG^BLRKIDSU("SUCCESSFUL system backup has >>> NOT <<< been confirmed.",15)

 +4        DO TABMESG^BLRKIDSU("Installer: "_$$GET1^DIQ(200,DUZ,"NAME")_" ["_DUZ_"].",25)

 +5        DO TABMESG^BLRKIDSU("Install Aborting.",15)

 +6       ; Pause to let the user see the message.

           HANG 2

 +7        QUIT "Q"

 +8       ;

DEBUG     ; EP - Debugging Line Label for environment checker

 +1        NEW BEGTIME,BLRVERN,CP,CPSTR,DEBUG,ENDTIME,ERRARRAY,LASTLOGI

 +2        NEW LRBLNOW,PATCHNUM,PREREQ,QFLG,ROWSTARS,RPMS,RPMSVER,STR

 +3        NEW SUCCSTR,TODAY,WHATCNT,WOTCNT,XPDABORT,XPDENV,XPDNM

 +4       ;

 +5       ; NOTE: DEBUG will not store "Backup" data.

 +6       ;

 +7        DO SETEVARS

 +8       ;

 +9        WRITE !!

 +10       WRITE "Debug Routine ",BLRVERN," Begins:",!!

 +11      ;

 +12      ; Don't Send Alerts

           SET DEBUG=1

 +13      ;

 +14       WRITE !

 +15       SET XPDNM=CPSTR

 +16       SET (XPDENV,XPDABORT)=0

 +17      ;

 +18       DO PRE

 +19       IF XPDABORT

               QUIT 

 +20      ;

 +21       WRITE !!!

 +22      ;

 +23       DO ^XBFMK

 +24       SET DIR(0)="YO"

 +25       SET DIR("B")="NO"

 +26       SET DIR("A")="Test Post Install Code"

 +27       DO ^DIR

 +28      ;

 +29       IF +$GET(Y)=1

               DO POST

 +30      ;

 +31       WRITE !!,"Debug Routine ",BLRVERN," Ends.",!!

 +32       QUIT 

 +33      ;

POST      ; EP - Post-Install

 +1        NEW BLRVERN,BLRVERN2,CP,CPSTR,PATCHNUM,TODAY,WOTCNT

 +2       ;

 +3        DO SETEVARS

 +4       ;

 +5        DO BLANK

 +6        DO BMES^XPDUTL("Laboratory Patch "_CPSTR_" POST INSTALL begins at "_$$UP^XLFSTR($$HTE^XLFDT($HOROLOG,"5MPZ"))_".")

 +7        DO BLANK

 +8       ;

 +9        SET TODAY=$$DT^XLFDT

 +10       SET WOTCNT=$$WOTCNT(BLRVERN)

 +11      ;

 +12      ; Add new options to BLRMENU

           DO ADDOPTS

 +13      ;

 +14      ; VBECS Update

           DO VBECSUPD

 +15      ;

 +16      ; Force new parameters to NO

           DO FORCENO

 +17      ;

 +18      ; Add Descriptions to 3 Mail Groups

           DO ADDDESC

 +19      ;

 +20       IF $LENGTH($GET(^DD(90475.8,0,"VR")))<1

               Begin DoDot:1

 +21               SET FORCEDD="^DD(90475.8,0,""VR"")"

 +22      ; Force Version Number into Data Dictionary.

                   SET @FORCEDD=5.2

 +23               SET FORCEDD="^DD(90475.8,0,""VRPK"")"

 +24      ; Force Lab Link into Data Dictionary.

                   SET @FORCEDD="LR"

               End DoDot:1

 +25      ;

 +26       DO BLANK

 +27       DO BMES^XPDUTL("Laboratory Patch "_CPSTR_" POST INSTALL ends at "_$$UP^XLFSTR($$HTE^XLFDT($HOROLOG,"5MPZ"))_".")

 +28       DO BLANK

 +29      ;

 +30       DO POSTMAIL(BLRVERN,CPSTR)

 +31      ;

 +32       SET ^XTMP(BLRVERN,TODAY,WOTCNT,"END")=$$NOW^XLFDT

 +33       QUIT 

 +34      ;

ADDOPTS   ; EP - Add new options

 +1        DO ADDOPTS^BLRKIDS2("BLRMENU","BLR PARMETERS AND MAIL GROUPS","PAMG")

 +2        DO ADDOPTS^BLRKIDS2("BLRMENU","BLROLOR","ORDO")

 +3       ; D ADDOPTS^BLRKIDS2("BLRMENU","BLRPURGU","PURG")

 +4        DO ADDOPTS^BLRKIDS2("LRSUPERVISOR","BLRPURGU","PURR")

 +5        DO ADDOPTS^BLRKIDS2("BLRMENU","BLR PATIENT REMINDER DOCUMENT","PDOC")

 +6        DO ADDOPTS^BLRKIDS2("BLRMENU","BLRERRTR","ERRT")

 +7        QUIT 

 +8       ;

FORCENO   ; EP - Force new parameters to be NO

 +1        NEW (DEBUG,DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)

 +2       ;

 +3        DO SETBLRVS

 +4        IF '$$GETPARS(.PARSLIST)

               QUIT 

 +5       ;

 +6       ; If DEBUG, just print messages & quit

           IF +$GET(DEBUG)

               Begin DoDot:1

 +7                SET TAB=$JUSTIFY("",10)

 +8                DO BLANK

                   DO OKAY^BLRKIDSU("DEBUG: FORCENO^"_BLRVERN,4)

 +9                SET PARAMETER=""

 +10               FOR 

                       SET PARAMETER=$ORDER(PARSLIST(PARAMETER))

                       IF PARAMETER=""

                           QUIT 

                       Begin DoDot:2

 +11                       DO MES^XPDUTL(TAB_"DEBUG will *NOT* modify "_PARAMETER_" parameter.")

                       End DoDot:2

               End DoDot:1

               QUIT 

 +12      ;

 +13       SET PARAMETER=""

 +14       FOR 

               SET PARAMETER=$ORDER(PARSLIST(PARAMETER))

               IF PARAMETER=""

                   QUIT 

               Begin DoDot:1

 +15               KILL ERRS

 +16               DO EN^XPAR("PKG",PARAMETER,,"NO",.ERRS)

 +17               IF +$GET(ERRS)

                       Begin DoDot:2

 +18                       DO BLANK

                           DO MES^XPDUTL(PARAMETER_" parameter not modified.")

                           DO BLANK

 +19                       DO STORERRS^BLREMERA(ERRS,PARAMETER)

                       End DoDot:2

               End DoDot:1

 +20       QUIT 

 +21      ;

GETPARS(PARSLIST) ; EP - Function to get Parameters from BUILD file

 +1        NEW (DEBUG,DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,PARSLIST,U,XPARSYS,XQXFLG)

 +2       ;

 +3        DO SETEVARS

 +4       ;

 +5        SET BUILDIEN=$$FIND1^DIC(9.6,,,CPSTR)

 +6        IF BUILDIEN<1

               QUIT 0

 +7       ;

 +8        SET PARAMTRS=""

           SET CNT=0

 +9        FOR 

               SET PARAMTRS=$ORDER(^XPD(9.6,BUILDIEN,"KRN",8989.51,"NM","B",PARAMTRS))

               IF PARAMTRS=""

                   QUIT 

               Begin DoDot:1

 +10               SET PARSLIST(PARAMTRS)=""

                   SET CNT=CNT+1

               End DoDot:1

 +11      ;

 +12       QUIT CNT

 +13      ;

 +14      ;

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)

 +2       ;

 +3       ; If not Cache, cannot use ^%R

           IF $GET(^%ZOSF("OS"))'["OpenM"

               QUIT