ADE60P31 ;IHS/OIT/GAB - ADE 6.0 PATCH 31 [ 09/09/2016 2:35 PM ]
;;6.0;ADE*6.0*31;;March 25, 1999;Build 28
;;This patch contains calls to 3 ADE PATCH 31 routines and contains the
;;2017 Dental Code Updates
ENV ;Environment check
I '$G(IOM) D HOME^%ZIS
;
I '$G(DUZ) W !,"YOUR DUZ VARIABLE IS UNDEFINED!! Please login with your Access & Verify." D SORRY(2) Q
;
I '$L($G(DUZ(0))) W !,"Your DUZ(0) VARIABLE IS UNDEFINED OR NULL." D SORRY(2) Q
;
I '(DUZ(0)["@") W:'$D(ZTQUEUED) !,"YOUR DUZ(0) VARIABLE DOES NOT CONTAIN AN '@'." D SORRY(2)
Q
POST ;EP Post-Install
; only post for patch 31 - /IHS/OIT/GAB 9/2016
; Add new, modify and delete ADA Codes
N ADED,ADECNT,ADEVALUE
D BMES^XPDUTL("Adding 2017 ADA-CDT Codes...")
D ADDCDT5^ADE6P311
D BMES^XPDUTL(" ...DONE")
D BMES^XPDUTL("Adding 2017 ADA-CDT Mods ...")
D MODCDT5^ADE6P312
D BMES^XPDUTL(" ...DONE")
D BMES^XPDUTL("Inactivating 2017 ADA-CDT Dental Codes ...")
D DELCDT5^ADE6P313
D BMES^XPDUTL("...DONE")
Q
; ********************************************************************
SORRY(X) ;
K DIFQ
S XPDQUIT=X
W *7,!,$$CJ^XLFSTR("Sorry....Please fix it.",40)
Q
ADE60P31 ;IHS/OIT/GAB - ADE 6.0 PATCH 31 [ 09/09/2016 2:35 PM ]
+1 ;;6.0;ADE*6.0*31;;March 25, 1999;Build 28
+2 ;;This patch contains calls to 3 ADE PATCH 31 routines and contains the
+3 ;;2017 Dental Code Updates
ENV ;Environment check
+1 IF '$GET(IOM)
DO HOME^%ZIS
+2 ;
+3 IF '$GET(DUZ)
WRITE !,"YOUR DUZ VARIABLE IS UNDEFINED!! Please login with your Access & Verify."
DO SORRY(2)
QUIT
+4 ;
+5 IF '$LENGTH($GET(DUZ(0)))
WRITE !,"Your DUZ(0) VARIABLE IS UNDEFINED OR NULL."
DO SORRY(2)
QUIT
+6 ;
+7 IF '(DUZ(0)["@")
IF '$DATA(ZTQUEUED)
WRITE !,"YOUR DUZ(0) VARIABLE DOES NOT CONTAIN AN '@'."
DO SORRY(2)
+8 QUIT
POST ;EP Post-Install
+1 ; only post for patch 31 - /IHS/OIT/GAB 9/2016
+2 ; Add new, modify and delete ADA Codes
+3 NEW ADED,ADECNT,ADEVALUE
+4 DO BMES^XPDUTL("Adding 2017 ADA-CDT Codes...")
+5 DO ADDCDT5^ADE6P311
+6 DO BMES^XPDUTL(" ...DONE")
+7 DO BMES^XPDUTL("Adding 2017 ADA-CDT Mods ...")
+8 DO MODCDT5^ADE6P312
+9 DO BMES^XPDUTL(" ...DONE")
+10 DO BMES^XPDUTL("Inactivating 2017 ADA-CDT Dental Codes ...")
+11 DO DELCDT5^ADE6P313
+12 DO BMES^XPDUTL("...DONE")
+13 QUIT
+14 ; ********************************************************************
SORRY(X) ;
+1 KILL DIFQ
+2 SET XPDQUIT=X
+3 WRITE *7,!,$$CJ^XLFSTR("Sorry....Please fix it.",40)
+4 QUIT