Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ADE6P303

ADE6P303.m

Go to the documentation of this file.
  1. ADE6P303 ;IHS/OIT/GAB - ADE6.0 PATCH 30 [ 11/17/2015 10:51 AM ]
  1. ;;6.0;ADE*6.0*30;;March 25, 1999;Build 19
  1. ;;Deactivate codes by setting inactivate date /IHS/OIT/GAB
  1. DELCDT5 ;EP
  1. D DELETES^ADEUPD30("DELADA^ADE6P303","SETX^ADE6P303","^AUTTADA(")
  1. Q
  1. ;
  1. SETX ;EP
  1. S ADEX=$P($P(ADEX,U),"D",2),ADEX=$O(^AUTTADA("B",ADEX,""))
  1. Q
  1. ;
  1. DELADA ; CODE & DESCRIPTION
  1. ;;D0260^
  1. ;;D0421^GENETIC TEST FOR SUSCEPTIBILITY TO ORAL DISEASES
  1. ;;D2970^TEMPORARY CROWN (FRACTURED TOOTH)
  1. ;;D9220^DEEP SEDATION/GENERAL ANESTHESIA - FIRST 30 MINUTES
  1. ;;D9221^DEEP SEDATION/GENERAL ANESTHESIA - EACH ADDITIONAL 15 MINUTES
  1. ;;D9241^INTRAVENOUS MODERATE (CONSCIOUS) SEDATION/ANALGESIA - FIRST 30 MINUTES
  1. ;;D9242^INTRAVENOUS MODERATE (CONSCIOUS) SEDATION/ANALGESIA - EACH ADDITIONAL 15 MINUTES
  1. ;;D9931^CLEANING AND INSPECTION OF A REMOVABLE APPLIANCE
  1. ;;***END***
  1. ;
  1. MODADA ;
  1. Q
  1. ZAPINA ;REMOVE INACTIVE DATE
  1. ;/IHS/OIT/GAB COMMENTED OUT NEXT THREE LINES, NO REACTIVATED CODES
  1. ;S ADEIRN=""
  1. ;S ADEIRN=$O(^AUTTADA("B","0191",0)) I +ADEIRN D ZAPIT
  1. ;S ADEIRN=$O(^AUTTADA("B","1208",0)) I +ADEIRN D ZAPIT
  1. Q
  1. ZAPIT ;
  1. ;/IHS/OIT/GAB commented out below no reactivated codes in patch #30
  1. ;S DIE="^AUTTADA(",DA=ADEIRN
  1. ;S DR=".08////@" D ^DIE
  1. ;S ADEIRN=""
  1. Q
  1. ZAP K D,DA,DR,DIE,D0,DIC,ADEIRN
  1. Q