AUT981P9 ;IHS/ASDST/GTH - AUT 98.1 PATCH 9 ; [ 01/07/2002 3:22 PM ]
;;98.1;IHS DICTIONARIES (POINTERS);**9**;MAR 04, 1998;Build 6
;
; IHS/ASDST/GTH AUT*98.1*9 01/07/2002
;
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
;
I '(DUZ(0)["@") W:'$D(ZTQUEUED) !,"DUZ(0) DOES NOT CONTAIN AN '@'." 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)_" Patch "_$P($T(+2),";",5)_".",IOM)
;
S X=$$VERSION^XPDUTL("AUT")
W !!,$$CJ^XLFSTR("Need AUT v 98.1.....AUT v "_X_" Present",IOM)
I X<98.1,+X'=1.1 D SORRY(2) Q
;
Q:'$$VCHK("DI","21.0",2)
Q:'$$VCHK("XU","8.0",2)
;
NEW DA,DIC
S X="AUT",DIC="^DIC(9.4,",DIC(0)="",D="C"
D IX^DIC
I Y<0,$D(^DIC(9.4,"C","AUT")) D Q
. W !!,*7,*7,$$CJ^XLFSTR("You Have More Than One Entry In The",IOM),!,$$CJ^XLFSTR("PACKAGE File with an ""AUT"" prefix.",IOM)
. W !,$$CJ^XLFSTR("One entry needs to be deleted.",IOM)
. W !,$$CJ^XLFSTR("FIX IT! Before Proceeding.",IOM),!!,*7,*7,*7
. D SORRY(2)
. I $$DIR^XBDIR("E")
.Q
W !,$$CJ^XLFSTR("No 'AUT' dups in PACKAGE file",IOM)
;
; 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
;
W !!,$$CJ^XLFSTR("ENVIRONMENT OK.",IOM)
;
I '$$DIR^XBDIR("E","","","","","",1) D SORRY(2) Q
Q
;
SORRY(X) ;
KILL DIFQ
S XPDQUIT=X
W:'$D(ZTQUEUED) *7,!,$$CJ^XLFSTR("Sorry....",IOM),$$DIR^XBDIR("E","Press RETURN")
Q
;
VCHK(AUTPRE,AUTVER,AUTQUIT) ; Check versions needed.
;
NEW AUTV
S AUTV=$$VERSION^XPDUTL(AUTPRE)
W !,$$CJ^XLFSTR("Need at least "_AUTPRE_" v "_AUTVER_"....."_AUTPRE_" v "_AUTV_" Present",IOM)
I AUTV<AUTVER KILL DIFQ S XPDQUIT=AUTQUIT W *7,!,$$CJ^XLFSTR("Sorry....",IOM) S AUTV=$$DIR^XBDIR("E","Press RETURN") Q 0
Q 1
;
PRE ;EP - From KIDS.
D BMES^XPDUTL("Beginning pre-install routine (PRE^AUT981P9).")
D BMES^XPDUTL("Removing fields from RPMS SITE file.")
NEW DA,DIK
S DIK="^DD(9999999.3911,",DA(1)=9999999.3911,DA=.01
D ^DIK
KILL ^DD(9999999.3911) ; 4 of the 0th nodes aren't KILL'd by ^DIK.
S DIK="^DD(9999999.39,",DA(1)=9999999.39
F DA=1,2,1101 D ^DIK
D BMES^XPDUTL("Pre-install routine is complete.")
Q
;
POST ;EP - From KIDS.
D BMES^XPDUTL("Beginning post-install routine (POST^AUT981P9).")
D BMES^XPDUTL("Delivering MailMan message to select users...")
D MAIL
D BMES^XPDUTL("Post-install routine is complete.")
Q
;
MAIL ; Send install mail message.
NEW DIFROM,XMSUB,XMDUZ,XMTEXT,XMY
KILL ^TMP("AUTP9MSG",$J)
S ^TMP("AUTP9MSG",$J,1)=" --- AUT v 6, Patch 9, has been installed into this uci ---"
S %=0
F S %=$O(^XTMP("XPDI",XPDA,"BLD",XPDBLD,1,%)) Q:'% S ^TMP("AUTP9MSG",$J,(%+1))=" "_^(%,0)
S XMSUB=$P($P($T(+1),";",2)," ",3,99),XMDUZ=$S($G(DUZ):DUZ,1:.5),XMTEXT="^TMP(""AUTP9MSG"",$J,",XMY(1)="",XMY(DUZ)=""
F %="XUMGR","XUPROG","XUPROGMODE" D SINGLE(%)
D ^XMD
KILL ^TMP("AUTP9MSG",$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
;
INSTALLD(AUT) ;EP - Determine if patch AUT was installed, where AUT is
; the name of the INSTALL. E.g "AUT*98.1*7".
;
NEW DIC,X,Y
; lookup package.
S X=$P(AUT,"*",1)
S DIC="^DIC(9.4,",DIC(0)="FM",D="C"
D IX^DIC
I Y<1 Q 0
; lookup version.
S DIC=DIC_+Y_",22,",X=$P(AUT,"*",2)
D ^DIC
I Y<1 Q 0
; lookup patch.
S DIC=DIC_+Y_",""PAH"",",X=$P(AUT,"*",3)
D ^DIC
Q $S(Y<1:0,1:1)
;
AUT981P9 ;IHS/ASDST/GTH - AUT 98.1 PATCH 9 ; [ 01/07/2002 3:22 PM ]
+1 ;;98.1;IHS DICTIONARIES (POINTERS);**9**;MAR 04, 1998;Build 6
+2 ;
+3 ; IHS/ASDST/GTH AUT*98.1*9 01/07/2002
+4 ;
+5 IF '$GET(DUZ)
WRITE !,"DUZ UNDEFINED OR 0."
DO SORRY(2)
QUIT
+6 ;
+7 IF '$LENGTH($GET(DUZ(0)))
WRITE !,"DUZ(0) UNDEFINED OR NULL."
DO SORRY(2)
QUIT
+8 ;
+9 IF '(DUZ(0)["@")
IF '$DATA(ZTQUEUED)
WRITE !,"DUZ(0) DOES NOT CONTAIN AN '@'."
DO SORRY(2)
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 SET X=$$VERSION^XPDUTL("AUT")
+16 WRITE !!,$$CJ^XLFSTR("Need AUT v 98.1.....AUT v "_X_" Present",IOM)
+17 IF X<98.1
IF +X'=1.1
DO SORRY(2)
QUIT
+18 ;
+19 IF '$$VCHK("DI","21.0",2)
QUIT
+20 IF '$$VCHK("XU","8.0",2)
QUIT
+21 ;
+22 NEW DA,DIC
+23 SET X="AUT"
SET DIC="^DIC(9.4,"
SET DIC(0)=""
SET D="C"
+24 DO IX^DIC
+25 IF Y<0
IF $DATA(^DIC(9.4,"C","AUT"))
Begin DoDot:1
+26 WRITE !!,*7,*7,$$CJ^XLFSTR("You Have More Than One Entry In The",IOM),!,$$CJ^XLFSTR("PACKAGE File with an ""AUT"" prefix.",IOM)
+27 WRITE !,$$CJ^XLFSTR("One entry needs to be deleted.",IOM)
+28 WRITE !,$$CJ^XLFSTR("FIX IT! Before Proceeding.",IOM),!!,*7,*7,*7
+29 DO SORRY(2)
+30 IF $$DIR^XBDIR("E")
+31 QUIT
End DoDot:1
QUIT
+32 WRITE !,$$CJ^XLFSTR("No 'AUT' dups in PACKAGE file",IOM)
+33 ;
+34 ; The following line prevents the "Disable Options..." and "Move
+35 ; Routines..." questions from being asked during the install.
+36 IF $GET(XPDENV)=1
SET (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
+37 ;
+38 WRITE !!,$$CJ^XLFSTR("ENVIRONMENT OK.",IOM)
+39 ;
+40 IF '$$DIR^XBDIR("E","","","","","",1)
DO SORRY(2)
QUIT
+41 QUIT
+42 ;
SORRY(X) ;
+1 KILL DIFQ
+2 SET XPDQUIT=X
+3 IF '$DATA(ZTQUEUED)
WRITE *7,!,$$CJ^XLFSTR("Sorry....",IOM),$$DIR^XBDIR("E","Press RETURN")
+4 QUIT
+5 ;
VCHK(AUTPRE,AUTVER,AUTQUIT) ; Check versions needed.
+1 ;
+2 NEW AUTV
+3 SET AUTV=$$VERSION^XPDUTL(AUTPRE)
+4 WRITE !,$$CJ^XLFSTR("Need at least "_AUTPRE_" v "_AUTVER_"....."_AUTPRE_" v "_AUTV_" Present",IOM)
+5 IF AUTV<AUTVER
KILL DIFQ
SET XPDQUIT=AUTQUIT
WRITE *7,!,$$CJ^XLFSTR("Sorry....",IOM)
SET AUTV=$$DIR^XBDIR("E","Press RETURN")
QUIT 0
+6 QUIT 1
+7 ;
PRE ;EP - From KIDS.
+1 DO BMES^XPDUTL("Beginning pre-install routine (PRE^AUT981P9).")
+2 DO BMES^XPDUTL("Removing fields from RPMS SITE file.")
+3 NEW DA,DIK
+4 SET DIK="^DD(9999999.3911,"
SET DA(1)=9999999.3911
SET DA=.01
+5 DO ^DIK
+6 ; 4 of the 0th nodes aren't KILL'd by ^DIK.
KILL ^DD(9999999.3911)
+7 SET DIK="^DD(9999999.39,"
SET DA(1)=9999999.39
+8 FOR DA=1,2,1101
DO ^DIK
+9 DO BMES^XPDUTL("Pre-install routine is complete.")
+10 QUIT
+11 ;
POST ;EP - From KIDS.
+1 DO BMES^XPDUTL("Beginning post-install routine (POST^AUT981P9).")
+2 DO BMES^XPDUTL("Delivering MailMan message to select users...")
+3 DO MAIL
+4 DO BMES^XPDUTL("Post-install routine is complete.")
+5 QUIT
+6 ;
MAIL ; Send install mail message.
+1 NEW DIFROM,XMSUB,XMDUZ,XMTEXT,XMY
+2 KILL ^TMP("AUTP9MSG",$JOB)
+3 SET ^TMP("AUTP9MSG",$JOB,1)=" --- AUT v 6, Patch 9, has been installed into this uci ---"
+4 SET %=0
+5 FOR
SET %=$ORDER(^XTMP("XPDI",XPDA,"BLD",XPDBLD,1,%))
IF '%
QUIT
SET ^TMP("AUTP9MSG",$JOB,(%+1))=" "_^(%,0)
+6 SET XMSUB=$PIECE($PIECE($TEXT(+1),";",2)," ",3,99)
SET XMDUZ=$SELECT($GET(DUZ):DUZ,1:.5)
SET XMTEXT="^TMP(""AUTP9MSG"",$J,"
SET XMY(1)=""
SET XMY(DUZ)=""
+7 FOR %="XUMGR","XUPROG","XUPROGMODE"
DO SINGLE(%)
+8 DO ^XMD
+9 KILL ^TMP("AUTP9MSG",$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 ;
INSTALLD(AUT) ;EP - Determine if patch AUT was installed, where AUT is
+1 ; the name of the INSTALL. E.g "AUT*98.1*7".
+2 ;
+3 NEW DIC,X,Y
+4 ; lookup package.
+5 SET X=$PIECE(AUT,"*",1)
+6 SET DIC="^DIC(9.4,"
SET DIC(0)="FM"
SET D="C"
+7 DO IX^DIC
+8 IF Y<1
QUIT 0
+9 ; lookup version.
+10 SET DIC=DIC_+Y_",22,"
SET X=$PIECE(AUT,"*",2)
+11 DO ^DIC
+12 IF Y<1
QUIT 0
+13 ; lookup patch.
+14 SET DIC=DIC_+Y_",""PAH"","
SET X=$PIECE(AUT,"*",3)
+15 DO ^DIC
+16 QUIT $SELECT(Y<1:0,1:1)
+17 ;
