Routine: BGPMUH15

BGPMUH15 ;IHS/MSC/MGH - MI measure NQF0376-VTE-6 ;02-Mar-2011 16:03;MGH

 ;;11.0;IHS CLINICAL REPORTING;**4**;JAN 06, 2011;Build 84

 ;ED meaningful use hospital measures

ENTRY ;PEP  Vte measure 6 - VTE prophylaxis not given and pt got VTE

 N START,END,BGPIEN,DFN,BGPVST,BGPISDX,BGPHSDX,BGPAGEE,BGPIPROB,BGPHPROB,SECOND,EXC,NUM,BGPDIS

 N BGPER,BGPADTMI,BGPDD,EVDT,PDTE,ONADMIT,FIRST,EXCL,BGPVCODE,BGPRCODE,BGPVTE,BGPVTEPB,BGPVICD0

 ;Start by finding all admissions during the reporting period

 S START=BGPBDATE,EXCL=""

 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 patient age at admission

 ..S BGPAGEE=$$AGE^AUPNPAT(DFN,BGPADMIT)

 ..;Look for DX of VTE

 ..S BGPVTE=$$VSTPOVB^BGPMUUT3(DFN,BGPVST,"BGPMU VTE DX")

 ..S BGPVCODE=$$VSTCPT^BGPMUUT1(DFN,BGPVST,"BGPMU VTE TEST CPT")

 ..S PROC=$P(BGPVCODE,U,3)

 ..;S BGPVICD0=$$VSTICD0^BGPMUUT3(DFN,BGPVST,"BGPMU VTE TEST ICD0")

 ..I +BGPVTE D             ;Must have DX of VTE

 ...;Now check to see if they were admitted with VTE

 ...S FIRST=$$FMADD^XLFDT(BGPADMIT,+1)

 ...S EXC=""

 ...S EVDT=$P(BGPVTE,U,3)           ;Event date of POV

 ...S ONADMIT=$P(BGPVTE,U,4)        ;Present on admission

 ...;I $P(EVDT,".",1)=$P(BGPADMIT,".",1)!($P(PDTE,".",1)=$P(BGPADMIT,".",1)) S EXC=1_U_"ADM"

 ...;I $P(EVDT,".",1)<$P(BGPADMIT,".",1)!($P(PDTE,".",1)<$P(BGPADMIT,".",1)) S EXC=1_U_"ADM"

 ...I ONADMIT="Y" S EXC=1_U_"ADM"

 ...I $P(EVDT,".",1)=$P(BGPADMIT,".",1) S EXC=1_U_"ADM"

 ...I $P(EVDT,".",1)<$P(BGPADMIT,".",1) S EXC=1_U_"ADM"

 ...I EXC="" S EXC=$$EXCLUDE(DFN,BGPIEN,BGPVST,BGPDIS,BGPADMIT)

 ...;If no exclusions see if they had VTE

 ...I EXC="" S NUM=$$NUMER(DFN,BGPADMIT,PROC,BGPVST)

 ...;Now add it all up

 ...D TOTAL(BGPIEN)

