BLRPRE19 ; IHS/ITSC/MKK - ENVIRONMENT CHECK FOR PATCH 19; [ 08/20/2004 2:15 PM ]
;;5.2;LR;**1019**;MAR 25, 2005
;
S $P(LINE,"*",81)=""
S XPDNOQUE="NO QUE" ;NO QUEUING ALLOWED
S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0 ;DISABLE THE "Disable options..." and "Move routines..." questions from being asked during install
S XPDDIQ("XPO1")=0 ;DISABLE "Rebuild Menu Tree" question
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) D BMES^XPDUTL("Installer cannot be identified!") D SORRY Q
D BMES^XPDUTL("Hello, "_$P(X,",",2)_" "_$P(X,","))
D BMES^XPDUTL("Checking Environment for Patch "_$P($T(+2),";",5)_" of Version "_$P($T(+2),";",3)_" of "_$P($T(+2),";",4)_".")
;
S X=$G(^DD("VERSION"))
D BMES^XPDUTL("Need at least FileMan 22.....FileMan "_X_" Present")
I X<22 D SORRY Q
;
S X=$G(^DIC(9.4,$O(^DIC(9.4,"C","XU",0)),"VERSION"))
D BMES^XPDUTL("Need at least Kernel 8.0.....Kernel "_X_" Present")
I X<8.0 D SORRY Q
;
D BMES^XPDUTL("Must have 'LMI' mail group present....")
I $$CHECKLMI<0 D SORRY Q
D BMES^XPDUTL("'LMI' mail group found. OK")
;
S X=$G(^DIC(9.4,$O(^DIC(9.4,"C","OR",0)),"VERSION"))
D BMES^XPDUTL("Need at least ORDER ENTRY/RESULTS REPORTING (OERR) 2.5.....OERR "_X_" Present")
I X<2.5 D SORRY Q
;
S X=$G(^DIC(9.4,$O(^DIC(9.4,"C","PIMS",0)),"VERSION"))
D BMES^XPDUTL("Need at least PIMS 5.3.....PIMS "_X_" Present")
I X<5.3 D SORRY Q
;
S X=$G(^DIC(9.4,$O(^DIC(9.4,"C","LEX",0)),"VERSION"))
D BMES^XPDUTL("Need at least LEXICON 2.0.....LEXICON "_X_" Present")
I X<2.0 D SORRY Q
;
VERSION ;
;CHECK FOR PREVIOUS PATCH NEEDED
S %=$D(^XPD("9.7","B","LR*5.2*1018"))
I '% D Q
. NEW STR
. S STR="Patch 1019 of version 5.2 of the RPMS Laboratory Package"
. S STR=STR_" CANNOT be"_$C(13)_$C(10)
. S STR=STR_"installed unless Patch 1018 of version 5.2 has been previously"
. S STR=STR_" installed."_$C(13)_$C(10)
. D BMES^XPDUTL(STR)
. D SORRY
;
;GET INSTALL STATUS
S %=$O(^XPD("9.7","B","LR*5.2*1018",""))
S LRSTATUS=$P($G(^XPD(9.7,%,0)),U,9)
I LRSTATUS'=3 D Q ;IF INSTALL STATUS NOT COMPLETE QUIT
.D BMES^XPDUTL("Install of Patch 1018 not complete!")
.D SORRY
;
D BMES^XPDUTL("Patch 1018 of version LR 5.2 Has Been Previously Installed......OK to continue")
;
;
;
ENVOK ; If this is just an environ check, end here.
D BMES^XPDUTL("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) D BMES^XPDUTL("Please perform a successful backup before contnuing!!") S XPDABORT=1 Q
S %DT="R",X="NOW" D ^%DT X ^DD("DD")
D BMES^XPDUTL("BACKUPS CONFIRMED BY "_$P($G(^VA(200,DUZ,0)),U)_" ON "_$P(Y,"@")_" AT "_$P(Y,"@",2))
S ^BLRINSTL("INSTALLED BY")=$P($G(^VA(200,DUZ,0)),U)
;
Q
;
SORRY ;
K DIFQ
S XPDABORT=1
; D BMES^XPDUTL("Sorry....something is wrong with your enviroment")
; D BMES^XPDUTL("for a Lab 5.2 Patch 1019 install!")
NEW STR
S STR="Sorry....something is wrong with your enviroment for"
S STR=STR_" an install of"_$C(13)_$C(10)_$$CJ^XLFSTR("Lab 5.2 Patch 1019",65)
D BMES^XPDUTL(STR)
; D BMES^XPDUTL("Please print/capture this screen and notify the Support Center at")
; D BMES^XPDUTL($$CJ^XLFSTR("1-999-999-9999",65))
S STR="Please print/capture this screen and notify the Support Center"
S STR=STR_" at"_$C(13)_$C(10)_$$CJ^XLFSTR("1-999-999-9999",65)_$C(13)_$C(10)
D BMES^XPDUTL(STR)
Q
;
;CHECK FOR LMI MAIL GROUP
CHECKLMI() ;
S DIC="^XMB(3.8,"
S X="LMI"
D ^DIC
Q +Y
;
POST ;
NEW STR
S STR=$$CJ^XLFSTR("Updating MODULE PCC LINK CONTROL failed",65)
S STR=$C(13)_$C(10)_"Please print/capture this screen and notify the Support Center"
S STR=STR_" at"_$C(13)_$C(10)_$$CJ^XLFSTR("1-999-999-9999",65)_$C(13)_$C(10)
;
S STR=$$KILL^ZIBGCHAR("BLRENTRY") ; Clear Tracking global
;
; The following code adds the correct PCC Merge code. The original code
; for LAB in the MODULE PCC LINK CONTROL dictionary is trying to call the
; ALRLINK routine, which was deleted years ago.
;
S BLRX=$O(^APCDLINK("B","LABORATORY",0)) ;get ien of entry
I 'BLRX D ADD ;if it doesn't exist add it
;
; Check to determine if valid routine (BZHELR) already exists in dictionary.
; If it does exist, just quit
I $G(^APCDLINK(BLRX,1))["BZHELR" Q
;
;if not, now edit it
S DA=BLRX
S DIE="^APCDLINK("
S DR="1////S BLROSAV=$G(X),X=""BLRPCCVM"" X ^%ZOSF(""TEST"") S X=BLROSAV K BLROSAV I $T D ^BLRPCCVM"
D ^DIE
I $D(Y) D BMES^XPDUTL(STR)
K DIE,DA,DR,DIC,DLAYGO,DD,DO
Q
;
ADD ;
S X="LABORATORY",DIC="^APCDLINK(",DLAYGO=9001002,DIC(0)="E" K DD,D0 D FILE^DICN
S BLRX=+Y
Q
BLRPRE19 ; IHS/ITSC/MKK - ENVIRONMENT CHECK FOR PATCH 19; [ 08/20/2004 2:15 PM ]
+1 ;;5.2;LR;**1019**;MAR 25, 2005
+2 ;
+3 SET $PIECE(LINE,"*",81)=""
+4 ;NO QUEUING ALLOWED
SET XPDNOQUE="NO QUE"
+5 ;DISABLE THE "Disable options..." and "Move routines..." questions from being asked during install
SET (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
+6 ;DISABLE "Rebuild Menu Tree" question
SET XPDDIQ("XPO1")=0
+7 SET XPDABORT=0
+8 IF '$GET(DUZ)
WRITE !,"DUZ UNDEFINED OR 0."
DO SORRY
QUIT
+9 ;
+10 IF '$LENGTH($GET(DUZ(0)))
WRITE !,"DUZ(0) UNDEFINED OR NULL."
DO SORRY
QUIT
+11 ;
+12 DO HOME^%ZIS
DO DT^DICRW
+13 SET X=$PIECE($GET(^VA(200,DUZ,0)),U)
+14 IF $GET(X)
DO BMES^XPDUTL("Installer cannot be identified!")
DO SORRY
QUIT
+15 DO BMES^XPDUTL("Hello, "_$PIECE(X,",",2)_" "_$PIECE(X,","))
+16 DO BMES^XPDUTL("Checking Environment for Patch "_$PIECE($TEXT(+2),";",5)_" of Version "_$PIECE($TEXT(+2),";",3)_" of "_$PIECE($TEXT(+2),";",4)_".")
+17 ;
+18 SET X=$GET(^DD("VERSION"))
+19 DO BMES^XPDUTL("Need at least FileMan 22.....FileMan "_X_" Present")
+20 IF X<22
DO SORRY
QUIT
+21 ;
+22 SET X=$GET(^DIC(9.4,$ORDER(^DIC(9.4,"C","XU",0)),"VERSION"))
+23 DO BMES^XPDUTL("Need at least Kernel 8.0.....Kernel "_X_" Present")
+24 IF X<8.0
DO SORRY
QUIT
+25 ;
+26 DO BMES^XPDUTL("Must have 'LMI' mail group present....")
+27 IF $$CHECKLMI<0
DO SORRY
QUIT
+28 DO BMES^XPDUTL("'LMI' mail group found. OK")
+29 ;
+30 SET X=$GET(^DIC(9.4,$ORDER(^DIC(9.4,"C","OR",0)),"VERSION"))
+31 DO BMES^XPDUTL("Need at least ORDER ENTRY/RESULTS REPORTING (OERR) 2.5.....OERR "_X_" Present")
+32 IF X<2.5
DO SORRY
QUIT
+33 ;
+34 SET X=$GET(^DIC(9.4,$ORDER(^DIC(9.4,"C","PIMS",0)),"VERSION"))
+35 DO BMES^XPDUTL("Need at least PIMS 5.3.....PIMS "_X_" Present")
+36 IF X<5.3
DO SORRY
QUIT
+37 ;
+38 SET X=$GET(^DIC(9.4,$ORDER(^DIC(9.4,"C","LEX",0)),"VERSION"))
+39 DO BMES^XPDUTL("Need at least LEXICON 2.0.....LEXICON "_X_" Present")
+40 IF X<2.0
DO SORRY
QUIT
+41 ;
VERSION ;
+1 ;CHECK FOR PREVIOUS PATCH NEEDED
+2 SET %=$DATA(^XPD("9.7","B","LR*5.2*1018"))
+3 IF '%
Begin DoDot:1
+4 NEW STR
+5 SET STR="Patch 1019 of version 5.2 of the RPMS Laboratory Package"
+6 SET STR=STR_" CANNOT be"_$CHAR(13)_$CHAR(10)
+7 SET STR=STR_"installed unless Patch 1018 of version 5.2 has been previously"
+8 SET STR=STR_" installed."_$CHAR(13)_$CHAR(10)
+9 DO BMES^XPDUTL(STR)
+10 DO SORRY
End DoDot:1
QUIT
+11 ;
+12 ;GET INSTALL STATUS
+13 SET %=$ORDER(^XPD("9.7","B","LR*5.2*1018",""))
+14 SET LRSTATUS=$PIECE($GET(^XPD(9.7,%,0)),U,9)
+15 ;IF INSTALL STATUS NOT COMPLETE QUIT
IF LRSTATUS'=3
Begin DoDot:1
+16 DO BMES^XPDUTL("Install of Patch 1018 not complete!")
+17 DO SORRY
End DoDot:1
QUIT
+18 ;
+19 DO BMES^XPDUTL("Patch 1018 of version LR 5.2 Has Been Previously Installed......OK to continue")
+20 ;
+21 ;
+22 ;
ENVOK ; If this is just an environ check, end here.
+1 DO BMES^XPDUTL("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)
DO BMES^XPDUTL("Please perform a successful backup before contnuing!!")
SET XPDABORT=1
QUIT
+14 SET %DT="R"
SET X="NOW"
DO ^%DT
XECUTE ^DD("DD")
+15 DO BMES^XPDUTL("BACKUPS CONFIRMED BY "_$PIECE($GET(^VA(200,DUZ,0)),U)_" ON "_$PIECE(Y,"@")_" AT "_$PIECE(Y,"@",2))
+16 SET ^BLRINSTL("INSTALLED BY")=$PIECE($GET(^VA(200,DUZ,0)),U)
+17 ;
+18 QUIT
+19 ;
SORRY ;
+1 KILL DIFQ
+2 SET XPDABORT=1
+3 ; D BMES^XPDUTL("Sorry....something is wrong with your enviroment")
+4 ; D BMES^XPDUTL("for a Lab 5.2 Patch 1019 install!")
+5 NEW STR
+6 SET STR="Sorry....something is wrong with your enviroment for"
+7 SET STR=STR_" an install of"_$CHAR(13)_$CHAR(10)_$$CJ^XLFSTR("Lab 5.2 Patch 1019",65)
+8 DO BMES^XPDUTL(STR)
+9 ; D BMES^XPDUTL("Please print/capture this screen and notify the Support Center at")
+10 ; D BMES^XPDUTL($$CJ^XLFSTR("1-999-999-9999",65))
+11 SET STR="Please print/capture this screen and notify the Support Center"
+12 SET STR=STR_" at"_$CHAR(13)_$CHAR(10)_$$CJ^XLFSTR("1-999-999-9999",65)_$CHAR(13)_$CHAR(10)
+13 DO BMES^XPDUTL(STR)
+14 QUIT
+15 ;
+16 ;CHECK FOR LMI MAIL GROUP
CHECKLMI() ;
+1 SET DIC="^XMB(3.8,"
+2 SET X="LMI"
+3 DO ^DIC
+4 QUIT +Y
+5 ;
POST ;
+1 NEW STR
+2 SET STR=$$CJ^XLFSTR("Updating MODULE PCC LINK CONTROL failed",65)
+3 SET STR=$CHAR(13)_$CHAR(10)_"Please print/capture this screen and notify the Support Center"
+4 SET STR=STR_" at"_$CHAR(13)_$CHAR(10)_$$CJ^XLFSTR("1-999-999-9999",65)_$CHAR(13)_$CHAR(10)
+5 ;
+6 ; Clear Tracking global
SET STR=$$KILL^ZIBGCHAR("BLRENTRY")
+7 ;
+8 ; The following code adds the correct PCC Merge code. The original code
+9 ; for LAB in the MODULE PCC LINK CONTROL dictionary is trying to call the
+10 ; ALRLINK routine, which was deleted years ago.
+11 ;
+12 ;get ien of entry
SET BLRX=$ORDER(^APCDLINK("B","LABORATORY",0))
+13 ;if it doesn't exist add it
IF 'BLRX
DO ADD
+14 ;
+15 ; Check to determine if valid routine (BZHELR) already exists in dictionary.
+16 ; If it does exist, just quit
+17 IF $GET(^APCDLINK(BLRX,1))["BZHELR"
QUIT
+18 ;
+19 ;if not, now edit it
+20 SET DA=BLRX
+21 SET DIE="^APCDLINK("
+22 SET DR="1////S BLROSAV=$G(X),X=""BLRPCCVM"" X ^%ZOSF(""TEST"") S X=BLROSAV K BLROSAV I $T D ^BLRPCCVM"
+23 DO ^DIE
+24 IF $DATA(Y)
DO BMES^XPDUTL(STR)
+25 KILL DIE,DA,DR,DIC,DLAYGO,DD,DO
+26 QUIT
+27 ;
ADD ;
+1 SET X="LABORATORY"
SET DIC="^APCDLINK("
SET DLAYGO=9001002
SET DIC(0)="E"
KILL DD,D0
DO FILE^DICN
+2 SET BLRX=+Y
+3 QUIT
