BLRPRE32.m

BLRPRE32 ; IHS/OIT/MKK - IHS Lab Patch 1032 Pre/Post/Environment Routine ; [ February 29, 2012 8:00 AM ]

 ;;5.2;IHS LABORATORY;**1032**;NOV 01, 1997

 ;

PRE ; EP

 NEW CP,PREREQ,RPMS,RPMSVER,QFLG,ROWSTARS,STR

 NEW ERRARRAY                 ; Errors array

 ;

 D BMES^XPDUTL("Beginning of Pre Check.")

 ;

 I $G(XPDNM)="" D  Q

 . S CP=$TR($P($T(+2),";",5),"*")

 . D SORRY^BLRPRE31(CP,"XPDNM not defined or 0.")

 ;

 S CP=$P(XPDNM,"*",3)        ; Patch Number

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

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

 ;

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

 ;

USERID ; EP - CHECK FOR USER ID

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

 ;

 I $P($G(^VA(200,DUZ,0)),U)="" D SORRY^BLRPRE31(CP,"Installer cannot be identified!")  Q

 ;

GETREADY ; EP

 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

 ;

ENVICHEK ; Environment Checker

 D ENVHEADR(CP,RPMSVER,RPMS)

 ;

 D NEEDIT^BLRPRE31(CP,"LR","5.2",1031,.ERRARRAY)  ; Lab Pre-Requisites

 ;

 D MES^XPDUTL("")

 ;

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

 ;

 D BOKAY^BLRPRE31("ENVIRONMENT")

 ;

 Q

 ;

ENVHEADR(CP,RPMSVER,RPMS) ; EP -- Environment Header

 NEW FULLNAME,LINE1,LINE2,STARS,TIMESTR

 S STARS=$TR($J("",IOM)," ","*")

 ;

 S LINE1="@Checking@Environment@for@Patch@"_CP_"@of@"

 S LINE2=$TR($$CJ^XLFSTR("@Version@"_RPMSVER_"@of@the@"_$TR("Laboratory Service Package"," ","@")_"@",$L(LINE1))," ","@")

 S LINE1=$TR($$CJ^XLFSTR(LINE1,$L(LINE2))," ","@")    ; Make LINE1 same width as LINE2.

 ;

 S TIMESTR=$TR($$CJ^XLFSTR("at "_$$UP^XLFSTR($$HTE^XLFDT($H,"5MPZ")),$L(LINE2))," ","@")

 ;

 D ^XBCLS

 W STARS,!

 W $TR($$CJ^XLFSTR(LINE1,IOM)," @","* "),!

 W $TR($$CJ^XLFSTR(LINE2,IOM)," @","* "),!

 W $TR($$CJ^XLFSTR(TIMESTR,IOM)," @","* "),!

 W STARS,!

 Q

 ;

POST ; EP -- POST INSTALL

 NEW CP,POSTMSG,STR

 ;

 S CP=$P($T(+2),"*",3)  ; Current Patch

 S POSTMSG="Laboratory Patch "_CP_" INSTALL completed."

 ;

 ; Store # of times installation occurred as well as person & date/time

 D ENDINSTL^BLRPRE31(CP)

 ;

 D BMES^XPDUTL("Laboratory Patch "_CP_" INSTALL complete.")

 ;

 S STR(1)=" "

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

 S STR(3)=" "

 S STR(4)=$J("",15)_POSTMSG

 S STR(5)=" "

 ;

 D MAILALMI^BLRUTIL3(POSTMSG,.STR,"IHS Lab Patch 1032")

 ;

 Q

 ;

DEBUG ; EP - Debugging Line Label for environment checker

 NEW CP,DEBUG,RPMS,RPMSVER,QFLG,STR

 W !!

 W "Debug BLRPRE32.",!!

 ;

 ; Note -- DEBUG is a negative flag:

 ;         YES="Don't Send Alerts"; NO="Send Alerts"

 S DEBUG="YES"

 D ^XBFMK

 S DIR(0)="YO"

 S DIR("B")="NO"

 S DIR("A")="Send Alerts/E-Mails"

 D ^DIR

 S:+$G(Y)=1 DEBUG="NO"

 ;

 W !

 S XPDNM="LR*5.2*1032"

 S XPDENV=0

 ;

 D PRESSKEY^BLRGMENU(4)

 ;

 D PRE

 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 !!!

 ;

 Q

 ;

