ADE60P16 ; IHS/SET/HMW - ADE GENERAL PATCH MODULE ; [ 07/28/2005 10:58 AM ]
;;6.0;ADE;**16**;JAN 01, 2004
;
; This patch accumulates ADE patches 1 through 16
; I copied this from ADE60P15 and only change POST line tag
;
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)
;
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
;
;is the AUT requirement present?
I '$$ISAUT14 D
.D BMES^XPDUTL("Patch 16 of version 6.0 of the IHS DENTAL Package")
. D BMES^XPDUTL("Cannot Be Installed Unless")
. D BMES^XPDUTL("Patch 14 of version 98.1 of the AUT IHS DICTIONARIES (POINTERS) package has been installed.")
. D SORRY(2)
Q
;End Environment check
;
PREINST ;EP Pre-install -- Do previous patches as needed
;
I '$$INSTALLD("ADE*6.0*16") D
.I '$$INSTALLD("ADE*6.0*15") D
. . I '$$INSTALLD("ADE*6.0*14") D
. . . I '$$INSTALLD("ADE*6.0*13") D
. . . . I '$$INSTALLD("ADE*6.0*12") D
. . . . . ;Install 12
. . . . . D BMES^XPDUTL("Installing ADE Patch 12.")
. . . . . D PREINST^ADE60P12
. . . . . D ^ADECD4
. . . . . Q
. . . . ;Install 13
. . . . D BMES^XPDUTL("Installing ADE Patch 13.")
. . . . D ^ADECD44
. . . . Q
. . . ;DO I NEED A CALL HERE TO A PATCH 14 ROUTINE
. . . ;Install 14
. . . D BMES^XPDUTL("Installing ADE Patch 14.")
. . . D POST^ADE60P14
. . . Q
. . ;Install 15
. . D BMES^XPDUTL("Installing ADE Patch 15.")
. . D POST^ADE60P15
. . Q
. Q
Q
;End Pre-Install
;
POST ;EP Post-Install
; only post for patch 16 - MJL 7/7/05
; Add new, modify and delete ADA Codes
N ADED,ADECNT,ADEVALUE
D BMES^XPDUTL("Adding ADA Codes: CDT-5 New Codes...")
D ADDCDT5^ADE6P161
D BMES^XPDUTL(" ...DONE")
D BMES^XPDUTL("Mods to ADA Codes: CDT-5 Codes/Categories with New Descriptors...")
D MODCDT5^ADE6P162
D BMES^XPDUTL(" ...DONE")
D BMES^XPDUTL("Deleting ADA Codes: Codes Deleted in CDT-5...")
D DELCDT5^ADE6P163
D BMES^XPDUTL("...DONE")
D BMES^XPDUTL("Mods to ADA Codes: Existing CDT-4 Codes with Revised RVUs...")
D MODCDT4^ADE6P164
D BMES^XPDUTL("...DONE")
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....Please fix it.",IOM)
Q
;Determine if AUT*98.1*14 is present. This patch adds the RVU (Relative Value Unit) field to the ADA Code
ISAUT14() ;
S KFINISH=$O(^XPD(9.7,"B","AUT*98.1*14",""))
I $G(KFINISH)="" Q 0
S KSTATUS=$P($G(^XPD(9.7,KFINISH,0)),U,9) ;'0' Loaded from Distribution
; '1' Queued for Install
; '2' Start of Install
; '3' Install Completed
; '4' FOR De-Installed;
;
I KSTATUS'=3 Q 0
Q 1
;
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)
ADE60P16 ; IHS/SET/HMW - ADE GENERAL PATCH MODULE ; [ 07/28/2005 10:58 AM ]
+1 ;;6.0;ADE;**16**;JAN 01, 2004
+2 ;
+3 ; This patch accumulates ADE patches 1 through 16
+4 ; I copied this from ADE60P15 and only change POST line tag
+5 ;
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 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 ;
+28 ;is the AUT requirement present?
+29 IF '$$ISAUT14
Begin DoDot:1
+30 DO BMES^XPDUTL("Patch 16 of version 6.0 of the IHS DENTAL Package")
+31 DO BMES^XPDUTL("Cannot Be Installed Unless")
+32 DO BMES^XPDUTL("Patch 14 of version 98.1 of the AUT IHS DICTIONARIES (POINTERS) package has been installed.")
+33 DO SORRY(2)
End DoDot:1
+34 QUIT
+35 ;End Environment check
+36 ;
PREINST ;EP Pre-install -- Do previous patches as needed
+1 ;
+2 IF '$$INSTALLD("ADE*6.0*16")
Begin DoDot:1
+3 IF '$$INSTALLD("ADE*6.0*15")
Begin DoDot:2
+4 IF '$$INSTALLD("ADE*6.0*14")
Begin DoDot:3
+5 IF '$$INSTALLD("ADE*6.0*13")
Begin DoDot:4
+6 IF '$$INSTALLD("ADE*6.0*12")
Begin DoDot:5
+7 ;Install 12
+8 DO BMES^XPDUTL("Installing ADE Patch 12.")
+9 DO PREINST^ADE60P12
+10 DO ^ADECD4
+11 QUIT
End DoDot:5
+12 ;Install 13
+13 DO BMES^XPDUTL("Installing ADE Patch 13.")
+14 DO ^ADECD44
+15 QUIT
End DoDot:4
+16 ;DO I NEED A CALL HERE TO A PATCH 14 ROUTINE
+17 ;Install 14
+18 DO BMES^XPDUTL("Installing ADE Patch 14.")
+19 DO POST^ADE60P14
+20 QUIT
End DoDot:3
+21 ;Install 15
+22 DO BMES^XPDUTL("Installing ADE Patch 15.")
+23 DO POST^ADE60P15
+24 QUIT
End DoDot:2
+25 QUIT
End DoDot:1
+26 QUIT
+27 ;End Pre-Install
+28 ;
POST ;EP Post-Install
+1 ; only post for patch 16 - MJL 7/7/05
+2 ; Add new, modify and delete ADA Codes
+3 NEW ADED,ADECNT,ADEVALUE
+4 DO BMES^XPDUTL("Adding ADA Codes: CDT-5 New Codes...")
+5 DO ADDCDT5^ADE6P161
+6 DO BMES^XPDUTL(" ...DONE")
+7 DO BMES^XPDUTL("Mods to ADA Codes: CDT-5 Codes/Categories with New Descriptors...")
+8 DO MODCDT5^ADE6P162
+9 DO BMES^XPDUTL(" ...DONE")
+10 DO BMES^XPDUTL("Deleting ADA Codes: Codes Deleted in CDT-5...")
+11 DO DELCDT5^ADE6P163
+12 DO BMES^XPDUTL("...DONE")
+13 DO BMES^XPDUTL("Mods to ADA Codes: Existing CDT-4 Codes with Revised RVUs...")
+14 DO MODCDT4^ADE6P164
+15 DO BMES^XPDUTL("...DONE")
+16 QUIT
+17 ; ********************************************************************
+18 ;
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....Please fix it.",IOM)
+4 QUIT
+5 ;Determine if AUT*98.1*14 is present. This patch adds the RVU (Relative Value Unit) field to the ADA Code
ISAUT14() ;
+1 SET KFINISH=$ORDER(^XPD(9.7,"B","AUT*98.1*14",""))
+2 IF $GET(KFINISH)=""
QUIT 0
+3 ;'0' Loaded from Distribution
SET KSTATUS=$PIECE($GET(^XPD(9.7,KFINISH,0)),U,9)
+4 ; '1' Queued for Install
+5 ; '2' Start of Install
+6 ; '3' Install Completed
+7 ; '4' FOR De-Installed;
+8 ;
+9 IF KSTATUS'=3
QUIT 0
+10 QUIT 1
+11 ;
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)