BGPMUH04 ; IHS/MSC/MGH - MI measure NQF0436-STK-3 ;02-Mar-2011 16:05;MGH
;;11.0;IHS CLINICAL REPORTING;**4**;JAN 06, 2011;Build 84
;ED meaningful use hospital measured
ENTRY ;PEP Stroke Measure 3- Stroke anticoagulation therapy
N START,END,BGPIEN,DFN,BGPVST,BGPISDX,BGPHSDX,BGPAGEE,BGPIPROB,BGPHPROB,STROKE,FIB,EXC,NUM,BGPDIS
N BGPFIBDX,BGPFIBPB,BGPFIBCP,BGPFIBPR
N BGPDT,BGPDSTR,BGPNSTR,BGPVCNT
; BGPTDT=visit date; BGPDSTR='not in numerator' string; BGPNSTR='in numerater' string
S (BGPDT,BGPDSTR,BGPNSTR)=""
S BGPVCNT=0
;Start by finding all admissions during the reporting period
S START=BGPBDATE
S END=BGPEDATE_".2359"
F S START=$O(^DGPM("B",START)) Q:START=""!(START>END) D
.S BGPIEN="" F S BGPIEN=$O(^DGPM("B",START,BGPIEN)) Q:BGPIEN="" D
..Q:$P($G(^DGPM(BGPIEN,0)),U,2)'=1 ;Only include admissions
..S DFN=$P($G(^DGPM(BGPIEN,0)),U,3)
..Q:DFN=""
..S BGPACTUP=$$ACTUPAP^BGPMUEHD(DFN,BGPBDATE,BGPEDATE,BGPBEN)
..I 'BGPACTUP,'$G(BGPXPXPX),'$G(BGPIISO) Q
..S BGPVST=$P($G(^DGPM(BGPIEN,0)),U,27) ;Get the visit
..Q:BGPVST=""
..S BGPADM=$P($$GET1^DIQ(9000010,BGPVST_",",.01,"I"),".",1) ;get admin date
..S BGPAGEE=$$AGE^AUPNPAT(DFN,BGPADM)
..S BGPDIS=$P($G(^DGPM(BGPIEN,0)),U,17) ;Don't use if pt is still an inpt
..Q:BGPDIS=""
..;Check for a diagnosis of stroke
..S STROKE=0,EXC=0,NUM=0
..S BGPISDX=$$VSTPOVA^BGPMUUT3(DFN,BGPVST,"BGPMU ISCHEMIC STROKE DX")
..;S BGPIPROB=$$PLTAX^BGPMUUT1(DFN,"BGPMU ISCHEMIC STROKE DX","A")
..;Pt must have both a POV of stoke and it must be an active problem
..;I +BGPISDX&(+BGPIPROB) S STROKE=1
..I +BGPISDX S STROKE=1
..Q:'STROKE
..;Check next for atrial fibrillation since pt must have both
..S FIB=0
..I +STROKE D
...S BGPFIBDX=$$VSTPOV^BGPMUUT3(DFN,BGPVST,"BGPMU ATRIAL FIB DX")
...I +BGPFIBDX S FIB=BGPFIBDX
...S BGPFIBPB=$$PLTAX^BGPMUUT1(DFN,"BGPMU ATRIAL FIB DX")
...I +BGPFIBPB S FIB=BGPFIBPB
...S BGPFIBCP=$$VSTCPT^BGPMUUT1(DFN,BGPVST,"BGPMU ATRIAL FIB CPT")
...I +BGPFIBCP S FIB=BGPFIBCP
...S BGPFIBPR=$$VSTICD0^BGPMUUT3(DFN,BGPVST,"BGPMU ATRIAL FIB ICD0")
...I +BGPFIBPR S FIB=BGPFIBPR
...;Next check for exclusions
...I +FIB D
....S EXC=$$EXCLUDE(DFN,BGPIEN,BGPVST,BGPDIS)
....;If no exclusions see if they had the drug ordered
....I EXC="" D
.....S (BGPNSTR,BGPDSTR)=""
.....S BGPDT=$P($P($G(^AUPNVSIT(BGPVST,0)),U,1),".",1)
.....;see if they had the drug ordered
.....S NUM=$$NUMER(DFN,BGPDIS)
.....I NUM'=0 S BGPNSTR=BGPDT_":"_$P(NUM,U,3)
.....I NUM=0 S BGPDSTR=BGPDT
....;Now add it all up
....D TOTAL(BGPIEN)
Q
TOTAL(BGPIEN) ;add up the totals
N PTCNT,EXCCT,DENCT,NUMCT,TOTALS,DATE,NOTCT
S TOTALS=$G(^TMP("BGPMU0436",$J,BGPMUTF,"TOT"))
S DENCT=+$G(^TMP("BGPMU0436",$J,BGPMUTF,"DEN"))
S NUMCT=+$G(^TMP("BGPMU0436",$J,BGPMUTF,"NUM"))
S EXCCT=+$G(^TMP("BGPMU0436",$J,BGPMUTF,"EXC"))
S NOTCT=+$G(^TMP("BGPMU0436",$J,BGPMUTF,"NOT"))
S PTCNT=TOTALS
S PTCNT=PTCNT+1
S DATE=$$DATE^BGPMUUTL($P($G(^DGPM(BGPIEN,0)),U,1))
S DENCT=DENCT+1 S ^TMP("BGPMU0436",$J,BGPMUTF,"DEN")=DENCT
I EXC'="" D
.S EXCCT=EXCCT+1 S ^TMP("BGPMU0436",$J,BGPMUTF,"EXC")=EXCCT
.I BGPMUTF="C" S ^TMP("BGPMU0436",$J,"PAT",BGPMUTF,"EXC",PTCNT)=DFN_U_DATE_U_$P(EXC,U,2)
I EXC="" D
.I +NUM D
..S NUMCT=NUMCT+1 S ^TMP("BGPMU0436",$J,BGPMUTF,"NUM")=NUMCT
..S BGPNSTR1=$P($G(^TMP("BGPMU0436",$J,"PAT",BGPMUTF,"NUM",PTCNT)),U,2)
..S ^TMP("BGPMU0436",$J,"PAT",BGPMUTF,"NUM",PTCNT)=DFN_U_DATE_U_$P(NUM,U,3)_U_$P(NUM,U,2)
.I +NUM=0 D
..S NOTCT=NOTCT+1 S ^TMP("BGPMU0436",$J,BGPMUTF,"NOT")=NOTCT
..S BGPDSTR1=$P($G(^TMP("BGPMU0436",$J,"PAT",BGPMUTF,"NOT",PTCNT)),U,2)
..S ^TMP("BGPMU0436",$J,"PAT",BGPMUTF,"NOT",PTCNT)=DFN_U_DATE_U_$P(NUM,U,3)_U_$P(NUM,U,2)
S ^TMP("BGPMU0436",$J,BGPMUTF,"TOT")=PTCNT
S BGPICARE("MU.STK.0436.1",BGPMUTF,DFN)=1_U_+$G(NUM)_U_+EXC_U_DATE_";"_$P($G(NUM),U,3)_";"_$P(EXC,U,2)
Q
EXCLUDE(DFN,BGPIEN,BGPVST,BGPDIS) ;See if there are exclusions
N ANTICOAG,REASON,BGPLOS,BGPHOS,BGPCLIN,BGPECI,DTYPE1,DTYPE2,BGPALL,BGPREF
S REASON=""
I BGPAGEE<18 S REASON="1^AGE" Q REASON
;Check for LOS
S BGPLOS=$$LOS^BGPMUH08(BGPIEN,BGPDIS)
I BGPLOS>120 S REASON="1^LOS" Q REASON
;Check for discharge reasons
S DTYPE2=$P($G(^DGPM(BGPDIS,"IHS")),U,7)
I (DTYPE2="2")!(DTYPE2="3")!(DTYPE2="4")!(DTYPE2="5")!(DTYPE2="7")!(DTYPE2="43")!(DTYPE2="50")!(DTYPE2="51") S REASON="1^"_DTYPE2 Q REASON
;Check for expired
S DTYPE2=$P($G(^DGPM(BGPDIS,"IHS")),U,7)
I (DTYPE2="20")!(DTYPE2="40")!(DTYPE2="41")!(DTYPE2="42") S REASON="1^"_DTYPE2 Q REASON
;Check for hospice care
S BGPHOS=$$HOSPICE^BGPMUH08(DFN,BGPVST)
I +BGPHOS S REASON=BGPHOS Q REASON
;Check for clinical trial
S BGPCLIN=$$TRIAL^BGPMUH08(DFN,BGPVST)
I +BGPCLIN S REASON=BGPCLIN Q REASON
;Check for elective carotid intervention procedure
S BGPECI=$$ELECTIVE^BGPMUH08(DFN,BGPVST,BGPIEN)
I +BGPECI S REASON=BGPECI Q REASON
;Check for allergies to warfarin
S BGPALL=$$ALLER^BGPMUH04(DFN)
I +BGPALL S REASON=BGPALL Q REASON
;Check for Anticoagulation CPT codes within past 180 days of discharge
S BGPDISDT=$P($P($G(^DGPM(BGPDIS,0)),U,1),".",1)
S ANTICOAG=$$CPT^BGPMUUT1(DFN,$$FMADD^XLFDT(BGPDISDT,-180),BGPDISDT,"BGPMU WARFARIN THERAPY CPT") ;(DFN,BDATE,EDATE,TAX)
I +ANTICOAG S REASON=ANTICOAG Q REASON
;Check for refusals
S BGPREF=$$REF(DFN,BGPVST,BGPDIS)
I +BGPREF S REASON=BGPREF
Q REASON
ALLER(DFN) ;Find if pt has allergies to warfarin
N AA,BB,X,Y,TEST
S (AA,TEST)=0
I '$D(^GMR(120.8,"B",DFN)) Q TEST
F S AA=$O(^GMR(120.8,"B",DFN,AA)) Q:AA'>0!(TEST=1) D
. I $P(^GMR(120.8,AA,0),"^",16)'=1 Q ;Quit if not verified
. I $D(^GMR(120.8,AA,"ER")),$P(^GMR(120.8,AA,"ER"),"^",1)=1 Q ;
. S X=$P(^GMR(120.8,AA,0),"^",2) X ^%ZOSF("UPPERCASE")
. I (Y["COUMADIN")!(Y["WARFARIN") S TEST="1^"_Y
. S BB=0
. F S BB=$O(^GMR(120.8,AA,3,"B",BB)) Q:BB'>0 D
. . I $P(^PS(50.605,BB,0),"^",1)="BL110" S TEST="1^"_Y
Q TEST
REF(DFN,BGPVST,BGPDIS) ;Find refuals for this medication
N ENDDT,X1,X2,X,MED,BGPEVT,DISDT
S MED=0
S BGPEVT=$P($G(^AUPNVSIT(BGPVST,0)),U,1)
S DISDT=$P($G(^DGPM(BGPDIS,0)),U,1)
S ENDDT=$$FMADD^XLFDT(DISDT,+1)
S TAX="BGPMU ANTICOAG NDCS"
S MED=$$MEDREF^BGPMUUT2(DFN,BGPEVT,ENDDT,TAX)
Q MED
NUMER(DFN,BGPDIS) ;Check to see if pt is in the numerator
N DRUG,TAX,MEDTYPE,DDATE
S MEDTYPE="OP",TAX="BGPMU ANTICOAG NDCS"
S DDATE=$P($G(^DGPM(BGPDIS,0)),U,1)
S DRUG=$$FIND^BGPMUUT4(DFN,TAX,DDATE,MEDTYPE) ; DRUG = 1_U_NDC
Q DRUG_U_DDATE
BGPMUH04 ; IHS/MSC/MGH - MI measure NQF0436-STK-3 ;02-Mar-2011 16:05;MGH
+1 ;;11.0;IHS CLINICAL REPORTING;**4**;JAN 06, 2011;Build 84
+2 ;ED meaningful use hospital measured
ENTRY ;PEP Stroke Measure 3- Stroke anticoagulation therapy
+1 NEW START,END,BGPIEN,DFN,BGPVST,BGPISDX,BGPHSDX,BGPAGEE,BGPIPROB,BGPHPROB,STROKE,FIB,EXC,NUM,BGPDIS
+2 NEW BGPFIBDX,BGPFIBPB,BGPFIBCP,BGPFIBPR
+3 NEW BGPDT,BGPDSTR,BGPNSTR,BGPVCNT
+4 ; BGPTDT=visit date; BGPDSTR='not in numerator' string; BGPNSTR='in numerater' string
+5 SET (BGPDT,BGPDSTR,BGPNSTR)=""
+6 SET BGPVCNT=0
+7 ;Start by finding all admissions during the reporting period
+8 SET START=BGPBDATE
+9 SET END=BGPEDATE_".2359"
+10 FOR
SET START=$ORDER(^DGPM("B",START))
IF START=""!(START>END)
QUIT
Begin DoDot:1
+11 SET BGPIEN=""
FOR
SET BGPIEN=$ORDER(^DGPM("B",START,BGPIEN))
IF BGPIEN=""
QUIT
Begin DoDot:2
+12 ;Only include admissions
IF $PIECE($GET(^DGPM(BGPIEN,0)),U,2)'=1
QUIT
+13 SET DFN=$PIECE($GET(^DGPM(BGPIEN,0)),U,3)
+14 IF DFN=""
QUIT
+15 SET BGPACTUP=$$ACTUPAP^BGPMUEHD(DFN,BGPBDATE,BGPEDATE,BGPBEN)
+16 IF 'BGPACTUP
IF '$GET(BGPXPXPX)
IF '$GET(BGPIISO)
QUIT
+17 ;Get the visit
SET BGPVST=$PIECE($GET(^DGPM(BGPIEN,0)),U,27)
+18 IF BGPVST=""
QUIT
+19 ;get admin date
SET BGPADM=$PIECE($$GET1^DIQ(9000010,BGPVST_",",.01,"I"),".",1)
+20 SET BGPAGEE=$$AGE^AUPNPAT(DFN,BGPADM)
+21 ;Don't use if pt is still an inpt
SET BGPDIS=$PIECE($GET(^DGPM(BGPIEN,0)),U,17)
+22 IF BGPDIS=""
QUIT
+23 ;Check for a diagnosis of stroke
+24 SET STROKE=0
SET EXC=0
SET NUM=0
+25 SET BGPISDX=$$VSTPOVA^BGPMUUT3(DFN,BGPVST,"BGPMU ISCHEMIC STROKE DX")
+26 ;S BGPIPROB=$$PLTAX^BGPMUUT1(DFN,"BGPMU ISCHEMIC STROKE DX","A")
+27 ;Pt must have both a POV of stoke and it must be an active problem
+28 ;I +BGPISDX&(+BGPIPROB) S STROKE=1
+29 IF +BGPISDX
SET STROKE=1
+30 IF 'STROKE
QUIT
+31 ;Check next for atrial fibrillation since pt must have both
+32 SET FIB=0
+33 IF +STROKE
Begin DoDot:3
+34 SET BGPFIBDX=$$VSTPOV^BGPMUUT3(DFN,BGPVST,"BGPMU ATRIAL FIB DX")
+35 IF +BGPFIBDX
SET FIB=BGPFIBDX
+36 SET BGPFIBPB=$$PLTAX^BGPMUUT1(DFN,"BGPMU ATRIAL FIB DX")
+37 IF +BGPFIBPB
SET FIB=BGPFIBPB
+38 SET BGPFIBCP=$$VSTCPT^BGPMUUT1(DFN,BGPVST,"BGPMU ATRIAL FIB CPT")
+39 IF +BGPFIBCP
SET FIB=BGPFIBCP
+40 SET BGPFIBPR=$$VSTICD0^BGPMUUT3(DFN,BGPVST,"BGPMU ATRIAL FIB ICD0")
+41 IF +BGPFIBPR
SET FIB=BGPFIBPR
+42 ;Next check for exclusions
+43 IF +FIB
Begin DoDot:4
+44 SET EXC=$$EXCLUDE(DFN,BGPIEN,BGPVST,BGPDIS)
+45 ;If no exclusions see if they had the drug ordered
+46 IF EXC=""
Begin DoDot:5
+47 SET (BGPNSTR,BGPDSTR)=""
+48 SET BGPDT=$PIECE($PIECE($GET(^AUPNVSIT(BGPVST,0)),U,1),".",1)
+49 ;see if they had the drug ordered
+50 SET NUM=$$NUMER(DFN,BGPDIS)
+51 IF NUM'=0
SET BGPNSTR=BGPDT_":"_$PIECE(NUM,U,3)
+52 IF NUM=0
SET BGPDSTR=BGPDT
End DoDot:5
+53 ;Now add it all up
+54 DO TOTAL(BGPIEN)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+55 QUIT
TOTAL(BGPIEN) ;add up the totals
+1 NEW PTCNT,EXCCT,DENCT,NUMCT,TOTALS,DATE,NOTCT
+2 SET TOTALS=$GET(^TMP("BGPMU0436",$JOB,BGPMUTF,"TOT"))
+3 SET DENCT=+$GET(^TMP("BGPMU0436",$JOB,BGPMUTF,"DEN"))
+4 SET NUMCT=+$GET(^TMP("BGPMU0436",$JOB,BGPMUTF,"NUM"))
+5 SET EXCCT=+$GET(^TMP("BGPMU0436",$JOB,BGPMUTF,"EXC"))
+6 SET NOTCT=+$GET(^TMP("BGPMU0436",$JOB,BGPMUTF,"NOT"))
+7 SET PTCNT=TOTALS
+8 SET PTCNT=PTCNT+1
+9 SET DATE=$$DATE^BGPMUUTL($PIECE($GET(^DGPM(BGPIEN,0)),U,1))
+10 SET DENCT=DENCT+1
SET ^TMP("BGPMU0436",$JOB,BGPMUTF,"DEN")=DENCT
+11 IF EXC'=""
Begin DoDot:1
+12 SET EXCCT=EXCCT+1
SET ^TMP("BGPMU0436",$JOB,BGPMUTF,"EXC")=EXCCT
+13 IF BGPMUTF="C"
SET ^TMP("BGPMU0436",$JOB,"PAT",BGPMUTF,"EXC",PTCNT)=DFN_U_DATE_U_$PIECE(EXC,U,2)
End DoDot:1
+14 IF EXC=""
Begin DoDot:1
+15 IF +NUM
Begin DoDot:2
+16 SET NUMCT=NUMCT+1
SET ^TMP("BGPMU0436",$JOB,BGPMUTF,"NUM")=NUMCT
+17 SET BGPNSTR1=$PIECE($GET(^TMP("BGPMU0436",$JOB,"PAT",BGPMUTF,"NUM",PTCNT)),U,2)
+18 SET ^TMP("BGPMU0436",$JOB,"PAT",BGPMUTF,"NUM",PTCNT)=DFN_U_DATE_U_$PIECE(NUM,U,3)_U_$PIECE(NUM,U,2)
End DoDot:2
+19 IF +NUM=0
Begin DoDot:2
+20 SET NOTCT=NOTCT+1
SET ^TMP("BGPMU0436",$JOB,BGPMUTF,"NOT")=NOTCT
+21 SET BGPDSTR1=$PIECE($GET(^TMP("BGPMU0436",$JOB,"PAT",BGPMUTF,"NOT",PTCNT)),U,2)
+22 SET ^TMP("BGPMU0436",$JOB,"PAT",BGPMUTF,"NOT",PTCNT)=DFN_U_DATE_U_$PIECE(NUM,U,3)_U_$PIECE(NUM,U,2)
End DoDot:2
End DoDot:1
+23 SET ^TMP("BGPMU0436",$JOB,BGPMUTF,"TOT")=PTCNT
+24 SET BGPICARE("MU.STK.0436.1",BGPMUTF,DFN)=1_U_+$GET(NUM)_U_+EXC_U_DATE_";"_$PIECE($GET(NUM),U,3)_";"_$PIECE(EXC,U,2)
+25 QUIT
EXCLUDE(DFN,BGPIEN,BGPVST,BGPDIS) ;See if there are exclusions
+1 NEW ANTICOAG,REASON,BGPLOS,BGPHOS,BGPCLIN,BGPECI,DTYPE1,DTYPE2,BGPALL,BGPREF
+2 SET REASON=""
+3 IF BGPAGEE<18
SET REASON="1^AGE"
QUIT REASON
+4 ;Check for LOS
+5 SET BGPLOS=$$LOS^BGPMUH08(BGPIEN,BGPDIS)
+6 IF BGPLOS>120
SET REASON="1^LOS"
QUIT REASON
+7 ;Check for discharge reasons
+8 SET DTYPE2=$PIECE($GET(^DGPM(BGPDIS,"IHS")),U,7)
+9 IF (DTYPE2="2")!(DTYPE2="3")!(DTYPE2="4")!(DTYPE2="5")!(DTYPE2="7")!(DTYPE2="43")!(DTYPE2="50")!(DTYPE2="51")
SET REASON="1^"_DTYPE2
QUIT REASON
+10 ;Check for expired
+11 SET DTYPE2=$PIECE($GET(^DGPM(BGPDIS,"IHS")),U,7)
+12 IF (DTYPE2="20")!(DTYPE2="40")!(DTYPE2="41")!(DTYPE2="42")
SET REASON="1^"_DTYPE2
QUIT REASON
+13 ;Check for hospice care
+14 SET BGPHOS=$$HOSPICE^BGPMUH08(DFN,BGPVST)
+15 IF +BGPHOS
SET REASON=BGPHOS
QUIT REASON
+16 ;Check for clinical trial
+17 SET BGPCLIN=$$TRIAL^BGPMUH08(DFN,BGPVST)
+18 IF +BGPCLIN
SET REASON=BGPCLIN
QUIT REASON
+19 ;Check for elective carotid intervention procedure
+20 SET BGPECI=$$ELECTIVE^BGPMUH08(DFN,BGPVST,BGPIEN)
+21 IF +BGPECI
SET REASON=BGPECI
QUIT REASON
+22 ;Check for allergies to warfarin
+23 SET BGPALL=$$ALLER^BGPMUH04(DFN)
+24 IF +BGPALL
SET REASON=BGPALL
QUIT REASON
+25 ;Check for Anticoagulation CPT codes within past 180 days of discharge
+26 SET BGPDISDT=$PIECE($PIECE($GET(^DGPM(BGPDIS,0)),U,1),".",1)
+27 ;(DFN,BDATE,EDATE,TAX)
SET ANTICOAG=$$CPT^BGPMUUT1(DFN,$$FMADD^XLFDT(BGPDISDT,-180),BGPDISDT,"BGPMU WARFARIN THERAPY CPT")
+28 IF +ANTICOAG
SET REASON=ANTICOAG
QUIT REASON
+29 ;Check for refusals
+30 SET BGPREF=$$REF(DFN,BGPVST,BGPDIS)
+31 IF +BGPREF
SET REASON=BGPREF
+32 QUIT REASON
ALLER(DFN) ;Find if pt has allergies to warfarin
+1 NEW AA,BB,X,Y,TEST
+2 SET (AA,TEST)=0
+3 IF '$DATA(^GMR(120.8,"B",DFN))
QUIT TEST
+4 FOR
SET AA=$ORDER(^GMR(120.8,"B",DFN,AA))
IF AA'>0!(TEST=1)
QUIT
Begin DoDot:1
+5 ;Quit if not verified
IF $PIECE(^GMR(120.8,AA,0),"^",16)'=1
QUIT
+6 ;
IF $DATA(^GMR(120.8,AA,"ER"))
IF $PIECE(^GMR(120.8,AA,"ER"),"^",1)=1
QUIT
+7 SET X=$PIECE(^GMR(120.8,AA,0),"^",2)
XECUTE ^%ZOSF("UPPERCASE")
+8 IF (Y["COUMADIN")!(Y["WARFARIN")
SET TEST="1^"_Y
+9 SET BB=0
+10 FOR
SET BB=$ORDER(^GMR(120.8,AA,3,"B",BB))
IF BB'>0
QUIT
Begin DoDot:2
+11 IF $PIECE(^PS(50.605,BB,0),"^",1)="BL110"
SET TEST="1^"_Y
End DoDot:2
End DoDot:1
+12 QUIT TEST
REF(DFN,BGPVST,BGPDIS) ;Find refuals for this medication
+1 NEW ENDDT,X1,X2,X,MED,BGPEVT,DISDT
+2 SET MED=0
+3 SET BGPEVT=$PIECE($GET(^AUPNVSIT(BGPVST,0)),U,1)
+4 SET DISDT=$PIECE($GET(^DGPM(BGPDIS,0)),U,1)
+5 SET ENDDT=$$FMADD^XLFDT(DISDT,+1)
+6 SET TAX="BGPMU ANTICOAG NDCS"
+7 SET MED=$$MEDREF^BGPMUUT2(DFN,BGPEVT,ENDDT,TAX)
+8 QUIT MED
NUMER(DFN,BGPDIS) ;Check to see if pt is in the numerator
+1 NEW DRUG,TAX,MEDTYPE,DDATE
+2 SET MEDTYPE="OP"
SET TAX="BGPMU ANTICOAG NDCS"
+3 SET DDATE=$PIECE($GET(^DGPM(BGPDIS,0)),U,1)
+4 ; DRUG = 1_U_NDC
SET DRUG=$$FIND^BGPMUUT4(DFN,TAX,DDATE,MEDTYPE)
+5 QUIT DRUG_U_DDATE
