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