ADE6P323.m

ADE6P323 ;IHS/OIT/GAB - ADE V6.0 PATCH 32 [ 10/12/2017  10:51 AM ]

 ;;6.0;ADE*6.0*32;;March 25, 1999;Build 42

 ;IHS/OIT/GAB 10/2017 Patch 32 ADA-CDT code updates for 2017

 ;Deactivated 6 ADA-CDT Codes

 ;ADA codes 9130 & 9140 are replaced with 9986 & 9987

DELCDT32 ;EP

 D DELETES^ADEUPD32("DELADA^ADE6P323","SETX^ADE6P323","^AUTTADA(")

 Q

 ;

SETX ;EP

 S ADEX=$P($P(ADEX,U),"D",2),ADEX=$O(^AUTTADA("B",ADEX,""))

 Q

 ;

DELADA ;  CODE & NOMENCLATURE

 ;;D5510^REPAIR BROKEN COMPLETE DENTURE BASE

 ;;D5610^REPAIR RESIN PARTIAL DENTURE

 ;;D5620^REPAIR CAST FRAMEWORK

 ;;D0114^SCREENING ORAL EXAMINATION

 ;;D9130^BROKEN APPOINTMENT

 ;;D9140^CANCELLED APPOINTMENT

 ;;***END***

MODADA ;

 Q

ZAPINA ;REMOVE INACTIVE DATE

 ;/IHS/OIT/GAB COMMENTED OUT NEXT THREE LINES, NO REACTIVATED CODES

 ;S ADEIRN=""

 ;S ADEIRN=$O(^AUTTADA("B","0191",0)) I +ADEIRN D ZAPIT

 ;S ADEIRN=$O(^AUTTADA("B","1208",0)) I +ADEIRN D ZAPIT

 Q

ZAPIT ;

 ;/IHS/OIT/GAB *32* commented out below no reactivated codes in this patch

 ;S DIE="^AUTTADA(",DA=ADEIRN

 ;S DR=".08////@" D ^DIE

 ;S ADEIRN=""

 Q

ZAP K D,DA,DR,DIE,D0,DIC,ADEIRN

 Q

ADE6P323  ;IHS/OIT/GAB - ADE V6.0 PATCH 32 [ 10/12/2017  10:51 AM ]

 +1       ;;6.0;ADE*6.0*32;;March 25, 1999;Build 42

 +2       ;IHS/OIT/GAB 10/2017 Patch 32 ADA-CDT code updates for 2017

 +3       ;Deactivated 6 ADA-CDT Codes

 +4       ;ADA codes 9130 & 9140 are replaced with 9986 & 9987

DELCDT32  ;EP

 +1        DO DELETES^ADEUPD32("DELADA^ADE6P323","SETX^ADE6P323","^AUTTADA(")

 +2        QUIT 

 +3       ;

SETX      ;EP

 +1        SET ADEX=$PIECE($PIECE(ADEX,U),"D",2)

           SET ADEX=$ORDER(^AUTTADA("B",ADEX,""))

 +2        QUIT 

 +3       ;

DELADA    ;  CODE & NOMENCLATURE

 +1       ;;D5510^REPAIR BROKEN COMPLETE DENTURE BASE

 +2       ;;D5610^REPAIR RESIN PARTIAL DENTURE

 +3       ;;D5620^REPAIR CAST FRAMEWORK

 +4       ;;D0114^SCREENING ORAL EXAMINATION

 +5       ;;D9130^BROKEN APPOINTMENT

 +6       ;;D9140^CANCELLED APPOINTMENT

 +7       ;;***END***

MODADA    ;

 +1        QUIT 

ZAPINA    ;REMOVE INACTIVE DATE

 +1       ;/IHS/OIT/GAB COMMENTED OUT NEXT THREE LINES, NO REACTIVATED CODES

 +2       ;S ADEIRN=""

 +3       ;S ADEIRN=$O(^AUTTADA("B","0191",0)) I +ADEIRN D ZAPIT

 +4       ;S ADEIRN=$O(^AUTTADA("B","1208",0)) I +ADEIRN D ZAPIT

 +5        QUIT 

ZAPIT     ;

 +1       ;/IHS/OIT/GAB *32* commented out below no reactivated codes in this patch

 +2       ;S DIE="^AUTTADA(",DA=ADEIRN

 +3       ;S DR=".08////@" D ^DIE

 +4       ;S ADEIRN=""

 +5        QUIT 

ZAP        KILL D,DA,DR,DIE,D0,DIC,ADEIRN

 +1        QUIT