- 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