AUMSCB ;IHS/OIT/NKD - SCB UPDATE ENVIRONMENT CHECK/PRE/POST INSTALL 3/08/2013 ;
;;19.0;TABLE MAINTENANCE;**1**;SEP 04,2018;Build 1
; 03/12/14 - Removed use of AUMPRE for pre-install, changed to just remove AUMDATA entries
; 12/16/14 - Removed old/unused code, added support for future environment checking
; 03/11/15 - Modified environment checking display to write to screen
; 12/04/17 - Removed confirmation prompt from environment checker
;
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)_$S($L($P($T(+2),";",5))>4:" Patch "_$P($T(+2),";",5),1:"")_".",IOM),!
;
S:'$$VCHK("XU","8.0") XPDQUIT=2
S:'$$VCHK("DI","22.0") XPDQUIT=2
S:'$$PCHK("AUM","18.0","4") XPDQUIT=2
S:'$$VCHK("AUT","98.1","27") XPDQUIT=2
;
NEW DA,DIC
S X="AUM",DIC="^DIC(9.4,",DIC(0)="",D="C"
D IX^DIC
I Y<0,$D(^DIC(9.4,"C","AUM")) D
. W !!,*7,*7,$$CJ^XLFSTR("You Have More Than One Entry In The",IOM),!,$$CJ^XLFSTR("PACKAGE File with an ""AUM"" prefix.",IOM)
. W !,$$CJ^XLFSTR("One entry needs to be deleted.",IOM)
. D SORRY(2)
.Q
;
I $G(XPDQUIT) W !,$$CJ^XLFSTR("FIX IT! Before Proceeding.",IOM),!!,*7,*7,*7 Q
;
W !!,$$CJ^XLFSTR("ENVIRONMENT OK.",IOM)
;
I $G(XPDENV)=1 D
. ; The following line prevents the "Disable Options..." and "Move
. ; Routines..." questions from being asked during the install.
. S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
.Q
;
;I '$$DIR^XBDIR("E","","","","","",1) D SORRY(2) ;IHS/OIT/NKD AUM*18.0*1 REMOVED CONFIRMATION PROMPT
Q
;
SORRY(X) ;
KILL DIFQ
S XPDQUIT=X
W *7,!,$$CJ^XLFSTR("Sorry....FIX IT!",IOM)
Q
;
VCHK(AUMPRE,AUMVER,AUMPAT) ; Check patch level
N AUMV,AUMP
S AUMV=$$VERSION^XPDUTL(AUMPRE)
I (AUMV<AUMVER) K DIFQ D DISP(AUMPRE,AUMVER,$G(AUMPAT),AUMV,$G(AUMP),0) Q 0
I '$D(AUMPAT) D DISP(AUMPRE,AUMVER,$G(AUMPAT),AUMV,$G(AUMP),1) Q 1
S AUMP=+$$LAST(AUMPRE,AUMVER)
I (AUMP<AUMPAT) K DIFQ D DISP(AUMPRE,AUMVER,$G(AUMPAT),AUMVER,$G(AUMP),0) Q 0
D DISP(AUMPRE,AUMVER,$G(AUMPAT),AUMVER,$G(AUMP),1)
Q 1
;
; IHS/OIT/NKD AUM*15.0*1 ADDED FUTURE SUPPORT FOR GLOBAL/PATCH CHECKING - START NEW CODE
GCHK(AUMGL,AUMMSG) ; Check for global
Q:'$L($G(AUMGL)) 0
N AUMS
S AUMS="Requires "_$S('$L($G(AUMMSG)):AUMGL,1:$G(AUMMSG))_"....."
S AUMS=AUMS_$S($D(@AUMGL):"Present",1:"Not found ***FIX IT***")
;D MES^XPDUTL($$CJ^XLFSTR(AUMS,IOM)) ; IHS/OIT/NKD AUM*15.0*2 WRITE TO SCREEN
W !,$$CJ^XLFSTR(AUMS,IOM)
Q $S($D(@AUMGL):1,1:0)
;
PCHK(PKG,VER,PAT) ; Check specific patch
N PKGIEN,VERIEN,PATIEN,AUMS
S PKG=$G(PKG),VER=$G(VER),PAT=$G(PAT)
S AUMS="Requires "_PKG_" v"_VER_" p"_PAT_"....."
D
. S PKGIEN=+$O(^DIC(9.4,"C",PKG,"")) Q:'PKGIEN
. S VERIEN=+$O(^DIC(9.4,PKGIEN,22,"B",VER,"")) Q:'VERIEN
. S PATIEN=+$O(^DIC(9.4,PKGIEN,22,VERIEN,"PAH","B",PAT,""))
S AUMS=AUMS_$S(+$G(PATIEN):"Present",1:"Not found ***FIX IT***")
;D MES^XPDUTL($$CJ^XLFSTR(AUMS,IOM)) ; IHS/OIT/NKD AUM*15.0*2 WRITE TO SCREEN
W !,$$CJ^XLFSTR(AUMS,IOM)
Q $S(+$G(PATIEN):1,1:0)
; IHS/OIT/NKD AUM*15.0*1 END NEW CODE
;
DISP(AUMPRE,AUMVER,AUMPAT,AUMV,AUMP,AUMR) ; Display requirement checking results
;
N AUMS
S AUMS="Need at least "_$G(AUMPRE)_" v"_$G(AUMVER)_$S($G(AUMPAT)]"":" p"_$G(AUMPAT),1:"")_"....."
S AUMS=AUMS_$G(AUMPRE)_" v"_$G(AUMV)_$S($G(AUMP)]"":" p"_$G(AUMP),1:"")_" Present"
S AUMS=AUMS_$S('AUMR:" ***FIX IT***",1:"")
W !,$$CJ^XLFSTR(AUMS,IOM)
Q
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
;
PRE ; EP FR KIDS
; IHS/OIT/NKD AUM*14.0*2 REMOVE DATA FROM AUMDATA W/O CLEANING UP CONTROL CHARS - START OLD CODE
;CLEAN UP CONTROL CHAR AND REMOVE DATA FROM AUMDATA
;D START^AUMPRE ; IHS/OIT/NKD AUM*14.0*2 END OLD CODE - START NEW CODE
N AUMI
S AUMI=0 F S AUMI=$O(^AUMDATA(AUMI)) Q:'AUMI K ^AUMDATA(AUMI)
F AUMI=3,4 S $P(^AUMDATA(0),"^",AUMI)=0
; IHS/OIT/NKD AUM*14.0*2 END NEW CODE
Q
;
POST ; EP FR KIDS
K ^TMP("AUM",$J)
D COUNT
D POST^AUMSCBD
K ^TMP("AUM",$J)
Q
;
COUNT ; COUNT THE NUMBER OF ENTRIES FOR EACH TABLE
N AUMI,AUMT,AUMA,AUMC
S AUMI=0 F S AUMI=$O(^AUMDATA(AUMI)) Q:'AUMI D
. S (AUMT,AUMA)=""
. S AUMT=$P(^AUMDATA(AUMI,0),U,2)
. F AUMC="ADD","INA","DEL","ALL" Q:$L(AUMA)>0 S:$E(AUMT,$L(AUMT)-2,$L(AUMT))=AUMC AUMA=$E(AUMT,$L(AUMT)-2,$L(AUMT)),AUMT=$E(AUMT,1,$L(AUMT)-3)
. S ^TMP("AUM",$J,"COUNT",AUMT)=$G(^TMP("AUM",$J,"COUNT",AUMT))+1
Q
;
AUMSCB ;IHS/OIT/NKD - SCB UPDATE ENVIRONMENT CHECK/PRE/POST INSTALL 3/08/2013 ;
+1 ;;19.0;TABLE MAINTENANCE;**1**;SEP 04,2018;Build 1
+2 ; 03/12/14 - Removed use of AUMPRE for pre-install, changed to just remove AUMDATA entries
+3 ; 12/16/14 - Removed old/unused code, added support for future environment checking
+4 ; 03/11/15 - Modified environment checking display to write to screen
+5 ; 12/04/17 - Removed confirmation prompt from environment checker
+6 ;
+7 IF '$GET(DUZ)
WRITE !,"DUZ UNDEFINED OR 0."
DO SORRY(2)
QUIT
+8 ;
+9 IF '$LENGTH($GET(DUZ(0)))
WRITE !,"DUZ(0) UNDEFINED OR NULL."
DO SORRY(2)
QUIT
+10 ;
+11 SET X=$PIECE(^VA(200,DUZ,0),U)
+12 WRITE !!,$$CJ^XLFSTR("Hello, "_$PIECE(X,",",2)_" "_$PIECE(X,","),IOM)
+13 WRITE !!,$$CJ^XLFSTR("Checking Environment for "_$PIECE($TEXT(+2),";",4)_" V "_$PIECE($TEXT(+2),";",3)_$SELECT($LENGTH($PIECE($TEXT(+2),";",5))>4:" Patch "_$PIECE($TEXT(+2),";",5),1:"")_".",IOM),!
+14 ;
+15 IF '$$VCHK("XU","8.0")
SET XPDQUIT=2
+16 IF '$$VCHK("DI","22.0")
SET XPDQUIT=2
+17 IF '$$PCHK("AUM","18.0","4")
SET XPDQUIT=2
+18 IF '$$VCHK("AUT","98.1","27")
SET XPDQUIT=2
+19 ;
+20 NEW DA,DIC
+21 SET X="AUM"
SET DIC="^DIC(9.4,"
SET DIC(0)=""
SET D="C"
+22 DO IX^DIC
+23 IF Y<0
IF $DATA(^DIC(9.4,"C","AUM"))
Begin DoDot:1
+24 WRITE !!,*7,*7,$$CJ^XLFSTR("You Have More Than One Entry In The",IOM),!,$$CJ^XLFSTR("PACKAGE File with an ""AUM"" prefix.",IOM)
+25 WRITE !,$$CJ^XLFSTR("One entry needs to be deleted.",IOM)
+26 DO SORRY(2)
+27 QUIT
End DoDot:1
+28 ;
+29 IF $GET(XPDQUIT)
WRITE !,$$CJ^XLFSTR("FIX IT! Before Proceeding.",IOM),!!,*7,*7,*7
QUIT
+30 ;
+31 WRITE !!,$$CJ^XLFSTR("ENVIRONMENT OK.",IOM)
+32 ;
+33 IF $GET(XPDENV)=1
Begin DoDot:1
+34 ; The following line prevents the "Disable Options..." and "Move
+35 ; Routines..." questions from being asked during the install.
+36 SET (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
+37 QUIT
End DoDot:1
+38 ;
+39 ;I '$$DIR^XBDIR("E","","","","","",1) D SORRY(2) ;IHS/OIT/NKD AUM*18.0*1 REMOVED CONFIRMATION PROMPT
+40 QUIT
+41 ;
SORRY(X) ;
+1 KILL DIFQ
+2 SET XPDQUIT=X
+3 WRITE *7,!,$$CJ^XLFSTR("Sorry....FIX IT!",IOM)
+4 QUIT
+5 ;
VCHK(AUMPRE,AUMVER,AUMPAT) ; Check patch level
+1 NEW AUMV,AUMP
+2 SET AUMV=$$VERSION^XPDUTL(AUMPRE)
+3 IF (AUMV<AUMVER)
KILL DIFQ
DO DISP(AUMPRE,AUMVER,$GET(AUMPAT),AUMV,$GET(AUMP),0)
QUIT 0
+4 IF '$DATA(AUMPAT)
DO DISP(AUMPRE,AUMVER,$GET(AUMPAT),AUMV,$GET(AUMP),1)
QUIT 1
+5 SET AUMP=+$$LAST(AUMPRE,AUMVER)
+6 IF (AUMP<AUMPAT)
KILL DIFQ
DO DISP(AUMPRE,AUMVER,$GET(AUMPAT),AUMVER,$GET(AUMP),0)
QUIT 0
+7 DO DISP(AUMPRE,AUMVER,$GET(AUMPAT),AUMVER,$GET(AUMP),1)
+8 QUIT 1
+9 ;
+10 ; IHS/OIT/NKD AUM*15.0*1 ADDED FUTURE SUPPORT FOR GLOBAL/PATCH CHECKING - START NEW CODE
GCHK(AUMGL,AUMMSG) ; Check for global
+1 IF '$LENGTH($GET(AUMGL))
QUIT 0
+2 NEW AUMS
+3 SET AUMS="Requires "_$SELECT('$LENGTH($GET(AUMMSG)):AUMGL,1:$GET(AUMMSG))_"....."
+4 SET AUMS=AUMS_$SELECT($DATA(@AUMGL):"Present",1:"Not found ***FIX IT***")
+5 ;D MES^XPDUTL($$CJ^XLFSTR(AUMS,IOM)) ; IHS/OIT/NKD AUM*15.0*2 WRITE TO SCREEN
+6 WRITE !,$$CJ^XLFSTR(AUMS,IOM)
+7 QUIT $SELECT($DATA(@AUMGL):1,1:0)
+8 ;
PCHK(PKG,VER,PAT) ; Check specific patch
+1 NEW PKGIEN,VERIEN,PATIEN,AUMS
+2 SET PKG=$GET(PKG)
SET VER=$GET(VER)
SET PAT=$GET(PAT)
+3 SET AUMS="Requires "_PKG_" v"_VER_" p"_PAT_"....."
+4 Begin DoDot:1
+5 SET PKGIEN=+$ORDER(^DIC(9.4,"C",PKG,""))
IF 'PKGIEN
QUIT
+6 SET VERIEN=+$ORDER(^DIC(9.4,PKGIEN,22,"B",VER,""))
IF 'VERIEN
QUIT
+7 SET PATIEN=+$ORDER(^DIC(9.4,PKGIEN,22,VERIEN,"PAH","B",PAT,""))
End DoDot:1
+8 SET AUMS=AUMS_$SELECT(+$GET(PATIEN):"Present",1:"Not found ***FIX IT***")
+9 ;D MES^XPDUTL($$CJ^XLFSTR(AUMS,IOM)) ; IHS/OIT/NKD AUM*15.0*2 WRITE TO SCREEN
+10 WRITE !,$$CJ^XLFSTR(AUMS,IOM)
+11 QUIT $SELECT(+$GET(PATIEN):1,1:0)
+12 ; IHS/OIT/NKD AUM*15.0*1 END NEW CODE
+13 ;
DISP(AUMPRE,AUMVER,AUMPAT,AUMV,AUMP,AUMR) ; Display requirement checking results
+1 ;
+2 NEW AUMS
+3 SET AUMS="Need at least "_$GET(AUMPRE)_" v"_$GET(AUMVER)_$SELECT($GET(AUMPAT)]"":" p"_$GET(AUMPAT),1:"")_"....."
+4 SET AUMS=AUMS_$GET(AUMPRE)_" v"_$GET(AUMV)_$SELECT($GET(AUMP)]"":" p"_$GET(AUMP),1:"")_" Present"
+5 SET AUMS=AUMS_$SELECT('AUMR:" ***FIX IT***",1:"")
+6 WRITE !,$$CJ^XLFSTR(AUMS,IOM)
+7 QUIT
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 ;
PRE ; EP FR KIDS
+1 ; IHS/OIT/NKD AUM*14.0*2 REMOVE DATA FROM AUMDATA W/O CLEANING UP CONTROL CHARS - START OLD CODE
+2 ;CLEAN UP CONTROL CHAR AND REMOVE DATA FROM AUMDATA
+3 ;D START^AUMPRE ; IHS/OIT/NKD AUM*14.0*2 END OLD CODE - START NEW CODE
+4 NEW AUMI
+5 SET AUMI=0
FOR
SET AUMI=$ORDER(^AUMDATA(AUMI))
IF 'AUMI
QUIT
KILL ^AUMDATA(AUMI)
+6 FOR AUMI=3,4
SET $PIECE(^AUMDATA(0),"^",AUMI)=0
+7 ; IHS/OIT/NKD AUM*14.0*2 END NEW CODE
+8 QUIT
+9 ;
POST ; EP FR KIDS
+1 KILL ^TMP("AUM",$JOB)
+2 DO COUNT
+3 DO POST^AUMSCBD
+4 KILL ^TMP("AUM",$JOB)
+5 QUIT
+6 ;
COUNT ; COUNT THE NUMBER OF ENTRIES FOR EACH TABLE
+1 NEW AUMI,AUMT,AUMA,AUMC
+2 SET AUMI=0
FOR
SET AUMI=$ORDER(^AUMDATA(AUMI))
IF 'AUMI
QUIT
Begin DoDot:1
+3 SET (AUMT,AUMA)=""
+4 SET AUMT=$PIECE(^AUMDATA(AUMI,0),U,2)
+5 FOR AUMC="ADD","INA","DEL","ALL"
IF $LENGTH(AUMA)>0
QUIT
IF $EXTRACT(AUMT,$LENGTH(AUMT)-2,$LENGTH(AUMT))=AUMC
SET AUMA=$EXTRACT(AUMT,$LENGTH(AUMT)-2,$LENGTH(AUMT))
SET AUMT=$EXTRACT(AUMT,1,$LENGTH(AUMT)-3)
+6 SET ^TMP("AUM",$JOB,"COUNT",AUMT)=$GET(^TMP("AUM",$JOB,"COUNT",AUMT))+1
End DoDot:1
+7 QUIT
+8 ;