BCKUPRPT ; EP - Report on the BLRINSTL global

 NEW CNT,HD1,HEADER,LINES,MAXLINES,PG,QFLG

 NEW BACKUP,BCKUPDT,BCKUPWHO,HOWMANY,INSTLDT,INSTLWHO,PATCH

 ;

 S HEADER(1)="^BLRINSTL Global Report"

 S HEADER(2)="Lab Package Installation"

 S HEADER(3)=" "

 S $E(HEADER(4),4)="Patch"

 S $E(HEADER(4),11)="#"

 S $E(HEADER(4),15)="Who Installed"

 S $E(HEADER(4),45)="Install Date/Time"

 S MAXLINES=20,LINES=MAXLINES+10,PG=0,(HD1,QFLG)="NO"

 ;

 S PATCH=1018

 F  S PATCH=$O(^BLRINSTL("LAB PATCH",PATCH))  Q:PATCH<1!(QFLG="Q")  D

 . S HOWMANY=0

 . F  S HOWMANY=$O(^BLRINSTL("LAB PATCH",PATCH,"INSTALLED BY",HOWMANY))  Q:HOWMANY<1!(QFLG="Q")  D

 .. I LINES>MAXLINES D HEADERPG^BLRGMENU(.PG,QFLG,HD1)  Q:QFLG="Q"

 .. ;

 .. S INSTLWHO=$G(^BLRINSTL("LAB PATCH",PATCH,"INSTALLED BY",HOWMANY))

 .. S:INSTLWHO["^" INSTLWHO=$P(INSTLWHO,"^",2)

 .. S INSTLDT=$G(^BLRINSTL("LAB PATCH",PATCH,"INSTALLED BY",HOWMANY,"DATE/TIME"))

 .. ;

 .. W ?4,PATCH

 .. W ?9,$J(HOWMANY,2)

 .. W ?14,INSTLWHO

 .. W ?44,INSTLDT

 .. W !

 .. S LINES=LINES+1

 ;

 D ^XBFMK

 S DIR(0)="YO"

 S DIR("A")="BACKUP LISTING"

 S DIR("B")="YES"

 D ^DIR

 I +$G(Y)'=1 D  Q

 . W !,?4,"No BACKUP report requested from ^BLRINSTL global.  Routine Ends.",!

 . D PRESSKEY^BLRGMENU(9)

 ;

 S MAXLINES=20,LINES=MAXLINES+10,PG=0,(HD1,QFLG)="NO"

 ;

 K HEADER(2)

 S HEADER(2)="Backup Confirmation"

 ;

 K HEADER(4)

 S $E(HEADER(4),4)="Patch"

 S $E(HEADER(4),11)="#"

 S $E(HEADER(4),15)="Who Confirmed"

 S $E(HEADER(4),45)="When Confirmed"

 ;

 S PATCH=1018

 F  S PATCH=$O(^BLRINSTL("LAB PATCH",PATCH))  Q:PATCH<1!(QFLG="Q")  D

 . S HOWMANY=0

 . F  S HOWMANY=$O(^BLRINSTL("LAB PATCH",PATCH,"BACKUP CONFIRMED BY",HOWMANY))  Q:HOWMANY<1!(QFLG="Q")  D

 .. I LINES>MAXLINES D HEADERPG^BLRGMENU(.PG,QFLG,HD1)  Q:QFLG="Q"

 .. ;

 .. S INSTLWHO=$G(^BLRINSTL("LAB PATCH",PATCH,"BACKUP CONFIRMED BY",HOWMANY))

 .. S:INSTLWHO["^" INSTLWHO=$P(INSTLWHO,"^",2)

 .. S INSTLDT=$G(^BLRINSTL("LAB PATCH",PATCH,"BACKUP CONFIRMED BY",HOWMANY,"DATE/TIME"))

 .. ;

 .. W ?4,PATCH

 .. W ?9,$J(HOWMANY,2)

 .. W ?14,INSTLWHO

 .. W ?44,INSTLDT

 .. W !

 .. S LINES=LINES+1

 Q

BLRPRE32  ; IHS/OIT/MKK - IHS Lab Patch 1032 Pre/Post/Environment Routine ; [ February 29, 2012 8:00 AM ]

 +1       ;;5.2;IHS LABORATORY;**1032**;NOV 01, 1997

 +2       ;

PRE       ; EP

 +1        NEW CP,PREREQ,RPMS,RPMSVER,QFLG,ROWSTARS,STR

 +2       ; Errors array

           NEW ERRARRAY

 +3       ;

 +4        DO BMES^XPDUTL("Beginning of Pre Check.")

 +5       ;

 +6        IF $GET(XPDNM)=""

               Begin DoDot:1

 +7                SET CP=$TRANSLATE($PIECE($TEXT(+2),";",5),"*")

 +8                DO SORRY^BLRPRE31(CP,"XPDNM not defined or 0.")

               End DoDot:1

               QUIT 

 +9       ;

 +10      ; Patch Number

           SET CP=$PIECE(XPDNM,"*",3)

 +11      ; RPMS Module

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

 +12      ; RPMS Version

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

 +13      ;

 +14      ; Row of asterisks

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

 +15      ;

USERID    ; EP - CHECK FOR USER ID

 +1        IF +$GET(DUZ)<1

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

               QUIT 

 +2       ;

 +3        IF $PIECE($GET(^VA(200,DUZ,0)),U)=""

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

               QUIT 

 +4       ;

GETREADY  ; EP

 +1       ; No Queuing Allowed

           SET XPDNOQUE=1

 +2       ;

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

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

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

               SET XPDDIQ(X)=0

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

 +6       ;

 +7       ; KIDS install Flag

           SET XPDABORT=0

 +8       ;

 +9       ; Reset/Initialize IO variables

           DO HOME^%ZIS

 +10      ; Set DT variable without a Line Feed

           DO DTNOLF^DICRW

 +11      ;

ENVICHEK  ; Environment Checker

 +1        DO ENVHEADR(CP,RPMSVER,RPMS)

 +2       ;

 +3       ; Lab Pre-Requisites

           DO NEEDIT^BLRPRE31(CP,"LR","5.2",1031,.ERRARRAY)

 +4       ;

 +5        DO MES^XPDUTL("")

 +6       ;

 +7       ; ENVIRONMENT HAS ERROR(S)

           IF XPDABORT>0

               DO SORRYEND^BLRPRE31(.ERRARRAY,CP)

               QUIT 

 +8       ;

 +9        DO BOKAY^BLRPRE31("ENVIRONMENT")

 +10      ;

 +11       QUIT 

 +12      ;

ENVHEADR(CP,RPMSVER,RPMS) ; EP -- Environment Header

 +1        NEW FULLNAME,LINE1,LINE2,STARS,TIMESTR

 +2        SET STARS=$TRANSLATE($JUSTIFY("",IOM)," ","*")

 +3       ;

 +4        SET LINE1="@Checking@Environment@for@Patch@"_CP_"@of@"

 +5        SET LINE2=$TRANSLATE($$CJ^XLFSTR("@Version@"_RPMSVER_"@of@the@"_$TRANSLATE("Laboratory Service Package"," ","@")_"@",$LENGTH(LINE1))," ","@")

 +6       ; Make LINE1 same width as LINE2.

           SET LINE1=$TRANSLATE($$CJ^XLFSTR(LINE1,$LENGTH(LINE2))," ","@")

 +7       ;

 +8        SET TIMESTR=$TRANSLATE($$CJ^XLFSTR("at "_$$UP^XLFSTR($$HTE^XLFDT($HOROLOG,"5MPZ")),$LENGTH(LINE2))," ","@")

 +9       ;

 +10       DO ^XBCLS

 +11       WRITE STARS,!

 +12       WRITE $TRANSLATE($$CJ^XLFSTR(LINE1,IOM)," @","* "),!

 +13       WRITE $TRANSLATE($$CJ^XLFSTR(LINE2,IOM)," @","* "),!

 +14       WRITE $TRANSLATE($$CJ^XLFSTR(TIMESTR,IOM)," @","* "),!

 +15       WRITE STARS,!

 +16       QUIT 

 +17      ;

POST      ; EP -- POST INSTALL

 +1        NEW CP,POSTMSG,STR

 +2       ;

 +3       ; Current Patch

           SET CP=$PIECE($TEXT(+2),"*",3)

 +4        SET POSTMSG="Laboratory Patch "_CP_" INSTALL completed."

 +5       ;

 +6       ; Store # of times installation occurred as well as person & date/time

 +7        DO ENDINSTL^BLRPRE31(CP)

 +8       ;

 +9        DO BMES^XPDUTL("Laboratory Patch "_CP_" INSTALL complete.")

 +10      ;

 +11       SET STR(1)=" "

 +12       SET STR(2)=$JUSTIFY("",10)_"POST INSTALL of BLRPRE32 Routine."

 +13       SET STR(3)=" "

 +14       SET STR(4)=$JUSTIFY("",15)_POSTMSG

 +15       SET STR(5)=" "

 +16      ;

 +17       DO MAILALMI^BLRUTIL3(POSTMSG,.STR,"IHS Lab Patch 1032")

 +18      ;

 +19       QUIT 

 +20      ;

DEBUG     ; EP - Debugging Line Label for environment checker

 +1        NEW CP,DEBUG,RPMS,RPMSVER,QFLG,STR

 +2        WRITE !!

 +3        WRITE "Debug BLRPRE32.",!!

 +4       ;

 +5       ; Note -- DEBUG is a negative flag:

 +6       ;         YES="Don't Send Alerts"; NO="Send Alerts"

 +7        SET DEBUG="YES"

 +8        DO ^XBFMK

 +9        SET DIR(0)="YO"

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

 +11       SET DIR("A")="Send Alerts/E-Mails"

 +12       DO ^DIR

 +13       IF +$GET(Y)=1

               SET DEBUG="NO"

 +14      ;

 +15       WRITE !

 +16       SET XPDNM="LR*5.2*1032"

 +17       SET XPDENV=0

 +18      ;

 +19       DO PRESSKEY^BLRGMENU(4)

 +20      ;

 +21       DO PRE

 +22       WRITE !!!

 +23      ;

 +24       DO ^XBFMK

 +25       SET DIR(0)="YO"

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

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

 +28       DO ^DIR

 +29      ;

 +30       IF +$GET(Y)=1

               DO POST

 +31       WRITE !!!

 +32      ;

 +33       QUIT 

 +34      ;

BCKUPRPT  ; EP - Report on the BLRINSTL global

 +1        NEW CNT,HD1,HEADER,LINES,MAXLINES,PG,QFLG

 +2        NEW BACKUP,BCKUPDT,BCKUPWHO,HOWMANY,INSTLDT,INSTLWHO,PATCH

 +3       ;

 +4        SET HEADER(1)="^BLRINSTL Global Report"

 +5        SET HEADER(2)="Lab Package Installation"

 +6        SET HEADER(3)=" "

 +7        SET $EXTRACT(HEADER(4),4)="Patch"

 +8        SET $EXTRACT(HEADER(4),11)="#"

 +9        SET $EXTRACT(HEADER(4),15)="Who Installed"

 +10       SET $EXTRACT(HEADER(4),45)="Install Date/Time"

 +11       SET MAXLINES=20

           SET LINES=MAXLINES+10

           SET PG=0

           SET (HD1,QFLG)="NO"

 +12      ;

 +13       SET PATCH=1018

 +14       FOR 

               SET PATCH=$ORDER(^BLRINSTL("LAB PATCH",PATCH))

               IF PATCH<1!(QFLG="Q")

                   QUIT 

               Begin DoDot:1

 +15               SET HOWMANY=0

 +16               FOR 

                       SET HOWMANY=$ORDER(^BLRINSTL("LAB PATCH",PATCH,"INSTALLED BY",HOWMANY))

                       IF HOWMANY<1!(QFLG="Q")

                           QUIT 

                       Begin DoDot:2

 +17                       IF LINES>MAXLINES

                               DO HEADERPG^BLRGMENU(.PG,QFLG,HD1)

                               IF QFLG="Q"

                                   QUIT 

 +18      ;

 +19                       SET INSTLWHO=$GET(^BLRINSTL("LAB PATCH",PATCH,"INSTALLED BY",HOWMANY))

 +20                       IF INSTLWHO["^"

                               SET INSTLWHO=$PIECE(INSTLWHO,"^",2)

 +21                       SET INSTLDT=$GET(^BLRINSTL("LAB PATCH",PATCH,"INSTALLED BY",HOWMANY,"DATE/TIME"))

 +22      ;

 +23                       WRITE ?4,PATCH

 +24                       WRITE ?9,$JUSTIFY(HOWMANY,2)

 +25                       WRITE ?14,INSTLWHO

 +26                       WRITE ?44,INSTLDT

 +27                       WRITE !

 +28                       SET LINES=LINES+1

                       End DoDot:2

               End DoDot:1

 +29      ;

 +30       DO ^XBFMK

 +31       SET DIR(0)="YO"

 +32       SET DIR("A")="BACKUP LISTING"

 +33       SET DIR("B")="YES"

 +34       DO ^DIR

 +35       IF +$GET(Y)'=1

               Begin DoDot:1

 +36               WRITE !,?4,"No BACKUP report requested from ^BLRINSTL global.  Routine Ends.",!

 +37               DO PRESSKEY^BLRGMENU(9)

               End DoDot:1

               QUIT 

 +38      ;

 +39       SET MAXLINES=20

           SET LINES=MAXLINES+10

           SET PG=0

           SET (HD1,QFLG)="NO"

 +40      ;

 +41       KILL HEADER(2)

 +42       SET HEADER(2)="Backup Confirmation"

 +43      ;

 +44       KILL HEADER(4)

 +45       SET $EXTRACT(HEADER(4),4)="Patch"

 +46       SET $EXTRACT(HEADER(4),11)="#"

 +47       SET $EXTRACT(HEADER(4),15)="Who Confirmed"

 +48       SET $EXTRACT(HEADER(4),45)="When Confirmed"

 +49      ;

 +50       SET PATCH=1018

 +51       FOR 

               SET PATCH=$ORDER(^BLRINSTL("LAB PATCH",PATCH))

               IF PATCH<1!(QFLG="Q")

                   QUIT 

               Begin DoDot:1

 +52               SET HOWMANY=0

 +53               FOR 

                       SET HOWMANY=$ORDER(^BLRINSTL("LAB PATCH",PATCH,"BACKUP CONFIRMED BY",HOWMANY))

                       IF HOWMANY<1!(QFLG="Q")

                           QUIT 

                       Begin DoDot:2

 +54                       IF LINES>MAXLINES

                               DO HEADERPG^BLRGMENU(.PG,QFLG,HD1)

                               IF QFLG="Q"

                                   QUIT 

 +55      ;

 +56                       SET INSTLWHO=$GET(^BLRINSTL("LAB PATCH",PATCH,"BACKUP CONFIRMED BY",HOWMANY))

 +57                       IF INSTLWHO["^"

                               SET INSTLWHO=$PIECE(INSTLWHO,"^",2)

 +58                       SET INSTLDT=$GET(^BLRINSTL("LAB PATCH",PATCH,"BACKUP CONFIRMED BY",HOWMANY,"DATE/TIME"))

 +59      ;

 +60                       WRITE ?4,PATCH

 +61                       WRITE ?9,$JUSTIFY(HOWMANY,2)

 +62                       WRITE ?14,INSTLWHO

 +63                       WRITE ?44,INSTLDT

 +64                       WRITE !

 +65                       SET LINES=LINES+1

                       End DoDot:2

               End DoDot:1

 +66       QUIT