AUMI10 ;IHS/OIT/NKD - ENVIRONMENT CHECK/PRE/POST-INSTALL FOR ICD10 - 09/04/2018 ;
;;19.0;ICD UPDATE;;SEP 04,2018;Build 1
;
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("AICD","4.0") XPDQUIT=2
S:'$$VCHK("AUM","18.0") 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)
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
;
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***")
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***")
W !,$$CJ^XLFSTR(AUMS,IOM)
Q $S(+$G(PATIEN):1,1:0)
;
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
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
Q
;
POST ; EP FR KIDS
K ^TMP("AUM",$J)
S ^TMP("AUM",$J,"AUMDT")="3"_(+$P($G(XPDNM)," ",2)-1)_"1001"
D POST^AUMI10D
K ^TMP("AUM",$J)
Q
;
AUMI10 ;IHS/OIT/NKD - ENVIRONMENT CHECK/PRE/POST-INSTALL FOR ICD10 - 09/04/2018 ;
+1 ;;19.0;ICD UPDATE;;SEP 04,2018;Build 1
+2 ;
+3 IF '$GET(DUZ)
WRITE !,"DUZ UNDEFINED OR 0."
DO SORRY(2)
QUIT
+4 ;
+5 IF '$LENGTH($GET(DUZ(0)))
WRITE !,"DUZ(0) UNDEFINED OR NULL."
DO SORRY(2)
QUIT
+6 ;
+7 SET X=$PIECE(^VA(200,DUZ,0),U)
+8 WRITE !!,$$CJ^XLFSTR("Hello, "_$PIECE(X,",",2)_" "_$PIECE(X,","),IOM)
+9 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),!
+10 ;
+11 IF '$$VCHK("AICD","4.0")
SET XPDQUIT=2
+12 IF '$$VCHK("AUM","18.0")
SET XPDQUIT=2
+13 ;
+14 NEW DA,DIC
+15 SET X="AUM"
SET DIC="^DIC(9.4,"
SET DIC(0)=""
SET D="C"
+16 DO IX^DIC
+17 IF Y<0
IF $DATA(^DIC(9.4,"C","AUM"))
Begin DoDot:1
+18 WRITE !!,*7,*7,$$CJ^XLFSTR("You Have More Than One Entry In The",IOM),!,$$CJ^XLFSTR("PACKAGE File with an ""AUM"" prefix.",IOM)
+19 WRITE !,$$CJ^XLFSTR("One entry needs to be deleted.",IOM)
+20 DO SORRY(2)
+21 QUIT
End DoDot:1
+22 ;
+23 IF $GET(XPDQUIT)
WRITE !,$$CJ^XLFSTR("FIX IT! Before Proceeding.",IOM),!!,*7,*7,*7
QUIT
+24 ;
+25 WRITE !!,$$CJ^XLFSTR("ENVIRONMENT OK.",IOM)
+26 ;
+27 IF $GET(XPDENV)=1
Begin DoDot:1
+28 ; The following line prevents the "Disable Options..." and "Move
+29 ; Routines..." questions from being asked during the install.
+30 SET (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
+31 QUIT
End DoDot:1
+32 ;
+33 IF '$$DIR^XBDIR("E","","","","","",1)
DO SORRY(2)
+34 QUIT
+35 ;
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 ;
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 WRITE !,$$CJ^XLFSTR(AUMS,IOM)
+6 QUIT $SELECT($DATA(@AUMGL):1,1:0)
+7 ;
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 WRITE !,$$CJ^XLFSTR(AUMS,IOM)
+10 QUIT $SELECT(+$GET(PATIEN):1,1:0)
+11 ;
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 NEW AUMI
+2 SET AUMI=0
FOR
SET AUMI=$ORDER(^AUMDATA(AUMI))
IF 'AUMI
QUIT
KILL ^AUMDATA(AUMI)
+3 FOR AUMI=3,4
SET $PIECE(^AUMDATA(0),"^",AUMI)=0
+4 QUIT
+5 ;
POST ; EP FR KIDS
+1 KILL ^TMP("AUM",$JOB)
+2 SET ^TMP("AUM",$JOB,"AUMDT")="3"_(+$PIECE($GET(XPDNM)," ",2)-1)_"1001"
+3 DO POST^AUMI10D
+4 KILL ^TMP("AUM",$JOB)
+5 QUIT
+6 ;
