BLRPRE18 ; IHS/HQW/TPF - ENVIRONMENT CHECK FOR PATCH 18; [ 06/03/2003 8:35 AM ]
;;5.2T8;LR;**1018**;Oct 27, 2004
;
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")
;
D BMES^XPDUTL("Must have Order Entry/Results Reporting....")
I '$O(^DIC(9.4,"B","ORDER ENTRY/RESULTS REPORTING","")) D SORRY Q
D BMES^XPDUTL("Order Entry/Results Reporting found. OK")
;
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
;
;CHECK FOR NLT VERSION LEVEL
;S X=$O(^DIC(9.4,"B","NATIONAL LABORATORY TEST",0))
;I X="" D SORRY Q
;S X=$P($G(^DIC(9.4,X,"VERSION")),U)
;D BMES^XPDUTL("Need at least 'NATIONAL LABORATORY TEST' Version 5.254 ...... "_X_" Present")
;I X<"5.254" D SORRY Q
;
;CHECK FOR ICPT VERSION LEVEL
;S X=$O(^DIC(9.4,"B","CPT/HCPCS CODES",0))
;I X="" D SORRY Q
;S X=$P($G(^DIC(9.4,X,"VERSION")),U)
;D BMES^XPDUTL("Need at least 'ICPT' Version 6.0 ......"_X_" Present")
;I X<"6.0" D SORRY Q
;
VERSION ;
;CHECK FOR PREVIOUS PATCH NEEDED
S %=$D(^XPD("9.7","B","LR*5.2*1016"))
I '% D Q
. D BMES^XPDUTL("Patch 1018 of version 5.2 of the RPMS Laboratory Package")
. D BMES^XPDUTL("Cannot Be Installed Unless")
. D BMES^XPDUTL("Patch 1016 of version 5.2 Has Been Previously Installed.")
. D SORRY
;
;GET INSTALL STATUS
S %=$O(^XPD("9.7","B","LR*5.2*1016",""))
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 1016 not complete!")
.D SORRY
;
D BMES^XPDUTL("Patch 1016 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 1018 install!")
D BMES^XPDUTL("Please print/capture this screen and notify")
D BMES^XPDUTL("the Help Desk")
Q
;CHECK FOR LMI MAIL GROUP
CHECKLMI() ;
S DIC="^XMB(3.8,"
S X="LMI"
D ^DIC
Q +Y
;
;RESET ^LR("BLRA" FOR NEW STRUCTURE -- IF AND ONLY IF Patch 18 has not been installed before.
; E-SIG sites are the only ones effected by this.
POST ;
NEW LAB18,LAB18C
;
S LAB18=$O(^XPD("9.7","B","LR*5.2*1018","")) ; Get Patch Pointer
; Post Install Completion Date
I $G(LAB18) S LAB18C=$P($G(^XPD(9.7,LAB18,"INIT",1,0)),"^",2)
I $G(LAB18C) D Q
. D BMES^XPDUTL("Post Install (LAB18C) -- Lab Patch 18 has been installed before.")
. D BMES^XPDUTL("BLRTEMP global not updated.")
;
I $D(^BLRTEMP("BLRA"))>0 D Q ; If temp global exists, quit
. D BMES^XPDUTL("Post Install (BLRTEMP) -- Lab Patch 18 has been installed before.")
. D BMES^XPDUTL("BLRTEMP global not updated.")
;
I $D(^LR("BLRA"))=0 D Q
. D BMES^XPDUTL("Post Install (BLRA) -- There is no E-SIG data on this site.")
. D BMES^XPDUTL("BLRTEMP global not created.")
;
D BMES^XPDUTL("Post Install -- Lab Patch 18 has not been installed before.")
D BMES^XPDUTL("BLRTEMP Global Being Created.")
;
M ^BLRTEMP("BLRA")=^LR("BLRA")
K ^LR("BLRA")
S BLRAPRAC=""
F S BLRAPRAC=$O(^BLRTEMP("BLRA",BLRAPRAC)) Q:BLRAPRAC="" D
.S BLRASTAT=""
.F S BLRASTAT=$O(^BLRTEMP("BLRA",BLRAPRAC,BLRASTAT)) Q:BLRASTAT="" D
..S BLRAIVDT=""
..F S BLRAIVDT=$O(^BLRTEMP("BLRA",BLRAPRAC,BLRASTAT,BLRAIVDT)) Q:BLRAIVDT="" D
...S BLRADFN=""
...F S BLRADFN=$O(^BLRTEMP("BLRA",BLRAPRAC,BLRASTAT,BLRAIVDT,BLRADFN)) Q:BLRADFN="" D
....S BLRASS=$G(^BLRTEMP("BLRA",BLRAPRAC,BLRASTAT,BLRAIVDT,BLRADFN))
....Q:BLRASS=""
....S ^LR("BLRA",BLRAPRAC,BLRASTAT,BLRAIVDT,BLRADFN,BLRASS)=BLRASS
;DO NOT KILL ^BLRTEMP IN CASE SOMETHING HAPPENED AND WE NEED IT LATER TO RESTORE DATA
;
Q
BLRPRE18 ; IHS/HQW/TPF - ENVIRONMENT CHECK FOR PATCH 18; [ 06/03/2003 8:35 AM ]
+1 ;;5.2T8;LR;**1018**;Oct 27, 2004
+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 DO BMES^XPDUTL("Must have Order Entry/Results Reporting....")
+31 IF '$ORDER(^DIC(9.4,"B","ORDER ENTRY/RESULTS REPORTING",""))
DO SORRY
QUIT
+32 DO BMES^XPDUTL("Order Entry/Results Reporting found. OK")
+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 ;CHECK FOR NLT VERSION LEVEL
+39 ;S X=$O(^DIC(9.4,"B","NATIONAL LABORATORY TEST",0))
+40 ;I X="" D SORRY Q
+41 ;S X=$P($G(^DIC(9.4,X,"VERSION")),U)
+42 ;D BMES^XPDUTL("Need at least 'NATIONAL LABORATORY TEST' Version 5.254 ...... "_X_" Present")
+43 ;I X<"5.254" D SORRY Q
+44 ;
+45 ;CHECK FOR ICPT VERSION LEVEL
+46 ;S X=$O(^DIC(9.4,"B","CPT/HCPCS CODES",0))
+47 ;I X="" D SORRY Q
+48 ;S X=$P($G(^DIC(9.4,X,"VERSION")),U)
+49 ;D BMES^XPDUTL("Need at least 'ICPT' Version 6.0 ......"_X_" Present")
+50 ;I X<"6.0" D SORRY Q
+51 ;
VERSION ;
+1 ;CHECK FOR PREVIOUS PATCH NEEDED
+2 SET %=$DATA(^XPD("9.7","B","LR*5.2*1016"))
+3 IF '%
Begin DoDot:1
+4 DO BMES^XPDUTL("Patch 1018 of version 5.2 of the RPMS Laboratory Package")
+5 DO BMES^XPDUTL("Cannot Be Installed Unless")
+6 DO BMES^XPDUTL("Patch 1016 of version 5.2 Has Been Previously Installed.")
+7 DO SORRY
End DoDot:1
QUIT
+8 ;
+9 ;GET INSTALL STATUS
+10 SET %=$ORDER(^XPD("9.7","B","LR*5.2*1016",""))
+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 DO BMES^XPDUTL("Install of Patch 1016 not complete!")
+14 DO SORRY
End DoDot:1
QUIT
+15 ;
+16 DO BMES^XPDUTL("Patch 1016 of version LR 5.2 Has Been Previously Installed......OK to continue")
+17 ;
+18 ;
+19 ;
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
SORRY ;
+1 KILL DIFQ
+2 SET XPDABORT=1
+3 DO BMES^XPDUTL("Sorry....something is wrong with your enviroment")
+4 DO BMES^XPDUTL("for a Lab 5.2 Patch 1018 install!")
+5 DO BMES^XPDUTL("Please print/capture this screen and notify")
+6 DO BMES^XPDUTL("the Help Desk")
+7 QUIT
+8 ;CHECK FOR LMI MAIL GROUP
CHECKLMI() ;
+1 SET DIC="^XMB(3.8,"
+2 SET X="LMI"
+3 DO ^DIC
+4 QUIT +Y
+5 ;
+6 ;RESET ^LR("BLRA" FOR NEW STRUCTURE -- IF AND ONLY IF Patch 18 has not been installed before.
+7 ; E-SIG sites are the only ones effected by this.
POST ;
+1 NEW LAB18,LAB18C
+2 ;
+3 ; Get Patch Pointer
SET LAB18=$ORDER(^XPD("9.7","B","LR*5.2*1018",""))
+4 ; Post Install Completion Date
+5 IF $GET(LAB18)
SET LAB18C=$PIECE($GET(^XPD(9.7,LAB18,"INIT",1,0)),"^",2)
+6 IF $GET(LAB18C)
Begin DoDot:1
+7 DO BMES^XPDUTL("Post Install (LAB18C) -- Lab Patch 18 has been installed before.")
+8 DO BMES^XPDUTL("BLRTEMP global not updated.")
End DoDot:1
QUIT
+9 ;
+10 ; If temp global exists, quit
IF $DATA(^BLRTEMP("BLRA"))>0
Begin DoDot:1
+11 DO BMES^XPDUTL("Post Install (BLRTEMP) -- Lab Patch 18 has been installed before.")
+12 DO BMES^XPDUTL("BLRTEMP global not updated.")
End DoDot:1
QUIT
+13 ;
+14 IF $DATA(^LR("BLRA"))=0
Begin DoDot:1
+15 DO BMES^XPDUTL("Post Install (BLRA) -- There is no E-SIG data on this site.")
+16 DO BMES^XPDUTL("BLRTEMP global not created.")
End DoDot:1
QUIT
+17 ;
+18 DO BMES^XPDUTL("Post Install -- Lab Patch 18 has not been installed before.")
+19 DO BMES^XPDUTL("BLRTEMP Global Being Created.")
+20 ;
+21 MERGE ^BLRTEMP("BLRA")=^LR("BLRA")
+22 KILL ^LR("BLRA")
+23 SET BLRAPRAC=""
+24 FOR
SET BLRAPRAC=$ORDER(^BLRTEMP("BLRA",BLRAPRAC))
IF BLRAPRAC=""
QUIT
Begin DoDot:1
+25 SET BLRASTAT=""
+26 FOR
SET BLRASTAT=$ORDER(^BLRTEMP("BLRA",BLRAPRAC,BLRASTAT))
IF BLRASTAT=""
QUIT
Begin DoDot:2
+27 SET BLRAIVDT=""
+28 FOR
SET BLRAIVDT=$ORDER(^BLRTEMP("BLRA",BLRAPRAC,BLRASTAT,BLRAIVDT))
IF BLRAIVDT=""
QUIT
Begin DoDot:3
+29 SET BLRADFN=""
+30 FOR
SET BLRADFN=$ORDER(^BLRTEMP("BLRA",BLRAPRAC,BLRASTAT,BLRAIVDT,BLRADFN))
IF BLRADFN=""
QUIT
Begin DoDot:4
+31 SET BLRASS=$GET(^BLRTEMP("BLRA",BLRAPRAC,BLRASTAT,BLRAIVDT,BLRADFN))
+32 IF BLRASS=""
QUIT
+33 SET ^LR("BLRA",BLRAPRAC,BLRASTAT,BLRAIVDT,BLRADFN,BLRASS)=BLRASS
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+34 ;DO NOT KILL ^BLRTEMP IN CASE SOMETHING HAPPENED AND WE NEED IT LATER TO RESTORE DATA
+35 ;
+36 QUIT
