- 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)
