ADE6P263.m

ADE6P263 ;IHS/OIT/GAB - ADE6.0 PATCH 26 [ 10/17/2014  10:51 AM ]

 ;;6.0;ADE*6.0*26;;March 25, 1999;Build 13

 ;;ADA Code Update

 ;;Deactivate codes by setting inactivate date /IHS/OIT/GAB

DELCDT5 ;EP

 D DELETES^ADEUPD26("DELADA^ADE6P263","SETX^ADE6P263","^AUTTADA(")

 Q

 ;

SETX ;EP

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

 Q

 ;

DELADA ;  CODE & DESCRIPTION

 ;;D6053^IMPLANT/ABUTMENT SUPPORTED REMOVABLE DENTURE FOR COMPLETELY EDENTULOUS ARCH

 ;;D6054^IMPLANT/ABUTMENT SUPPORTED REMOVABLE DENTURE FOR PARTIALLY EDENTULOUS ARCH

 ;;D6078^IMPLANT/ABUTMENT SUPPORTED FIXED DENTURE FOR COMPLETELY EDENTULOUS ARCH

 ;;D6079^IMPLANT/ABUTMENT SUPPORTED FIXED DENTURE FOR PARTIALLY EDENTULOUS ARCH

 ;;D6975^COPING

 ;;***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 no reactivated codes in patch #26, no call to ZAPIT (commented out in ZAPINA above)

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

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

 S ADEIRN=""

 Q

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

 Q

ADE6P263  ;IHS/OIT/GAB - ADE6.0 PATCH 26 [ 10/17/2014  10:51 AM ]

 +1       ;;6.0;ADE*6.0*26;;March 25, 1999;Build 13

 +2       ;;ADA Code Update

 +3       ;;Deactivate codes by setting inactivate date /IHS/OIT/GAB

DELCDT5   ;EP

 +1        DO DELETES^ADEUPD26("DELADA^ADE6P263","SETX^ADE6P263","^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 & DESCRIPTION

 +1       ;;D6053^IMPLANT/ABUTMENT SUPPORTED REMOVABLE DENTURE FOR COMPLETELY EDENTULOUS ARCH

 +2       ;;D6054^IMPLANT/ABUTMENT SUPPORTED REMOVABLE DENTURE FOR PARTIALLY EDENTULOUS ARCH

 +3       ;;D6078^IMPLANT/ABUTMENT SUPPORTED FIXED DENTURE FOR COMPLETELY EDENTULOUS ARCH

 +4       ;;D6079^IMPLANT/ABUTMENT SUPPORTED FIXED DENTURE FOR PARTIALLY EDENTULOUS ARCH

 +5       ;;D6975^COPING

 +6       ;;***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 no reactivated codes in patch #26, no call to ZAPIT (commented out in ZAPINA above)

 +2        SET DIE="^AUTTADA("

           SET DA=ADEIRN

 +3        SET DR=".08////@"

           DO ^DIE

 +4        SET ADEIRN=""

 +5        QUIT 

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

 +1        QUIT