BPMENVC ; IHS/OIT/NKD - Environment checker for BPM - 7/23/12 ;
;;1.0;IHS PATIENT MERGE;**2**;MAR 01, 2010;Build 1
;IHS/OIT/NKD 6/05/2012 Added new requirements
;
I '$G(DUZ) W !,"DUZ UNDEFINED OR 0." D SORRY(2) Q
;
I '$L($G(DUZ(0))) W !,"DUZ(0) UNDEFINED OR NULL." D SORRY(2) Q
;
S X=$P(^VA(200,DUZ,0),U)
W !!,$$CJ^XLFSTR("Hello, "_$P(X,",",2)_" "_$P(X,","),IOM)
W !!,$$CJ^XLFSTR("Checking Environment for "_$P($T(+2),";",4)_" V "_$P($T(+2),";",3)_" Patch "_$P($T(+2),";",5)_".",IOM),!
;
S XPDQUIT=0,BPMQUIT=0
I '$$VCHK2("XU","8.0.1017",2)
I '$$VCHK("DI","21.0",2)
I '$$VCHK2("XT","7.3.1017",2)
I '$$VCHK("BPM","1.0",2)
;IHS/OIT/NKD BPM*1.0*2 Check to ensure official BADE*1.0*1 patch is installed
I $$PATCH^XPDUTL("BADE*1.0*1") N X S X="BADEMRG" X ^%ZOSF("TEST") I '$T D
. W !,$$CJ^XLFSTR("ERROR: BADE*1.0*1 is installed but BADEMRG routine not present.",IOM)
. W !,$$CJ^XLFSTR("This may be due to an unofficial release of BADE*1.0*1.",IOM)
. W !,$$CJ^XLFSTR("The official November 2011 patch of BADE*1.0*1 must be installed to continue.",IOM)
. W *7,!,$$CJ^XLFSTR("^^^^**NEEDS TO BE FIXED**^^^^",IOM)
. S XPDQUIT=2
;
I XPDQUIT D SORRY(XPDQUIT) Q
;
W !!,$$CJ^XLFSTR("ENVIRONMENT OK.",IOM)
;
Q
;
SORRY(X) ;
KILL DIFQ
S XPDQUIT=X
W:'$D(ZTQUEUED) *7,!,$$CJ^XLFSTR("Sorry....",IOM),$$DIR^XBDIR("E","Press RETURN")
Q
;
VCHK(BPMPRE,BPMVER,BPMQUIT) ; Check versions needed.
;
NEW BPMV
S BPMV=$$VERSION^XPDUTL(BPMPRE)
W !,$$CJ^XLFSTR("Need at least "_BPMPRE_" v "_BPMVER_"....."_BPMPRE_" v "_BPMV_" Present",IOM)
I BPMV<BPMVER S XPDQUIT=BPMQUIT W *7,!,$$CJ^XLFSTR("^^^^**NEEDS FIXED**^^^^",IOM) Q 0
Q 1
;
VCHK2(BPMPRE,BPMVER,BPMQUIT) ; Check patch level
NEW BPMV
S BPMV=$$VERSION^XPDUTL(BPMPRE)
I $L(BPMV)<1 S XPDQUIT=BPMQUIT W !,$$CJ^XLFSTR("Need at least "_BPMPRE_" v "_BPMVER_"....."_BPMPRE_" Not Installed",IOM),*7,!,$$CJ^XLFSTR("^^^^**NEEDS TO BE FIXED**^^^^",IOM) Q 1
S PTCH=+$$LAST(BPMPRE,BPMV) S:PTCH=-1 DPTCH="" S:PTCH'=-1 DPTCH="."_PTCH
W !,$$CJ^XLFSTR("Need at least "_BPMPRE_" v "_BPMVER_"....."_BPMPRE_" v "_BPMV_DPTCH_" Present",IOM)
I (BPMV=$P(BPMVER,".",1,2))&(PTCH<$P(BPMVER,".",3)) KILL DIFQ S XPDQUIT=BPMQUIT W *7,!,$$CJ^XLFSTR("^^^^**NEEDS TO BE FIXED**^^^^",IOM)
Q 1
LAST(PKG,VER) ;EP - returns last patch applied for a Package, PATCH^DATE
; Patch includes Seq # if Released
N PKGIEN,VERIEN,LATEST,PATCH,SUBIEN
I $G(VER)="" S VER=$$VERSION^XPDUTL(PKG) Q:'VER -1
S PKGIEN=$O(^DIC(9.4,"C",PKG,"")) Q:'PKGIEN -1
S VERIEN=$O(^DIC(9.4,PKGIEN,22,"B",VER,"")) Q:'VERIEN -1
S LATEST=-1,PATCH=-1,SUBIEN=0
F S SUBIEN=$O(^DIC(9.4,PKGIEN,22,VERIEN,"PAH",SUBIEN)) Q:SUBIEN'>0 D
. I $P(^DIC(9.4,PKGIEN,22,VERIEN,"PAH",SUBIEN,0),U,2)>LATEST S LATEST=$P(^(0),U,2),PATCH=$P(^(0),U)
. I $P(^DIC(9.4,PKGIEN,22,VERIEN,"PAH",SUBIEN,0),U,2)=LATEST,$P(^(0),U)>PATCH S PATCH=$P(^(0),U)
Q PATCH_U_LATEST
;
BPMENVC ; IHS/OIT/NKD - Environment checker for BPM - 7/23/12 ;
+1 ;;1.0;IHS PATIENT MERGE;**2**;MAR 01, 2010;Build 1
+2 ;IHS/OIT/NKD 6/05/2012 Added new requirements
+3 ;
+4 IF '$GET(DUZ)
WRITE !,"DUZ UNDEFINED OR 0."
DO SORRY(2)
QUIT
+5 ;
+6 IF '$LENGTH($GET(DUZ(0)))
WRITE !,"DUZ(0) UNDEFINED OR NULL."
DO SORRY(2)
QUIT
+7 ;
+8 SET X=$PIECE(^VA(200,DUZ,0),U)
+9 WRITE !!,$$CJ^XLFSTR("Hello, "_$PIECE(X,",",2)_" "_$PIECE(X,","),IOM)
+10 WRITE !!,$$CJ^XLFSTR("Checking Environment for "_$PIECE($TEXT(+2),";",4)_" V "_$PIECE($TEXT(+2),";",3)_" Patch "_$PIECE($TEXT(+2),";",5)_".",IOM),!
+11 ;
+12 SET XPDQUIT=0
SET BPMQUIT=0
+13 IF '$$VCHK2("XU","8.0.1017",2)
+14 IF '$$VCHK("DI","21.0",2)
+15 IF '$$VCHK2("XT","7.3.1017",2)
+16 IF '$$VCHK("BPM","1.0",2)
+17 ;IHS/OIT/NKD BPM*1.0*2 Check to ensure official BADE*1.0*1 patch is installed
+18 IF $$PATCH^XPDUTL("BADE*1.0*1")
NEW X
SET X="BADEMRG"
XECUTE ^%ZOSF("TEST")
IF '$TEST
Begin DoDot:1
+19 WRITE !,$$CJ^XLFSTR("ERROR: BADE*1.0*1 is installed but BADEMRG routine not present.",IOM)
+20 WRITE !,$$CJ^XLFSTR("This may be due to an unofficial release of BADE*1.0*1.",IOM)
+21 WRITE !,$$CJ^XLFSTR("The official November 2011 patch of BADE*1.0*1 must be installed to continue.",IOM)
+22 WRITE *7,!,$$CJ^XLFSTR("^^^^**NEEDS TO BE FIXED**^^^^",IOM)
+23 SET XPDQUIT=2
End DoDot:1
+24 ;
+25 IF XPDQUIT
DO SORRY(XPDQUIT)
QUIT
+26 ;
+27 WRITE !!,$$CJ^XLFSTR("ENVIRONMENT OK.",IOM)
+28 ;
+29 QUIT
+30 ;
SORRY(X) ;
+1 KILL DIFQ
+2 SET XPDQUIT=X
+3 IF '$DATA(ZTQUEUED)
WRITE *7,!,$$CJ^XLFSTR("Sorry....",IOM),$$DIR^XBDIR("E","Press RETURN")
+4 QUIT
+5 ;
VCHK(BPMPRE,BPMVER,BPMQUIT) ; Check versions needed.
+1 ;
+2 NEW BPMV
+3 SET BPMV=$$VERSION^XPDUTL(BPMPRE)
+4 WRITE !,$$CJ^XLFSTR("Need at least "_BPMPRE_" v "_BPMVER_"....."_BPMPRE_" v "_BPMV_" Present",IOM)
+5 IF BPMV<BPMVER
SET XPDQUIT=BPMQUIT
WRITE *7,!,$$CJ^XLFSTR("^^^^**NEEDS FIXED**^^^^",IOM)
QUIT 0
+6 QUIT 1
+7 ;
VCHK2(BPMPRE,BPMVER,BPMQUIT) ; Check patch level
+1 NEW BPMV
+2 SET BPMV=$$VERSION^XPDUTL(BPMPRE)
+3 IF $LENGTH(BPMV)<1
SET XPDQUIT=BPMQUIT
WRITE !,$$CJ^XLFSTR("Need at least "_BPMPRE_" v "_BPMVER_"....."_BPMPRE_" Not Installed",IOM),*7,!,$$CJ^XLFSTR("^^^^**NEEDS TO BE FIXED**^^^^",IOM)
QUIT 1
+4 SET PTCH=+$$LAST(BPMPRE,BPMV)
IF PTCH=-1
SET DPTCH=""
IF PTCH'=-1
SET DPTCH="."_PTCH
+5 WRITE !,$$CJ^XLFSTR("Need at least "_BPMPRE_" v "_BPMVER_"....."_BPMPRE_" v "_BPMV_DPTCH_" Present",IOM)
+6 IF (BPMV=$PIECE(BPMVER,".",1,2))&(PTCH<$PIECE(BPMVER,".",3))
KILL DIFQ
SET XPDQUIT=BPMQUIT
WRITE *7,!,$$CJ^XLFSTR("^^^^**NEEDS TO BE FIXED**^^^^",IOM)
+7 QUIT 1
LAST(PKG,VER) ;EP - returns last patch applied for a Package, PATCH^DATE
+1 ; Patch includes Seq # if Released
+2 NEW PKGIEN,VERIEN,LATEST,PATCH,SUBIEN
+3 IF $GET(VER)=""
SET VER=$$VERSION^XPDUTL(PKG)
IF 'VER
QUIT -1
+4 SET PKGIEN=$ORDER(^DIC(9.4,"C",PKG,""))
IF 'PKGIEN
QUIT -1
+5 SET VERIEN=$ORDER(^DIC(9.4,PKGIEN,22,"B",VER,""))
IF 'VERIEN
QUIT -1
+6 SET LATEST=-1
SET PATCH=-1
SET SUBIEN=0
+7 FOR
SET SUBIEN=$ORDER(^DIC(9.4,PKGIEN,22,VERIEN,"PAH",SUBIEN))
IF SUBIEN'>0
QUIT
Begin DoDot:1
+8 IF $PIECE(^DIC(9.4,PKGIEN,22,VERIEN,"PAH",SUBIEN,0),U,2)>LATEST
SET LATEST=$PIECE(^(0),U,2)
SET PATCH=$PIECE(^(0),U)
+9 IF $PIECE(^DIC(9.4,PKGIEN,22,VERIEN,"PAH",SUBIEN,0),U,2)=LATEST
IF $PIECE(^(0),U)>PATCH
SET PATCH=$PIECE(^(0),U)
End DoDot:1
+10 QUIT PATCH_U_LATEST
+11 ;
