Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: AVA32P14

AVA32P14.m

Go to the documentation of this file. 
  1. AVA32P14 ;IHS/ASDST/GTH - AVA 93.2 PATCH 14 ; [ 10/10/2002   4:36 PM ]
  1.  ;;93.2;VA SUPPORT FILES;**14**;JUL 01, 1993;Build 12
  1.  ;
  1.  ; IHS/ASDST/GTH AVA*93.2*14 09/12/2002
  1.  ;
  1.  I '$G(IOM) D HOME^%ZIS
  1.  ;
  1.  I '$G(DUZ) W !,"DUZ UNDEFINED OR 0." D FAIL(2),SORRY Q
  1.  ;
  1.  I '$L($G(DUZ(0))) W !,"DUZ(0) UNDEFINED OR NULL." D FAIL(2),SORRY Q
  1.  ;
  1.  S X=$P(^VA(200,DUZ,0),U)
  1.  W !!,$$CJ^XLFSTR("Hello, "_$P(X,",",2)_" "_$P(X,","),IOM)
  1.  W !!,$$CJ^XLFSTR("Checking Environment for "_$P($T(+2),";",4)_" V "_$P($T(+2),";",3)_" Patch "_$P($T(+2),";",5)_".",IOM)
  1.  ;
  1.  NEW IORVON,IORVOFF
  1.  S X="IORVON;IORVOFF"
  1.  D ENDR^%ZISS
  1.  ;
  1.  I $$VCHK("AVA","93.2",2)
  1.  I $$VCHK("DI","21.0",2)
  1.  I $$VCHK("XU","8.0",2)
  1.  ;
  1.  NEW DA,DIC
  1.  S X="AVA",DIC="^DIC(9.4,",DIC(0)="",D="C"
  1.  D IX^DIC
  1.  I Y<0,$D(^DIC(9.4,"C","AVA")) D
  1.  . W !!,*7,*7,$$CJ^XLFSTR("You Have More Than One Entry In The",IOM),!,$$CJ^XLFSTR("PACKAGE File with an ""AVA"" prefix.",IOM)
  1.  . W !,$$CJ^XLFSTR(IORVON_"One entry needs to be deleted."_IORVOFF,IOM)
  1.  . W !,$$CJ^XLFSTR("FIX IT! Before Proceeding.",IOM),!!,*7,*7,*7
  1.  . D FAIL(2)
  1.  .Q
  1.  ;
  1.  I $G(XPDENV)=1 D
  1.  . ; The following line prevents the "Disable Options..." and "Move
  1.  . ; Routines..." questions from being asked during the install.
  1.  . S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
  1.  .Q
  1.  ;
  1.  I '(DUZ(0)["@") W !,$$CJ^XLFSTR("The dd updates require an '@' in your DUZ(0). "_IORVON_"<<<-- FIX IT!"_IORVOFF,IOM) D FAIL(2)
  1.  ;
  1.  S DA=0
  1.  F  S DA=$O(^VA(200,DA)) Q:'DA  I $P($G(^(DA,"USC1",0)),U,3) D
  1.  . D FAIL(2)
  1.  . W !,$$CJ^XLFSTR("NEW PERSON '"_IORVON_$P(^VA(200,DA,0),U,1)_IORVOFF_"' has a Person Class.",IOM)
  1.  .Q
  1.  ;
  1.  I $D(XPDQUIT) W !!,$$CJ^XLFSTR(IORVON_"Please Fix It!!"_IORVOFF,IOM) D SORRY Q
  1.  ;
  1.  W !!,$$CJ^XLFSTR("ENVIRONMENT OK.",IOM)
  1.  ;
  1.  I '$$DIR^XBDIR("E","","","","","",1) D FAIL(2),SORRY
  1.  Q
  1.  ;
  1. FAIL(X) ;
  1.  KILL DIFQ
  1.  S XPDQUIT=X
  1.  Q
  1.  ;
  1. SORRY ;
  1.  W:'$D(ZTQUEUED) *7,!,$$CJ^XLFSTR("Sorry....",IOM),$$DIR^XBDIR("E","Press RETURN")
  1.  Q
  1.  ;
  1. VCHK(AVAPRE,AVAVER,AVAQUIT) ; Check versions needed.
  1.  ;  
  1.  NEW AVAV,AVAMSG
  1.  S AVAV=$$VERSION^XPDUTL(AVAPRE),AVAMSG=$S(AVAV<AVAVER:" <<<-- FIX IT!",1:"")
  1.  W !,$$CJ^XLFSTR("Need at least "_AVAPRE_" v "_AVAVER_"....."_AVAPRE_" v "_AVAV_" Present"_AVAMSG,IOM)
  1.  I AVAV<AVAVER D FAIL(AVAQUIT) Q 0
  1.  Q 1
  1.  ;
  1. PRE ;EP - From KIDS.
  1.  D BMES^XPDUTL("Beginning pre-install routine (PRE^AVA32P14).")
  1.  D MES^XPDUTL("Deleting entries in PERSON CLASS file (8932.1).")
  1.  KILL ^UTILITY("XBDSET",$J)
  1.  S ^UTILITY("XBDSET",$J,8932.1)=""
  1.  D EN2^XBFRESET
  1.  D MES^XPDUTL("Pre-install routine is complete.")
  1.  Q
  1.  ;
  1. POST ;EP - From KIDS.
  1.  NEW AVA
  1.  D BMES^XPDUTL("Beginning post-install routine (POST^AVA32P14).")
  1.  ;
  1.  D BMES^XPDUTL("Changing sub-file dictionary number in the 9999999.18 multiple...")
  1.  D SFDD
  1.  ;
  1.  D BMES^XPDUTL("Delivering AVA*93.2*14 install message to select users...")
  1.  D MAIL
  1.  ;
  1.  D BMES^XPDUTL("Post-install routine is complete.")
  1.  Q
  1.  ;
  1. SFDD ;
  1.  NEW I,P
  1.  S I=0,P=$P(^DD(200,9999999.18,0),U,2)
  1.  F  S I=$O(^VA(200,I)) Q:'(I=+I)  I $D(^VA(200,I,9999999.18,0)) S $P(^(0),U,2)=P
  1.  Q
  1.  ;
  1. MAIL ; Send install mail message.
  1.  NEW DIFROM,XMSUB,XMDUZ,XMTEXT,XMY
  1.  KILL ^TMP("AVAP14MS",$J)
  1.  S ^TMP("AVAP14MS",$J,1)=" --- AVA v 93.2, Patch 14, has been installed into this uci ---"
  1.  S %=0
  1.  F  S %=$O(^XTMP("XPDI",XPDA,"BLD",XPDBLD,1,%)) Q:'%   S ^TMP("AVAP14MS",$J,(%+1))=" "_^(%,0)
  1.  S XMSUB=$P($P($T(+1),";",2)," ",4,99),XMDUZ=$S($G(DUZ):DUZ,1:.5),XMTEXT="^TMP(""AVAP14MS"",$J,",XMY(1)="",XMY(DUZ)=""
  1.  F %="XUMGR","XUPROG","XUPROGMODE" D SINGLE(%)
  1.  D ^XMD
  1.  KILL ^TMP("AVAP14MS",$J)
  1.  Q
  1.  ;
  1. SINGLE(K) ; Get holders of a single key K.
  1.  NEW Y
  1.  S Y=0
  1.  Q:'$D(^XUSEC(K))
  1.  F  S Y=$O(^XUSEC(K,Y)) Q:'Y  S XMY(Y)=""
  1.  Q
  1.  ;