- AUPN9926 ; IHS/OIT/FBD&NKD - AUPN V99.1 PATCH 26 ENVIRONMENT CHECKS AND POST-INIT PROCESS ; 11/07/2017
- ;;99.1;IHS DICTIONARIES (PATIENT);**26**;MAR 9, 1999;Build 11
- ;
- ;
- 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","25") XPDQUIT=2 ; AUPN
- ; 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("AUPN9926",$J)
- S ^TMP("AUPN9926",$J,1)=" --- AUPN v 99.1, Patch 26, has been installed into this uci ---"
- S %=0
- F S %=$O(^XTMP("XPDI",XPDA,"BLD",XPDBLD,1,%)) Q:'% S ^TMP("AUPN9926",$J,(%+1))=" "_^(%,0)
- S XMSUB=$P($P($T(+1),";",2)," ",3,99),XMDUZ=$S($G(DUZ):DUZ,1:.5),XMTEXT="^TMP(""AUPN9926"",$J,",XMY(1)="",XMY(DUZ)=""
- F %="XUMGR","XUPROG","XUPROGMODE" D SINGLE(%)
- D ^XMD
- KILL ^TMP("AUPN9926",$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
- ;
- AUPN9926 ; IHS/OIT/FBD&NKD - AUPN V99.1 PATCH 26 ENVIRONMENT CHECKS AND POST-INIT PROCESS ; 11/07/2017
- +1 ;;99.1;IHS DICTIONARIES (PATIENT);**26**;MAR 9, 1999;Build 11
- +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","25")
- SET XPDQUIT=2
- +23 ; END OF REQUIRED VERSION/PATCH CHECKS
- +24 ;
- +25 ; REQUIRED UPDATE GLOBALS
- +26 ;
- +27 ; ADDITIONAL CHECKS IF RE-INSTALLING
- +28 ;
- +29 IF $GET(XPDQUIT)
- WRITE !,$$CJ^XLFSTR("FIX IT! Before Proceeding.",IOM),!!,*7,*7,*7
- QUIT
- +30 ;
- +31 IF +$GET(XPDQUIT)
- DO SORRY(XPDQUIT)
- +32 ;
- +33 ; END OF ENVIRONMENT CHECK RUN LOGIC
- +34 QUIT
- +35 ;
- 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("AUPN9926",$JOB)
- +4 SET ^TMP("AUPN9926",$JOB,1)=" --- AUPN v 99.1, Patch 26, has been installed into this uci ---"
- +5 SET %=0
- +6 FOR
- SET %=$ORDER(^XTMP("XPDI",XPDA,"BLD",XPDBLD,1,%))
- IF '%
- QUIT
- SET ^TMP("AUPN9926",$JOB,(%+1))=" "_^(%,0)
- +7 SET XMSUB=$PIECE($PIECE($TEXT(+1),";",2)," ",3,99)
- SET XMDUZ=$SELECT($GET(DUZ):DUZ,1:.5)
- SET XMTEXT="^TMP(""AUPN9926"",$J,"
- SET XMY(1)=""
- SET XMY(DUZ)=""
- +8 FOR %="XUMGR","XUPROG","XUPROGMODE"
- DO SINGLE(%)
- +9 DO ^XMD
- +10 KILL ^TMP("AUPN9926",$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 ;