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

ADE60P12.m

Go to the documentation of this file. 
  1. ADE60P12 ; IHS/SET/HMW - ADE6.0 PATCH 12 ;  
  1.  ;;6.0;ADE;**12**;MAR 25, 1999
  1.  ;
  1.  ;This patch accumulates ADE patches 1 through 11
  1.  ;and also applies American Dental Association changes to the
  1.  ;ADA CODES published in CDT-4
  1.  ;IHS/SET/HMW 1-22-2003
  1.  ;
  1. ENV ;Environment check
  1.  I '$G(IOM) D HOME^%ZIS
  1.  ;
  1.  I '$G(DUZ) W !,"DUZ UNDEFINED OR 0." D SORRY(2) Q
  1.  ;
  1.  I '$L($G(DUZ(0))) W !,"DUZ(0) UNDEFINED OR NULL." D SORRY(2) Q
  1.  ;
  1.  I '(DUZ(0)["@") W:'$D(ZTQUEUED) !,"DUZ(0) DOES NOT CONTAIN AN '@'." D SORRY(2) Q
  1.  ;
  1.  S X=$$GET1^DIQ(200,DUZ,.01)
  1.  W !!,$$CJ^XLFSTR("Hello, "_$P(X,",",2)_" "_$P(X,","),IOM)
  1.  W !!,$$CJ^XLFSTR("Checking Environment...",IOM) ; 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("ADE","6.0",2,"'=")
  1.  ;
  1.  NEW DA,DIC
  1.  S X="ADE",DIC="^DIC(9.4,",DIC(0)="",D="C"
  1.  D IX^DIC
  1.  I Y<0,$D(^DIC(9.4,"C","ADE")) D
  1.  . W !!,*7,*7,$$CJ^XLFSTR("You Have More Than One Entry In The",IOM),!,$$CJ^XLFSTR("PACKAGE File with an ""ADE"" prefix.",IOM)
  1.  . W !,$$CJ^XLFSTR(IORVON_"One entry needs to be deleted."_IORVOFF,IOM)
  1.  . D SORRY(2)
  1.  .Q
  1.  Q
  1.  ;End Environment check
  1.  ;
  1. PREINST ;EP Pre-install
  1.  I '$$INSTALLD("ADE*6.0*12") D
  1.  . I '$$INSTALLD("ADE*6.0*2") D  Q
  1.  . . D BMES^XPDUTL("Installing ADE patches from Patch 2 forward.")
  1.  . . D ^ADE0602,^ADE0603,^ADECDT,^ADE0608,^ADE0610,^ADE0611
  1.  . . Q
  1.  . I '$$INSTALLD("ADE*6.0*3") D  Q
  1.  . . D BMES^XPDUTL("Installing ADE patches from Patch 3 forward.")
  1.  . . D ^ADE0603,^ADECDT,^ADE0608,^ADE0610,^ADE0611
  1.  . . Q
  1.  . I '$$INSTALLD("ADE*6.0*7") D  Q
  1.  . . D BMES^XPDUTL("Installing ADE patches from Patch 7 forward.")
  1.  . . D ^ADECDT,^ADE0608,^ADE0610,^ADE0611
  1.  . . Q
  1.  . I '$$INSTALLD("ADE*6.0*8") D  Q
  1.  . . D BMES^XPDUTL("Installing ADE patches from Patch 8 forward.")
  1.  . . D ^ADE0608,^ADE0610,^ADE0611
  1.  . . Q
  1.  . I '$$INSTALLD("ADE*6.0*10") D  Q
  1.  . . D BMES^XPDUTL("Installing ADE patches from Patch 10 forward.")
  1.  . . D ^ADE0610,^ADE0611
  1.  . . Q
  1.  . I '$$INSTALLD("ADE*6.0*11") D  Q
  1.  . . D BMES^XPDUTL("Installing ADE Patch 11.")
  1.  . . D ^ADE0611
  1.  . . Q
  1.  . Q
  1.  Q
  1.  ;End Pre-Install
  1.  ;
  1. POST ;Post-Install
  1.  D ^ADECD4
  1.  Q
  1.  ;
  1. VCHK(ADEPRE,ADEVER,ADEQUIT,ADECOMP) ; Check versions needed.
  1.  ;  
  1.  NEW ADEV
  1.  S ADEV=$$VERSION^XPDUTL(ADEPRE)
  1.  W !,$$CJ^XLFSTR("Need "_$S(ADECOMP="<":"at least ",1:"")_ADEPRE_" v "_ADEVER_"....."_ADEPRE_" v "_ADEV_" Present",IOM)
  1.  I @($C(34)_ADEV_$C(34)_ADECOMP_$C(34)_ADEVER_$C(34)) D SORRY(ADEQUIT) Q 0
  1.  Q 1
  1.  ;
  1. SORRY(X) ;
  1.  KILL DIFQ
  1.  S XPDQUIT=X
  1.  W *7,!,$$CJ^XLFSTR("Sorry....FIX IT!",IOM)
  1.  Q
  1.  ;
  1. INSTALLD(ADE) ; Determine if patch ADE was installed, where ADE is
  1.  ; the name of the INSTALL.  E.g "AVA*93.2*12".
  1.  ;
  1.  NEW DIC,X,Y
  1.  ;  lookup package.
  1.  S X=$P(ADE,"*",1)
  1.  S DIC="^DIC(9.4,",DIC(0)="FM",D="C"
  1.  D IX^DIC
  1.  I Y<1 Q 0
  1.  ;  lookup version.
  1.  S DIC=DIC_+Y_",22,",X=$P(ADE,"*",2)
  1.  D ^DIC
  1.  I Y<1 Q 0
  1.  ;  lookup patch.
  1.  S DIC=DIC_+Y_",""PAH"",",X=$P(ADE,"*",3)
  1.  D ^DIC
  1.  Q $S(Y<1:0,1:1)