TOTAL(BGPIEN) ;add up the totals

 N PTCNT,EXCCT,DENCT,NUMCT,TOTALS,DATE,NOTCT

 S TOTALS=$G(^TMP("BGPMU0376",$J,BGPMUTF,"TOT"))

 S DENCT=+$G(^TMP("BGPMU0376",$J,BGPMUTF,"DEN"))

 S NUMCT=+$G(^TMP("BGPMU0376",$J,BGPMUTF,"NUM"))

 S EXCCT=+$G(^TMP("BGPMU0376",$J,BGPMUTF,"EXC"))

 S NOTCT=+$G(^TMP("BGPMU0376",$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("BGPMU0376",$J,BGPMUTF,"DEN")=DENCT

 I EXC'="" D

 .S EXCCT=EXCCT+1 S ^TMP("BGPMU0376",$J,BGPMUTF,"EXC")=EXCCT

 .I BGPMUTF="C" S ^TMP("BGPMU0376",$J,"PAT",BGPMUTF,"EXC",PTCNT)=DFN_U_DATE_U_$P(EXC,U,2)

 I EXC="" D

 .I +NUM=0 D

 ..S NUMCT=NUMCT+1 S ^TMP("BGPMU0376",$J,BGPMUTF,"NUM")=NUMCT

 ..S ^TMP("BGPMU0376",$J,"PAT",BGPMUTF,"NUM",PTCNT)=DFN_U_DATE_U_PROC

 .I +NUM=1 D

 ..S ^TMP("BGPMU0376",$J,"PAT",BGPMUTF,"NOT",PTCNT)=DFN_U_DATE

 ..S NOTCT=NOTCT+1 S ^TMP("BGPMU0376",$J,BGPMUTF,"NOT")=NOTCT

 S ^TMP("BGPMU0376",$J,BGPMUTF,"TOT")=PTCNT

 S BGPICARE("MU.VTE.0376.1",BGPMUTF,DFN)=1_U_+$G(NUM)_U_+$G(EXC)_U_DATE_";"_$G(PROC)_";"_$P($G(EXC),U,2)

EXCLUDE(DFN,BGPIEN,BGPVST,BGPDIS,BGPADMIT) ;See if there are exclusions

 N REASON,BGPLOS,BGPHOS,BGPCLIN,BGPECI,BGPALL,BGPREF,MED,PHARM,PHARMP,MECH,MECHP,FIRST,CPT

 N BGPRCODE,BGPVCODE,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

 ;Check for refusal of VTE med

 S FIRST=$$FMADD^XLFDT(BGPADMIT,+1)

 S MED=$$MEDREF^BGPMUUT2(DFN,$P(BGPADMIT,"."),$P(FIRST,".")_".2359","BGPMU VTE PROPHYLAXIS")

 I +MED S REASON=MED Q REASON

 ;Check for refusals of procedures

 S CPT=$$REFTAX^BGPMUUT2(DFN,81,"BGPMU VTE DEVICES CPT",$P(BGPADMIT,"."),$P(FIRST,"."))

 I +CPT S REASON=CPT Q REASON

 ;Check for refusal of ICD

 S ICD=$$REFTAX^BGPMUUT2(DFN,81.1,"BGPMU VTE DEVICES ICD0",$P(BGPADMIT,"."),$P(FIRST,"."))

 I +ICD S REASON=ICD Q REASON

 ;Check diagnoses for whom VTE is not appropriate

 S PHARM=$$VSTPOV^BGPMUUT3(DFN,BGPVST,"BGPMU VTE EXCLUDE PHARM DXS")

 I +PHARM S REASON=PHARM Q REASON

 S PHARMP=$$PLTAX^BGPMUUT1(DFN,"BGPMU VTE EXCLUDE PHARM DXS","C")

 I +PHARMP S REASON=PHARMP Q REASON

 S MECH=$$VSTPOVB^BGPMUUT3(DFN,BGPVST,"BGPMU VTE EXCLUDE-MECH DX")

 I +MECH S REASON=MECH Q REASON

 S MECHP=$$PLTAX^BGPMUUT1(DFN,"BGPMU VTE EXCLUDE-MECH DX","C")

 I +MECHP S REASON=MECHP Q REASON

 ;Check for confirmation codes

 S BGPRCODE=$$FIND^BGPMUUT7(DFN,"BGPMU VTE TEST CPT",BGPADMIT,BGPDD) ;RAD procedure check

 S BGPVCODE=$$VSTCPT^BGPMUUT1(DFN,BGPVST,"BGPMU VTE TEST CPT")

 ;S BGPVICD0=$$VSTICD0^BGPMUUT3(DFN,BGPVST,"BGPMU VTE TEST ICD0")   ;this is not in the ORT

 ;I ('+BGPRCODE)&('+BGPVCODE)&('+BGPVICD0) S REASON="1^no VTE test"

 I ('+BGPRCODE)&('+BGPVCODE) S REASON="1^no VTE test"

 Q REASON

NUMER(DFN,ADMIT,PROC,VST) ;Check to see if pt is in the numerator

 N TAX,MEDDTE,ENDDT,VTE,MEDIEN,STATUS,DRUG,DISPENSE

 N TEDS,FIRST,GIVEN,NOTGIV,RETURN,DEV

 S VTE=0,RETURN=0

 ;First, see if the pt has CPT for procedure in first 24hrs

 S FIRST=$$FMADD^XLFDT(ADMIT,+1)

 S TEDS=$$DTECPT^BGPMUUT3(DFN,VST,"BGPMU VTE DEVICES CPT",ADMIT,PROC)

 I +TEDS S VTE=TEDS S $P(VTE,U,3)=BGPDD Q VTE

 S DEV=$$DTECPT^BGPMUUT3(DFN,VST,"BGPMU VTE DEVICES ICD0",ADMIT,PROC)

 I +DEV S VTE=DEV S $P(VTE,U,3)=BGPDD Q VTE

 ;See if the VTE CPT code was entered

 ;DEV thinks this should be here, but it is not in the ORT

 ;S GIVEN=$$DTECPT^BGPMUUT3(DFN,VST,"BGPMU VTE GIVEN CPT",ADMIT,PROC)

 ;I +GIVEN S VTE=GIVEN S $P(VTE,U,3)=BGPDD Q VTE

 ;Check for code that patient is not eligible

 ;S NOTGIV=$$DTECPT^BGPMUUT3(DFN,VST,"BGPMU VTE NOT GIVEN CPT",ADMIT,PROC)

 ;I +NOTGIV S VTE=NOTGIV S $P(VTE,U,3)=BGPDD Q VTE

 ;Check for confirmation codes

 S BGPRCODE=$$FIND^BGPMUUT7(DFN,"BGPMU VTE TEST CPT",ADMIT,BGPDD) ;RAD procedure check

 S BGPVCODE=$$VSTCPT^BGPMUUT1(DFN,BGPVST,"BGPMU VTE TEST CPT")

 ;S BGPVICD0=$$VSTICD0^BGPMUUT3(DFN,BGPVST,"BGPMU VTE TEST ICD0") ;this is not in the ORT

 ;I (+BGPRCODE)!(+BGPVCODE)!(+BGPVICD0) S VTE=$S(BGPRCODE'="":BGPRCODE,BGPVICD0'="":BGPVICD0,1:BGPVCODE) S $P(VTE,U,3)=BGPDD Q VTE

 I (+BGPRCODE)!(+BGPVCODE) S VTE=$S(BGPRCODE'="":BGPRCODE,1:BGPVCODE) S $P(VTE,U,3)=BGPDD Q VTE

 ;Finally check for a BMCA code for antithrombotics

 S MEDDTE=ADMIT

 F  S MEDDTE=$O(^PSB(53.79,"AADT",DFN,MEDDTE)) Q:'+MEDDTE!(MEDDTE>PROC)!(+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)

 ....S $P(VTE,U,3)=BGPDD

 Q VTE

TEST ;ZSAT

 ;S BGPBDATE=3110101

 ;S BGPEDATE=3110601

 ;S BGPBEN=3

 ;S DUZ("AG")="I"

 ;S U="^"

 ;D ENTRY

BGPMUH15  ;IHS/MSC/MGH - MI measure NQF0376-VTE-6 ;02-Mar-2011 16:03;MGH

 +1       ;;11.0;IHS CLINICAL REPORTING;**4**;JAN 06, 2011;Build 84

 +2       ;ED meaningful use hospital measures

ENTRY     ;PEP  Vte measure 6 - VTE prophylaxis not given and pt got VTE

 +1        NEW START,END,BGPIEN,DFN,BGPVST,BGPISDX,BGPHSDX,BGPAGEE,BGPIPROB,BGPHPROB,SECOND,EXC,NUM,BGPDIS

 +2        NEW BGPER,BGPADTMI,BGPDD,EVDT,PDTE,ONADMIT,FIRST,EXCL,BGPVCODE,BGPRCODE,BGPVTE,BGPVTEPB,BGPVICD0

 +3       ;Start by finding all admissions during the reporting period

 +4        SET START=BGPBDATE

           SET EXCL=""

 +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                       IF DFN=""

                               QUIT

 +11                       SET BGPACTUP=$$ACTUPAP^BGPMUEHD(DFN,BGPBDATE,BGPEDATE,BGPBEN)

 +12                       IF 'BGPACTUP

                               IF '$GET(BGPXPXPX)

                                   IF '$GET(BGPIISO)

                                       QUIT

 +13      ;Get the visit

                           SET BGPVST=$PIECE($GET(^DGPM(BGPIEN,0)),U,27)

 +14                       IF BGPVST=""

                               QUIT

 +15      ;Don't use if pt is still an inpt

                           SET BGPDIS=$PIECE($GET(^DGPM(BGPIEN,0)),U,17)

 +16                       IF BGPDIS=""

                               QUIT

 +17      ;Get the admit time & discharge times

 +18                       SET BGPADMIT=$PIECE($GET(^DGPM(BGPIEN,0)),U,1)

 +19                       SET BGPDD=$PIECE($GET(^DGPM(BGPDIS,0)),U,1)

 +20      ;Get patient age at admission

 +21                       SET BGPAGEE=$$AGE^AUPNPAT(DFN,BGPADMIT)

 +22      ;Look for DX of VTE

 +23                       SET BGPVTE=$$VSTPOVB^BGPMUUT3(DFN,BGPVST,"BGPMU VTE DX")

 +24                       SET BGPVCODE=$$VSTCPT^BGPMUUT1(DFN,BGPVST,"BGPMU VTE TEST CPT")

 +25                       SET PROC=$PIECE(BGPVCODE,U,3)

 +26      ;S BGPVICD0=$$VSTICD0^BGPMUUT3(DFN,BGPVST,"BGPMU VTE TEST ICD0")

 +27      ;Must have DX of VTE

                           IF +BGPVTE

                               Begin DoDot:3

 +28      ;Now check to see if they were admitted with VTE

 +29                               SET FIRST=$$FMADD^XLFDT(BGPADMIT,+1)

 +30                               SET EXC=""

 +31      ;Event date of POV

                                   SET EVDT=$PIECE(BGPVTE,U,3)

 +32      ;Present on admission

                                   SET ONADMIT=$PIECE(BGPVTE,U,4)

 +33      ;I $P(EVDT,".",1)=$P(BGPADMIT,".",1)!($P(PDTE,".",1)=$P(BGPADMIT,".",1)) S EXC=1_U_"ADM"

 +34      ;I $P(EVDT,".",1)<$P(BGPADMIT,".",1)!($P(PDTE,".",1)<$P(BGPADMIT,".",1)) S EXC=1_U_"ADM"

 +35                               IF ONADMIT="Y"

                                       SET EXC=1_U_"ADM"

 +36                               IF $PIECE(EVDT,".",1)=$PIECE(BGPADMIT,".",1)

                                       SET EXC=1_U_"ADM"

 +37                               IF $PIECE(EVDT,".",1)<$PIECE(BGPADMIT,".",1)

                                       SET EXC=1_U_"ADM"

 +38                               IF EXC=""

                                       SET EXC=$$EXCLUDE(DFN,BGPIEN,BGPVST,BGPDIS,BGPADMIT)

 +39      ;If no exclusions see if they had VTE

 +40                               IF EXC=""

                                       SET NUM=$$NUMER(DFN,BGPADMIT,PROC,BGPVST)

 +41      ;Now add it all up

 +42                               DO TOTAL(BGPIEN)

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +43       QUIT

TOTAL(BGPIEN) ;add up the totals

 +1        NEW PTCNT,EXCCT,DENCT,NUMCT,TOTALS,DATE,NOTCT

 +2        SET TOTALS=$GET(^TMP("BGPMU0376",$JOB,BGPMUTF,"TOT"))

 +3        SET DENCT=+$GET(^TMP("BGPMU0376",$JOB,BGPMUTF,"DEN"))

 +4        SET NUMCT=+$GET(^TMP("BGPMU0376",$JOB,BGPMUTF,"NUM"))

 +5        SET EXCCT=+$GET(^TMP("BGPMU0376",$JOB,BGPMUTF,"EXC"))

 +6        SET NOTCT=+$GET(^TMP("BGPMU0376",$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("BGPMU0376",$JOB,BGPMUTF,"DEN")=DENCT

 +11       IF EXC'=""

               Begin DoDot:1

 +12               SET EXCCT=EXCCT+1

                   SET ^TMP("BGPMU0376",$JOB,BGPMUTF,"EXC")=EXCCT

 +13               IF BGPMUTF="C"

                       SET ^TMP("BGPMU0376",$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=0

                       Begin DoDot:2

 +16                       SET NUMCT=NUMCT+1

                           SET ^TMP("BGPMU0376",$JOB,BGPMUTF,"NUM")=NUMCT

 +17                       SET ^TMP("BGPMU0376",$JOB,"PAT",BGPMUTF,"NUM",PTCNT)=DFN_U_DATE_U_PROC

                       End DoDot:2

 +18               IF +NUM=1

                       Begin DoDot:2

 +19                       SET ^TMP("BGPMU0376",$JOB,"PAT",BGPMUTF,"NOT",PTCNT)=DFN_U_DATE

 +20                       SET NOTCT=NOTCT+1

                           SET ^TMP("BGPMU0376",$JOB,BGPMUTF,"NOT")=NOTCT

                       End DoDot:2

               End DoDot:1

 +21       SET ^TMP("BGPMU0376",$JOB,BGPMUTF,"TOT")=PTCNT

 +22       SET BGPICARE("MU.VTE.0376.1",BGPMUTF,DFN)=1_U_+$GET(NUM)_U_+$GET(EXC)_U_DATE_";"_$GET(PROC)_";"_$PIECE($GET(EXC),U,2)

 +23       QUIT

EXCLUDE(DFN,BGPIEN,BGPVST,BGPDIS,BGPADMIT) ;See if there are exclusions

 +1        NEW REASON,BGPLOS,BGPHOS,BGPCLIN,BGPECI,BGPALL,BGPREF,MED,PHARM,PHARMP,MECH,MECHP,FIRST,CPT

 +2        NEW BGPRCODE,BGPVCODE,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      ;Check for refusal of VTE med

 +15       SET FIRST=$$FMADD^XLFDT(BGPADMIT,+1)

 +16       SET MED=$$MEDREF^BGPMUUT2(DFN,$PIECE(BGPADMIT,"."),$PIECE(FIRST,".")_".2359","BGPMU VTE PROPHYLAXIS")

 +17       IF +MED

               SET REASON=MED

               QUIT REASON

 +18      ;Check for refusals of procedures

 +19       SET CPT=$$REFTAX^BGPMUUT2(DFN,81,"BGPMU VTE DEVICES CPT",$PIECE(BGPADMIT,"."),$PIECE(FIRST,"."))

 +20       IF +CPT

               SET REASON=CPT

               QUIT REASON

 +21      ;Check for refusal of ICD

 +22       SET ICD=$$REFTAX^BGPMUUT2(DFN,81.1,"BGPMU VTE DEVICES ICD0",$PIECE(BGPADMIT,"."),$PIECE(FIRST,"."))

 +23       IF +ICD

               SET REASON=ICD

               QUIT REASON

 +24      ;Check diagnoses for whom VTE is not appropriate

 +25       SET PHARM=$$VSTPOV^BGPMUUT3(DFN,BGPVST,"BGPMU VTE EXCLUDE PHARM DXS")

 +26       IF +PHARM

               SET REASON=PHARM

               QUIT REASON

 +27       SET PHARMP=$$PLTAX^BGPMUUT1(DFN,"BGPMU VTE EXCLUDE PHARM DXS","C")

 +28       IF +PHARMP

               SET REASON=PHARMP

               QUIT REASON

 +29       SET MECH=$$VSTPOVB^BGPMUUT3(DFN,BGPVST,"BGPMU VTE EXCLUDE-MECH DX")

 +30       IF +MECH

               SET REASON=MECH

               QUIT REASON

 +31       SET MECHP=$$PLTAX^BGPMUUT1(DFN,"BGPMU VTE EXCLUDE-MECH DX","C")

 +32       IF +MECHP

               SET REASON=MECHP

               QUIT REASON

 +33      ;Check for confirmation codes

 +34      ;RAD procedure check

           SET BGPRCODE=$$FIND^BGPMUUT7(DFN,"BGPMU VTE TEST CPT",BGPADMIT,BGPDD)

 +35       SET BGPVCODE=$$VSTCPT^BGPMUUT1(DFN,BGPVST,"BGPMU VTE TEST CPT")

 +36      ;S BGPVICD0=$$VSTICD0^BGPMUUT3(DFN,BGPVST,"BGPMU VTE TEST ICD0")   ;this is not in the ORT

 +37      ;I ('+BGPRCODE)&('+BGPVCODE)&('+BGPVICD0) S REASON="1^no VTE test"

 +38       IF ('+BGPRCODE)&('+BGPVCODE)

               SET REASON="1^no VTE test"

 +39       QUIT REASON

NUMER(DFN,ADMIT,PROC,VST) ;Check to see if pt is in the numerator

 +1        NEW TAX,MEDDTE,ENDDT,VTE,MEDIEN,STATUS,DRUG,DISPENSE

 +2        NEW TEDS,FIRST,GIVEN,NOTGIV,RETURN,DEV

 +3        SET VTE=0

           SET RETURN=0

 +4       ;First, see if the pt has CPT for procedure in first 24hrs

 +5        SET FIRST=$$FMADD^XLFDT(ADMIT,+1)

 +6        SET TEDS=$$DTECPT^BGPMUUT3(DFN,VST,"BGPMU VTE DEVICES CPT",ADMIT,PROC)

 +7        IF +TEDS

               SET VTE=TEDS

               SET $PIECE(VTE,U,3)=BGPDD

               QUIT VTE

 +8        SET DEV=$$DTECPT^BGPMUUT3(DFN,VST,"BGPMU VTE DEVICES ICD0",ADMIT,PROC)

 +9        IF +DEV

               SET VTE=DEV

               SET $PIECE(VTE,U,3)=BGPDD

               QUIT VTE

 +10      ;See if the VTE CPT code was entered

 +11      ;DEV thinks this should be here, but it is not in the ORT

 +12      ;S GIVEN=$$DTECPT^BGPMUUT3(DFN,VST,"BGPMU VTE GIVEN CPT",ADMIT,PROC)

 +13      ;I +GIVEN S VTE=GIVEN S $P(VTE,U,3)=BGPDD Q VTE

 +14      ;Check for code that patient is not eligible

 +15      ;S NOTGIV=$$DTECPT^BGPMUUT3(DFN,VST,"BGPMU VTE NOT GIVEN CPT",ADMIT,PROC)

 +16      ;I +NOTGIV S VTE=NOTGIV S $P(VTE,U,3)=BGPDD Q VTE

 +17      ;Check for confirmation codes

 +18      ;RAD procedure check

           SET BGPRCODE=$$FIND^BGPMUUT7(DFN,"BGPMU VTE TEST CPT",ADMIT,BGPDD)

 +19       SET BGPVCODE=$$VSTCPT^BGPMUUT1(DFN,BGPVST,"BGPMU VTE TEST CPT")

 +20      ;S BGPVICD0=$$VSTICD0^BGPMUUT3(DFN,BGPVST,"BGPMU VTE TEST ICD0") ;this is not in the ORT

 +21      ;I (+BGPRCODE)!(+BGPVCODE)!(+BGPVICD0) S VTE=$S(BGPRCODE'="":BGPRCODE,BGPVICD0'="":BGPVICD0,1:BGPVCODE) S $P(VTE,U,3)=BGPDD Q VTE

 +22       IF (+BGPRCODE)!(+BGPVCODE)

               SET VTE=$SELECT(BGPRCODE'="":BGPRCODE,1:BGPVCODE)

               SET $PIECE(VTE,U,3)=BGPDD

               QUIT VTE

 +23      ;Finally check for a BMCA code for antithrombotics

 +24       SET MEDDTE=ADMIT

 +25       FOR

               SET MEDDTE=$ORDER(^PSB(53.79,"AADT",DFN,MEDDTE))

               IF '+MEDDTE!(MEDDTE>PROC)!(+VTE)

                   QUIT

               Begin DoDot:1

 +26               SET MEDIEN=""

FOR

                       SET MEDIEN=$ORDER(^PSB(53.79,"AADT",DFN,MEDDTE,MEDIEN))

                       IF '+MEDIEN!(+VTE)

                           QUIT

                       Begin DoDot:2

 +27                       SET STATUS=$PIECE($GET(^PSB(53.79,MEDIEN,0)),U,9)

 +28      ;Drug given

                           IF STATUS="G"!(STATUS="I")!(STATUS="C")

                               Begin DoDot:3

 +29                               SET DISPENSE=0

FOR

                                       SET DISPENSE=$ORDER(^PSB(53.79,MEDIEN,.5,DISPENSE))

                                       IF '+DISPENSE!(+VTE)

                                           QUIT

                                       Begin DoDot:4

 +30                                       SET DRUG=$GET(^PSB(53.79,MEDIEN,.5,DISPENSE,0))

 +31                                       SET DRUG=$PIECE(DRUG,U,1)

 +32                                       SET TAX="BGPMU VTE PROPHYLAXIS"

 +33                                       SET VTE=$$NDC^BGPMUUT4(DRUG,TAX)

 +34                                       SET $PIECE(VTE,U,3)=BGPDD

                                       End DoDot:4

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +35       QUIT VTE

TEST      ;ZSAT

 +1       ;S BGPBDATE=3110101

 +2       ;S BGPEDATE=3110601

 +3       ;S BGPBEN=3

 +4       ;S DUZ("AG")="I"

 +5       ;S U="^"

 +6       ;D ENTRY

 +7        QUIT

BGPMUH15.m