BLRPRE1 ; IHS/HQW/TPF - ENVIRONMENT CHECK FOR PATCH 13; [ 10/09/2002 6:55 AM ]
;;5.2;LR;**1014**;OCT 9, 2002
S $P(LINE,"*",81)=""
S XPDNOQUE="NO QUE" ;NO QUEUING ALLOWED
S XPDABORT=0
I '$G(DUZ) W !,"DUZ UNDEFINED OR 0." D SORRY Q
;
I '$L($G(DUZ(0))) W !,"DUZ(0) UNDEFINED OR NULL." D SORRY Q
;
D HOME^%ZIS,DT^DICRW
S X=$P($G(^VA(200,DUZ,0)),U)
I $G(X)="" W !,$$C^XBFUNC("Who are you????") D SORRY Q
W !,$$C^XBFUNC("Hello, "_$P(X,",",2)_" "_$P(X,","))
W !!,$$C^XBFUNC("Checking Environment for Patch "_$P($T(+2),";",5)_" of Version "_$P($T(+2),";",3)_" of "_$P($T(+2),";",4)_".")
;
S X=$G(^DD("VERSION"))
W !!,$$C^XBFUNC("Need at least FileMan 21.....FileMan "_X_" Present")
I X<21 D SORRY Q
;
S X=$G(^DIC(9.4,$O(^DIC(9.4,"C","XU",0)),"VERSION"))
W !!,$$C^XBFUNC("Need at least Kernel 8.0.....Kernel "_X_" Present")
I X<8.0 D SORRY Q
;
VERSION ;
;CHECK FOR PREVIOUS PATCH NEEDED
S %=$D(^XPD("9.7","B","LR*5.2*1013"))
I '% D Q
. W !,$$C^XBFUNC("Patch 1014 of version 5.2 of the RPMS Laboratory Package Cannot Be Installed Unless")
. W !,$$C^XBFUNC("Patch 1013 of version 5.2 Has not Been Previously Installed.")
. D SORRY
. I $$DIR^XBDIR("E","Press RETURN...")
;
;GET INSTALL STATUS
S %=$O(^XPD("9.7","B","LR*5.2*1013",""))
S LRSTATUS=$P($G(^XPD(9.7,%,0)),U,9)
I LRSTATUS'=3 D Q ;IF INSTALL STATUS NOT COMPLETE QUIT
.W !,$$C^XBFUNC("Install of Patch 1013 not complete!")
.D SORRY
.I $$DIR^XBDIR("E","Press RETURN...")
;
W !!!,$$C^XBFUNC("Patch 1013 of version LR 5.2 Has Been Previously Installed......OK to continue")
;
;
ENVOK ; If this is just an environ check, end here.
W !!,$$C^XBFUNC("ENVIRONMENT OK.")
;
; The following line prevents the "Disable Options..." and "Move
; Routines..." questions from being asked during the install.
I $G(XPDENV)=1 S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
;
;VERIFY BACKUPS HAVE BEEN DONE
W !!
S DIR(0)="Y"
S DIR("B")="NO"
S DIR("A")="Has a SUCCESSFUL system backup been performed??"
D ^DIR
I $D(DIRUT)!($G(Y)=0) S XPDABORT=1 Q
S ^TMP("BLRAPRE","BACKUPS CONFIRMED BY "_DUZ)=$H
;
Q
SORRY ;
K DIFQ
S XPDABORT=1
W *7,!!!,$$C^XBFUNC("Sorry....something is wrong with your enviroment")
W !,$$C^XBFUNC("Aborting Electronic Signature Plug-in install!")
W !,$$C^XBFUNC("Please print/capture this screen and notify")
W !,$$C^XBFUNC("the Help Desk")
W !!,LINE
Q
BLRPRE1 ; IHS/HQW/TPF - ENVIRONMENT CHECK FOR PATCH 13; [ 10/09/2002 6:55 AM ]
+1 ;;5.2;LR;**1014**;OCT 9, 2002
+2 SET $PIECE(LINE,"*",81)=""
+3 ;NO QUEUING ALLOWED
SET XPDNOQUE="NO QUE"
+4 SET XPDABORT=0
+5 IF '$GET(DUZ)
WRITE !,"DUZ UNDEFINED OR 0."
DO SORRY
QUIT
+6 ;
+7 IF '$LENGTH($GET(DUZ(0)))
WRITE !,"DUZ(0) UNDEFINED OR NULL."
DO SORRY
QUIT
+8 ;
+9 DO HOME^%ZIS
DO DT^DICRW
+10 SET X=$PIECE($GET(^VA(200,DUZ,0)),U)
+11 IF $GET(X)=""
WRITE !,$$C^XBFUNC("Who are you????")
DO SORRY
QUIT
+12 WRITE !,$$C^XBFUNC("Hello, "_$PIECE(X,",",2)_" "_$PIECE(X,","))
+13 WRITE !!,$$C^XBFUNC("Checking Environment for Patch "_$PIECE($TEXT(+2),";",5)_" of Version "_$PIECE($TEXT(+2),";",3)_" of "_$PIECE($TEXT(+2),";",4)_".")
+14 ;
+15 SET X=$GET(^DD("VERSION"))
+16 WRITE !!,$$C^XBFUNC("Need at least FileMan 21.....FileMan "_X_" Present")
+17 IF X<21
DO SORRY
QUIT
+18 ;
+19 SET X=$GET(^DIC(9.4,$ORDER(^DIC(9.4,"C","XU",0)),"VERSION"))
+20 WRITE !!,$$C^XBFUNC("Need at least Kernel 8.0.....Kernel "_X_" Present")
+21 IF X<8.0
DO SORRY
QUIT
+22 ;
VERSION ;
+1 ;CHECK FOR PREVIOUS PATCH NEEDED
+2 SET %=$DATA(^XPD("9.7","B","LR*5.2*1013"))
+3 IF '%
Begin DoDot:1
+4 WRITE !,$$C^XBFUNC("Patch 1014 of version 5.2 of the RPMS Laboratory Package Cannot Be Installed Unless")
+5 WRITE !,$$C^XBFUNC("Patch 1013 of version 5.2 Has not Been Previously Installed.")
+6 DO SORRY
+7 IF $$DIR^XBDIR("E","Press RETURN...")
End DoDot:1
QUIT
+8 ;
+9 ;GET INSTALL STATUS
+10 SET %=$ORDER(^XPD("9.7","B","LR*5.2*1013",""))
+11 SET LRSTATUS=$PIECE($GET(^XPD(9.7,%,0)),U,9)
+12 ;IF INSTALL STATUS NOT COMPLETE QUIT
IF LRSTATUS'=3
Begin DoDot:1
+13 WRITE !,$$C^XBFUNC("Install of Patch 1013 not complete!")
+14 DO SORRY
+15 IF $$DIR^XBDIR("E","Press RETURN...")
End DoDot:1
QUIT
+16 ;
+17 WRITE !!!,$$C^XBFUNC("Patch 1013 of version LR 5.2 Has Been Previously Installed......OK to continue")
+18 ;
+19 ;
ENVOK ; If this is just an environ check, end here.
+1 WRITE !!,$$C^XBFUNC("ENVIRONMENT OK.")
+2 ;
+3 ; The following line prevents the "Disable Options..." and "Move
+4 ; Routines..." questions from being asked during the install.
+5 IF $GET(XPDENV)=1
SET (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
+6 ;
+7 ;VERIFY BACKUPS HAVE BEEN DONE
+8 WRITE !!
+9 SET DIR(0)="Y"
+10 SET DIR("B")="NO"
+11 SET DIR("A")="Has a SUCCESSFUL system backup been performed??"
+12 DO ^DIR
+13 IF $DATA(DIRUT)!($GET(Y)=0)
SET XPDABORT=1
QUIT
+14 SET ^TMP("BLRAPRE","BACKUPS CONFIRMED BY "_DUZ)=$HOROLOG
+15 ;
+16 QUIT
SORRY ;
+1 KILL DIFQ
+2 SET XPDABORT=1
+3 WRITE *7,!!!,$$C^XBFUNC("Sorry....something is wrong with your enviroment")
+4 WRITE !,$$C^XBFUNC("Aborting Electronic Signature Plug-in install!")
+5 WRITE !,$$C^XBFUNC("Please print/capture this screen and notify")
+6 WRITE !,$$C^XBFUNC("the Help Desk")
+7 WRITE !!,LINE
+8 QUIT
