BGPMUH10.m

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)