BGPMUH06 ;IHS/MSC/MGH - MI measure NQF0438-STK-5 ;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 5 - Antithrobtic therapy by end of 2nd day
N START,END,BGPIEN,DFN,BGPVST,BGPISDX,BGPHSDX,BGPAGEE,BGPIPROB,BGPHPROB,STROKE,EXC,NUM,BGPDIS
N BGPER,BGPADTMI,BDPDD,LKW,BGPADMIT,BGPDD,ADATE,SECOND
;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)
..S BGPAGEE=$$AGE^AUPNPAT(DFN,BGPEDATE)
..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 BGPDIS=$P($G(^DGPM(BGPIEN,0)),U,17) ;Don't use if pt is still an inpt
..Q:BGPDIS=""
..S BGPADMIT=$P($G(^DGPM(BGPIEN,0)),U,1) ;Admit date/time
..S BGPDD=$P($G(^DGPM(BGPDIS,0)),U,1) ;Discharge date/time
..;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
..;Next check for exclusions
..I +STROKE D
...;See if there is an ER visit prior to admission
...S BGPER=$$ER(DFN,BGPADMIT)
...S EXC=$$EXCLUDE(DFN,BGPIEN,BGPVST,BGPDIS)
...;If no exclusions see if they had antithrombolytics given in correct time frame
...I EXC="" S NUM=$$NUMER(DFN,BGPADMIT,SECOND)
...;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("BGPMU0438",$J,BGPMUTF,"TOT"))
S DENCT=+$G(^TMP("BGPMU0438",$J,BGPMUTF,"DEN"))
S NUMCT=+$G(^TMP("BGPMU0438",$J,BGPMUTF,"NUM"))
S EXCCT=+$G(^TMP("BGPMU0438",$J,BGPMUTF,"EXC"))
S NOTCT=+$G(^TMP("BGPMU0438",$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("BGPMU0438",$J,BGPMUTF,"DEN")=DENCT
I EXC'="" D
.S EXCCT=EXCCT+1 S ^TMP("BGPMU0438",$J,BGPMUTF,"EXC")=EXCCT
.I BGPMUTF="C" S ^TMP("BGPMU0438",$J,"PAT",BGPMUTF,"EXC",PTCNT)=DFN_U_DATE_U_$P(EXC,U,2)
I EXC="" D
.I +NUM=1 D
..S NUMCT=NUMCT+1 S ^TMP("BGPMU0438",$J,BGPMUTF,"NUM")=NUMCT
..S ^TMP("BGPMU0438",$J,"PAT",BGPMUTF,"NUM",PTCNT)=DFN_U_DATE_U_$P(NUM,U,3)_U_$P(NUM,U,2)
.I +NUM=0 D
..S ^TMP("BGPMU0438",$J,"PAT",BGPMUTF,"NOT",PTCNT)=DFN_U_DATE_U_$P(NUM,U,3)_U_$P(NUM,U,2)
..S NOTCT=NOTCT+1 S ^TMP("BGPMU0438",$J,BGPMUTF,"NOT")=NOTCT
S ^TMP("BGPMU0438",$J,BGPMUTF,"TOT")=PTCNT
S BGPICARE("MU.STK.0438.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 REASON,BGPLOS,BGPHOS,BGPCLIN,BGPECI,DTYPE1,DTYPE2,BGPALL,BGPREF,BGPTPA
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 if LOS < 2 days
;Find the end of hospital day 2
S ADATE=$P(BGPADMIT,".",1)
S SECOND=$$FMADD^XLFDT(ADATE,2),SECOND=SECOND_".2359"
I BGPDD<SECOND S EXC="1^LOS" ;Length of stay too short
;Check for palliative Care
S BGPHOS=$$HOSPICE(DFN,BGPVST,BGPADMIT)
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(DFN)
I +BGPALL S REASON=BGPALL Q REASON
;Check for refusals
S BGPREF=$$REF(DFN,BGPVST,BGPDIS)
I +BGPREF S REASON=BGPREF Q REASON
;Check if they had tPA
S BGPTPA=$$TPA(DFN,BGPADMIT,BGPDD)
I +BGPTPA S REASON=BGPTPA
Q REASON
HOSPICE(DFN,BGPVST,BGPADMT) ;Find palliative care patients
N COMFORT,BGPTDX,BGPTPROB,BGPTCPT
S COMFORT=0
S BGPTDX=$$COMFORT^BGPMUUT3(DFN,BGPVST,"BGPMU TERMINAL",BGPADMIT,1)
I +BGPTDX S COMFORT=BGPTDX
S BGPTPROB=$$PLSTART^BGPMUUT3(DFN,"BGPMU TERMINAL","A",BGPADMIT)
I +BGPTPROB S COMFORT=BGPTPROB
S BGPTCPT=$$PALCPT^BGPMUUT3(DFN,BGPVST,"BGPMU PALLIATIVE CARE CPT",BGPADMIT)
I +BGPTCPT S COMFORT=BGPTCPT
Q COMFORT
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 refusals 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 ANTITHROMBOTIC NDCS"
S MED=$$MEDREF^BGPMUUT2(DFN,BGPEVT,ENDDT,TAX)
Q MED
TPA(DFN,ADMIT,DIS) ;Check to see if had tpa
N TAX,MEDDTE,ENDDT,TPA,MEDIEN,STATUS,DRUG,BGPIDX,DISPENSE
S TPA=0
S MEDDTE=$$FMADD^XLFDT(ADMIT,-1) ;Start time is 24hrs prior to admission
S TAX="BGPMU TPA NDC CODES"
S TPA=$$BCMA(DFN,MEDDTE,DIS,TAX)
I TPA=0 D ;Check non-VA meds
.N N0,IEN,ST,ED,STATUS,BGPIDX,DC
.S IEN=0 F S IEN=$O(^PS(55,DFN,"NVA",IEN)) Q:'+IEN!(+TPA) D
..S N0=$G(^PS(55,DFN,"NVA",IEN,0))
..S DC=$P(N0,U,7),ST=$P(N0,U,9),ED=$P(N0,U,10)
..S BGPIDX=$P(N0,U,2)
..I ST="" S ST=ED
..I ST>MEDDTE&(ST<DIS) S RESULT=$$NDC^BGPMUUT4(BGPIDX,TAX)
Q TPA
ER(DFN,BGPADMIT,BGPVST) ;Find ER admit time since TPA is often given in the ER
N VST,IEN,FOUND,ERDTE,NEW
S FOUND=0,VST=0
S IEN="" F S IEN=$O(^AMERVSIT("AC",DFN,IEN),-1) Q:IEN=""!(+FOUND) D
.S ERDTE=$P($G(^AMERVSIT(IEN,0)),U,1)
.S NEW=$$FMADD^XLFDT(BGPADMIT,-1)
.I ERDTE>NEW&(ERDTE<BGPADMIT) S FOUND=1,VST=ERDTE
Q VST
NUMER(DFN,ADMIT,SECOND) ;Find if pt in the numerator
N TAX,RESULT
S RESULT=0
S TAX="BGPMU ANTITHROMBOTIC NDCS"
S RESULT=$$BCMA(DFN,ADMIT,SECOND,TAX)
S:+RESULT $P(RESULT,U,3)=BGPDD
Q RESULT
BCMA(DFN,MEDDTE,ENDDT,TAX) ;Check to see if pt is in the numerator
N MED,MEDIEN,STATUS,DRUG,DISPENSE
S MED=0
F S MEDDTE=$O(^PSB(53.79,"AADT",DFN,MEDDTE)) Q:'+MEDDTE!(MEDDTE>ENDDT)!(+MED) D
.S MEDIEN="" F S MEDIEN=$O(^PSB(53.79,"AADT",DFN,MEDDTE,MEDIEN)) Q:'+MEDIEN!(+MED) D
..S STATUS=$P($G(^PSB(53.79,MEDIEN,0)),U,9)
..I STATUS="G"!(STATUS="I")!(STATUS="C") D ;Drug given
...S DISPENSE=0 F S DISPENSE=$O(^PSB(53.79,MEDIEN,.5,DISPENSE)) Q:'+DISPENSE!(+MED) D
....S DRUG=$G(^PSB(53.79,MEDIEN,.5,DISPENSE,0))
....S DRUG=$P(DRUG,U,1)
....S MED=$$NDC^BGPMUUT4(DRUG,TAX)
Q MED
BGPMUH06 ;IHS/MSC/MGH - MI measure NQF0438-STK-5 ;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 5 - Antithrobtic therapy by end of 2nd day
+1 NEW START,END,BGPIEN,DFN,BGPVST,BGPISDX,BGPHSDX,BGPAGEE,BGPIPROB,BGPHPROB,STROKE,EXC,NUM,BGPDIS
+2 NEW BGPER,BGPADTMI,BDPDD,LKW,BGPADMIT,BGPDD,ADATE,SECOND
+3 ;Start by finding all admissions during the reporting period
+4 SET START=BGPBDATE
+5 SET END=BGPEDATE_".2359"
+6 FOR
SET START=$ORDER(^DGPM("B",START))
IF START=""!(START>END)
QUIT
Begin DoDot:1
+7 SET BGPIEN=""
FOR
SET BGPIEN=$ORDER(^DGPM("B",START,BGPIEN))
IF BGPIEN=""
QUIT
Begin DoDot:2
+8 ;Only include admissions
IF $PIECE($GET(^DGPM(BGPIEN,0)),U,2)'=1
QUIT
+9 SET DFN=$PIECE($GET(^DGPM(BGPIEN,0)),U,3)
+10 SET BGPAGEE=$$AGE^AUPNPAT(DFN,BGPEDATE)
+11 IF DFN=""
QUIT
+12 SET BGPACTUP=$$ACTUPAP^BGPMUEHD(DFN,BGPBDATE,BGPEDATE,BGPBEN)
+13 IF 'BGPACTUP
IF '$GET(BGPXPXPX)
IF '$GET(BGPIISO)
QUIT
+14 ;Get the visit
SET BGPVST=$PIECE($GET(^DGPM(BGPIEN,0)),U,27)
+15 IF BGPVST=""
QUIT
+16 ;Don't use if pt is still an inpt
SET BGPDIS=$PIECE($GET(^DGPM(BGPIEN,0)),U,17)
+17 IF BGPDIS=""
QUIT
+18 ;Admit date/time
SET BGPADMIT=$PIECE($GET(^DGPM(BGPIEN,0)),U,1)
+19 ;Discharge date/time
SET BGPDD=$PIECE($GET(^DGPM(BGPDIS,0)),U,1)
+20 ;Check for a diagnosis of stroke
+21 SET STROKE=0
SET EXC=0
SET NUM=0
+22 SET BGPISDX=$$VSTPOVA^BGPMUUT3(DFN,BGPVST,"BGPMU ISCHEMIC STROKE DX")
+23 ;S BGPIPROB=$$PLTAX^BGPMUUT1(DFN,"BGPMU ISCHEMIC STROKE DX","A")
+24 ;Pt must have both a POV of stoke and it must be an active problem
+25 ;I +BGPISDX&(+BGPIPROB) S STROKE=1
+26 IF +BGPISDX
SET STROKE=1
+27 ;Next check for exclusions
+28 IF +STROKE
Begin DoDot:3
+29 ;See if there is an ER visit prior to admission
+30 SET BGPER=$$ER(DFN,BGPADMIT)
+31 SET EXC=$$EXCLUDE(DFN,BGPIEN,BGPVST,BGPDIS)
+32 ;If no exclusions see if they had antithrombolytics given in correct time frame
+33 IF EXC=""
SET NUM=$$NUMER(DFN,BGPADMIT,SECOND)
+34 ;Now add it all up
+35 DO TOTAL(BGPIEN)
End DoDot:3
End DoDot:2
End DoDot:1
+36 QUIT
TOTAL(BGPIEN) ;add up the totals
+1 NEW PTCNT,EXCCT,DENCT,NUMCT,TOTALS,DATE,NOTCT
+2 SET TOTALS=$GET(^TMP("BGPMU0438",$JOB,BGPMUTF,"TOT"))
+3 SET DENCT=+$GET(^TMP("BGPMU0438",$JOB,BGPMUTF,"DEN"))
+4 SET NUMCT=+$GET(^TMP("BGPMU0438",$JOB,BGPMUTF,"NUM"))
+5 SET EXCCT=+$GET(^TMP("BGPMU0438",$JOB,BGPMUTF,"EXC"))
+6 SET NOTCT=+$GET(^TMP("BGPMU0438",$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("BGPMU0438",$JOB,BGPMUTF,"DEN")=DENCT
+11 IF EXC'=""
Begin DoDot:1
+12 SET EXCCT=EXCCT+1
SET ^TMP("BGPMU0438",$JOB,BGPMUTF,"EXC")=EXCCT
+13 IF BGPMUTF="C"
SET ^TMP("BGPMU0438",$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=1
Begin DoDot:2
+16 SET NUMCT=NUMCT+1
SET ^TMP("BGPMU0438",$JOB,BGPMUTF,"NUM")=NUMCT
+17 SET ^TMP("BGPMU0438",$JOB,"PAT",BGPMUTF,"NUM",PTCNT)=DFN_U_DATE_U_$PIECE(NUM,U,3)_U_$PIECE(NUM,U,2)
End DoDot:2
+18 IF +NUM=0
Begin DoDot:2
+19 SET ^TMP("BGPMU0438",$JOB,"PAT",BGPMUTF,"NOT",PTCNT)=DFN_U_DATE_U_$PIECE(NUM,U,3)_U_$PIECE(NUM,U,2)
+20 SET NOTCT=NOTCT+1
SET ^TMP("BGPMU0438",$JOB,BGPMUTF,"NOT")=NOTCT
End DoDot:2
End DoDot:1
+21 SET ^TMP("BGPMU0438",$JOB,BGPMUTF,"TOT")=PTCNT
+22 SET BGPICARE("MU.STK.0438.1",BGPMUTF,DFN)=1_U_+$GET(NUM)_U_+EXC_U_DATE_";"_$PIECE($GET(NUM),U,3)_";"_$PIECE(EXC,U,2)
+23 QUIT
EXCLUDE(DFN,BGPIEN,BGPVST,BGPDIS) ;See if there are exclusions
+1 NEW REASON,BGPLOS,BGPHOS,BGPCLIN,BGPECI,DTYPE1,DTYPE2,BGPALL,BGPREF,BGPTPA
+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 if LOS < 2 days
+8 ;Find the end of hospital day 2
+9 SET ADATE=$PIECE(BGPADMIT,".",1)
+10 SET SECOND=$$FMADD^XLFDT(ADATE,2)
SET SECOND=SECOND_".2359"
+11 ;Length of stay too short
IF BGPDD<SECOND
SET EXC="1^LOS"
+12 ;Check for palliative Care
+13 SET BGPHOS=$$HOSPICE(DFN,BGPVST,BGPADMIT)
+14 IF +BGPHOS
SET REASON=BGPHOS
QUIT REASON
+15 ;Check for clinical trial
+16 SET BGPCLIN=$$TRIAL^BGPMUH08(DFN,BGPVST)
+17 IF +BGPCLIN
SET REASON=BGPCLIN
QUIT REASON
+18 ;Check for elective carotid intervention procedure
+19 SET BGPECI=$$ELECTIVE^BGPMUH08(DFN,BGPVST,BGPIEN)
+20 IF +BGPECI
SET REASON=BGPECI
QUIT REASON
+21 ;Check for allergies to warfarin
+22 SET BGPALL=$$ALLER(DFN)
+23 IF +BGPALL
SET REASON=BGPALL
QUIT REASON
+24 ;Check for refusals
+25 SET BGPREF=$$REF(DFN,BGPVST,BGPDIS)
+26 IF +BGPREF
SET REASON=BGPREF
QUIT REASON
+27 ;Check if they had tPA
+28 SET BGPTPA=$$TPA(DFN,BGPADMIT,BGPDD)
+29 IF +BGPTPA
SET REASON=BGPTPA
+30 QUIT REASON
HOSPICE(DFN,BGPVST,BGPADMT) ;Find palliative care patients
+1 NEW COMFORT,BGPTDX,BGPTPROB,BGPTCPT
+2 SET COMFORT=0
+3 SET BGPTDX=$$COMFORT^BGPMUUT3(DFN,BGPVST,"BGPMU TERMINAL",BGPADMIT,1)
+4 IF +BGPTDX
SET COMFORT=BGPTDX
+5 SET BGPTPROB=$$PLSTART^BGPMUUT3(DFN,"BGPMU TERMINAL","A",BGPADMIT)
+6 IF +BGPTPROB
SET COMFORT=BGPTPROB
+7 SET BGPTCPT=$$PALCPT^BGPMUUT3(DFN,BGPVST,"BGPMU PALLIATIVE CARE CPT",BGPADMIT)
+8 IF +BGPTCPT
SET COMFORT=BGPTCPT
+9 QUIT COMFORT
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 refusals 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 ANTITHROMBOTIC NDCS"
+7 SET MED=$$MEDREF^BGPMUUT2(DFN,BGPEVT,ENDDT,TAX)
+8 QUIT MED
TPA(DFN,ADMIT,DIS) ;Check to see if had tpa
+1 NEW TAX,MEDDTE,ENDDT,TPA,MEDIEN,STATUS,DRUG,BGPIDX,DISPENSE
+2 SET TPA=0
+3 ;Start time is 24hrs prior to admission
SET MEDDTE=$$FMADD^XLFDT(ADMIT,-1)
+4 SET TAX="BGPMU TPA NDC CODES"
+5 SET TPA=$$BCMA(DFN,MEDDTE,DIS,TAX)
+6 ;Check non-VA meds
IF TPA=0
Begin DoDot:1
+7 NEW N0,IEN,ST,ED,STATUS,BGPIDX,DC
+8 SET IEN=0
FOR
SET IEN=$ORDER(^PS(55,DFN,"NVA",IEN))
IF '+IEN!(+TPA)
QUIT
Begin DoDot:2
+9 SET N0=$GET(^PS(55,DFN,"NVA",IEN,0))
+10 SET DC=$PIECE(N0,U,7)
SET ST=$PIECE(N0,U,9)
SET ED=$PIECE(N0,U,10)
+11 SET BGPIDX=$PIECE(N0,U,2)
+12 IF ST=""
SET ST=ED
+13 IF ST>MEDDTE&(ST<DIS)
SET RESULT=$$NDC^BGPMUUT4(BGPIDX,TAX)
End DoDot:2
End DoDot:1
+14 QUIT TPA
ER(DFN,BGPADMIT,BGPVST) ;Find ER admit time since TPA is often given in the ER
+1 NEW VST,IEN,FOUND,ERDTE,NEW
+2 SET FOUND=0
SET VST=0
+3 SET IEN=""
FOR
SET IEN=$ORDER(^AMERVSIT("AC",DFN,IEN),-1)
IF IEN=""!(+FOUND)
QUIT
Begin DoDot:1
+4 SET ERDTE=$PIECE($GET(^AMERVSIT(IEN,0)),U,1)
+5 SET NEW=$$FMADD^XLFDT(BGPADMIT,-1)
+6 IF ERDTE>NEW&(ERDTE<BGPADMIT)
SET FOUND=1
SET VST=ERDTE
End DoDot:1
+7 QUIT VST
NUMER(DFN,ADMIT,SECOND) ;Find if pt in the numerator
+1 NEW TAX,RESULT
+2 SET RESULT=0
+3 SET TAX="BGPMU ANTITHROMBOTIC NDCS"
+4 SET RESULT=$$BCMA(DFN,ADMIT,SECOND,TAX)
+5 IF +RESULT
SET $PIECE(RESULT,U,3)=BGPDD
+6 QUIT RESULT
BCMA(DFN,MEDDTE,ENDDT,TAX) ;Check to see if pt is in the numerator
+1 NEW MED,MEDIEN,STATUS,DRUG,DISPENSE
+2 SET MED=0
+3 FOR
SET MEDDTE=$ORDER(^PSB(53.79,"AADT",DFN,MEDDTE))
IF '+MEDDTE!(MEDDTE>ENDDT)!(+MED)
QUIT
Begin DoDot:1
+4 SET MEDIEN=""
FOR
SET MEDIEN=$ORDER(^PSB(53.79,"AADT",DFN,MEDDTE,MEDIEN))
IF '+MEDIEN!(+MED)
QUIT
Begin DoDot:2
+5 SET STATUS=$PIECE($GET(^PSB(53.79,MEDIEN,0)),U,9)
+6 ;Drug given
IF STATUS="G"!(STATUS="I")!(STATUS="C")
Begin DoDot:3
+7 SET DISPENSE=0
FOR
SET DISPENSE=$ORDER(^PSB(53.79,MEDIEN,.5,DISPENSE))
IF '+DISPENSE!(+MED)
QUIT
Begin DoDot:4
+8 SET DRUG=$GET(^PSB(53.79,MEDIEN,.5,DISPENSE,0))
+9 SET DRUG=$PIECE(DRUG,U,1)
+10 SET MED=$$NDC^BGPMUUT4(DRUG,TAX)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+11 QUIT MED
