ADE6P183.m

ADE6P183 ;IHS/OIT/ENM - ADE6.0 PATCH 18 [ 09/17/2008  10:51 AM ]

 ;;6.0;ADE;**18**;SEP 17, 2008

 ;

DELCDT5 ;EP

 D DELETES^ADEUPD8("DELADA^ADE6P183","SETX^ADE6P183","^AUTTADA(")

 Q

 ;

SETX ;EP

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

 Q

 ;

DELADA ;

 ;;DIH50^LOW RISK CARIES PATIENT

 ;;DIH51^MODERATE RISK CARIES PATIENT

 ;;DIH52^HIGH RISK CARIES PATIENT

 ;;DIH53^VERY HIGH RISK CARIES PATIENT

 ;;DIH70^PATIENT HAS BEEN ASSESSED FOR 437 OBJECTIVES

 ;;DIH71^PATIENT IS CARIES FREE (AGE <20)

 ;;DIH72^PATIENT WITH UNTREATED DENTAL DECAY (AGE <20)

 ;;DIH73^PATIENT WITH MOLAR SEALANTS (AGE <20)

 ;;DIH74^PATIENT WITH ACCEPTABLE PERIODONTAL HEALTH (AGE 15-45)

 ;;DIH75^PATIENT WITH DESTRUCTIVE PERIODONTAL DISEASE (AGE 15-45)

 ;;DIH76^PATIENT WITH MISSING TOOTH (AGE 15-45)

 ;;DIH77^PATIENT BECOMES EDENTULOUS (AGE 15-74)

 ;;***END***

 ;

MODADA ;

 Q

ZAPINA ;REMOVE INACTIVE DATE FOR 3 RECORDS THAT WERE REACTIVATED

 Q

 S ADEIRN=""

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

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

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

 Q

ZAPIT ;

 Q

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

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

 S ADEIRN=""

 Q

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

 Q

ADE6P183  ;IHS/OIT/ENM - ADE6.0 PATCH 18 [ 09/17/2008  10:51 AM ]

 +1       ;;6.0;ADE;**18**;SEP 17, 2008

 +2       ;

DELCDT5   ;EP

 +1        DO DELETES^ADEUPD8("DELADA^ADE6P183","SETX^ADE6P183","^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    ;

 +1       ;;DIH50^LOW RISK CARIES PATIENT

 +2       ;;DIH51^MODERATE RISK CARIES PATIENT

 +3       ;;DIH52^HIGH RISK CARIES PATIENT

 +4       ;;DIH53^VERY HIGH RISK CARIES PATIENT

 +5       ;;DIH70^PATIENT HAS BEEN ASSESSED FOR 437 OBJECTIVES

 +6       ;;DIH71^PATIENT IS CARIES FREE (AGE <20)

 +7       ;;DIH72^PATIENT WITH UNTREATED DENTAL DECAY (AGE <20)

 +8       ;;DIH73^PATIENT WITH MOLAR SEALANTS (AGE <20)

 +9       ;;DIH74^PATIENT WITH ACCEPTABLE PERIODONTAL HEALTH (AGE 15-45)

 +10      ;;DIH75^PATIENT WITH DESTRUCTIVE PERIODONTAL DISEASE (AGE 15-45)

 +11      ;;DIH76^PATIENT WITH MISSING TOOTH (AGE 15-45)

 +12      ;;DIH77^PATIENT BECOMES EDENTULOUS (AGE 15-74)

 +13      ;;***END***

 +14      ;

MODADA    ;

 +1        QUIT 

ZAPINA    ;REMOVE INACTIVE DATE FOR 3 RECORDS THAT WERE REACTIVATED

 +1        QUIT 

 +2        SET ADEIRN=""

 +3        SET ADEIRN=$ORDER(^AUTTADA("B",2970,0))

           IF +ADEIRN

               DO ZAPIT

 +4        SET ADEIRN=$ORDER(^AUTTADA("B",2953,0))

           IF +ADEIRN

               DO ZAPIT

 +5        SET ADEIRN=$ORDER(^AUTTADA("B",3331,0))

           IF +ADEIRN

               DO ZAPIT

 +6        QUIT 

ZAPIT     ;

 +1        QUIT 

 +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