BGPMUH10 ;IHS/MSC/MGH - MI measure NQF0371-VTE-1 ;02-Mar-2011 16:06;MGH
;;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
;
ENTRY ;PEP Vte measure 1 NQF0371- VTE started in 24hrs of arrival
; Print routine - VTE1^BGPMUHP6
; Delimited output - VTE1^BGPMUHD5
N START,END,BGPIEN,DFN,BGPVST,BGPISDX,BGPHSDX,BGPAGEE,BGPIPROB,BGPHPROB,SECOND,EXC,NUM,BGPDIS
N BGPER,BGPADMIT,BGPDD
;Start by finding all admissions during the reporting period
S START=BGPBDATE,NUM=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)
..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)
..;get age at admission
..S BGPAGEE=$$AGE^AUPNPAT(DFN,$P(BGPADMIT,".",1))
..;Get the end of the second day
..S SECOND=$$FMADD^XLFDT(BGPADMIT,2),SECOND=SECOND_".2359"
..S EXC=$$EXCLUDE(DFN,BGPIEN,BGPVST,BGPDIS)
..;If no exclusions see if they had VTE prophylaxis
..I EXC="" S NUM=$$NUMER(DFN,BGPADMIT,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("BGPMU0371",$J,BGPMUTF,"TOT"))
S DENCT=+$G(^TMP("BGPMU0371",$J,BGPMUTF,"DEN"))
S NUMCT=+$G(^TMP("BGPMU0371",$J,BGPMUTF,"NUM"))
S EXCCT=+$G(^TMP("BGPMU0371",$J,BGPMUTF,"EXC"))
S NOTCT=+$G(^TMP("BGPMU0371",$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("BGPMU0371",$J,BGPMUTF,"DEN")=DENCT
I EXC'="" D
.S EXCCT=EXCCT+1 S ^TMP("BGPMU0371",$J,BGPMUTF,"EXC")=EXCCT
.I BGPMUTF="C" S ^TMP("BGPMU0371",$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("BGPMU0371",$J,BGPMUTF,"NUM")=NUMCT
..S ^TMP("BGPMU0371",$J,"PAT",BGPMUTF,"NUM",PTCNT)=DFN_U_DATE_U_$P(NUM,U,3)_U_$P(NUM,U,2)
.I +NUM=0 D
..S ^TMP("BGPMU0371",$J,"PAT",BGPMUTF,"NOT",PTCNT)=DFN_U_DATE_U_$P(NUM,U,3)_U_$P(NUM,U,2)
..S NOTCT=NOTCT+1 S ^TMP("BGPMU0371",$J,BGPMUTF,"NOT")=NOTCT
S ^TMP("BGPMU0371",$J,BGPMUTF,"TOT")=PTCNT
S BGPICARE("MU.VTE.0371.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,BGPALL,BGPREF,BGWARD,BGPISDX,BGPHSDX,BGPVTE,BGPTS
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
I BGPLOS<2 S REASON="1^LOS" Q REASON
;
;Check for ICU AND Refusal of VTE Prophylaxis AND Reason for no VTE Prophylaxis
; ICU
S BGWARD=$$ICUADM(DFN,BGPIEN,BGPADMIT,BGPDIS)
; refusal of VTE med
S ICUADMIT=$P($P(BGWARD,U,2),".",1)
S FIRST=$$FMADD^XLFDT(ICUADMIT,+1)
S MED=$$MEDREF^BGPMUUT2(DFN,ICUADMIT,FIRST_".2359","BGPMU VTE PROPHYLAXIS")
; OR refusal of device application
; CPT code check
S CPT=$$REFTAX^BGPMUUT2(DFN,81,"BGPMU VTE DEVICES CPT",ICUADMIT,FIRST_".2359")
; ICD0 code check
S ICD0=$$REFTAX^BGPMUUT2(DFN,80.1,"BGPMU VTE DEVICES ICD0",BGPADMIT,FIRST_".2359")
; Reason for no VTE prophylaxis
S MECH=$$VSTPOVB^BGPMUUT3(DFN,BGPVST,"BGPMU VTE EXCLUDE-MECH DX")
I 'MECH S MECH=$$PLTAX^BGPMUUT1(DFN,"BGPMU VTE EXCLUDE-MECH DX")
I (+BGWARD)&(+MED!+CPT!+ICD0)&(+MECH) S REASON="1^ICU/"_$S(+MED:"MED:"_MED,+CPT:"CPT:"_CPT,+ICD0:"ICD:"_ICD0,1:"")_"/"_MECH Q REASON
;
;Check for OB or behavioral health admissions
;S BGPTS=$$TS(DFN,BGPIEN,BGPDIS)
S BGPTS=$$TS(DFN,BGPVST,BGPIEN)
I +BGPTS S REASON=BGPTS Q REASON
;Check for palliative Care
S BGPHOS=$$HOSPICE^BGPMUH06(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 a diagnosis of stroke
S BGPISDX=$$VSTPOVA^BGPMUUT3(DFN,BGPVST,"BGPMU ISCHEMIC STROKE DX")
I +BGPISDX S REASON=BGPISDX Q REASON
S BGPHSDX=$$VSTPOVA^BGPMUUT3(DFN,BGPVST,"BGPMU HEMORRHAGIC STROKE DX")
I +BGPHSDX S REASON=BGPHSDX Q REASON
;Check for a diagnosis of VTE
S BGPVTE=$$VSTPOVA^BGPMUUT3(DFN,BGPVST,"BGPMU VTE DX")
I +BGPVTE S REASON=BGPVTE Q REASON
Q REASON
NUMER(DFN,ADMIT,VST) ;Check to see if pt is in the numerator
N TAX,MEDDTE,ENDDT,VTE,MEDIEN,STATUS,DRUG,DISPENSE,CPT,MED
N TEDS,FIRST,GIVEN,NOTGIV,PROP,PHARM,PHARMP,MECH,MECHP,ICD0
S VTE=0
;First, see if the pt has CPT for procedure in first 24hrs
S FIRST=$$FMADD^XLFDT(ADMIT,+1)
S TEDS=$$PALCPT^BGPMUUT3(DFN,VST,"BGPMU VTE DEVICES CPT",ADMIT)
I +TEDS S VTE=TEDS_U_BGPDD Q VTE
;See, if the pt has ICD0 for procedures in first 24hrs
S PROP=$$PALICD0^BGPMUUT3(DFN,VST,"BGP VTE DEVICES ICD0",ADMIT)
I +PROP S VTE=PROP_U_BGPDD Q VTE
;See if the VTE CPT code was entered
S GIVEN=$$PALCPT^BGPMUUT3(DFN,VST,"BGPMU VTE GIVEN CPT",ADMIT)
I +GIVEN S VTE=GIVEN_U_BGPDD Q VTE
;Check for code that patient is not eligible
S NOTGIV=$$PALCPT^BGPMUUT3(DFN,VST,"BGPMU VTE NOT GIVEN CPT",ADMIT)
I +NOTGIV S VTE=$P(NOTGIV,U,1)_U_"NMI "_$P(NOTGIV,U,2)_U_BGPDD Q VTE
;Check diagnosis for whom VTE is not appropriate
S PHARM=$$VSTPOVB^BGPMUUT3(DFN,BGPVST,"BGPMU VTE EXCLUDE PHARM DXS")
I +PHARM S VTE=$P(PHARM,U,1)_U_"NMI "_$P(PHARM,U,2)_U_BGPDD Q VTE
S PHARMP=$$PLTAX^BGPMUUT1(DFN,"BGPMU VTE EXCLUDE PHARM DXS")
I +PHARMP S VTE=$P(PHARMP,U,1)_U_"NMI "_$P(PHARM,U,2)_U_BGPDD Q VTE
S MECH=$$VSTPOVB^BGPMUUT3(DFN,BGPVST,"BGPMU VTE EXCLUDE-MECH DX")
I +MECH S VTE=$P(MECH,U,1)_U_"NMI "_$P(MECH,U,2)_U_BGPDD Q VTE
S MECHP=$$PLTAX^BGPMUUT1(DFN,"BGPMU VTE EXCLUDE-MECH DX")
I +MECHP S VTE=MECHP_U_BGPDD Q VTE
;Check for refusal of VTE med
S MED=$$MEDREF^BGPMUUT2(DFN,$P(ADMIT,"."),FIRST,"BGPMU VTE PROPHYLAXIS")
I +MED S VTE=$P(MED,U,1)_U_"REF "_$P(MED,U,2)_U_BGPDD Q VTE
;Check for refusals of procedures
S CPT=$$REFTAX^BGPMUUT2(DFN,81,"BGPMU VTE DEVICES CPT",$P(ADMIT,"."),$P(FIRST,"."))
I +CPT S VTE=$P(CPT,U,1)_U_"REF "_$P(CPT,U,2)_U_BGPDD Q VTE
S ICD0=$$REFTAX^BGPMUUT2(DFN,80.1,"BGPMU VTE DEVICES ICD0",$P(ADMIT,"."),$P(FIRST,"."))
I +ICD0 S VTE=$P(ICD0,U,1)_U_"REF "_$P(ICD0,U,2)_U_BGPDD Q VTE
;Finally check for a BMCA code for antithrombotics
S MEDDTE=ADMIT
S FIRST=$P(FIRST,".",1)_".2359"
F S MEDDTE=$O(^PSB(53.79,"AADT",DFN,MEDDTE)) Q:'+MEDDTE!(MEDDTE>FIRST)!(+VTE) D
.S MEDIEN="" F S MEDIEN=$O(^PSB(53.79,"AADT",DFN,MEDDTE,MEDIEN)) Q:'+MEDIEN!(+VTE) 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!(+VTE) D
....S DRUG=$G(^PSB(53.79,MEDIEN,.5,DISPENSE,0))
....S DRUG=$P(DRUG,U,1)
....S TAX="BGPMU VTE PROPHYLAXIS"
....S VTE=$$NDC^BGPMUUT4(DRUG,TAX)
....I +VTE S VTE=$P(VTE,U,1)_U_"MED "_$P(VTE,U,2)_U_BGPDD
Q VTE
TS(DFN,BGPVST,BGPIEN) ;Check the treating specialty
N IEN,TYPE,INV,TSIEN,TSDATA,TS,TN,OBDX,TSFLD
S IEN=BGPIEN,INV="",TS=0
S OBDX=$$VSTPOV^BGPMUUT3(DFN,BGPVST,"BGPMU VTE OB DXS")
I +OBDX S TS=OBDX Q TS
S INV="" F S INV=$O(^DGPM("ATS",DFN,IEN,INV)) Q:INV=""!(+TS) D
.S TSIEN="" F S TSIEN=$O(^DGPM("ATS",DFN,IEN,INV,TSIEN)) Q:TSIEN=""!(+TS) D
..S TSDATA=$G(^DIC(45.7,TSIEN,0))
..Q:TSDATA=""
..S TN=$$GET1^DIQ(45.7,TSIEN,.01)
..S TS=$S(TN["MENTAL HEALTH":1,TN["ALCOHOLISM":1,TN["BEHAVIORAL HEALTH":1,TN["SUBSTANCE ABUSE":1,1:0)
Q TS
ICUADM(DFN,IEN,ADMIT,DISC) ;Check for ward location
; ICU admission check for day of or day after
N WARDM,TIME,TRF,TYPE,FIRST,TDATE,WARD
S WARDM=0
S WARD=$$GET1^DIQ(405,IEN,.06)
I WARD["ICU" S WARDM="1^"_ADMIT G ICULOS
;Check for transfer movements
S TRF=IEN F S TRF=$O(^DGPM("C",DFN,TRF)) Q:TRF=""!(+WARD) D
.S TYPE=$P($G(^DGPM(TRF,0)),U,2)
.I TYPE=2 D ;This was a transfer movement
..S WARD=$$GET1^DIQ(405,TRF,.06)
..I WARD["ICU" D
...S FIRST=$$FMADD^XLFDT(ADMIT,+1),TDATE=$P($G(^DGPM(TRF,0)),U,1)
...I $P(TDATE,".",1)=$P(ADMIT,".",1)!($P(TDATE,".",1)=$P(FIRST,".",1)) S WARDM="1^"_$P(TDATE,".",1)
Q:'WARDM 0
ICULOS ;NOW CHECK LOS
N ICULOS,TRF,TYPE,FIRST,TDATE,CNT,ARRAY,WARD,TIME
S ICULOS=0,CNT=0
S WARD=$$GET1^DIQ(405,IEN,.06)
S CNT=CNT+1
S ARRAY(CNT)=WARD_U_ADMIT ;Keep track of all admits to ICU
;Get all transfer movements
S TRF=IEN F S TRF=$O(^DGPM("C",DFN,TRF)) Q:TRF="" D
.S TYPE=$P($G(^DGPM(TRF,0)),U,2)
.I TYPE=2 D ;This was a transfer movement
..S WARD=$$GET1^DIQ(405,TRF,.06)
..S CNT=CNT+1
..S TDATE=$P($G(^DGPM(TRF,0)),U,1)
..S ARRAY(CNT)=WARD_U_TDATE
;Now loop through all the admits and transfers looking for an ICU
N I,X1,X2,J
S I=0 F S I=$O(ARRAY(I)) Q:'+I D
.I $P(ARRAY(I),U,1)["ICU" D
.I I+1>CNT S X1=DISC
.E S J=I+1,X1=$P(ARRAY(J),U,2)
.S X2=$P(ARRAY(I),U,2)
.S TIME=$$FMDIFF^XLFDT(X1,X2,1)
.S ICULOS=TIME
Q $S(+ICULOS:WARDM,1:0) ; 0=false; "1"=true; <Admit or transfer to ICU day of or day after admission> AND <ICU LOS is greater or equal to 1 day>
BGPMUH10 ;IHS/MSC/MGH - MI measure NQF0371-VTE-1 ;02-Mar-2011 16:06;MGH
+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 ;
ENTRY ;PEP Vte measure 1 NQF0371- VTE started in 24hrs of arrival
+1 ; Print routine - VTE1^BGPMUHP6
+2 ; Delimited output - VTE1^BGPMUHD5
+3 NEW START,END,BGPIEN,DFN,BGPVST,BGPISDX,BGPHSDX,BGPAGEE,BGPIPROB,BGPHPROB,SECOND,EXC,NUM,BGPDIS
+4 NEW BGPER,BGPADMIT,BGPDD
+5 ;Start by finding all admissions during the reporting period
+6 SET START=BGPBDATE
SET NUM=0
+7 SET END=BGPEDATE_".2359"
+8 FOR
SET START=$ORDER(^DGPM("B",START))
IF START=""!(START>END)
QUIT
Begin DoDot:1
+9 SET BGPIEN=""
FOR
SET BGPIEN=$ORDER(^DGPM("B",START,BGPIEN))
IF BGPIEN=""
QUIT
Begin DoDot:2
+10 ;Only include admissions
IF $PIECE($GET(^DGPM(BGPIEN,0)),U,2)'=1
QUIT
+11 SET DFN=$PIECE($GET(^DGPM(BGPIEN,0)),U,3)
+12 IF DFN=""
QUIT
+13 SET BGPACTUP=$$ACTUPAP^BGPMUEHD(DFN,BGPBDATE,BGPEDATE,BGPBEN)
+14 IF 'BGPACTUP
IF '$GET(BGPXPXPX)
IF '$GET(BGPIISO)
QUIT
+15 ;Get the visit
SET BGPVST=$PIECE($GET(^DGPM(BGPIEN,0)),U,27)
+16 IF BGPVST=""
QUIT
+17 ;Don't use if pt is still an inpt
SET BGPDIS=$PIECE($GET(^DGPM(BGPIEN,0)),U,17)
+18 IF BGPDIS=""
QUIT
+19 ;Get the admit time & discharge times
+20 SET BGPADMIT=$PIECE($GET(^DGPM(BGPIEN,0)),U,1)
+21 SET BGPDD=$PIECE($GET(^DGPM(BGPDIS,0)),U,1)
+22 ;get age at admission
+23 SET BGPAGEE=$$AGE^AUPNPAT(DFN,$PIECE(BGPADMIT,".",1))
+24 ;Get the end of the second day
+25 SET SECOND=$$FMADD^XLFDT(BGPADMIT,2)
SET SECOND=SECOND_".2359"
+26 SET EXC=$$EXCLUDE(DFN,BGPIEN,BGPVST,BGPDIS)
+27 ;If no exclusions see if they had VTE prophylaxis
+28 IF EXC=""
SET NUM=$$NUMER(DFN,BGPADMIT,BGPVST)
+29 ;Now add it all up
+30 DO TOTAL(BGPIEN)
End DoDot:2
End DoDot:1
+31 QUIT
TOTAL(BGPIEN) ;add up the totals
+1 NEW PTCNT,EXCCT,DENCT,NUMCT,TOTALS,DATE,NOTCT
+2 SET TOTALS=$GET(^TMP("BGPMU0371",$JOB,BGPMUTF,"TOT"))
+3 SET DENCT=+$GET(^TMP("BGPMU0371",$JOB,BGPMUTF,"DEN"))
+4 SET NUMCT=+$GET(^TMP("BGPMU0371",$JOB,BGPMUTF,"NUM"))
+5 SET EXCCT=+$GET(^TMP("BGPMU0371",$JOB,BGPMUTF,"EXC"))
+6 SET NOTCT=+$GET(^TMP("BGPMU0371",$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("BGPMU0371",$JOB,BGPMUTF,"DEN")=DENCT
+11 IF EXC'=""
Begin DoDot:1
+12 SET EXCCT=EXCCT+1
SET ^TMP("BGPMU0371",$JOB,BGPMUTF,"EXC")=EXCCT
+13 IF BGPMUTF="C"
SET ^TMP("BGPMU0371",$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("BGPMU0371",$JOB,BGPMUTF,"NUM")=NUMCT
+17 SET ^TMP("BGPMU0371",$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("BGPMU0371",$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("BGPMU0371",$JOB,BGPMUTF,"NOT")=NOTCT
End DoDot:2
End DoDot:1
+21 SET ^TMP("BGPMU0371",$JOB,BGPMUTF,"TOT")=PTCNT
+22 SET BGPICARE("MU.VTE.0371.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,BGPALL,BGPREF,BGWARD,BGPISDX,BGPHSDX,BGPVTE,BGPTS
+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 IF BGPLOS<2
SET REASON="1^LOS"
QUIT REASON
+8 ;
+9 ;Check for ICU AND Refusal of VTE Prophylaxis AND Reason for no VTE Prophylaxis
+10 ; ICU
+11 SET BGWARD=$$ICUADM(DFN,BGPIEN,BGPADMIT,BGPDIS)
+12 ; refusal of VTE med
+13 SET ICUADMIT=$PIECE($PIECE(BGWARD,U,2),".",1)
+14 SET FIRST=$$FMADD^XLFDT(ICUADMIT,+1)
+15 SET MED=$$MEDREF^BGPMUUT2(DFN,ICUADMIT,FIRST_".2359","BGPMU VTE PROPHYLAXIS")
+16 ; OR refusal of device application
+17 ; CPT code check
+18 SET CPT=$$REFTAX^BGPMUUT2(DFN,81,"BGPMU VTE DEVICES CPT",ICUADMIT,FIRST_".2359")
+19 ; ICD0 code check
+20 SET ICD0=$$REFTAX^BGPMUUT2(DFN,80.1,"BGPMU VTE DEVICES ICD0",BGPADMIT,FIRST_".2359")
+21 ; Reason for no VTE prophylaxis
+22 SET MECH=$$VSTPOVB^BGPMUUT3(DFN,BGPVST,"BGPMU VTE EXCLUDE-MECH DX")
+23 IF 'MECH
SET MECH=$$PLTAX^BGPMUUT1(DFN,"BGPMU VTE EXCLUDE-MECH DX")
+24 IF (+BGWARD)&(+MED!+CPT!+ICD0)&(+MECH)
SET REASON="1^ICU/"_$SELECT(+MED:"MED:"_MED,+CPT:"CPT:"_CPT,+ICD0:"ICD:"_ICD0,1:"")_"/"_MECH
QUIT REASON
+25 ;
+26 ;Check for OB or behavioral health admissions
+27 ;S BGPTS=$$TS(DFN,BGPIEN,BGPDIS)
+28 SET BGPTS=$$TS(DFN,BGPVST,BGPIEN)
+29 IF +BGPTS
SET REASON=BGPTS
QUIT REASON
+30 ;Check for palliative Care
+31 SET BGPHOS=$$HOSPICE^BGPMUH06(DFN,BGPVST,BGPADMIT)
+32 IF +BGPHOS
SET REASON=BGPHOS
QUIT REASON
+33 ;Check for clinical trial
+34 SET BGPCLIN=$$TRIAL^BGPMUH08(DFN,BGPVST)
+35 IF +BGPCLIN
SET REASON=BGPCLIN
QUIT REASON
+36 ;Check for a diagnosis of stroke
+37 SET BGPISDX=$$VSTPOVA^BGPMUUT3(DFN,BGPVST,"BGPMU ISCHEMIC STROKE DX")
+38 IF +BGPISDX
SET REASON=BGPISDX
QUIT REASON
+39 SET BGPHSDX=$$VSTPOVA^BGPMUUT3(DFN,BGPVST,"BGPMU HEMORRHAGIC STROKE DX")
+40 IF +BGPHSDX
SET REASON=BGPHSDX
QUIT REASON
+41 ;Check for a diagnosis of VTE
+42 SET BGPVTE=$$VSTPOVA^BGPMUUT3(DFN,BGPVST,"BGPMU VTE DX")
+43 IF +BGPVTE
SET REASON=BGPVTE
QUIT REASON
+44 QUIT REASON
NUMER(DFN,ADMIT,VST) ;Check to see if pt is in the numerator
+1 NEW TAX,MEDDTE,ENDDT,VTE,MEDIEN,STATUS,DRUG,DISPENSE,CPT,MED
+2 NEW TEDS,FIRST,GIVEN,NOTGIV,PROP,PHARM,PHARMP,MECH,MECHP,ICD0
+3 SET VTE=0
+4 ;First, see if the pt has CPT for procedure in first 24hrs
+5 SET FIRST=$$FMADD^XLFDT(ADMIT,+1)
+6 SET TEDS=$$PALCPT^BGPMUUT3(DFN,VST,"BGPMU VTE DEVICES CPT",ADMIT)
+7 IF +TEDS
SET VTE=TEDS_U_BGPDD
QUIT VTE
+8 ;See, if the pt has ICD0 for procedures in first 24hrs
+9 SET PROP=$$PALICD0^BGPMUUT3(DFN,VST,"BGP VTE DEVICES ICD0",ADMIT)
+10 IF +PROP
SET VTE=PROP_U_BGPDD
QUIT VTE
+11 ;See if the VTE CPT code was entered
+12 SET GIVEN=$$PALCPT^BGPMUUT3(DFN,VST,"BGPMU VTE GIVEN CPT",ADMIT)
+13 IF +GIVEN
SET VTE=GIVEN_U_BGPDD
QUIT VTE
+14 ;Check for code that patient is not eligible
+15 SET NOTGIV=$$PALCPT^BGPMUUT3(DFN,VST,"BGPMU VTE NOT GIVEN CPT",ADMIT)
+16 IF +NOTGIV
SET VTE=$PIECE(NOTGIV,U,1)_U_"NMI "_$PIECE(NOTGIV,U,2)_U_BGPDD
QUIT VTE
+17 ;Check diagnosis for whom VTE is not appropriate
+18 SET PHARM=$$VSTPOVB^BGPMUUT3(DFN,BGPVST,"BGPMU VTE EXCLUDE PHARM DXS")
+19 IF +PHARM
SET VTE=$PIECE(PHARM,U,1)_U_"NMI "_$PIECE(PHARM,U,2)_U_BGPDD
QUIT VTE
+20 SET PHARMP=$$PLTAX^BGPMUUT1(DFN,"BGPMU VTE EXCLUDE PHARM DXS")
+21 IF +PHARMP
SET VTE=$PIECE(PHARMP,U,1)_U_"NMI "_$PIECE(PHARM,U,2)_U_BGPDD
QUIT VTE
+22 SET MECH=$$VSTPOVB^BGPMUUT3(DFN,BGPVST,"BGPMU VTE EXCLUDE-MECH DX")
+23 IF +MECH
SET VTE=$PIECE(MECH,U,1)_U_"NMI "_$PIECE(MECH,U,2)_U_BGPDD
QUIT VTE
+24 SET MECHP=$$PLTAX^BGPMUUT1(DFN,"BGPMU VTE EXCLUDE-MECH DX")
+25 IF +MECHP
SET VTE=MECHP_U_BGPDD
QUIT VTE
+26 ;Check for refusal of VTE med
+27 SET MED=$$MEDREF^BGPMUUT2(DFN,$PIECE(ADMIT,"."),FIRST,"BGPMU VTE PROPHYLAXIS")
+28 IF +MED
SET VTE=$PIECE(MED,U,1)_U_"REF "_$PIECE(MED,U,2)_U_BGPDD
QUIT VTE
+29 ;Check for refusals of procedures
+30 SET CPT=$$REFTAX^BGPMUUT2(DFN,81,"BGPMU VTE DEVICES CPT",$PIECE(ADMIT,"."),$PIECE(FIRST,"."))
+31 IF +CPT
SET VTE=$PIECE(CPT,U,1)_U_"REF "_$PIECE(CPT,U,2)_U_BGPDD
QUIT VTE
+32 SET ICD0=$$REFTAX^BGPMUUT2(DFN,80.1,"BGPMU VTE DEVICES ICD0",$PIECE(ADMIT,"."),$PIECE(FIRST,"."))
+33 IF +ICD0
SET VTE=$PIECE(ICD0,U,1)_U_"REF "_$PIECE(ICD0,U,2)_U_BGPDD
QUIT VTE
+34 ;Finally check for a BMCA code for antithrombotics
+35 SET MEDDTE=ADMIT
+36 SET FIRST=$PIECE(FIRST,".",1)_".2359"
+37 FOR
SET MEDDTE=$ORDER(^PSB(53.79,"AADT",DFN,MEDDTE))
IF '+MEDDTE!(MEDDTE>FIRST)!(+VTE)
QUIT
Begin DoDot:1
+38 SET MEDIEN=""
FOR
SET MEDIEN=$ORDER(^PSB(53.79,"AADT",DFN,MEDDTE,MEDIEN))
IF '+MEDIEN!(+VTE)
QUIT
Begin DoDot:2
+39 SET STATUS=$PIECE($GET(^PSB(53.79,MEDIEN,0)),U,9)
+40 ;Drug given
IF STATUS="G"!(STATUS="I")!(STATUS="C")
Begin DoDot:3
+41 SET DISPENSE=0
FOR
SET DISPENSE=$ORDER(^PSB(53.79,MEDIEN,.5,DISPENSE))
IF '+DISPENSE!(+VTE)
QUIT
Begin DoDot:4
+42 SET DRUG=$GET(^PSB(53.79,MEDIEN,.5,DISPENSE,0))
+43 SET DRUG=$PIECE(DRUG,U,1)
+44 SET TAX="BGPMU VTE PROPHYLAXIS"
+45 SET VTE=$$NDC^BGPMUUT4(DRUG,TAX)
+46 IF +VTE
SET VTE=$PIECE(VTE,U,1)_U_"MED "_$PIECE(VTE,U,2)_U_BGPDD
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+47 QUIT VTE
TS(DFN,BGPVST,BGPIEN) ;Check the treating specialty
+1 NEW IEN,TYPE,INV,TSIEN,TSDATA,TS,TN,OBDX,TSFLD
+2 SET IEN=BGPIEN
SET INV=""
SET TS=0
+3 SET OBDX=$$VSTPOV^BGPMUUT3(DFN,BGPVST,"BGPMU VTE OB DXS")
+4 IF +OBDX
SET TS=OBDX
QUIT TS
+5 SET INV=""
FOR
SET INV=$ORDER(^DGPM("ATS",DFN,IEN,INV))
IF INV=""!(+TS)
QUIT
Begin DoDot:1
+6 SET TSIEN=""
FOR
SET TSIEN=$ORDER(^DGPM("ATS",DFN,IEN,INV,TSIEN))
IF TSIEN=""!(+TS)
QUIT
Begin DoDot:2
+7 SET TSDATA=$GET(^DIC(45.7,TSIEN,0))
+8 IF TSDATA=""
QUIT
+9 SET TN=$$GET1^DIQ(45.7,TSIEN,.01)
+10 SET TS=$SELECT(TN["MENTAL HEALTH":1,TN["ALCOHOLISM":1,TN["BEHAVIORAL HEALTH":1,TN["SUBSTANCE ABUSE":1,1:0)
End DoDot:2
End DoDot:1
+11 QUIT TS
ICUADM(DFN,IEN,ADMIT,DISC) ;Check for ward location
+1 ; ICU admission check for day of or day after
+2 NEW WARDM,TIME,TRF,TYPE,FIRST,TDATE,WARD
+3 SET WARDM=0
+4 SET WARD=$$GET1^DIQ(405,IEN,.06)
+5 IF WARD["ICU"
SET WARDM="1^"_ADMIT
GOTO ICULOS
+6 ;Check for transfer movements
+7 SET TRF=IEN
FOR
SET TRF=$ORDER(^DGPM("C",DFN,TRF))
IF TRF=""!(+WARD)
QUIT
Begin DoDot:1
+8 SET TYPE=$PIECE($GET(^DGPM(TRF,0)),U,2)
+9 ;This was a transfer movement
IF TYPE=2
Begin DoDot:2
+10 SET WARD=$$GET1^DIQ(405,TRF,.06)
+11 IF WARD["ICU"
Begin DoDot:3
+12 SET FIRST=$$FMADD^XLFDT(ADMIT,+1)
SET TDATE=$PIECE($GET(^DGPM(TRF,0)),U,1)
+13 IF $PIECE(TDATE,".",1)=$PIECE(ADMIT,".",1)!($PIECE(TDATE,".",1)=$PIECE(FIRST,".",1))
SET WARDM="1^"_$PIECE(TDATE,".",1)
End DoDot:3
End DoDot:2
End DoDot:1
+14 IF 'WARDM
QUIT 0
ICULOS ;NOW CHECK LOS
+1 NEW ICULOS,TRF,TYPE,FIRST,TDATE,CNT,ARRAY,WARD,TIME
+2 SET ICULOS=0
SET CNT=0
+3 SET WARD=$$GET1^DIQ(405,IEN,.06)
+4 SET CNT=CNT+1
+5 ;Keep track of all admits to ICU
SET ARRAY(CNT)=WARD_U_ADMIT
+6 ;Get all transfer movements
+7 SET TRF=IEN
FOR
SET TRF=$ORDER(^DGPM("C",DFN,TRF))
IF TRF=""
QUIT
Begin DoDot:1
+8 SET TYPE=$PIECE($GET(^DGPM(TRF,0)),U,2)
+9 ;This was a transfer movement
IF TYPE=2
Begin DoDot:2
+10 SET WARD=$$GET1^DIQ(405,TRF,.06)
+11 SET CNT=CNT+1
+12 SET TDATE=$PIECE($GET(^DGPM(TRF,0)),U,1)
+13 SET ARRAY(CNT)=WARD_U_TDATE
End DoDot:2
End DoDot:1
+14 ;Now loop through all the admits and transfers looking for an ICU
+15 NEW I,X1,X2,J
+16 SET I=0
FOR
SET I=$ORDER(ARRAY(I))
IF '+I
QUIT
Begin DoDot:1
+17 IF $PIECE(ARRAY(I),U,1)["ICU"
Begin DoDot:2
End DoDot:2
+18 IF I+1>CNT
SET X1=DISC
+19 IF '$TEST
SET J=I+1
SET X1=$PIECE(ARRAY(J),U,2)
+20 SET X2=$PIECE(ARRAY(I),U,2)
+21 SET TIME=$$FMDIFF^XLFDT(X1,X2,1)
+22 SET ICULOS=TIME
End DoDot:1
+23 ; 0=false; "1"=true; <Admit or transfer to ICU day of or day after admission> AND <ICU LOS is greater or equal to 1 day>
QUIT $SELECT(+ICULOS:WARDM,1:0)
