AVA32P13 ;IHS/ASDST/GTH - AVA 93.2 PATCH 13 ; [ 09/12/2002 3:15 PM ]
;;93.2;VA SUPPORT FILES;**13**;JUL 01, 1993;Build 12
;
; IHS/ASDST/GTH AVA*93.2*13 09/12/2002
;
I '$G(IOM) D HOME^%ZIS
;
I '$G(DUZ) W !,"DUZ UNDEFINED OR 0." D FAIL(2),SORRY Q
;
I '$L($G(DUZ(0))) W !,"DUZ(0) UNDEFINED OR NULL." D FAIL(2),SORRY 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)_" Patch "_$P($T(+2),";",5)_".",IOM)
;
NEW IORVON,IORVOFF
S X="IORVON;IORVOFF"
D ENDR^%ZISS
;
I $$VCHK("AVA","93.2",2)
I $$VCHK("DI","21.0",2)
I $$VCHK("XU","8.0",2)
;
NEW DA,DIC
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),!,$$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,*7
. D FAIL(2)
.Q
;
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 '(DUZ(0)["@") W !,$$CJ^XLFSTR("The dd updates require an '@' in your DUZ(0). "_IORVON_"<<<-- FIX IT!"_IORVOFF,IOM) D FAIL(2)
;
S DA=0
F S DA=$O(^VA(200,DA)) Q:'DA I $P($G(^(DA,"USC1",0)),U,3) D
. D FAIL(2)
. W !,$$CJ^XLFSTR("NEW PERSON '"_IORVON_$P(^VA(200,DA,0),U,1)_IORVOFF_"' has a Person Class.",IOM)
.Q
;
I $D(XPDQUIT) W !!,$$CJ^XLFSTR(IORVON_"Please Fix It!!"_IORVOFF,IOM) D SORRY Q
;
W !!,$$CJ^XLFSTR("ENVIRONMENT OK.",IOM)
;
I '$$DIR^XBDIR("E","","","","","",1) D FAIL(2),SORRY
Q
;
FAIL(X) ;
KILL DIFQ
S XPDQUIT=X
Q
;
SORRY ;
W:'$D(ZTQUEUED) *7,!,$$CJ^XLFSTR("Sorry....",IOM),$$DIR^XBDIR("E","Press RETURN")
Q
;
VCHK(AVAPRE,AVAVER,AVAQUIT) ; Check versions needed.
;
NEW AVAV,AVAMSG
S AVAV=$$VERSION^XPDUTL(AVAPRE),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) Q 0
Q 1
;
PRE ;EP - From KIDS.
D BMES^XPDUTL("Beginning pre-install routine (PRE^AVA32P13).")
D MES^XPDUTL("Deleting entries in PERSON CLASS file (8932.1).")
KILL ^UTILITY("XBDSET",$J)
S ^UTILITY("XBDSET",$J,8932.1)=""
D EN2^XBFRESET
D MES^XPDUTL("Pre-install routine is complete.")
Q
;
POST ;EP - From KIDS.
NEW AVA
D BMES^XPDUTL("Beginning post-install routine (POST^AVA32P13).")
;
D BMES^XPDUTL("Changing sub-file dictionary number in the 9999999.18 multiple...")
D SFDD
;
D BMES^XPDUTL("Delivering AVA*93.2*13 install message to select users...")
D MAIL
;
D BMES^XPDUTL("Post-install routine is complete.")
Q
;
SFDD ;
NEW I,P
S I=0,P=$P(^DD(200,9999999.18,0),U,2)
F S I=$O(^VA(200,I)) Q:'(I=+I) I $D(^VA(200,I,9999999.18,0)) S $P(^(0),U,2)=P
Q
;
MAIL ; Send install mail message.
NEW DIFROM,XMSUB,XMDUZ,XMTEXT,XMY
KILL ^TMP("AVAP13MS",$J)
S ^TMP("AVAP13MS",$J,1)=" --- AVA v 93.2, Patch 13, has been installed into this uci ---"
S %=0
F S %=$O(^XTMP("XPDI",XPDA,"BLD",XPDBLD,1,%)) Q:'% S ^TMP("AVAP13MS",$J,(%+1))=" "_^(%,0)
S XMSUB=$P($P($T(+1),";",2)," ",4,99),XMDUZ=$S($G(DUZ):DUZ,1:.5),XMTEXT="^TMP(""AVAP13MS"",$J,",XMY(1)="",XMY(DUZ)=""
F %="XUMGR","XUPROG","XUPROGMODE" D SINGLE(%)
D ^XMD
KILL ^TMP("AVAP13MS",$J)
Q
;
SINGLE(K) ; Get holders of a single key K.
NEW Y
S Y=0
Q:'$D(^XUSEC(K))
F S Y=$O(^XUSEC(K,Y)) Q:'Y S XMY(Y)=""
Q
;
AVA32P13 ;IHS/ASDST/GTH - AVA 93.2 PATCH 13 ; [ 09/12/2002 3:15 PM ]
+1 ;;93.2;VA SUPPORT FILES;**13**;JUL 01, 1993;Build 12
+2 ;
+3 ; IHS/ASDST/GTH AVA*93.2*13 09/12/2002
+4 ;
+5 IF '$GET(IOM)
DO HOME^%ZIS
+6 ;
+7 IF '$GET(DUZ)
WRITE !,"DUZ UNDEFINED OR 0."
DO FAIL(2)
DO SORRY
QUIT
+8 ;
+9 IF '$LENGTH($GET(DUZ(0)))
WRITE !,"DUZ(0) UNDEFINED OR NULL."
DO FAIL(2)
DO SORRY
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)_" Patch "_$PIECE($TEXT(+2),";",5)_".",IOM)
+14 ;
+15 NEW IORVON,IORVOFF
+16 SET X="IORVON;IORVOFF"
+17 DO ENDR^%ZISS
+18 ;
+19 IF $$VCHK("AVA","93.2",2)
+20 IF $$VCHK("DI","21.0",2)
+21 IF $$VCHK("XU","8.0",2)
+22 ;
+23 NEW DA,DIC
+24 SET X="AVA"
SET DIC="^DIC(9.4,"
SET DIC(0)=""
SET D="C"
+25 DO IX^DIC
+26 IF Y<0
IF $DATA(^DIC(9.4,"C","AVA"))
Begin DoDot:1
+27 WRITE !!,*7,*7,$$CJ^XLFSTR("You Have More Than One Entry In The",IOM),!,$$CJ^XLFSTR("PACKAGE File with an ""AVA"" prefix.",IOM)
+28 WRITE !,$$CJ^XLFSTR(IORVON_"One entry needs to be deleted."_IORVOFF,IOM)
+29 WRITE !,$$CJ^XLFSTR("FIX IT! Before Proceeding.",IOM),!!,*7,*7,*7
+30 DO FAIL(2)
+31 QUIT
End DoDot:1
+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 IF '(DUZ(0)["@")
WRITE !,$$CJ^XLFSTR("The dd updates require an '@' in your DUZ(0). "_IORVON_"<<<-- FIX IT!"_IORVOFF,IOM)
DO FAIL(2)
+40 ;
+41 SET DA=0
+42 FOR
SET DA=$ORDER(^VA(200,DA))
IF 'DA
QUIT
IF $PIECE($GET(^(DA,"USC1",0)),U,3)
Begin DoDot:1
+43 DO FAIL(2)
+44 WRITE !,$$CJ^XLFSTR("NEW PERSON '"_IORVON_$PIECE(^VA(200,DA,0),U,1)_IORVOFF_"' has a Person Class.",IOM)
+45 QUIT
End DoDot:1
+46 ;
+47 IF $DATA(XPDQUIT)
WRITE !!,$$CJ^XLFSTR(IORVON_"Please Fix It!!"_IORVOFF,IOM)
DO SORRY
QUIT
+48 ;
+49 WRITE !!,$$CJ^XLFSTR("ENVIRONMENT OK.",IOM)
+50 ;
+51 IF '$$DIR^XBDIR("E","","","","","",1)
DO FAIL(2)
DO SORRY
+52 QUIT
+53 ;
FAIL(X) ;
+1 KILL DIFQ
+2 SET XPDQUIT=X
+3 QUIT
+4 ;
SORRY ;
+1 IF '$DATA(ZTQUEUED)
WRITE *7,!,$$CJ^XLFSTR("Sorry....",IOM),$$DIR^XBDIR("E","Press RETURN")
+2 QUIT
+3 ;
VCHK(AVAPRE,AVAVER,AVAQUIT) ; Check versions needed.
+1 ;
+2 NEW AVAV,AVAMSG
+3 SET AVAV=$$VERSION^XPDUTL(AVAPRE)
SET AVAMSG=$SELECT(AVAV<AVAVER:" <<<-- FIX IT!",1:"")
+4 WRITE !,$$CJ^XLFSTR("Need at least "_AVAPRE_" v "_AVAVER_"....."_AVAPRE_" v "_AVAV_" Present"_AVAMSG,IOM)
+5 IF AVAV<AVAVER
DO FAIL(AVAQUIT)
QUIT 0
+6 QUIT 1
+7 ;
PRE ;EP - From KIDS.
+1 DO BMES^XPDUTL("Beginning pre-install routine (PRE^AVA32P13).")
+2 DO MES^XPDUTL("Deleting entries in PERSON CLASS file (8932.1).")
+3 KILL ^UTILITY("XBDSET",$JOB)
+4 SET ^UTILITY("XBDSET",$JOB,8932.1)=""
+5 DO EN2^XBFRESET
+6 DO MES^XPDUTL("Pre-install routine is complete.")
+7 QUIT
+8 ;
POST ;EP - From KIDS.
+1 NEW AVA
+2 DO BMES^XPDUTL("Beginning post-install routine (POST^AVA32P13).")
+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*13 install message to select users...")
+8 DO MAIL
+9 ;
+10 DO BMES^XPDUTL("Post-install routine is complete.")
+11 QUIT
+12 ;
SFDD ;
+1 NEW I,P
+2 SET I=0
SET P=$PIECE(^DD(200,9999999.18,0),U,2)
+3 FOR
SET I=$ORDER(^VA(200,I))
IF '(I=+I)
QUIT
IF $DATA(^VA(200,I,9999999.18,0))
SET $PIECE(^(0),U,2)=P
+4 QUIT
+5 ;
MAIL ; Send install mail message.
+1 NEW DIFROM,XMSUB,XMDUZ,XMTEXT,XMY
+2 KILL ^TMP("AVAP13MS",$JOB)
+3 SET ^TMP("AVAP13MS",$JOB,1)=" --- AVA v 93.2, Patch 13, has been installed into this uci ---"
+4 SET %=0
+5 FOR
SET %=$ORDER(^XTMP("XPDI",XPDA,"BLD",XPDBLD,1,%))
IF '%
QUIT
SET ^TMP("AVAP13MS",$JOB,(%+1))=" "_^(%,0)
+6 SET XMSUB=$PIECE($PIECE($TEXT(+1),";",2)," ",4,99)
SET XMDUZ=$SELECT($GET(DUZ):DUZ,1:.5)
SET XMTEXT="^TMP(""AVAP13MS"",$J,"
SET XMY(1)=""
SET XMY(DUZ)=""
+7 FOR %="XUMGR","XUPROG","XUPROGMODE"
DO SINGLE(%)
+8 DO ^XMD
+9 KILL ^TMP("AVAP13MS",$JOB)
+10 QUIT
+11 ;
SINGLE(K) ; Get holders of a single key K.
+1 NEW Y
+2 SET Y=0
+3 IF '$DATA(^XUSEC(K))
QUIT
+4 FOR
SET Y=$ORDER(^XUSEC(K,Y))
IF 'Y
QUIT
SET XMY(Y)=""
+5 QUIT
+6 ;
