BGPMUH12 ;IHS/MSC/MGH - MI measure NQF0373-VTE-3 ;02-Mar-2011 16:21;DU
;;11.0;IHS CLINICAL REPORTING;**4**;JAN 06, 2011;Build 84
;ED meaningful use hospital measures
;BGPMUH10 - VTE Measure 1 - VTE started in 24hrs of arrival
;BGPMUH11 - VTE Measure 2 - VTE started in 24hrs of arrival to ICU
;BGPMUH12 - VTE Measure 3 - VTE measure 3 - VTE pts on overlap therapy
ENTRY ;PEP Vte measure 3 - VTE pts on overlap therapy
; Print routine - VTE3^BGPMUHP7
; Delimited output - VTE3^BGPMUHD6
N START,END,BGPIEN,DFN,BGPVST,BGPISDX,BGPHSDX,BGPAGEE,BGPIPROB,BGPHPROB,EXC,NUM,BGPDIS,INWAR
N BGPER,BGPADTMI,BGPDD,EVDT,PDTE,FIRST,EXCL,OPWAR,IPWAR,EXC,BGPVCODE,BGPVTEPB,BGPVTE,BGPVICD0
S EXC=""
;Start by finding all admissions during the reporting period
S START=BGPBDATE,EXCL="",OPWAR=0,IPWAR=0
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=""
..;Get the admit time & discharge times
..S BGPADMIT=$P($G(^DGPM(BGPIEN,0)),U,1)
..S BGPDD=$P($G(^DGPM(BGPDIS,0)),U,1)
..;Look for DX of VTE
..S BGPVTE=$$VSTPOVA^BGPMUUT3(DFN,BGPVST,"BGPMU VTE DX")
..;S BGPVTEPB=$$PLTAX^BGPMUUT1(DFN,"BGPMU VTE DX")
..;I (+BGPVTE!(+BGPVTEPB))&(BGPVCODE!(BGPVICD0)) D ;Must have DX of VTE
..I +BGPVTE D ;Must have DX of VTE
...S EXC=$$EXCLUDE(DFN,BGPIEN,BGPVST,BGPDIS,BGPADMIT)
...;If no exclusions see if they had Warfarin ordered at discharge
...I EXC="" D
....S OPWAR=$$OPWAR(DFN,BGPDIS)
....I '+OPWAR S EXC=OPWAR
...;If pt had warfarin in discharge, check and make sure pt had warfar on inpt
...I EXC="" D
....S INWAR=$$INWAR(DFN,BGPADMIT,BGPDD)
....I '+INWAR S EXC=INWAR
...;OK, now can evaluate overlaping therapy
...I EXC="" S NUM=$$NUMER(DFN,BGPADMIT,BGPDD,BGPVST)
...;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("BGPMU0373",$J,BGPMUTF,"TOT"))
S DENCT=+$G(^TMP("BGPMU0373",$J,BGPMUTF,"DEN"))
S NUMCT=+$G(^TMP("BGPMU0373",$J,BGPMUTF,"NUM"))
S EXCCT=+$G(^TMP("BGPMU0373",$J,BGPMUTF,"EXC"))
S NOTCT=+$G(^TMP("BGPMU0373",$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("BGPMU0373",$J,BGPMUTF,"DEN")=DENCT
I EXC'="" D
.S EXCCT=EXCCT+1 S ^TMP("BGPMU0373",$J,BGPMUTF,"EXC")=EXCCT
.I BGPMUTF="C" S ^TMP("BGPMU0373",$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("BGPMU0373",$J,BGPMUTF,"NUM")=NUMCT
..S ^TMP("BGPMU0373",$J,"PAT",BGPMUTF,"NUM",PTCNT)=DFN_U_DATE_U_$P(NUM,U,2)_U_$P(NUM,U,4)_U_$P(NUM,U,5)_U_$P(NUM,U,3)
.I '+NUM D
..S ^TMP("BGPMU0373",$J,"PAT",BGPMUTF,"NOT",PTCNT)=DFN_U_DATE_U_$P(NUM,U,2)
..S NOTCT=NOTCT+1 S ^TMP("BGPMU0373",$J,BGPMUTF,"NOT")=NOTCT
S ^TMP("BGPMU0373",$J,BGPMUTF,"TOT")=PTCNT
S BGPICARE("MU.VTE.0373.1",BGPMUTF,DFN)=1_U_+$G(NUM)_U_+EXC_U_DATE_";"_$P($G(NUM),U,2)_","_$P($G(NUM),U,4)_","_$P($G(NUM),U,5)_","_$P($G(NUM),U,3)_";"_$P(EXC,U,2)
Q
EXCLUDE(DFN,BGPIEN,BGPVST,BGPDIS,BGPADMIT,OPWAR,IPWAR) ;See if there are exclusions
N REASON,BGPLOS,BGPHOS,BGPCLIN,BGPECI,BGPALL,BGPREF,MED,PHARM,PHARMP,MECH,MECHP,FIRST,CPT
N BGPVCODE,BGPRCODE,BGPVICD0
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 palliative 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
S BGPVCODE=$$VSTCPT^BGPMUUT1(DFN,BGPVST,"BGPMU VTE TEST CPT")
S BGPRCODE=$$FIND^BGPMUUT7(DFN,"BGPMU VTE TEST CPT",BGPADMIT,BGPDD) ;RAD procedure check
;S BGPVICD0=$$VSTICD0^BGPMUUT3(DFN,BGPVST,"BGPMU VTE TEST ICD0") ;not in ORT
;I '+BGPRCODE&('BGPVCODE)&('+BGPVICD0) S REASON="1^No VTE Proc"
I '+BGPRCODE&('BGPVCODE) S REASON="1^No VTE Proc"
Q REASON
NUMER(DFN,ADMIT,DISCH,TVST) ;Check to see if pt is in the numerator
N TAX,MEDDTE,ENDDT,MEDIEN,STATUS,DRUG,DISPENSE,INR,RETURN
N LABDATA,WARDATA,INJDATA,OVER,X,CNT
S RETURN=0
;Get return list of INRs between admit and discharge
S TAX="BGPMU LAB LOINC INR"
D LAB^BGPMUUT5(.LABDATA,DFN,TAX,ADMIT,DISCH)
;Get array of inpt dates for which Warfarin was active
S TAX="BGPMU WARFARIN NDCS"
D MEDLIST(.WARDATA,DFN,ADMIT,DISCH,TAX)
;Get array of inpt dates for which concurrent anticoag therapy was active
S TAX="BGPMU VTE ANTICOAG NDCS"
D MEDLIST(.INJDATA,DFN,ADMIT,DISCH,TAX)
;Now loop through the list of warfarin dates and see if a corresponding
;date exists in the injectable list. If it does, increment the count of days
;If it doesn't, start over
S CNT=0
S X=0 F S X=$O(WARDATA(X)) Q:X="" D
.I $D(INJDATA(X)) S CNT=CNT+1
;If the count >4, then check the latest INR to see if it was >2
I CNT=0 Q 0 ;No overlap therapy
I CNT>4 D
.S INR=$$INRCK(.LABDATA,BGPDD)
.I $P(INR,U,1)>1.99999 S RETURN=1_U_CNT_U_U_INR
.;If its less then 2, must go home on concurrent therapy
.I $P(INR,U,1)<2.0 D
..S OVER=$$OPINJ(DFN,BGPDIS)
..I OVER S RETURN=1_U_CNT_U_BGPDD_U_INR
;If the count <5, check for an outpt RX for overlap med
I CNT<5 D
.S INR=$$INRCK(.LABDATA,BGPDD)
.S OVER=$$OPINJ(DFN,BGPDIS)
.I OVER S RETURN=1_U_CNT_U_BGPDD_U_INR
Q RETURN
OPWAR(DFN,BGPDIS) ;Check to see if pt was discharged on Warfarin
N DRUG,TAX,MEDTYPE,DDATE
S MEDTYPE="OP",TAX="BGPMU WARFARIN NDCS"
S DDATE=$P($G(^DGPM(BGPDIS,0)),U,1)
S DRUG=$$FIND^BGPMUUT4(DFN,TAX,DDATE,MEDTYPE)
Q DRUG
INWAR(DFN,BGPADMIT,BGPDD) ;Check to see if Warfarin given in inpt
N DRUG,TAX,MEDTYPE
S MEDTYPE="UD",TAX="BGPMU WARFARIN NDCS"
S DRUG=$$FIND^BGPMUUT4(DFN,TAX,BGPADMIT,MEDTYPE,BGPDD)
Q DRUG
MEDLIST(ARRAY,DFN,BGPADMIT,BGPDD,TAX) ;Check each day of inpt stay to see if med active
N DRUG,MEDTYPE,BDATE,EDATE,DDATE,I,START,END
S MEDTYPE="UD"
;Only use the date portion
S BDATE=$P(BGPADMIT,".",1),EDATE=$$FMADD^XLFDT($P(BGPDD,".",1),1)
S START=$$FMADD^XLFDT(BDATE,-1)
F S START=$$FMADD^XLFDT(START,1) Q:START>EDATE D
.S END=$$FMADD^XLFDT(START,+1)
.S DRUG=$$FIND^BGPMUUT6(DFN,TAX,START,MEDTYPE,END)
.I +DRUG S ARRAY(START)=DRUG
S MEDTYPE="IV"
S BDATE=$P(BGPADMIT,".",1),EDATE=$$FMADD^XLFDT($P(BGPDD,".",1),1)
S START=$$FMADD^XLFDT(BDATE,-1)
F S START=$$FMADD^XLFDT(START,1) Q:START>EDATE D
.S END=$$FMADD^XLFDT(START,+1)
.S DRUG=$$FIND^BGPMUUT6(DFN,TAX,START,MEDTYPE,END)
.I +DRUG S ARRAY(START)=DRUG
Q
OPINJ(DFN,BGPDIS) ;Check to see if pt was discharged on concurrent therapy
N DRUG,TAX,MEDTYPE,DDATE
S MEDTYPE="OP",TAX="BGPMU VTE ANTICOAG NDCS"
S DDATE=$P($G(^DGPM(BGPDIS,0)),U,1)
S DRUG=$$FIND^BGPMUUT4(DFN,TAX,DDATE,MEDTYPE)
Q DRUG
INRCK(LABS,BGPDD) ;Find the INR prior to discharge date
N VALUE,X,CK
S VALUE=0
S X="" F S X=$O(LABS(X)) Q:'+X!(+VALUE) D
.S CK=9999999-X
.Q:CK>BGPDD
.I CK<BGPDD S VALUE=$G(LABS(X))
Q VALUE_U_$$DATE^BGPMUUTL(CK)
BGPMUH12 ;IHS/MSC/MGH - MI measure NQF0373-VTE-3 ;02-Mar-2011 16:21;DU
+1 ;;11.0;IHS CLINICAL REPORTING;**4**;JAN 06, 2011;Build 84
+2 ;ED meaningful use hospital measures
+3 ;BGPMUH10 - VTE Measure 1 - VTE started in 24hrs of arrival
+4 ;BGPMUH11 - VTE Measure 2 - VTE started in 24hrs of arrival to ICU
+5 ;BGPMUH12 - VTE Measure 3 - VTE measure 3 - VTE pts on overlap therapy
ENTRY ;PEP Vte measure 3 - VTE pts on overlap therapy
+1 ; Print routine - VTE3^BGPMUHP7
+2 ; Delimited output - VTE3^BGPMUHD6
+3 NEW START,END,BGPIEN,DFN,BGPVST,BGPISDX,BGPHSDX,BGPAGEE,BGPIPROB,BGPHPROB,EXC,NUM,BGPDIS,INWAR
+4 NEW BGPER,BGPADTMI,BGPDD,EVDT,PDTE,FIRST,EXCL,OPWAR,IPWAR,EXC,BGPVCODE,BGPVTEPB,BGPVTE,BGPVICD0
+5 SET EXC=""
+6 ;Start by finding all admissions during the reporting period
+7 SET START=BGPBDATE
SET EXCL=""
SET OPWAR=0
SET IPWAR=0
+8 SET END=BGPEDATE_".2359"
+9 FOR
SET START=$ORDER(^DGPM("B",START))
IF START=""!(START>END)
QUIT
Begin DoDot:1
+10 SET BGPIEN=""
FOR
SET BGPIEN=$ORDER(^DGPM("B",START,BGPIEN))
IF BGPIEN=""
QUIT
Begin DoDot:2
+11 ;Only include admissions
IF $PIECE($GET(^DGPM(BGPIEN,0)),U,2)'=1
QUIT
+12 SET DFN=$PIECE($GET(^DGPM(BGPIEN,0)),U,3)
+13 SET BGPAGEE=$$AGE^AUPNPAT(DFN,BGPEDATE)
+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 ;Don't use if pt is still an inpt
SET BGPDIS=$PIECE($GET(^DGPM(BGPIEN,0)),U,17)
+20 IF BGPDIS=""
QUIT
+21 ;Get the admit time & discharge times
+22 SET BGPADMIT=$PIECE($GET(^DGPM(BGPIEN,0)),U,1)
+23 SET BGPDD=$PIECE($GET(^DGPM(BGPDIS,0)),U,1)
+24 ;Look for DX of VTE
+25 SET BGPVTE=$$VSTPOVA^BGPMUUT3(DFN,BGPVST,"BGPMU VTE DX")
+26 ;S BGPVTEPB=$$PLTAX^BGPMUUT1(DFN,"BGPMU VTE DX")
+27 ;I (+BGPVTE!(+BGPVTEPB))&(BGPVCODE!(BGPVICD0)) D ;Must have DX of VTE
+28 ;Must have DX of VTE
IF +BGPVTE
Begin DoDot:3
+29 SET EXC=$$EXCLUDE(DFN,BGPIEN,BGPVST,BGPDIS,BGPADMIT)
+30 ;If no exclusions see if they had Warfarin ordered at discharge
+31 IF EXC=""
Begin DoDot:4
+32 SET OPWAR=$$OPWAR(DFN,BGPDIS)
+33 IF '+OPWAR
SET EXC=OPWAR
End DoDot:4
+34 ;If pt had warfarin in discharge, check and make sure pt had warfar on inpt
+35 IF EXC=""
Begin DoDot:4
+36 SET INWAR=$$INWAR(DFN,BGPADMIT,BGPDD)
+37 IF '+INWAR
SET EXC=INWAR
End DoDot:4
+38 ;OK, now can evaluate overlaping therapy
+39 IF EXC=""
SET NUM=$$NUMER(DFN,BGPADMIT,BGPDD,BGPVST)
+40 ;Now add it all up
+41 DO TOTAL(BGPIEN)
End DoDot:3
End DoDot:2
End DoDot:1
+42 QUIT
TOTAL(BGPIEN) ;add up the totals
+1 NEW PTCNT,EXCCT,DENCT,NUMCT,TOTALS,DATE,NOTCT
+2 SET TOTALS=$GET(^TMP("BGPMU0373",$JOB,BGPMUTF,"TOT"))
+3 SET DENCT=+$GET(^TMP("BGPMU0373",$JOB,BGPMUTF,"DEN"))
+4 SET NUMCT=+$GET(^TMP("BGPMU0373",$JOB,BGPMUTF,"NUM"))
+5 SET EXCCT=+$GET(^TMP("BGPMU0373",$JOB,BGPMUTF,"EXC"))
+6 SET NOTCT=+$GET(^TMP("BGPMU0373",$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("BGPMU0373",$JOB,BGPMUTF,"DEN")=DENCT
+11 IF EXC'=""
Begin DoDot:1
+12 SET EXCCT=EXCCT+1
SET ^TMP("BGPMU0373",$JOB,BGPMUTF,"EXC")=EXCCT
+13 IF BGPMUTF="C"
SET ^TMP("BGPMU0373",$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("BGPMU0373",$JOB,BGPMUTF,"NUM")=NUMCT
+17 SET ^TMP("BGPMU0373",$JOB,"PAT",BGPMUTF,"NUM",PTCNT)=DFN_U_DATE_U_$PIECE(NUM,U,2)_U_$PIECE(NUM,U,4)_U_$PIECE(NUM,U,5)_U_$PIECE(NUM,U,3)
End DoDot:2
+18 IF '+NUM
Begin DoDot:2
+19 SET ^TMP("BGPMU0373",$JOB,"PAT",BGPMUTF,"NOT",PTCNT)=DFN_U_DATE_U_$PIECE(NUM,U,2)
+20 SET NOTCT=NOTCT+1
SET ^TMP("BGPMU0373",$JOB,BGPMUTF,"NOT")=NOTCT
End DoDot:2
End DoDot:1
+21 SET ^TMP("BGPMU0373",$JOB,BGPMUTF,"TOT")=PTCNT
+22 SET BGPICARE("MU.VTE.0373.1",BGPMUTF,DFN)=1_U_+$GET(NUM)_U_+EXC_U_DATE_";"_$PIECE($GET(NUM),U,2)_","_$PIECE($GET(NUM),U,4)_","_$PIECE($GET(NUM),U,5)_","_$PIECE($GET(NUM),U,3)_";"_$PIECE(EXC,U,2)
+23 QUIT
EXCLUDE(DFN,BGPIEN,BGPVST,BGPDIS,BGPADMIT,OPWAR,IPWAR) ;See if there are exclusions
+1 NEW REASON,BGPLOS,BGPHOS,BGPCLIN,BGPECI,BGPALL,BGPREF,MED,PHARM,PHARMP,MECH,MECHP,FIRST,CPT
+2 NEW BGPVCODE,BGPRCODE,BGPVICD0
+3 SET REASON=""
+4 IF BGPAGEE<18
SET REASON="1^AGE"
QUIT REASON
+5 ;Check for LOS
+6 SET BGPLOS=$$LOS^BGPMUH08(BGPIEN,BGPDIS)
+7 IF BGPLOS>120
SET REASON="1^LOS"
QUIT REASON
+8 ;Check for palliative Care
+9 SET BGPHOS=$$HOSPICE^BGPMUH08(DFN,BGPVST)
+10 IF +BGPHOS
SET REASON=BGPHOS
QUIT REASON
+11 ;Check for clinical trial
+12 SET BGPCLIN=$$TRIAL^BGPMUH08(DFN,BGPVST)
+13 IF +BGPCLIN
SET REASON=BGPCLIN
QUIT REASON
+14 SET BGPVCODE=$$VSTCPT^BGPMUUT1(DFN,BGPVST,"BGPMU VTE TEST CPT")
+15 ;RAD procedure check
SET BGPRCODE=$$FIND^BGPMUUT7(DFN,"BGPMU VTE TEST CPT",BGPADMIT,BGPDD)
+16 ;S BGPVICD0=$$VSTICD0^BGPMUUT3(DFN,BGPVST,"BGPMU VTE TEST ICD0") ;not in ORT
+17 ;I '+BGPRCODE&('BGPVCODE)&('+BGPVICD0) S REASON="1^No VTE Proc"
+18 IF '+BGPRCODE&('BGPVCODE)
SET REASON="1^No VTE Proc"
+19 QUIT REASON
NUMER(DFN,ADMIT,DISCH,TVST) ;Check to see if pt is in the numerator
+1 NEW TAX,MEDDTE,ENDDT,MEDIEN,STATUS,DRUG,DISPENSE,INR,RETURN
+2 NEW LABDATA,WARDATA,INJDATA,OVER,X,CNT
+3 SET RETURN=0
+4 ;Get return list of INRs between admit and discharge
+5 SET TAX="BGPMU LAB LOINC INR"
+6 DO LAB^BGPMUUT5(.LABDATA,DFN,TAX,ADMIT,DISCH)
+7 ;Get array of inpt dates for which Warfarin was active
+8 SET TAX="BGPMU WARFARIN NDCS"
+9 DO MEDLIST(.WARDATA,DFN,ADMIT,DISCH,TAX)
+10 ;Get array of inpt dates for which concurrent anticoag therapy was active
+11 SET TAX="BGPMU VTE ANTICOAG NDCS"
+12 DO MEDLIST(.INJDATA,DFN,ADMIT,DISCH,TAX)
+13 ;Now loop through the list of warfarin dates and see if a corresponding
+14 ;date exists in the injectable list. If it does, increment the count of days
+15 ;If it doesn't, start over
+16 SET CNT=0
+17 SET X=0
FOR
SET X=$ORDER(WARDATA(X))
IF X=""
QUIT
Begin DoDot:1
+18 IF $DATA(INJDATA(X))
SET CNT=CNT+1
End DoDot:1
+19 ;If the count >4, then check the latest INR to see if it was >2
+20 ;No overlap therapy
IF CNT=0
QUIT 0
+21 IF CNT>4
Begin DoDot:1
+22 SET INR=$$INRCK(.LABDATA,BGPDD)
+23 IF $PIECE(INR,U,1)>1.99999
SET RETURN=1_U_CNT_U_U_INR
+24 ;If its less then 2, must go home on concurrent therapy
+25 IF $PIECE(INR,U,1)<2.0
Begin DoDot:2
+26 SET OVER=$$OPINJ(DFN,BGPDIS)
+27 IF OVER
SET RETURN=1_U_CNT_U_BGPDD_U_INR
End DoDot:2
End DoDot:1
+28 ;If the count <5, check for an outpt RX for overlap med
+29 IF CNT<5
Begin DoDot:1
+30 SET INR=$$INRCK(.LABDATA,BGPDD)
+31 SET OVER=$$OPINJ(DFN,BGPDIS)
+32 IF OVER
SET RETURN=1_U_CNT_U_BGPDD_U_INR
End DoDot:1
+33 QUIT RETURN
OPWAR(DFN,BGPDIS) ;Check to see if pt was discharged on Warfarin
+1 NEW DRUG,TAX,MEDTYPE,DDATE
+2 SET MEDTYPE="OP"
SET TAX="BGPMU WARFARIN NDCS"
+3 SET DDATE=$PIECE($GET(^DGPM(BGPDIS,0)),U,1)
+4 SET DRUG=$$FIND^BGPMUUT4(DFN,TAX,DDATE,MEDTYPE)
+5 QUIT DRUG
INWAR(DFN,BGPADMIT,BGPDD) ;Check to see if Warfarin given in inpt
+1 NEW DRUG,TAX,MEDTYPE
+2 SET MEDTYPE="UD"
SET TAX="BGPMU WARFARIN NDCS"
+3 SET DRUG=$$FIND^BGPMUUT4(DFN,TAX,BGPADMIT,MEDTYPE,BGPDD)
+4 QUIT DRUG
MEDLIST(ARRAY,DFN,BGPADMIT,BGPDD,TAX) ;Check each day of inpt stay to see if med active
+1 NEW DRUG,MEDTYPE,BDATE,EDATE,DDATE,I,START,END
+2 SET MEDTYPE="UD"
+3 ;Only use the date portion
+4 SET BDATE=$PIECE(BGPADMIT,".",1)
SET EDATE=$$FMADD^XLFDT($PIECE(BGPDD,".",1),1)
+5 SET START=$$FMADD^XLFDT(BDATE,-1)
+6 FOR
SET START=$$FMADD^XLFDT(START,1)
IF START>EDATE
QUIT
Begin DoDot:1
+7 SET END=$$FMADD^XLFDT(START,+1)
+8 SET DRUG=$$FIND^BGPMUUT6(DFN,TAX,START,MEDTYPE,END)
+9 IF +DRUG
SET ARRAY(START)=DRUG
End DoDot:1
+10 SET MEDTYPE="IV"
+11 SET BDATE=$PIECE(BGPADMIT,".",1)
SET EDATE=$$FMADD^XLFDT($PIECE(BGPDD,".",1),1)
+12 SET START=$$FMADD^XLFDT(BDATE,-1)
+13 FOR
SET START=$$FMADD^XLFDT(START,1)
IF START>EDATE
QUIT
Begin DoDot:1
+14 SET END=$$FMADD^XLFDT(START,+1)
+15 SET DRUG=$$FIND^BGPMUUT6(DFN,TAX,START,MEDTYPE,END)
+16 IF +DRUG
SET ARRAY(START)=DRUG
End DoDot:1
+17 QUIT
OPINJ(DFN,BGPDIS) ;Check to see if pt was discharged on concurrent therapy
+1 NEW DRUG,TAX,MEDTYPE,DDATE
+2 SET MEDTYPE="OP"
SET TAX="BGPMU VTE ANTICOAG NDCS"
+3 SET DDATE=$PIECE($GET(^DGPM(BGPDIS,0)),U,1)
+4 SET DRUG=$$FIND^BGPMUUT4(DFN,TAX,DDATE,MEDTYPE)
+5 QUIT DRUG
INRCK(LABS,BGPDD) ;Find the INR prior to discharge date
+1 NEW VALUE,X,CK
+2 SET VALUE=0
+3 SET X=""
FOR
SET X=$ORDER(LABS(X))
IF '+X!(+VALUE)
QUIT
Begin DoDot:1
+4 SET CK=9999999-X
+5 IF CK>BGPDD
QUIT
+6 IF CK<BGPDD
SET VALUE=$GET(LABS(X))
End DoDot:1
+7 QUIT VALUE_U_$$DATE^BGPMUUTL(CK)
