- 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 ;