AVA32P16 ;IHS/ITSC/AEF - AVA 93.2 PATCH 16 ; [ 05/12/2003 5:07 PM ]
;;93.2;VA SUPPORT FILES;**16**;JUL 01, 1993;Build 12
;
;IHS/ITSC/AEF AVA*93.2*16 05/07/2003
;
ENV ;----- ENVIRONMENT CHECK
;
N IORVOFF,IORVON
;
D HOME^%ZIS
;
D DUZ
I $G(XPDQUIT) D SORRY Q
;
D RV
D XPZ
D HELLO
D VER
D DUPE
D OK
;
I $D(XPDQUIT) W !,"INSTALL ABORTED!"
;
Q
;
DUZ ;----- CHECK FOR VALID DUZ VARIABLES
;
I '$G(DUZ) W !,"DUZ UNDEFINED OR 0." D FAIL(2)
I '$L($G(DUZ(0))) W !,"DUZ(0) UNDEFINED OR NULL." D FAIL(2)
I '($G(DUZ(0))["@") W !,"THE DD UPDATES REQUIRE AN '@' IN YOUR DUZ(0)" D FAIL(2)
Q
;
RV ;----- SET REVERSE VIDEO ON/OFF VARIABLES
;
D HOME^%ZIS
N X
S X="IORVON;IORVOFF"
D ENDR^%ZISS
Q
;
XPZ ;----- PREVENT 'DISABLE OPTIONS' AND 'MOVE ROUTINES' PROMPTS
;
I $G(XPDENV)=1 D
. S XPDDIQ("XPZ1")=0 ;SUPPRESS 'DISABLE OPTIONS' PROMPT
. S XPDDIQ("XPZ2")=0 ;SUPPRESS 'MOVE ROUTINES' PROMT
Q
;
HELLO ;----- HELLO MESSAGE AND ENVIRONMENT CHECK
;
N X
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)
Q
;
VER ;----- CHECK FOR VERSIONS
;
I $$VCHK("AVA","93.2",2)
I $$VCHK("DI","21.0",2)
I $$VCHK("XU","8.0",2)
Q
;
CHKPAT(X) ;
;----- CHECK IF PATCH HAS BEEN INSTALLED
;
N XPDA,OK
S OK=0
S XPDA=0
F S XPDA=$O(^XPD(9.7,"B",X,XPDA)) Q:'XPDA D
. I $P($G(^XPD(9.7,XPDA,0)),U,9)=3 S OK=1
Q OK
;
DUPE ;----- CHECK FOR DUPLICATE AVA ENTRIES IN PACKAGE FILE
;
N D,DA,DIC,X,Y
S X="AVA",DIC="^DIC(9.4,",DIC(0)="",D="C"
D IX^DIC
I Y<0,$D(^DIC(9.4,"C","AVA")) D
. W !!,*7,*7,$$CJ^XLFSTR("You have more than one entry in the ",IOM)
. W !,$$CJ^XLFSTR("PACKAGE file with an 'AVA' prefix. ",IOM)
. W !,$$CJ^XLFSTR(IORVON_"One entry needs to be deleted"_IORVOFF,IOM)
. W !,$$CJ^XLFSTR("FIX IT! Before proceeding. ",IOM),!!,*7,*7
. D FAIL(2)
Q
;
OK ;----- OK TO INSTALL?
;
I $D(XPDQUIT) D
. W !!,$$CJ^XLFSTR(IORVON_"Please FIX it!!"_IORVOFF,IOM) D SORRY
;
I '$D(XPDQUIT) D
. W !!,$$CJ^XLFSTR("ENVIRONMENT OK.",IOM)
. I '$$DIR^XBDIR("E","","","","","",1) D FAIL(2)
Q
;
FAIL(X) ;----- SET XPDQUIT
;
K DIFQ
S XPDQUIT=X
Q
;
SORRY ;----- ISSUE 'SORRY... PRESS RETURN' MESSAGES
;
N Y
I '$D(ZTQUEUED) D
. W *7,!,$$CJ^XLFSTR("Sorry.... ",IOM)
. S Y=$$DIR^XBDIR("E","Press RETURN")
Q
;
VCHK(AVAPRE,AVAVER,AVAQUIT) ;
;----- CHECK VERSIONS NEEDED
;
N AVAV,AVAMSG,Y
;
S Y=1
S AVAV=$$VERSION^XPDUTL(AVAPRE)
S AVAMSG=$S(AVAV<AVAVER:" <<<--- FIX IT!",1:"")
;
W !,$$CJ^XLFSTR("Need at least "_AVAPRE_" v "_AVAVER_"....."_AVAPRE_" v "_AVAV_" Present"_AVAMSG,IOM)
;
I AVAV<AVAVER D FAIL(AVAQUIT) S Y=0
;
Q Y
;
PRE ;EP -- PREINSTALL FROM KIDS.
D BMES^XPDUTL("Beginning pre-install routine (PRE^AVA32P16).")
;
D MES^XPDUTL("Pre-install routine is complete.")
Q
;
POST ;EP -- POST INSTALL FROM KIDS.
NEW AVA
D BMES^XPDUTL("Beginning post-install routine (POST^AVA32P16).")
;
D BMES^XPDUTL("Changing sub-file dictionary number in the 9999999.18 multiple...")
D SFDD
;
D BMES^XPDUTL("Delivering AVA*93.2*16 install message to select users...")
D MAIL
;
D BMES^XPDUTL("Post-install routine is complete.")
Q
;
SFDD ;----- CHANGE SUB-FILE DD NUMBER IN THE 9999999.18 MULTIPLE OF FILE 200
;
N I,P
;
S P=$P(^DD(200,9999999.18,0),U,2)
S I=0
F S I=$O(^VA(200,I)) Q:'(I=+I) D
. I $D(^VA(200,I,9999999.18,0)) S $P(^(0),U,2)=P
Q
;
MAIL ;----- SEND INSTALL MAIL MESSAGE
;
N DIFROM,XMSUB,XMDUZ,XMTEXT,XMY
;
K ^TMP("AVAP16MS",$J)
;
S ^TMP("AVAP16MS",$J,1)=" --- AVA v 93.2, Patch 16, has been installed into this uci ---"
;
S %=0
F S %=$O(^XTMP("XPDI",XPDA,"BLD",XPDBLD,1,%)) Q:'% D
. S ^TMP("AVAP16MS",$J,(%+1))=" "_^(%,0)
;
S XMSUB=$P($P($T(+1),";",2)," ",4,99)
S XMDUZ=$S($G(DUZ):DUZ,1:.5)
S XMTEXT="^TMP(""AVAP16MS"",$J,"
S XMY(1)=""
S XMY(DUZ)=""
;
F %="XUMGR","XUPROG","XUPROGMODE" D SINGLE(%)
;
D ^XMD
;
K ^TMP("AVAP16MS",$J)
;
Q
;
SINGLE(K) ;----- GET HOLDERS OF A SINGLE KEY K.
;
N Y
;
Q:'$D(^XUSEC(K))
;
S Y=0
F S Y=$O(^XUSEC(K,Y)) Q:'Y S XMY(Y)=""
;
Q
;
AVA32P16 ;IHS/ITSC/AEF - AVA 93.2 PATCH 16 ; [ 05/12/2003 5:07 PM ]
+1 ;;93.2;VA SUPPORT FILES;**16**;JUL 01, 1993;Build 12
+2 ;
+3 ;IHS/ITSC/AEF AVA*93.2*16 05/07/2003
+4 ;
ENV ;----- ENVIRONMENT CHECK
+1 ;
+2 NEW IORVOFF,IORVON
+3 ;
+4 DO HOME^%ZIS
+5 ;
+6 DO DUZ
+7 IF $GET(XPDQUIT)
DO SORRY
QUIT
+8 ;
+9 DO RV
+10 DO XPZ
+11 DO HELLO
+12 DO VER
+13 DO DUPE
+14 DO OK
+15 ;
+16 IF $DATA(XPDQUIT)
WRITE !,"INSTALL ABORTED!"
+17 ;
+18 QUIT
+19 ;
DUZ ;----- CHECK FOR VALID DUZ VARIABLES
+1 ;
+2 IF '$GET(DUZ)
WRITE !,"DUZ UNDEFINED OR 0."
DO FAIL(2)
+3 IF '$LENGTH($GET(DUZ(0)))
WRITE !,"DUZ(0) UNDEFINED OR NULL."
DO FAIL(2)
+4 IF '($GET(DUZ(0))["@")
WRITE !,"THE DD UPDATES REQUIRE AN '@' IN YOUR DUZ(0)"
DO FAIL(2)
+5 QUIT
+6 ;
RV ;----- SET REVERSE VIDEO ON/OFF VARIABLES
+1 ;
+2 DO HOME^%ZIS
+3 NEW X
+4 SET X="IORVON;IORVOFF"
+5 DO ENDR^%ZISS
+6 QUIT
+7 ;
XPZ ;----- PREVENT 'DISABLE OPTIONS' AND 'MOVE ROUTINES' PROMPTS
+1 ;
+2 IF $GET(XPDENV)=1
Begin DoDot:1
+3 ;SUPPRESS 'DISABLE OPTIONS' PROMPT
SET XPDDIQ("XPZ1")=0
+4 ;SUPPRESS 'MOVE ROUTINES' PROMT
SET XPDDIQ("XPZ2")=0
End DoDot:1
+5 QUIT
+6 ;
HELLO ;----- HELLO MESSAGE AND ENVIRONMENT CHECK
+1 ;
+2 NEW X
+3 SET X=$PIECE(^VA(200,DUZ,0),U)
+4 WRITE !!,$$CJ^XLFSTR("Hello, "_$PIECE(X,",",2)_" "_$PIECE(X,","),IOM)
+5 WRITE !!,$$CJ^XLFSTR("Checking Environment for "_$PIECE($TEXT(+2),";",4)_" V "_$PIECE($TEXT(+2),";",3)_" Patch "_$PIECE($TEXT(+2),";",5)_".",IOM)
+6 QUIT
+7 ;
VER ;----- CHECK FOR VERSIONS
+1 ;
+2 IF $$VCHK("AVA","93.2",2)
+3 IF $$VCHK("DI","21.0",2)
+4 IF $$VCHK("XU","8.0",2)
+5 QUIT
+6 ;
CHKPAT(X) ;
+1 ;----- CHECK IF PATCH HAS BEEN INSTALLED
+2 ;
+3 NEW XPDA,OK
+4 SET OK=0
+5 SET XPDA=0
+6 FOR
SET XPDA=$ORDER(^XPD(9.7,"B",X,XPDA))
IF 'XPDA
QUIT
Begin DoDot:1
+7 IF $PIECE($GET(^XPD(9.7,XPDA,0)),U,9)=3
SET OK=1
End DoDot:1
+8 QUIT OK
+9 ;
DUPE ;----- CHECK FOR DUPLICATE AVA ENTRIES IN PACKAGE FILE
+1 ;
+2 NEW D,DA,DIC,X,Y
+3 SET X="AVA"
SET DIC="^DIC(9.4,"
SET DIC(0)=""
SET D="C"
+4 DO IX^DIC
+5 IF Y<0
IF $DATA(^DIC(9.4,"C","AVA"))
Begin DoDot:1
+6 WRITE !!,*7,*7,$$CJ^XLFSTR("You have more than one entry in the ",IOM)
+7 WRITE !,$$CJ^XLFSTR("PACKAGE file with an 'AVA' prefix. ",IOM)
+8 WRITE !,$$CJ^XLFSTR(IORVON_"One entry needs to be deleted"_IORVOFF,IOM)
+9 WRITE !,$$CJ^XLFSTR("FIX IT! Before proceeding. ",IOM),!!,*7,*7
+10 DO FAIL(2)
End DoDot:1
+11 QUIT
+12 ;
OK ;----- OK TO INSTALL?
+1 ;
+2 IF $DATA(XPDQUIT)
Begin DoDot:1
+3 WRITE !!,$$CJ^XLFSTR(IORVON_"Please FIX it!!"_IORVOFF,IOM)
DO SORRY
End DoDot:1
+4 ;
+5 IF '$DATA(XPDQUIT)
Begin DoDot:1
+6 WRITE !!,$$CJ^XLFSTR("ENVIRONMENT OK.",IOM)
+7 IF '$$DIR^XBDIR("E","","","","","",1)
DO FAIL(2)
End DoDot:1
+8 QUIT
+9 ;
FAIL(X) ;----- SET XPDQUIT
+1 ;
+2 KILL DIFQ
+3 SET XPDQUIT=X
+4 QUIT
+5 ;
SORRY ;----- ISSUE 'SORRY... PRESS RETURN' MESSAGES
+1 ;
+2 NEW Y
+3 IF '$DATA(ZTQUEUED)
Begin DoDot:1
+4 WRITE *7,!,$$CJ^XLFSTR("Sorry.... ",IOM)
+5 SET Y=$$DIR^XBDIR("E","Press RETURN")
End DoDot:1
+6 QUIT
+7 ;
VCHK(AVAPRE,AVAVER,AVAQUIT) ;
+1 ;----- CHECK VERSIONS NEEDED
+2 ;
+3 NEW AVAV,AVAMSG,Y
+4 ;
+5 SET Y=1
+6 SET AVAV=$$VERSION^XPDUTL(AVAPRE)
+7 SET AVAMSG=$SELECT(AVAV<AVAVER:" <<<--- FIX IT!",1:"")
+8 ;
+9 WRITE !,$$CJ^XLFSTR("Need at least "_AVAPRE_" v "_AVAVER_"....."_AVAPRE_" v "_AVAV_" Present"_AVAMSG,IOM)
+10 ;
+11 IF AVAV<AVAVER
DO FAIL(AVAQUIT)
SET Y=0
+12 ;
+13 QUIT Y
+14 ;
PRE ;EP -- PREINSTALL FROM KIDS.
+1 DO BMES^XPDUTL("Beginning pre-install routine (PRE^AVA32P16).")
+2 ;
+3 DO MES^XPDUTL("Pre-install routine is complete.")
+4 QUIT
+5 ;
POST ;EP -- POST INSTALL FROM KIDS.
+1 NEW AVA
+2 DO BMES^XPDUTL("Beginning post-install routine (POST^AVA32P16).")
+3 ;
+4 DO BMES^XPDUTL("Changing sub-file dictionary number in the 9999999.18 multiple...")
+5 DO SFDD
+6 ;
+7 DO BMES^XPDUTL("Delivering AVA*93.2*16 install message to select users...")
+8 DO MAIL
+9 ;
+10 DO BMES^XPDUTL("Post-install routine is complete.")
+11 QUIT
+12 ;
SFDD ;----- CHANGE SUB-FILE DD NUMBER IN THE 9999999.18 MULTIPLE OF FILE 200
+1 ;
+2 NEW I,P
+3 ;
+4 SET P=$PIECE(^DD(200,9999999.18,0),U,2)
+5 SET I=0
+6 FOR
SET I=$ORDER(^VA(200,I))
IF '(I=+I)
QUIT
Begin DoDot:1
+7 IF $DATA(^VA(200,I,9999999.18,0))
SET $PIECE(^(0),U,2)=P
End DoDot:1
+8 QUIT
+9 ;
MAIL ;----- SEND INSTALL MAIL MESSAGE
+1 ;
+2 NEW DIFROM,XMSUB,XMDUZ,XMTEXT,XMY
+3 ;
+4 KILL ^TMP("AVAP16MS",$JOB)
+5 ;
+6 SET ^TMP("AVAP16MS",$JOB,1)=" --- AVA v 93.2, Patch 16, has been installed into this uci ---"
+7 ;
+8 SET %=0
+9 FOR
SET %=$ORDER(^XTMP("XPDI",XPDA,"BLD",XPDBLD,1,%))
IF '%
QUIT
Begin DoDot:1
+10 SET ^TMP("AVAP16MS",$JOB,(%+1))=" "_^(%,0)
End DoDot:1
+11 ;
+12 SET XMSUB=$PIECE($PIECE($TEXT(+1),";",2)," ",4,99)
+13 SET XMDUZ=$SELECT($GET(DUZ):DUZ,1:.5)
+14 SET XMTEXT="^TMP(""AVAP16MS"",$J,"
+15 SET XMY(1)=""
+16 SET XMY(DUZ)=""
+17 ;
+18 FOR %="XUMGR","XUPROG","XUPROGMODE"
DO SINGLE(%)
+19 ;
+20 DO ^XMD
+21 ;
+22 KILL ^TMP("AVAP16MS",$JOB)
+23 ;
+24 QUIT
+25 ;
SINGLE(K) ;----- GET HOLDERS OF A SINGLE KEY K.
+1 ;
+2 NEW Y
+3 ;
+4 IF '$DATA(^XUSEC(K))
QUIT
+5 ;
+6 SET Y=0
+7 FOR
SET Y=$ORDER(^XUSEC(K,Y))
IF 'Y
QUIT
SET XMY(Y)=""
+8 ;
+9 QUIT
+10 ;
