BGPMUH08 ; IHS/MSC/MGH - MI measure NQF0440-STK-8 ;02-Mar-2011 16:19;DU
;;11.0;IHS CLINICAL REPORTING;**4**;JAN 06, 2011;Build 84
;ED meaningful use hospital measured
; print output routine is BGPMUHP4
; delimited output routine is BGPMUHD3
ENTRY ;PEP Stroke Measure 8 - stroke education
N START,END,BGPIEN,DFN,BGPVST,BGPISDX,BGPHSDX,BGPAGEE,BGPIPROB,BGPHPROB,STROKE,EXC,NUM,BGPDIS
;Start by finding all admissions during the reporting period
S START=BGPBDATE
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 BGPADM=$P($$GET1^DIQ(9000010,BGPVST_",",.01,"I"),".",1) ;get admin date
..S BGPAGEE=$$AGE^AUPNPAT(DFN,BGPADM)
..S BGPDIS=$P($G(^DGPM(BGPIEN,0)),U,17) ;Don't use if pt is still an inpt
..Q:BGPDIS=""
..;Check for a diagnosis of stroke (both types for this measure)
..S STROKE=0,EXC=0,NUM=0
..;S BGPISDX=$$VSTPOV^BGPMUUT3(DFN,BGPVST,"BGPMU ISCHEMIC STROKE DX") ;ZSAT
..;S BGPHSDX=$$VSTPOV^BGPMUUT3(DFN,BGPVST,"BGPMU HEMORRHAGIC STROKE DX") ;ZSAT
..S BGPISDX=$$VSTPOVA^BGPMUUT3(DFN,BGPVST,"BGPMU ISCHEMIC STROKE DX")
..S BGPHSDX=$$VSTPOVA^BGPMUUT3(DFN,BGPVST,"BGPMU HEMORRHAGIC STROKE DX")
..;S BGPIPROB=$$PLTAX^BGPMUUT1(DFN,"BGPMU ISCHEMIC STROKE DX","A")
..;S BGPHPROB=$$PLTAX^BGPMUUT1(DFN,"BGPMU HEMORRHAGIC STROKE DX","A")
..;Pt must have both a POV of stoke and it must be an active problem
..;I +BGPISDX&(+BGPIPROB) S STROKE=1
..;I +BGPHSDX&(+BGPHPROB) S STROKE=1
..I +BGPISDX S STROKE=1
..I +BGPHSDX S STROKE=1
..;Next check for exclusions
..I +STROKE D
...S EXC=$$EXCLUDE(DFN,BGPIEN,BGPVST)
...;If no exclusions see if they had the education coded
...I EXC="" S NUM=$$NUMER(DFN,BGPVST,BGPIEN,BGPDIS)
...;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("BGPMU0440",$J,BGPMUTF,"TOT"))
S DENCT=+$G(^TMP("BGPMU0440",$J,BGPMUTF,"DEN"))
S NUMCT=+$G(^TMP("BGPMU0440",$J,BGPMUTF,"NUM"))
S NOTCT=+$G(^TMP("BGPMU0440",$J,BGPMUTF,"NOT"))
S EXCCT=+$G(^TMP("BGPMU0440",$J,BGPMUTF,"EXC"))
S PTCNT=TOTALS
S PTCNT=PTCNT+1
S DATE=$$DATE^BGPMUUTL($P($G(^DGPM(BGPIEN,0)),U,1))
S DENCT=DENCT+1 S ^TMP("BGPMU0440",$J,BGPMUTF,"DEN")=DENCT
I EXC'="" D
.S EXCCT=EXCCT+1 S ^TMP("BGPMU0440",$J,BGPMUTF,"EXC")=EXCCT
.I BGPMUTF="C" S ^TMP("BGPMU0440",$J,"PAT",BGPMUTF,"EXC",PTCNT)=DFN_U_$P(EXC,U,2)
I EXC="" D
.S ^TMP("BGPMU0440",$J,"PAT",BGPMUTF,"DEN",PTCNT)=DFN_U_DATE
.I +NUM=1 D
..S NUMCT=NUMCT+1 S ^TMP("BGPMU0440",$J,BGPMUTF,"NUM")=NUMCT
..S ^TMP("BGPMU0440",$J,"PAT",BGPMUTF,"NUM",PTCNT)=DFN_U_DATE_U_$P(NUM,U,3)_U_$P(NUM,U,2)
.I +NUM=0 D
..S NOTCT=NOTCT+1 S ^TMP("BGPMU0440",$J,BGPMUTF,"NOT")=NOTCT
..S ^TMP("BGPMU0440",$J,"PAT",BGPMUTF,"NOT",PTCNT)=DFN_U_DATE_U_$P(NUM,U,3)_U_$P(NUM,U,2)
S ^TMP("BGPMU0440",$J,BGPMUTF,"TOT")=PTCNT
S BGPICARE("MU.STK.0435.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) ;See if there are exclusions
N REASON,BGPLOS,BGPHOS,BGPCLIN,BGPECI
S REASON=""
I BGPAGEE<18 S REASON="1^AGE" Q REASON
;Check for LOS
S BGPLOS=$$LOS(BGPIEN,BGPDIS)
I BGPLOS>120 S REASON="1^LOS" Q REASON
;Check for hospice care
S BGPHOS=$$HOSPICE(DFN,BGPVST)
I +BGPHOS S REASON=BGPHOS Q REASON
;Check for clinical trials
S BGPCLIN=$$TRIAL(DFN,BGPVST)
I +BGPCLIN S REASON=BGPCLIN Q REASON
;Check for elective carotid intervention procedure
S BGPECI=$$ELECTIVE(DFN,BGPVST,BGPIEN)
I +BGPECI S REASON=BGPECI Q REASON
Q REASON
NUMER(DFN,BGPVST,BGPIEN,BGPDIS) ;Check to see if pt is in the numerator
N EDU,ETOPIC,D,Y,BDATE,EDATE,LIT,LIT2,%,EIEN,ICD,BGPMU,TNAME
S BDATE=$P($G(^DGPM(BGPIEN,0)),U,1)
S EDATE=$P($G(^DGPM(BGPDIS,0)),U,1)
S (%,ETOPIC,LIT,LIT2)=0
;Find all the patient ed topics from admission to discharge
;Loop through the array and look for stroke education
S EIEN="" F S EIEN=$O(^AUPNVPED("AD",BGPVST,EIEN)) Q:EIEN=""!(%'=0) D
.S ETOPIC=$P($G(^AUPNVPED(EIEN,0)),U,1)
.Q:'ETOPIC
.Q:'$D(^AUTTEDT(ETOPIC,0))
.;Quit if you find the specific stroke eduction topic
.S TNAME=$P($G(^AUTTEDT(ETOPIC,0)),U,1)
.S TTIME=$P($G(^AUPNVPED(EIEN,12)),U,1)
.I TNAME="STROK-LITERATURE" S %=1_U_TNAME_U_TTIME Q
.I $P(TNAME,"-",2)="LITERATURE" D
..;Check for diagnoses related literature
..S ICD=$P(TNAME,"-",1)
..I +ICD S LIT=$$EDLOOP(ICD,"BGPMU ISCHEMIC STROKE DX")
..I +LIT S %=LIT_U_TTIME
..I +ICD S LIT2=$$EDLOOP(ICD,"BGPMU HEMORRHAGIC STROKE DX")
..I +LIT2 S %=LIT2_U_TTIME
S:+% $P(%,U,3)=EDATE
Q %
EDLOOP(ICD,TAX) ;Find ed code in taxonomy
N BGPTX,X,%,CODE
S %=0
S BGPTX=$O(^ATXAX("B",TAX,0))
S X=0 F S X=$O(^ATXAX(BGPTX,21,X)) Q:X=""!(%'=0) D
.S CODE=$P($G(^ATXAX(BGPTX,21,X,0)),U,1)
.I CODE=ICD S %=1_U_CODE_"-LITERATURE"
Q %
LOS(BGPIEN,BGPDIS) ;Return the length of stay
N DAYS,X1,X2,X
S DAYS=0
S X2=$P($G(^DGPM(BGPIEN,0)),U,1)
S X1=$P($G(^DGPM(BGPDIS,0)),U,1)
D ^%DTC S DAYS=X
Q DAYS
HOSPICE(DFN,BGPVST) ;Return if hospice DX/problem was found for this patient
N COMFORT,BGPTDX,BGPTPROB,BGPTCPT
S COMFORT=0
S BGPTDX=$$VSTPOVB^BGPMUUT3(DFN,BGPVST,"BGPMU TERMINAL")
I +BGPTDX S COMFORT=BGPTDX
S BGPTPROB=$$PLTAX^BGPMUUT1(DFN,"BGPMU TERMINAL","C")
I +BGPTPROB S COMFORT=BGPTPROB
S BGPTCPT=$$VSTCPT^BGPMUUT1(DFN,BGPVST,"BGPMU PALLIATIVE CARE CPT")
I +BGPTCPT S COMFORT=BGPTCPT
Q COMFORT
TRIAL(DFN,BGPVST) ;Return if patient is on a clinical trial
N CLIN,BGPCDX,BGPCPROB
S CLIN=0
S BGPCDX=$$VSTPOVB^BGPMUUT3(DFN,BGPVST,"BGPMU CLINICAL TRIAL DX")
I +BGPCDX S CLIN=BGPCDX
S BGPCPROB=$$PLTAX^BGPMUUT1(DFN,"BGPMU CLINICAL TRIAL DX","C")
I +BGPCPROB S CLIN=BGPCPROB
Q CLIN
ELECTIVE(DFN,BGPVST,BGPIEN) ;Return if pt was admitted for an elective carotic interventions procedures
N PROC,TYPE,BGPCPT,BGPICD0
S PROC=0
S TYPE=$$GET1^DIQ(405,BGPIEN,9999999.05)
I TYPE="ELECTIVE" D
.S BGPICD0=$$VSTICD0^BGPMUUT3(DFN,BGPVST,"BGPMU CAROTID INTER ICD0")
.I +BGPICD0 S PROC=BGPICD0
Q PROC
BGPMUH08 ; IHS/MSC/MGH - MI measure NQF0440-STK-8 ;02-Mar-2011 16:19;DU
+1 ;;11.0;IHS CLINICAL REPORTING;**4**;JAN 06, 2011;Build 84
+2 ;ED meaningful use hospital measured
+3 ; print output routine is BGPMUHP4
+4 ; delimited output routine is BGPMUHD3
ENTRY ;PEP Stroke Measure 8 - stroke education
+1 NEW START,END,BGPIEN,DFN,BGPVST,BGPISDX,BGPHSDX,BGPAGEE,BGPIPROB,BGPHPROB,STROKE,EXC,NUM,BGPDIS
+2 ;Start by finding all admissions during the reporting period
+3 SET START=BGPBDATE
+4 SET END=BGPEDATE_".2359"
+5 FOR
SET START=$ORDER(^DGPM("B",START))
IF START=""!(START>END)
QUIT
Begin DoDot:1
+6 SET BGPIEN=""
FOR
SET BGPIEN=$ORDER(^DGPM("B",START,BGPIEN))
IF BGPIEN=""
QUIT
Begin DoDot:2
+7 ;Only include admissions
IF $PIECE($GET(^DGPM(BGPIEN,0)),U,2)'=1
QUIT
+8 SET DFN=$PIECE($GET(^DGPM(BGPIEN,0)),U,3)
+9 IF DFN=""
QUIT
+10 SET BGPACTUP=$$ACTUPAP^BGPMUEHD(DFN,BGPBDATE,BGPEDATE,BGPBEN)
+11 IF 'BGPACTUP
IF '$GET(BGPXPXPX)
IF '$GET(BGPIISO)
QUIT
+12 ;Get the visit
SET BGPVST=$PIECE($GET(^DGPM(BGPIEN,0)),U,27)
+13 IF BGPVST=""
QUIT
+14 ;get admin date
SET BGPADM=$PIECE($$GET1^DIQ(9000010,BGPVST_",",.01,"I"),".",1)
+15 SET BGPAGEE=$$AGE^AUPNPAT(DFN,BGPADM)
+16 ;Don't use if pt is still an inpt
SET BGPDIS=$PIECE($GET(^DGPM(BGPIEN,0)),U,17)
+17 IF BGPDIS=""
QUIT
+18 ;Check for a diagnosis of stroke (both types for this measure)
+19 SET STROKE=0
SET EXC=0
SET NUM=0
+20 ;S BGPISDX=$$VSTPOV^BGPMUUT3(DFN,BGPVST,"BGPMU ISCHEMIC STROKE DX") ;ZSAT
+21 ;S BGPHSDX=$$VSTPOV^BGPMUUT3(DFN,BGPVST,"BGPMU HEMORRHAGIC STROKE DX") ;ZSAT
+22 SET BGPISDX=$$VSTPOVA^BGPMUUT3(DFN,BGPVST,"BGPMU ISCHEMIC STROKE DX")
+23 SET BGPHSDX=$$VSTPOVA^BGPMUUT3(DFN,BGPVST,"BGPMU HEMORRHAGIC STROKE DX")
+24 ;S BGPIPROB=$$PLTAX^BGPMUUT1(DFN,"BGPMU ISCHEMIC STROKE DX","A")
+25 ;S BGPHPROB=$$PLTAX^BGPMUUT1(DFN,"BGPMU HEMORRHAGIC STROKE DX","A")
+26 ;Pt must have both a POV of stoke and it must be an active problem
+27 ;I +BGPISDX&(+BGPIPROB) S STROKE=1
+28 ;I +BGPHSDX&(+BGPHPROB) S STROKE=1
+29 IF +BGPISDX
SET STROKE=1
+30 IF +BGPHSDX
SET STROKE=1
+31 ;Next check for exclusions
+32 IF +STROKE
Begin DoDot:3
+33 SET EXC=$$EXCLUDE(DFN,BGPIEN,BGPVST)
+34 ;If no exclusions see if they had the education coded
+35 IF EXC=""
SET NUM=$$NUMER(DFN,BGPVST,BGPIEN,BGPDIS)
+36 ;Now add it all up
+37 DO TOTAL(BGPIEN)
End DoDot:3
End DoDot:2
End DoDot:1
+38 QUIT
TOTAL(BGPIEN) ;add up the totals
+1 NEW PTCNT,EXCCT,DENCT,NUMCT,TOTALS,DATE,NOTCT
+2 SET TOTALS=$GET(^TMP("BGPMU0440",$JOB,BGPMUTF,"TOT"))
+3 SET DENCT=+$GET(^TMP("BGPMU0440",$JOB,BGPMUTF,"DEN"))
+4 SET NUMCT=+$GET(^TMP("BGPMU0440",$JOB,BGPMUTF,"NUM"))
+5 SET NOTCT=+$GET(^TMP("BGPMU0440",$JOB,BGPMUTF,"NOT"))
+6 SET EXCCT=+$GET(^TMP("BGPMU0440",$JOB,BGPMUTF,"EXC"))
+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("BGPMU0440",$JOB,BGPMUTF,"DEN")=DENCT
+11 IF EXC'=""
Begin DoDot:1
+12 SET EXCCT=EXCCT+1
SET ^TMP("BGPMU0440",$JOB,BGPMUTF,"EXC")=EXCCT
+13 IF BGPMUTF="C"
SET ^TMP("BGPMU0440",$JOB,"PAT",BGPMUTF,"EXC",PTCNT)=DFN_U_$PIECE(EXC,U,2)
End DoDot:1
+14 IF EXC=""
Begin DoDot:1
+15 SET ^TMP("BGPMU0440",$JOB,"PAT",BGPMUTF,"DEN",PTCNT)=DFN_U_DATE
+16 IF +NUM=1
Begin DoDot:2
+17 SET NUMCT=NUMCT+1
SET ^TMP("BGPMU0440",$JOB,BGPMUTF,"NUM")=NUMCT
+18 SET ^TMP("BGPMU0440",$JOB,"PAT",BGPMUTF,"NUM",PTCNT)=DFN_U_DATE_U_$PIECE(NUM,U,3)_U_$PIECE(NUM,U,2)
End DoDot:2
+19 IF +NUM=0
Begin DoDot:2
+20 SET NOTCT=NOTCT+1
SET ^TMP("BGPMU0440",$JOB,BGPMUTF,"NOT")=NOTCT
+21 SET ^TMP("BGPMU0440",$JOB,"PAT",BGPMUTF,"NOT",PTCNT)=DFN_U_DATE_U_$PIECE(NUM,U,3)_U_$PIECE(NUM,U,2)
End DoDot:2
End DoDot:1
+22 SET ^TMP("BGPMU0440",$JOB,BGPMUTF,"TOT")=PTCNT
+23 SET BGPICARE("MU.STK.0435.1",BGPMUTF,DFN)=1_U_+$GET(NUM)_U_+EXC_U_DATE_";"_$PIECE($GET(NUM),U,3)_";"_$PIECE(EXC,U,2)
+24 QUIT
EXCLUDE(DFN,BGPIEN,BGPVST) ;See if there are exclusions
+1 NEW REASON,BGPLOS,BGPHOS,BGPCLIN,BGPECI
+2 SET REASON=""
+3 IF BGPAGEE<18
SET REASON="1^AGE"
QUIT REASON
+4 ;Check for LOS
+5 SET BGPLOS=$$LOS(BGPIEN,BGPDIS)
+6 IF BGPLOS>120
SET REASON="1^LOS"
QUIT REASON
+7 ;Check for hospice care
+8 SET BGPHOS=$$HOSPICE(DFN,BGPVST)
+9 IF +BGPHOS
SET REASON=BGPHOS
QUIT REASON
+10 ;Check for clinical trials
+11 SET BGPCLIN=$$TRIAL(DFN,BGPVST)
+12 IF +BGPCLIN
SET REASON=BGPCLIN
QUIT REASON
+13 ;Check for elective carotid intervention procedure
+14 SET BGPECI=$$ELECTIVE(DFN,BGPVST,BGPIEN)
+15 IF +BGPECI
SET REASON=BGPECI
QUIT REASON
+16 QUIT REASON
NUMER(DFN,BGPVST,BGPIEN,BGPDIS) ;Check to see if pt is in the numerator
+1 NEW EDU,ETOPIC,D,Y,BDATE,EDATE,LIT,LIT2,%,EIEN,ICD,BGPMU,TNAME
+2 SET BDATE=$PIECE($GET(^DGPM(BGPIEN,0)),U,1)
+3 SET EDATE=$PIECE($GET(^DGPM(BGPDIS,0)),U,1)
+4 SET (%,ETOPIC,LIT,LIT2)=0
+5 ;Find all the patient ed topics from admission to discharge
+6 ;Loop through the array and look for stroke education
+7 SET EIEN=""
FOR
SET EIEN=$ORDER(^AUPNVPED("AD",BGPVST,EIEN))
IF EIEN=""!(%'=0)
QUIT
Begin DoDot:1
+8 SET ETOPIC=$PIECE($GET(^AUPNVPED(EIEN,0)),U,1)
+9 IF 'ETOPIC
QUIT
+10 IF '$DATA(^AUTTEDT(ETOPIC,0))
QUIT
+11 ;Quit if you find the specific stroke eduction topic
+12 SET TNAME=$PIECE($GET(^AUTTEDT(ETOPIC,0)),U,1)
+13 SET TTIME=$PIECE($GET(^AUPNVPED(EIEN,12)),U,1)
+14 IF TNAME="STROK-LITERATURE"
SET %=1_U_TNAME_U_TTIME
QUIT
+15 IF $PIECE(TNAME,"-",2)="LITERATURE"
Begin DoDot:2
+16 ;Check for diagnoses related literature
+17 SET ICD=$PIECE(TNAME,"-",1)
+18 IF +ICD
SET LIT=$$EDLOOP(ICD,"BGPMU ISCHEMIC STROKE DX")
+19 IF +LIT
SET %=LIT_U_TTIME
+20 IF +ICD
SET LIT2=$$EDLOOP(ICD,"BGPMU HEMORRHAGIC STROKE DX")
+21 IF +LIT2
SET %=LIT2_U_TTIME
End DoDot:2
End DoDot:1
+22 IF +%
SET $PIECE(%,U,3)=EDATE
+23 QUIT %
EDLOOP(ICD,TAX) ;Find ed code in taxonomy
+1 NEW BGPTX,X,%,CODE
+2 SET %=0
+3 SET BGPTX=$ORDER(^ATXAX("B",TAX,0))
+4 SET X=0
FOR
SET X=$ORDER(^ATXAX(BGPTX,21,X))
IF X=""!(%'=0)
QUIT
Begin DoDot:1
+5 SET CODE=$PIECE($GET(^ATXAX(BGPTX,21,X,0)),U,1)
+6 IF CODE=ICD
SET %=1_U_CODE_"-LITERATURE"
End DoDot:1
+7 QUIT %
LOS(BGPIEN,BGPDIS) ;Return the length of stay
+1 NEW DAYS,X1,X2,X
+2 SET DAYS=0
+3 SET X2=$PIECE($GET(^DGPM(BGPIEN,0)),U,1)
+4 SET X1=$PIECE($GET(^DGPM(BGPDIS,0)),U,1)
+5 DO ^%DTC
SET DAYS=X
+6 QUIT DAYS
HOSPICE(DFN,BGPVST) ;Return if hospice DX/problem was found for this patient
+1 NEW COMFORT,BGPTDX,BGPTPROB,BGPTCPT
+2 SET COMFORT=0
+3 SET BGPTDX=$$VSTPOVB^BGPMUUT3(DFN,BGPVST,"BGPMU TERMINAL")
+4 IF +BGPTDX
SET COMFORT=BGPTDX
+5 SET BGPTPROB=$$PLTAX^BGPMUUT1(DFN,"BGPMU TERMINAL","C")
+6 IF +BGPTPROB
SET COMFORT=BGPTPROB
+7 SET BGPTCPT=$$VSTCPT^BGPMUUT1(DFN,BGPVST,"BGPMU PALLIATIVE CARE CPT")
+8 IF +BGPTCPT
SET COMFORT=BGPTCPT
+9 QUIT COMFORT
TRIAL(DFN,BGPVST) ;Return if patient is on a clinical trial
+1 NEW CLIN,BGPCDX,BGPCPROB
+2 SET CLIN=0
+3 SET BGPCDX=$$VSTPOVB^BGPMUUT3(DFN,BGPVST,"BGPMU CLINICAL TRIAL DX")
+4 IF +BGPCDX
SET CLIN=BGPCDX
+5 SET BGPCPROB=$$PLTAX^BGPMUUT1(DFN,"BGPMU CLINICAL TRIAL DX","C")
+6 IF +BGPCPROB
SET CLIN=BGPCPROB
+7 QUIT CLIN
ELECTIVE(DFN,BGPVST,BGPIEN) ;Return if pt was admitted for an elective carotic interventions procedures
+1 NEW PROC,TYPE,BGPCPT,BGPICD0
+2 SET PROC=0
+3 SET TYPE=$$GET1^DIQ(405,BGPIEN,9999999.05)
+4 IF TYPE="ELECTIVE"
Begin DoDot:1
+5 SET BGPICD0=$$VSTICD0^BGPMUUT3(DFN,BGPVST,"BGPMU CAROTID INTER ICD0")
+6 IF +BGPICD0
SET PROC=BGPICD0
End DoDot:1
+7 QUIT PROC
