ADECD49.m

ADECD49 ;  IHS/SET/HMW - ADA CODE TABLE UPDATE (CDT4) ;

 ;;6.0;ADE;**12**;MAR 25, 1999;Build 13

 ;

CDT4REM ;EP - Reminder that ADA Codes for dental extractions were changed by CDT-4

 ;

 N ADEPDAT,Y

 S ADEPDAT=$$PDATE^ADECD49("IHS DENTAL","6.0",12)

 I +ADEPDAT S Y=ADEPDAT X ^DD("DD") S ADEPDAT=Y

 E  S ADEPDAT=""

 W !!,"***Reminder:  Codes from the American Dental Association CDT-4"

 I ADEPDAT]"" W !,"were installed on this system on ",ADEPDAT,"."

 E  W !,"have been installed on this system."

 W !,"If you are searching for extractions (CDT-4 Code 7140),"

 W !,"you must also search for codes 7110, 7120 and 7130"

 W !,"if the beginning date of your search is prior to ",ADEPDAT,".",!

 W !!,"2015 CDT codes were installed on this system"

 W !,"If you are searching for cancelled (9987) and missed (9986)"

 W !,"appointments you must also search for codes (9140) and (9130)" 

 W !,"if the beginning date of your search is prior to January 1, 2015",!

 ;

 Q

 ;

PDATE(ADEPKG,ADEVER,ADEPATCH) ;Returns FM date patch # ADEPATCH was applied to version ADEVER of

 ;package ADEPKG on current system

 ;Returns 0 if unable to find patch install date.

 ;

 N ADEPDATE

 S ADEPDATE=0

 S ADEPKG=+$O(^DIC(9.4,"B",ADEPKG,0)) ;Package

 Q:'ADEPKG ADEPDATE

 S ADEVER=+$O(^DIC(9.4,ADEPKG,22,"B",ADEVER,0)) ;Version

 Q:'ADEVER ADEPDATE

 S ADEPATCH=+$O(^DIC(9.4,ADEPKG,22,ADEVER,"PAH","B",ADEPATCH,0)) ;Patch

 Q:'ADEVER ADEPDATE

 S ADEPDATE=+$P($G(^DIC(9.4,ADEPKG,22,ADEVER,"PAH",ADEPATCH,0)),"^",2)

 Q ADEPDATE

 ;;TEST CODE

 ;;W $$PDATE^ADECD49("IHS DENTAL","6.0",10)

ADECD49   ;  IHS/SET/HMW - ADA CODE TABLE UPDATE (CDT4) ;

 +1       ;;6.0;ADE;**12**;MAR 25, 1999;Build 13

 +2       ;

CDT4REM   ;EP - Reminder that ADA Codes for dental extractions were changed by CDT-4

 +1       ;

 +2        NEW ADEPDAT,Y

 +3        SET ADEPDAT=$$PDATE^ADECD49("IHS DENTAL","6.0",12)

 +4        IF +ADEPDAT

               SET Y=ADEPDAT

               XECUTE ^DD("DD")

               SET ADEPDAT=Y

 +5       IF '$TEST

               SET ADEPDAT=""

 +6        WRITE !!,"***Reminder:  Codes from the American Dental Association CDT-4"

 +7        IF ADEPDAT]""

               WRITE !,"were installed on this system on ",ADEPDAT,"."

 +8       IF '$TEST

               WRITE !,"have been installed on this system."

 +9        WRITE !,"If you are searching for extractions (CDT-4 Code 7140),"

 +10       WRITE !,"you must also search for codes 7110, 7120 and 7130"

 +11       WRITE !,"if the beginning date of your search is prior to ",ADEPDAT,".",!

 +12       WRITE !!,"2015 CDT codes were installed on this system"

 +13       WRITE !,"If you are searching for cancelled (9987) and missed (9986)"

 +14       WRITE !,"appointments you must also search for codes (9140) and (9130)"

 +15       WRITE !,"if the beginning date of your search is prior to January 1, 2015",!

 +16      ;

 +17       QUIT 

 +18      ;

PDATE(ADEPKG,ADEVER,ADEPATCH) ;Returns FM date patch # ADEPATCH was applied to version ADEVER of

 +1       ;package ADEPKG on current system

 +2       ;Returns 0 if unable to find patch install date.

 +3       ;

 +4        NEW ADEPDATE

 +5        SET ADEPDATE=0

 +6       ;Package

           SET ADEPKG=+$ORDER(^DIC(9.4,"B",ADEPKG,0))

 +7        IF 'ADEPKG

               QUIT ADEPDATE

 +8       ;Version

           SET ADEVER=+$ORDER(^DIC(9.4,ADEPKG,22,"B",ADEVER,0))

 +9        IF 'ADEVER

               QUIT ADEPDATE

 +10      ;Patch

           SET ADEPATCH=+$ORDER(^DIC(9.4,ADEPKG,22,ADEVER,"PAH","B",ADEPATCH,0))

 +11       IF 'ADEVER

               QUIT ADEPDATE

 +12       SET ADEPDATE=+$PIECE($GET(^DIC(9.4,ADEPKG,22,ADEVER,"PAH",ADEPATCH,0)),"^",2)

 +13       QUIT ADEPDATE

 +14      ;;TEST CODE

 +15      ;;W $$PDATE^ADECD49("IHS DENTAL","6.0",10)