Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BGPMUH09

BGPMUH09.m

Go to the documentation of this file. 
  1. BGPMUH09 ; IHS/MSC/MGH - MU measure NQF0441-STK-10 ;02-Mar-2011 16:20;DU
  1.  ;;11.0;IHS CLINICAL REPORTING;**4**;JAN 06, 2011;Build 84
  1.  ;meaningful use hospital measure STROKE-10 - Assessed for Rehabilitation
  1. ENTRY ;PEP  Stroke Measure 10 - assessed for rehab
  1.  N START,END,BGPIEN,DFN,BGPVST,BGPISDX,BGPHSDX,BGPAGEE,BGPIPROB,BGPHPROB,STROKE,EXC,NUM,BGPDIS
  1.  ;Start by finding all admissions during the reporting period
  1.  S START=BGPBDATE
  1.  S END=BGPEDATE_".2359"
  1.  F  S START=$O(^DGPM("B",START)) Q:START=""!(START>END)  D
  1.  .S BGPIEN="" F  S BGPIEN=$O(^DGPM("B",START,BGPIEN)) Q:BGPIEN=""  D
  1.  ..Q:$P($G(^DGPM(BGPIEN,0)),U,2)'=1    ;Only include admissions
  1.  ..S DFN=$P($G(^DGPM(BGPIEN,0)),U,3)
  1.  ..S BGPAGEE=$$AGE^AUPNPAT(DFN,BGPEDATE)
  1.  ..Q:DFN=""
  1.  ..S BGPACTUP=$$ACTUPAP^BGPMUEHD(DFN,BGPBDATE,BGPEDATE,BGPBEN)
  1.  ..I 'BGPACTUP,'$G(BGPXPXPX),'$G(BGPIISO) Q
  1.  ..S BGPVST=$P($G(^DGPM(BGPIEN,0)),U,27)  ;Get the visit
  1.  ..Q:BGPVST=""
  1.  ..S BGPDIS=$P($G(^DGPM(BGPIEN,0)),U,17)  ;Don't use if pt is still an inpt
  1.  ..Q:BGPDIS=""
  1.  ..;Check for a diagnosis of stroke (both types for this measure)
  1.  ..S STROKE=0,EXC=0,NUM=0
  1.  ..;In These next two taxonomies almost all Stroke ICD9s are included
  1.  ..;S BGPISDX=$$VSTPOVA^BGPMUUT3(DFN,BGPVST,"BGPMU ISCHEMIC STROKE DX")
  1.  ..;S BGPHSDX=$$VSTPOVA^BGPMUUT3(DFN,BGPVST,"BGPMU HEMORRHAGIC STROKE DX")
  1.  ..;************
  1.  ..;S BGPIPROB=$$PLTAX^BGPMUUT1(DFN,"BGPMU ISCHEMIC STROKE DX","A")
  1.  ..;S BGPHPROB=$$PLTAX^BGPMUUT1(DFN,"BGPMU HEMORRHAGIC STROKE DX","A")
  1.  ..;Pt must have both a POV of stoke and it must be an active problem
  1.  ..;I +BGPISDX&(+BGPIPROB) S STROKE=1
  1.  ..;I +BGPHSDX&(+BGPHPROB) S STROKE=1
  1.  ..;S:BGPISDX STROKE=1
  1.  ..;S:BGPHSDX STROKE=1
  1.  ..S:'STROKE STROKE=$$STROKE(DFN,BGPVST)
  1.  ..;Next check for exclusions
  1.  ..I +STROKE D
  1.  ...S EXC=$$EXCLUDE(DFN,BGPIEN,BGPVST)
  1.  ...;If no exclusions see if they were assessed for rehabilitation
  1.  ...I '+EXC S NUM=$$NUMER(DFN,BGPVST,BGPIEN,BGPDIS)
  1.  ...;Now add it all up
  1.  ...D TOTAL(BGPIEN)
  1.  Q
  1. TOTAL(BGPIEN) ;add up the totals
  1.  N PTCNT,EXCCT,DENCT,NUMCT,TOTALS,DATE,NOTCT
  1.  S TOTALS=$G(^TMP("BGPMU0441",$J,BGPMUTF,"TOT"))
  1.  S DENCT=+$G(^TMP("BGPMU0441",$J,BGPMUTF,"DEN"))
  1.  S NUMCT=+$G(^TMP("BGPMU0441",$J,BGPMUTF,"NUM"))
  1.  S EXCCT=+$G(^TMP("BGPMU0441",$J,BGPMUTF,"EXC"))
  1.  S NOTCT=+$G(^TMP("BGPMU0441",$J,BGPMUTF,"NOT"))
  1.  S PTCNT=TOTALS
  1.  S PTCNT=PTCNT+1
  1.  S DATE=$$DATE^BGPMUUTL($P($G(^DGPM(BGPIEN,0)),U,1))
  1.  S DENCT=DENCT+1 S ^TMP("BGPMU0441",$J,BGPMUTF,"DEN")=DENCT
  1.  I +EXC D
  1.  .S EXCCT=EXCCT+1 S ^TMP("BGPMU0441",$J,BGPMUTF,"EXC")=EXCCT
  1.  .I BGPMUTF="C" S ^TMP("BGPMU0441",$J,"PAT",BGPMUTF,"EXC",PTCNT)=DFN_U_$P(EXC,U,2)
  1.  I '+EXC D
  1.  .I +NUM=1 D
  1.  ..S NUMCT=NUMCT+1 S ^TMP("BGPMU0441",$J,BGPMUTF,"NUM")=NUMCT
  1.  ..S ^TMP("BGPMU0441",$J,"PAT",BGPMUTF,"NUM",PTCNT)=DFN_U_DATE_U_$P(NUM,U,3)_U_$P(NUM,U,2)
  1.  .I +NUM=0 D
  1.  ..S NOTCT=NOTCT+1 S ^TMP("BGPMU0441",$J,BGPMUTF,"NOT")=NOTCT
  1.  ..S ^TMP("BGPMU0441",$J,"PAT",BGPMUTF,"NOT",PTCNT)=DFN_U_DATE_U_$P(NUM,U,3)_U_$P(NUM,U,2)
  1.  S ^TMP("BGPMU0441",$J,BGPMUTF,"TOT")=PTCNT
  1.  S BGPICARE("MU.STK.0441.1",BGPMUTF,DFN)=1_U_+$G(NUM)_U_+EXC_U_DATE_";"_$P($G(NUM),U,3)_";"_$P(EXC,U,2)
  1.  Q
  1. EXCLUDE(DFN,BGPIEN,BGPVST) ;See if there are exclusions
  1.  N REASON,BGPLOS,BGPHOS,BGPCLIN,BGPECI,DTYPE1,DTYPE2
  1.  S REASON=""
  1.  I BGPAGEE<18 S REASON="1^AGE" Q REASON
  1.  ;Check for LOS
  1.  S BGPLOS=$$LOS^BGPMUH08(BGPIEN,BGPDIS)
  1.  I BGPLOS>120 S REASON="1^LOS" Q REASON
  1.  ;Check for discharge reasons
  1.  S DTYPE2=$P($G(^DGPM(BGPDIS,"IHS")),U,7)
  1.  I (DTYPE2="2")!(DTYPE2="3")!(DTYPE2="4")!(DTYPE2="5")!(DTYPE2="7")!(DTYPE2="43")!(DTYPE2="50")!(DTYPE2="51") S REASON="1^"_DTYPE2 Q REASON
  1.  ;Check for expired
  1.  S DTYPE2=$P($G(^DGPM(BGPDIS,"IHS")),U,7)
  1.  I (DTYPE2="20")!(DTYPE2="40")!(DTYPE2="41")!(DTYPE2="42") S REASON="1^"_DTYPE2 Q REASON
  1.  ;Check for hospice care
  1.  S BGPHOS=$$HOSPICE^BGPMUH08(DFN,BGPVST)
  1.  I +BGPHOS S REASON=BGPHOS Q REASON
  1.  ;Check for clinical trials
  1.  S BGPCLIN=$$TRIAL^BGPMUH08(DFN,BGPVST)
  1.  I +BGPCLIN S REASON=BGPCLIN Q REASON
  1.  ;Check for elective carotid intervention procedure
  1.  S BGPECI=$$ELECTIVE^BGPMUH08(DFN,BGPVST,BGPIEN)
  1.  I +BGPECI S REASON=BGPECI Q REASON
  1.  Q REASON
  1. NUMER(DFN,BGPVST,BGPIEN,BGPDIS) ;Check to see if pt is in the numerator
  1.  N %
  1.  S %=$$VSTCPT^BGPMUUT1(DFN,BGPVST,"BGPMU REHAB ASSESS CPT")
  1.  I +% D
  1.  .S BGPDD=$P($G(^DGPM(BGPDIS,0)),U,1)
  1.  .S $P(%,U,3)=BGPDD
  1.  Q %
  1. STROKE(DFN,BGPVST) ;Check for Stroke diagnoses
  1.  Q:'DFN 0
  1.  Q:'BGPVST 0
  1.  N IEN,M,ICD9,X,I,J,Y,STROKE
  1.  S (STROKE,IEN)=0
  1.  F  S IEN=$O(^AUPNVPOV("AD",BGPVST,IEN)) Q:'IEN  D
  1.  .;Quit if other patient
  1.  .Q:$P(^AUPNVPOV(IEN,0),U,2)'=DFN
  1.  .;Quit if modifier = C or D or M or O or P or S
  1.  .S M=$P(^AUPNVPOV(IEN,0),U,6)
  1.  .I $L(M),"CDMOPS"[M Q
  1.  .;Quit if diagnosis not primary
  1.  .Q:$P(^AUPNVPOV(IEN,0),U,12)="S"
  1.  .S ICD9=$P(^AUPNVPOV(IEN,0),U),ICD9=$P(^ICD9(ICD9,0),U)
  1.  .;Quit if ICD9 is not on list of Ischemic strokes or Homorrhagic strokes.
  1.  .F I=1:1 S X=$P($T(ICD9+I),";;",2) Q:X["END"!STROKE  F J=1:1 S Y=$P(X,U,J) Q:'$L(Y)!STROKE  D
  1.  ..I Y["-" Q:ICD9<$P(Y,"-")!(ICD9>$P(Y,"-",2))  S STROKE=1 Q
  1.  ..S:ICD9=Y STROKE=1
  1.  Q STROKE
  1. ICD9 ;List of stroke ICD9 codes to be included in Denominator logic
  1.  ;;433.0^433.00^433.01^433.1^433.10^433.11^433.2^433.20^433.21^433.3^433.30^433.31^433.8
  1.  ;;433.80^433.81^433.9^433.90^433.91^434.0^434.00^434.01^434.1^434.10^434.11^434.9^434.90
  1.  ;;434.91^435.8^435.9^436.^430-432.99
  1.  ;;END
  1.  Q