ADE6P313 ;IHS/OIT/GAB - ADE6.0 PATCH 31 [ 09/09/2016 10:51 AM ]
;;6.0;ADE*6.0*31;;March 25, 1999;Build 28
;IHS/OIT/GAB 9/2016 Patch 31 ADA-CDT code updates for 2017
;Deactivated 1 ADA-CDT Code
DELCDT5 ;EP
D DELETES^ADEUPD31("DELADA^ADE6P313","SETX^ADE6P313","^AUTTADA(")
Q
;
SETX ;EP
S ADEX=$P($P(ADEX,U),"D",2),ADEX=$O(^AUTTADA("B",ADEX,""))
Q
;
DELADA ; CODE & DESCRIPTION
;;D0290^POSTERIOR - ANTERIOR OR LATERAL SKULL AND FACIAL BONE SURVEY RADIOGRAPHIC IMAGE
;;***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 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
ADE6P313 ;IHS/OIT/GAB - ADE6.0 PATCH 31 [ 09/09/2016 10:51 AM ]
+1 ;;6.0;ADE*6.0*31;;March 25, 1999;Build 28
+2 ;IHS/OIT/GAB 9/2016 Patch 31 ADA-CDT code updates for 2017
+3 ;Deactivated 1 ADA-CDT Code
DELCDT5 ;EP
+1 DO DELETES^ADEUPD31("DELADA^ADE6P313","SETX^ADE6P313","^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 ;;D0290^POSTERIOR - ANTERIOR OR LATERAL SKULL AND FACIAL BONE SURVEY RADIOGRAPHIC IMAGE
+2 ;;***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 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