AMERENV1 ; IHS/OIT/SCR - ERS V3.0 ENVIRONMENT CHECK ROUTINE ;
;;3.0;ER VISIT SYSTEM;**1,2,3**;DEC 07, 2011;Build 11
;
;
PRECHK ; EP
D BMES^XPDUTL("Beginning of Pre Check.")
NEW STR ; String variable -- used for messages.
;
S $P(LINE,"*",81)=""
S XPDNOQUE="NO QUE" ;NO QUEUING ALLOWED
;
; DISABLE THE "Disable options..." and "Move routines..."
; questions from being asked during install
S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
;
S XPDDIQ("XPO1")=0 ;DISABLE "Rebuild Menu Tree" question
S XPDABORT=0
;
USERID ; CHECK FOR USER ID
I '$G(DUZ) D SORRY("DUZ UNDEFINED OR 0!") Q
;
I '$L($G(DUZ(0))) D SORRY("DUZ(0) UNDEFINED OR NULL!") Q
;
D HOME^%ZIS,DT^DICRW
S X=$P($G(^VA(200,DUZ,0)),U)
I $G(X) D SORRY("Installer cannot be identified!") Q
;
LETSGO ; USER IDENTIFIED -- LET'S GO
D MES^XPDUTL("Hello, "_$P(X,",",2)_" "_$P(X,","))
;
AMER ; CHECK FOR AMER PATCH 2 ;IHS/OIT/GIS 8/23/11 patch 3
D BMES^XPDUTL("Need AMER 3.0, Patch 2")
I $T(+2^AMER0)'["2**;" D SORRY("AMER 3.0, Patch 2 NOT installed!") Q
D OKAY("AMER 3.0, Patch 2 has been installed!")
;
FILEMAN ; CHECK FOR FILEMAN 22.0
S X=$G(^DD("VERSION"))
D BMES^XPDUTL("Need at least FileMan 22.0")
I X<22 D SORRY("Need FileMan 22.0 & FileMan "_X_" found!") Q
D OKAY("FileMan "_X_" found.")
;
KERNEL ; CHECK FOR KERNEL 8.0
S X=$G(^DIC(9.4,$O(^DIC(9.4,"C","XU",0)),"VERSION"))
D BMES^XPDUTL("Need at least Kernel 8.0.")
I X<8.0 D SORRY("Need Kernel 8.0 & Kernel "_X_" found!") Q
D OKAY("Kernel "_X_" found.")
;
PIMS ; CHECK FOR PIMS 5.3
;first check for PIMS
S X=$$VERSION^XPDUTL("PIMS")
D BMES^XPDUTL("Need at least PIMS 5.3.")
I X="" D SORRY("Please install PIMS 5.3 before loading this version") Q
I X<5.3 D SORRY("Need PIMS 5.3 & PIMS "_X_" found!") Q
D OKAY("PIMS "_X_" found.")
;
MM1006 ; CHECK FOR MAILMAN patch 1006
;IHS/OIT/SCR 050409 modied to allow v 8.0 OR required 7.1 patch
S VERSION=$$XMV8()
I VERSION="8.0" D OKAY("MailMan version 8.0 found")
I VERSION="7.1" D
.D OKAY("MailMan version 7.1 found")
.D BMES^XPDUTL("Need XM patch 1006.")
.I $$XMPATCH(50)'["Y" D SORRY("MailMan v7.1 Patch 1006 IS NOT installed!") Q
.D OKAY("MailMan v7.1 Patch 1006 found")
.Q
I (VERSION'="8.0")&&(VERSION'="7.1") D SORRY("Unsupported MailMan Version Found") Q
;
AICD7 ; CHECK FOR AICD 3.51 patch 7
S X=$$VERSION^XPDUTL("AICD")
N Y S Y=+$$LAST^XPDUTL("IHS ICD/CPT LOOKUP & GROUPER",X)
D BMES^XPDUTL("Need AICD 3.51 patch 7.")
I X<3.51!((X=3.51)&(Y<7)) D Q
. D:Y=-1 SORRY("Need AICD 3.51 patch 7 & AICD "_X_" found!")
. D:Y'=-1 SORRY("Need AICD 3.51 patch 7 & AICD "_X_" patch "_Y_" found!")
D OKAY("AICD 3.51 Patch 7 found")
;
AG ; CHECK FOR AG 7.1 PATCH 2
S X=$$VERSION^XPDUTL("IHS PATIENT REGISTRATION")
N Y S Y=+$$LAST^XPDUTL("IHS PATIENT REGISTRATION",X)
D BMES^XPDUTL("Need IHS PATIENT REGISTRATION 7.1 patch 2.")
I X<7.1!((X=7.1)&(Y<2)) D Q
. D:Y=-1 SORRY("Need IHS PATIENT REGISTRATION 7.1 patch 2 & IHS PATIENT REGISTRATION "_X_" found!")
. D:Y'=-1 SORRY("Need IHS PATIENT REGISTRATION 7.1 patch 2 & IHS PATIENT REGISTRATION "_X_" patch "_Y_" found!")
D OKAY("IHS PATIENT REGISTRATION 7.1 Patch 2 found")
;
PCC ; CHECK FOR PCC DATA ENTRY 2.0
S X=$$VERSION^XPDUTL("APCD")
D BMES^XPDUTL("Need PCC DATA ENTRY 2.0.")
I X<2.0 D SORRY("Need PCC DATA ENTRY 2.0 to install this version") Q
D OKAY("PCC DATA ENTRY 2.0 found.")
;
AMER ; CHECK FOR AMER 3.0 PATCH 1
D BMES^XPDUTL("Need ER VISIT SYSTEM v3.0 patch 1")
S X=$$VERSION^XPDUTL("ER VISIT SYSTEM")
S Y=+$$LAST^XPDUTL("ER VISIT SYSTEM",X)
I X<1 D SORRY("NEED ERS PATCH 1 before installing this patch") Q
D OKAY("ERS v3.0 patch 1 found")
;
ENVOK ; ENVIRONMENT OK
D BMES^XPDUTL("ENVIRONMENT OK.")
;
BACKUPS ; CHECK TO CONFIRM BACKUPS HAVE BEEN DONE
D BMES^XPDUTL("SYSTEM BACKUP Check.")
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 Q
. D SORRY("Please perform a successful backup before continuing!!")
S %DT="R",X="NOW" D ^%DT X ^DD("DD")
S STR="BACKUPS CONFIRMED BY "_$P($G(^VA(200,DUZ,0)),U)_" ON "
S STR=STR_$P(Y,"@")_" AT "_$P(Y,"@",2)
D BMES^XPDUTL(STR)
D MES^XPDUTL(" ")
Q ;END OF MAIN ROUTINE
;
SORRY(MSG,MODE) ; MESSAGE TO DISPLAY WHEN SOMETHING GOES WRONG
NEW MESSAGE
I $G(MODE)'["NONFATAL" D
. S MESSAGE="Install Aborting due to the following Systems Environment issue:"
. S XPDABORT=1
;
I $G(MODE)["NONFATAL" S MESSAGE="*** WARNING *** WARNING *** WARNING ***"
;
K DIFQ
;
NEW STR
S STR(1)=""
S STR(2)=$TR($J("",65)," ","*") ; Row of asterisks
S STR(3)=" "
S STR(4)=$$CJ^XLFSTR("Site: "_$$LOC^XBFUNC,65)
S STR(5)=" "
S STR(6)=$$CJ^XLFSTR(MESSAGE,65)
S STR(7)=" "
S STR(8)=$$CJ^XLFSTR(">>> "_MSG_" <<<",65)
S STR(9)=" "
S STR(10)=$$CJ^XLFSTR("Please print/capture this screen and",65)
S STR(11)=$$CJ^XLFSTR("notify the Support Center at",65)
S STR(12)=""
S STR(13)=$$CJ^XLFSTR("1-888-830-7280.",65)
S STR(14)=" "
S STR(15)=$G(STR(2)) ; Row of asterisks
S STR(16)=""
D BMES^XPDUTL(.STR)
Q
;
OKAY(MSG,TAB) ; MESSAGE WITH "OK" AT THE END
NEW MESSAGE
I $G(TAB)="" S TAB=5
S MESSAGE=$J("",TAB)_MSG_" OK."
D MES^XPDUTL(MESSAGE)
Q
;
XMV8() ; CHECK FOR MAILMAN v8.0
;IHS/OIT/SCR 050409
S X=$$VERSION^XPDUTL("XM")
D BMES^XPDUTL("Checking MailMan Version")
S MESSAGE="MAIL MAN v"_X_" found"
D OKAY(MESSAGE)
Q X
;
XMPATCH(CHK) ; Check for mail-man patch
NEW PAT,PATCH,XMPTR,OKGIS,OKPATCH
S XMPTR=$O(^DIC(9.4,"C","XM",0))
S PAT="",OKPATCH="NO"
F S PAT=$O(^DIC(9.4,XMPTR,22,PAT)) Q:PAT=""!(OKPATCH["Y") D
. S PATCH=""
. F S PATCH=$O(^DIC(9.4,XMPTR,22,PAT,"PAH",PATCH)) Q:PATCH=""!(OKPATCH["Y") D
.. I +$G(^DIC(9.4,XMPTR,22,PAT,"PAH",PATCH,0))[CHK S OKPATCH="YES"
Q OKPATCH
;
NEW MESSAGE
I $G(TAB)="" S TAB=5
S MESSAGE=$J("",TAB)_MSG
I $G(TAIL)'="" S MESSAGE=MESSAGE_" "_TAIL
D MES^XPDUTL(MESSAGE)
Q
AMERENV1 ; IHS/OIT/SCR - ERS V3.0 ENVIRONMENT CHECK ROUTINE ;
+1 ;;3.0;ER VISIT SYSTEM;**1,2,3**;DEC 07, 2011;Build 11
+2 ;
+3 ;
PRECHK ; EP
+1 DO BMES^XPDUTL("Beginning of Pre Check.")
+2 ; String variable -- used for messages.
NEW STR
+3 ;
+4 SET $PIECE(LINE,"*",81)=""
+5 ;NO QUEUING ALLOWED
SET XPDNOQUE="NO QUE"
+6 ;
+7 ; DISABLE THE "Disable options..." and "Move routines..."
+8 ; questions from being asked during install
+9 SET (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
+10 ;
+11 ;DISABLE "Rebuild Menu Tree" question
SET XPDDIQ("XPO1")=0
+12 SET XPDABORT=0
+13 ;
USERID ; CHECK FOR USER ID
+1 IF '$GET(DUZ)
DO SORRY("DUZ UNDEFINED OR 0!")
QUIT
+2 ;
+3 IF '$LENGTH($GET(DUZ(0)))
DO SORRY("DUZ(0) UNDEFINED OR NULL!")
QUIT
+4 ;
+5 DO HOME^%ZIS
DO DT^DICRW
+6 SET X=$PIECE($GET(^VA(200,DUZ,0)),U)
+7 IF $GET(X)
DO SORRY("Installer cannot be identified!")
QUIT
+8 ;
LETSGO ; USER IDENTIFIED -- LET'S GO
+1 DO MES^XPDUTL("Hello, "_$PIECE(X,",",2)_" "_$PIECE(X,","))
+2 ;
AMER ; CHECK FOR AMER PATCH 2 ;IHS/OIT/GIS 8/23/11 patch 3
+1 DO BMES^XPDUTL("Need AMER 3.0, Patch 2")
+2 IF $TEXT(+2^AMER0)'["2**;"
DO SORRY("AMER 3.0, Patch 2 NOT installed!")
QUIT
+3 DO OKAY("AMER 3.0, Patch 2 has been installed!")
+4 ;
FILEMAN ; CHECK FOR FILEMAN 22.0
+1 SET X=$GET(^DD("VERSION"))
+2 DO BMES^XPDUTL("Need at least FileMan 22.0")
+3 IF X<22
DO SORRY("Need FileMan 22.0 & FileMan "_X_" found!")
QUIT
+4 DO OKAY("FileMan "_X_" found.")
+5 ;
KERNEL ; CHECK FOR KERNEL 8.0
+1 SET X=$GET(^DIC(9.4,$ORDER(^DIC(9.4,"C","XU",0)),"VERSION"))
+2 DO BMES^XPDUTL("Need at least Kernel 8.0.")
+3 IF X<8.0
DO SORRY("Need Kernel 8.0 & Kernel "_X_" found!")
QUIT
+4 DO OKAY("Kernel "_X_" found.")
+5 ;
PIMS ; CHECK FOR PIMS 5.3
+1 ;first check for PIMS
+2 SET X=$$VERSION^XPDUTL("PIMS")
+3 DO BMES^XPDUTL("Need at least PIMS 5.3.")
+4 IF X=""
DO SORRY("Please install PIMS 5.3 before loading this version")
QUIT
+5 IF X<5.3
DO SORRY("Need PIMS 5.3 & PIMS "_X_" found!")
QUIT
+6 DO OKAY("PIMS "_X_" found.")
+7 ;
MM1006 ; CHECK FOR MAILMAN patch 1006
+1 ;IHS/OIT/SCR 050409 modied to allow v 8.0 OR required 7.1 patch
+2 SET VERSION=$$XMV8()
+3 IF VERSION="8.0"
DO OKAY("MailMan version 8.0 found")
+4 IF VERSION="7.1"
Begin DoDot:1
+5 DO OKAY("MailMan version 7.1 found")
+6 DO BMES^XPDUTL("Need XM patch 1006.")
+7 IF $$XMPATCH(50)'["Y"
DO SORRY("MailMan v7.1 Patch 1006 IS NOT installed!")
QUIT
+8 DO OKAY("MailMan v7.1 Patch 1006 found")
+9 QUIT
End DoDot:1
+10 IF (VERSION'="8.0")&&(VERSION'="7.1")
DO SORRY("Unsupported MailMan Version Found")
QUIT
+11 ;
AICD7 ; CHECK FOR AICD 3.51 patch 7
+1 SET X=$$VERSION^XPDUTL("AICD")
+2 NEW Y
SET Y=+$$LAST^XPDUTL("IHS ICD/CPT LOOKUP & GROUPER",X)
+3 DO BMES^XPDUTL("Need AICD 3.51 patch 7.")
+4 IF X<3.51!((X=3.51)&(Y<7))
Begin DoDot:1
+5 IF Y=-1
DO SORRY("Need AICD 3.51 patch 7 & AICD "_X_" found!")
+6 IF Y'=-1
DO SORRY("Need AICD 3.51 patch 7 & AICD "_X_" patch "_Y_" found!")
End DoDot:1
QUIT
+7 DO OKAY("AICD 3.51 Patch 7 found")
+8 ;
AG ; CHECK FOR AG 7.1 PATCH 2
+1 SET X=$$VERSION^XPDUTL("IHS PATIENT REGISTRATION")
+2 NEW Y
SET Y=+$$LAST^XPDUTL("IHS PATIENT REGISTRATION",X)
+3 DO BMES^XPDUTL("Need IHS PATIENT REGISTRATION 7.1 patch 2.")
+4 IF X<7.1!((X=7.1)&(Y<2))
Begin DoDot:1
+5 IF Y=-1
DO SORRY("Need IHS PATIENT REGISTRATION 7.1 patch 2 & IHS PATIENT REGISTRATION "_X_" found!")
+6 IF Y'=-1
DO SORRY("Need IHS PATIENT REGISTRATION 7.1 patch 2 & IHS PATIENT REGISTRATION "_X_" patch "_Y_" found!")
End DoDot:1
QUIT
+7 DO OKAY("IHS PATIENT REGISTRATION 7.1 Patch 2 found")
+8 ;
PCC ; CHECK FOR PCC DATA ENTRY 2.0
+1 SET X=$$VERSION^XPDUTL("APCD")
+2 DO BMES^XPDUTL("Need PCC DATA ENTRY 2.0.")
+3 IF X<2.0
DO SORRY("Need PCC DATA ENTRY 2.0 to install this version")
QUIT
+4 DO OKAY("PCC DATA ENTRY 2.0 found.")
+5 ;
AMER ; CHECK FOR AMER 3.0 PATCH 1
+1 DO BMES^XPDUTL("Need ER VISIT SYSTEM v3.0 patch 1")
+2 SET X=$$VERSION^XPDUTL("ER VISIT SYSTEM")
+3 SET Y=+$$LAST^XPDUTL("ER VISIT SYSTEM",X)
+4 IF X<1
DO SORRY("NEED ERS PATCH 1 before installing this patch")
QUIT
+5 DO OKAY("ERS v3.0 patch 1 found")
+6 ;
ENVOK ; ENVIRONMENT OK
+1 DO BMES^XPDUTL("ENVIRONMENT OK.")
+2 ;
BACKUPS ; CHECK TO CONFIRM BACKUPS HAVE BEEN DONE
+1 DO BMES^XPDUTL("SYSTEM BACKUP Check.")
+2 WRITE !!
+3 SET DIR(0)="Y"
+4 SET DIR("B")="NO"
+5 SET DIR("A")="Has a SUCCESSFUL system backup been performed"
+6 DO ^DIR
+7 IF $DATA(DIRUT)!($GET(Y)=0)
Begin DoDot:1
+8 DO SORRY("Please perform a successful backup before continuing!!")
End DoDot:1
QUIT
+9 SET %DT="R"
SET X="NOW"
DO ^%DT
XECUTE ^DD("DD")
+10 SET STR="BACKUPS CONFIRMED BY "_$PIECE($GET(^VA(200,DUZ,0)),U)_" ON "
+11 SET STR=STR_$PIECE(Y,"@")_" AT "_$PIECE(Y,"@",2)
+12 DO BMES^XPDUTL(STR)
+13 DO MES^XPDUTL(" ")
+14 ;END OF MAIN ROUTINE
QUIT
+15 ;
SORRY(MSG,MODE) ; MESSAGE TO DISPLAY WHEN SOMETHING GOES WRONG
+1 NEW MESSAGE
+2 IF $GET(MODE)'["NONFATAL"
Begin DoDot:1
+3 SET MESSAGE="Install Aborting due to the following Systems Environment issue:"
+4 SET XPDABORT=1
End DoDot:1
+5 ;
+6 IF $GET(MODE)["NONFATAL"
SET MESSAGE="*** WARNING *** WARNING *** WARNING ***"
+7 ;
+8 KILL DIFQ
+9 ;
+10 NEW STR
+11 SET STR(1)=""
+12 ; Row of asterisks
SET STR(2)=$TRANSLATE($JUSTIFY("",65)," ","*")
+13 SET STR(3)=" "
+14 SET STR(4)=$$CJ^XLFSTR("Site: "_$$LOC^XBFUNC,65)
+15 SET STR(5)=" "
+16 SET STR(6)=$$CJ^XLFSTR(MESSAGE,65)
+17 SET STR(7)=" "
+18 SET STR(8)=$$CJ^XLFSTR(">>> "_MSG_" <<<",65)
+19 SET STR(9)=" "
+20 SET STR(10)=$$CJ^XLFSTR("Please print/capture this screen and",65)
+21 SET STR(11)=$$CJ^XLFSTR("notify the Support Center at",65)
+22 SET STR(12)=""
+23 SET STR(13)=$$CJ^XLFSTR("1-888-830-7280.",65)
+24 SET STR(14)=" "
+25 ; Row of asterisks
SET STR(15)=$GET(STR(2))
+26 SET STR(16)=""
+27 DO BMES^XPDUTL(.STR)
+28 QUIT
+29 ;
OKAY(MSG,TAB) ; MESSAGE WITH "OK" AT THE END
+1 NEW MESSAGE
+2 IF $GET(TAB)=""
SET TAB=5
+3 SET MESSAGE=$JUSTIFY("",TAB)_MSG_" OK."
+4 DO MES^XPDUTL(MESSAGE)
+5 QUIT
+6 ;
XMV8() ; CHECK FOR MAILMAN v8.0
+1 ;IHS/OIT/SCR 050409
+2 SET X=$$VERSION^XPDUTL("XM")
+3 DO BMES^XPDUTL("Checking MailMan Version")
+4 SET MESSAGE="MAIL MAN v"_X_" found"
+5 DO OKAY(MESSAGE)
+6 QUIT X
+7 ;
XMPATCH(CHK) ; Check for mail-man patch
+1 NEW PAT,PATCH,XMPTR,OKGIS,OKPATCH
+2 SET XMPTR=$ORDER(^DIC(9.4,"C","XM",0))
+3 SET PAT=""
SET OKPATCH="NO"
+4 FOR
SET PAT=$ORDER(^DIC(9.4,XMPTR,22,PAT))
IF PAT=""!(OKPATCH["Y")
QUIT
Begin DoDot:1
+5 SET PATCH=""
+6 FOR
SET PATCH=$ORDER(^DIC(9.4,XMPTR,22,PAT,"PAH",PATCH))
IF PATCH=""!(OKPATCH["Y")
QUIT
Begin DoDot:2
+7 IF +$GET(^DIC(9.4,XMPTR,22,PAT,"PAH",PATCH,0))[CHK
SET OKPATCH="YES"
End DoDot:2
End DoDot:1
+8 QUIT OKPATCH
+9 ;
+1 NEW MESSAGE
+2 IF $GET(TAB)=""
SET TAB=5
+3 SET MESSAGE=$JUSTIFY("",TAB)_MSG
+4 IF $GET(TAIL)'=""
SET MESSAGE=MESSAGE_" "_TAIL
+5 DO MES^XPDUTL(MESSAGE)
+6 QUIT
