ADE0611.m

ADE0611 ;IHS/ANMC/HMW - ADA CODE FILE CORRECTIONS

 ;;6.0;ADE;**11**;AUG 14 2002

 ;

IH59 ;IHS/ANMC/HMW 8-14-2002 **11**

 ;Add ADA Code IH59

 N ADEFDA,ADEDA,ADERR

 ;If IH59 doesn't exist in ADA CODE then add it

 I '$D(^AUTTADA("B","IH59")) D

 . N ADEFDA

 . S ADEFDA(9999999.31,"+1,",.01)="IH59"

 . S ADEFDA(9999999.31,"+1,",".02")="PLANNED CARIES TREATMENT COMPLETE"

 . S ADEFDA(9999999.31,"+1,",".06")="CARIES TX COMPL"

 . D UPDATE^DIE("","ADEFDA","","ADERR")

 ;

 ;Edit IH59 field values

 S ADEDA=$O(^AUTTADA("B","IH59",0))

 I +ADEDA D

 . N ADEFDA

 . S ADEFDA(9999999.31,ADEDA_",",".02")="PLANNED CARIES TREATMENT COMPLETE"

 . S ADEFDA(9999999.31,ADEDA_",",".03")="V72.2"

 . S ADEFDA(9999999.31,ADEDA_",",".05")="0"

 . S ADEFDA(9999999.31,ADEDA_",",".06")="CARIES TX COMPL"

 . S ADEFDA(9999999.31,ADEDA_",",".09")="NO OPSITE ASKED"

 . S ADEFDA(9999999.31,ADEDA_",","8801")="PCTC"

 . D FILE^DIE("E","ADEFDA","ADERR")

 ;

 Q

ADE0611   ;IHS/ANMC/HMW - ADA CODE FILE CORRECTIONS

 +1       ;;6.0;ADE;**11**;AUG 14 2002

 +2       ;

IH59      ;IHS/ANMC/HMW 8-14-2002 **11**

 +1       ;Add ADA Code IH59

 +2        NEW ADEFDA,ADEDA,ADERR

 +3       ;If IH59 doesn't exist in ADA CODE then add it

 +4        IF '$DATA(^AUTTADA("B","IH59"))

               Begin DoDot:1

 +5                NEW ADEFDA

 +6                SET ADEFDA(9999999.31,"+1,",.01)="IH59"

 +7                SET ADEFDA(9999999.31,"+1,",".02")="PLANNED CARIES TREATMENT COMPLETE"

 +8                SET ADEFDA(9999999.31,"+1,",".06")="CARIES TX COMPL"

 +9                DO UPDATE^DIE("","ADEFDA","","ADERR")

               End DoDot:1

 +10      ;

 +11      ;Edit IH59 field values

 +12       SET ADEDA=$ORDER(^AUTTADA("B","IH59",0))

 +13       IF +ADEDA

               Begin DoDot:1

 +14               NEW ADEFDA

 +15               SET ADEFDA(9999999.31,ADEDA_",",".02")="PLANNED CARIES TREATMENT COMPLETE"

 +16               SET ADEFDA(9999999.31,ADEDA_",",".03")="V72.2"

 +17               SET ADEFDA(9999999.31,ADEDA_",",".05")="0"

 +18               SET ADEFDA(9999999.31,ADEDA_",",".06")="CARIES TX COMPL"

 +19               SET ADEFDA(9999999.31,ADEDA_",",".09")="NO OPSITE ASKED"

 +20               SET ADEFDA(9999999.31,ADEDA_",","8801")="PCTC"

 +21               DO FILE^DIE("E","ADEFDA","ADERR")

               End DoDot:1

 +22      ;

 +23       QUIT