AUPN9925 ; IHS/OIT/FBD&NKD - AUPN V99.1 PATCH 25 ENVIRONMENT CHECKS AND POST-INIT PROCESS ; 07/14/2017
;;99.1;IHS DICTIONARIES (PATIENT);**25**;MAR 9, 1999;Build 1
;
;
D:'$D(IOM) HOME^%ZIS
;
; 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
F X="XPO1","XPZ1","XPZ2","XPI1" S XPDDIQ(X)=0
;
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),!
;
; REQUIRED VERSION/PATCH CHECKS
S:'$$VCHK("XU","8.0") XPDQUIT=2 ; KERNEL
S:'$$VCHK("DI","22.0") XPDQUIT=2 ; FILEMAN
S:'$$VCHK("AUPN","99.1","24") XPDQUIT=2 ; AUPN
S:'$$VCHK("AUT","98.1","28") XPDQUIT=2 ; AUT
; END OF REQUIRED VERSION/PATCH CHECKS
;
; REQUIRED UPDATE GLOBALS
;
; ADDITIONAL CHECKS IF RE-INSTALLING
;
I $G(XPDQUIT) W !,$$CJ^XLFSTR("FIX IT! Before Proceeding.",IOM),!!,*7,*7,*7 Q
;
I +$G(XPDQUIT) D SORRY(XPDQUIT)
;
; END OF ENVIRONMENT CHECK RUN LOGIC
Q
;
SORRY(X) ; Environment check failure message
KILL DIFQ
S XPDQUIT=X
W *7,!,$$CJ^XLFSTR("Sorry....FIX IT!",IOM)
Q
;
VCHK(PRE,VER,PAT) ; Check patch level
N V,P
S V=$$VERSION^XPDUTL(PRE)
I (V<VER) K DIFQ D DISP(PRE,VER,$G(PAT),V,$G(P),0) Q 0
I '$D(PAT) D DISP(PRE,VER,$G(PAT),V,$G(P),1) Q 1
S P=+$$LAST(PRE,VER)
I (P<PAT) K DIFQ D DISP(PRE,VER,$G(PAT),VER,$G(P),0) Q 0
D DISP(PRE,VER,$G(PAT),VER,$G(P),1)
Q 1
;
GCHK(GL,MSG) ; Check for global
Q:'$L($G(GL)) 0
N S
S S="Requires "_$S('$L($G(MSG)):GL,1:$G(MSG))_"....."
S S=S_$S($D(@GL):"Present",1:"Not found ***FIX IT***")
W !,$$CJ^XLFSTR(S,IOM)
Q $S($D(@GL):1,1:0)
;
PCHK(PKG,VER,PAT) ; Check specific patch
N PKGIEN,VERIEN,PATIEN,S
S PKG=$G(PKG),VER=$G(VER),PAT=$G(PAT)
S S="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 S=S_$S(+$G(PATIEN):"Present",1:"Not found ***FIX IT***")
W !,$$CJ^XLFSTR(S,IOM)
Q $S(+$G(PATIEN):1,1:0)
;
DISP(PRE,VER,PAT,V,P,R) ; Display requirement checking results
N S
S S="Need at least "_$G(PRE)_" v"_$G(VER)_$S($G(PAT)]"":" p"_$G(PAT),1:"")_"....."
S S=S_$G(PRE)_" v"_$G(V)_$S($G(P)]"":" p"_$G(P),1:"")_" Present"
S S=S_$S('R:" ***FIX IT***",1:"")
W !,$$CJ^XLFSTR(S,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
Q
;
POST ; EP FR KIDS
D BMES^XPDUTL("Delivering "_$G(XPDNM)_" install message to select users...")
D MAIL
Q
;
MAIL ;----- SEND INSTALL MAIL MESSAGE
;
NEW DIFROM,XMSUB,XMDUZ,XMTEXT,XMY
KILL ^TMP("AUPN9925",$J)
S ^TMP("AUPN9925",$J,1)=" --- AUPN v 99.1, Patch 25, has been installed into this uci ---"
S %=0
F S %=$O(^XTMP("XPDI",XPDA,"BLD",XPDBLD,1,%)) Q:'% S ^TMP("AUPN9925",$J,(%+1))=" "_^(%,0)
S XMSUB=$P($P($T(+1),";",2)," ",3,99),XMDUZ=$S($G(DUZ):DUZ,1:.5),XMTEXT="^TMP(""AUPN9925"",$J,",XMY(1)="",XMY(DUZ)=""
F %="XUMGR","XUPROG","XUPROGMODE" D SINGLE(%)
D ^XMD
KILL ^TMP("AUPN9925",$J)
Q
;
SINGLE(K) ;----- GET HOLDERS OF A SINGLE KEY K.
Q:'$D(^XUSEC(K))
N Y S Y=0 F S Y=$O(^XUSEC(K,Y)) Q:'Y S XMY(Y)=""
Q
;
AUPN9925 ; IHS/OIT/FBD&NKD - AUPN V99.1 PATCH 25 ENVIRONMENT CHECKS AND POST-INIT PROCESS ; 07/14/2017
+1 ;;99.1;IHS DICTIONARIES (PATIENT);**25**;MAR 9, 1999;Build 1
+2 ;
+3 ;
+4 IF '$DATA(IOM)
DO HOME^%ZIS
+5 ;
+6 ; The following line prevents the "Disable Options..." and "Move Routines..."
+7 ; questions from being asked during the install.
+8 IF $GET(XPDENV)=1
SET (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
+9 FOR X="XPO1","XPZ1","XPZ2","XPI1"
SET XPDDIQ(X)=0
+10 ;
+11 IF '$GET(DUZ)
WRITE !,"DUZ UNDEFINED OR 0."
DO SORRY(2)
QUIT
+12 ;
+13 IF '$LENGTH($GET(DUZ(0)))
WRITE !,"DUZ(0) UNDEFINED OR NULL."
DO SORRY(2)
QUIT
+14 ;
+15 SET X=$PIECE(^VA(200,DUZ,0),U)
+16 WRITE !!,$$CJ^XLFSTR("Hello, "_$PIECE(X,",",2)_" "_$PIECE(X,","),IOM)
+17 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),!
+18 ;
+19 ; REQUIRED VERSION/PATCH CHECKS
+20 ; KERNEL
IF '$$VCHK("XU","8.0")
SET XPDQUIT=2
+21 ; FILEMAN
IF '$$VCHK("DI","22.0")
SET XPDQUIT=2
+22 ; AUPN
IF '$$VCHK("AUPN","99.1","24")
SET XPDQUIT=2
+23 ; AUT
IF '$$VCHK("AUT","98.1","28")
SET XPDQUIT=2
+24 ; END OF REQUIRED VERSION/PATCH CHECKS
+25 ;
+26 ; REQUIRED UPDATE GLOBALS
+27 ;
+28 ; ADDITIONAL CHECKS IF RE-INSTALLING
+29 ;
+30 IF $GET(XPDQUIT)
WRITE !,$$CJ^XLFSTR("FIX IT! Before Proceeding.",IOM),!!,*7,*7,*7
QUIT
+31 ;
+32 IF +$GET(XPDQUIT)
DO SORRY(XPDQUIT)
+33 ;
+34 ; END OF ENVIRONMENT CHECK RUN LOGIC
+35 QUIT
+36 ;
SORRY(X) ; Environment check failure message
+1 KILL DIFQ
+2 SET XPDQUIT=X
+3 WRITE *7,!,$$CJ^XLFSTR("Sorry....FIX IT!",IOM)
+4 QUIT
+5 ;
VCHK(PRE,VER,PAT) ; Check patch level
+1 NEW V,P
+2 SET V=$$VERSION^XPDUTL(PRE)
+3 IF (V<VER)
KILL DIFQ
DO DISP(PRE,VER,$GET(PAT),V,$GET(P),0)
QUIT 0
+4 IF '$DATA(PAT)
DO DISP(PRE,VER,$GET(PAT),V,$GET(P),1)
QUIT 1
+5 SET P=+$$LAST(PRE,VER)
+6 IF (P<PAT)
KILL DIFQ
DO DISP(PRE,VER,$GET(PAT),VER,$GET(P),0)
QUIT 0
+7 DO DISP(PRE,VER,$GET(PAT),VER,$GET(P),1)
+8 QUIT 1
+9 ;
GCHK(GL,MSG) ; Check for global
+1 IF '$LENGTH($GET(GL))
QUIT 0
+2 NEW S
+3 SET S="Requires "_$SELECT('$LENGTH($GET(MSG)):GL,1:$GET(MSG))_"....."
+4 SET S=S_$SELECT($DATA(@GL):"Present",1:"Not found ***FIX IT***")
+5 WRITE !,$$CJ^XLFSTR(S,IOM)
+6 QUIT $SELECT($DATA(@GL):1,1:0)
+7 ;
PCHK(PKG,VER,PAT) ; Check specific patch
+1 NEW PKGIEN,VERIEN,PATIEN,S
+2 SET PKG=$GET(PKG)
SET VER=$GET(VER)
SET PAT=$GET(PAT)
+3 SET S="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 S=S_$SELECT(+$GET(PATIEN):"Present",1:"Not found ***FIX IT***")
+9 WRITE !,$$CJ^XLFSTR(S,IOM)
+10 QUIT $SELECT(+$GET(PATIEN):1,1:0)
+11 ;
DISP(PRE,VER,PAT,V,P,R) ; Display requirement checking results
+1 NEW S
+2 SET S="Need at least "_$GET(PRE)_" v"_$GET(VER)_$SELECT($GET(PAT)]"":" p"_$GET(PAT),1:"")_"....."
+3 SET S=S_$GET(PRE)_" v"_$GET(V)_$SELECT($GET(P)]"":" p"_$GET(P),1:"")_" Present"
+4 SET S=S_$SELECT('R:" ***FIX IT***",1:"")
+5 WRITE !,$$CJ^XLFSTR(S,IOM)
+6 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 QUIT
+2 ;
POST ; EP FR KIDS
+1 DO BMES^XPDUTL("Delivering "_$GET(XPDNM)_" install message to select users...")
+2 DO MAIL
+3 QUIT
+4 ;
MAIL ;----- SEND INSTALL MAIL MESSAGE
+1 ;
+2 NEW DIFROM,XMSUB,XMDUZ,XMTEXT,XMY
+3 KILL ^TMP("AUPN9925",$JOB)
+4 SET ^TMP("AUPN9925",$JOB,1)=" --- AUPN v 99.1, Patch 25, has been installed into this uci ---"
+5 SET %=0
+6 FOR
SET %=$ORDER(^XTMP("XPDI",XPDA,"BLD",XPDBLD,1,%))
IF '%
QUIT
SET ^TMP("AUPN9925",$JOB,(%+1))=" "_^(%,0)
+7 SET XMSUB=$PIECE($PIECE($TEXT(+1),";",2)," ",3,99)
SET XMDUZ=$SELECT($GET(DUZ):DUZ,1:.5)
SET XMTEXT="^TMP(""AUPN9925"",$J,"
SET XMY(1)=""
SET XMY(DUZ)=""
+8 FOR %="XUMGR","XUPROG","XUPROGMODE"
DO SINGLE(%)
+9 DO ^XMD
+10 KILL ^TMP("AUPN9925",$JOB)
+11 QUIT
+12 ;
SINGLE(K) ;----- GET HOLDERS OF A SINGLE KEY K.
+1 IF '$DATA(^XUSEC(K))
QUIT
+2 NEW Y
SET Y=0
FOR
SET Y=$ORDER(^XUSEC(K,Y))
IF 'Y
QUIT
SET XMY(Y)=""
+3 QUIT
+4 ;
