BPXRMDM.m

BPXRMDM ; IHS/CIA/MGH - Dental Exam reminders. ;15-Apr-2008 14:20;MGH

 ;;1.5;CLINICAL REMINDERS;**1003,1004,1005**;Jun 19, 2000

 ;===================================================================

 ;This routine will be used as a computed finding for the ADA codes

 ;for a dental exam

 ;1004 Included for backward compatibility

 ;=====================================================================

DENTAL(DFN,TEST,DATE,VALUE,TEXT) ;EP

 K BPXRMDEN

 N BPXRMERR

 S BPXRMERR=$$START1^APCLDF(DFN_"^LAST ADA [APCH DM ADA EXAMS;","BPXRMDEN(")

 I BPXRMERR D

 .  S TEST=0

 .  S:BPXRMERR=7 TEXT="DM AUDIT DENTAL EXAM TAXONOMY does not exist!"

 .  S:BPXRMERR'=7 TEXT="Unable to determine Dental Exam status for this patient.  Notify Site Manager."

 .  Q

 I $D(BPXRMDEN)<1 S TEST=0

 E  D

 .S TEST=1,DATE=$P(BPXRMDEN(1),U,1),VALUE=$P(BPXRMDEN(1),U,2)

 K BPXRMERR

 Q

BPXRMDM   ; IHS/CIA/MGH - Dental Exam reminders. ;15-Apr-2008 14:20;MGH

 +1       ;;1.5;CLINICAL REMINDERS;**1003,1004,1005**;Jun 19, 2000

 +2       ;===================================================================

 +3       ;This routine will be used as a computed finding for the ADA codes

 +4       ;for a dental exam

 +5       ;1004 Included for backward compatibility

 +6       ;=====================================================================

DENTAL(DFN,TEST,DATE,VALUE,TEXT) ;EP

 +1        KILL BPXRMDEN

 +2        NEW BPXRMERR

 +3        SET BPXRMERR=$$START1^APCLDF(DFN_"^LAST ADA [APCH DM ADA EXAMS;","BPXRMDEN(")

 +4        IF BPXRMERR

               Begin DoDot:1

 +5                SET TEST=0

 +6                IF BPXRMERR=7

                       SET TEXT="DM AUDIT DENTAL EXAM TAXONOMY does not exist!"

 +7                IF BPXRMERR'=7

                       SET TEXT="Unable to determine Dental Exam status for this patient.  Notify Site Manager."

 +8                QUIT 

               End DoDot:1

 +9        IF $DATA(BPXRMDEN)<1

               SET TEST=0

 +10      IF '$TEST

               Begin DoDot:1

 +11               SET TEST=1

                   SET DATE=$PIECE(BPXRMDEN(1),U,1)

                   SET VALUE=$PIECE(BPXRMDEN(1),U,2)

               End DoDot:1

 +12       KILL BPXRMERR

 +13       QUIT