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

BGPMUH14.m

Go to the documentation of this file.
BGPMUH14 ; IHS/MSC/MMT - MU measure NQF0375-VTE-5 ;02-Mar-2011 16:24;DU
 ;;11.0;IHS CLINICAL REPORTING;**4**;JAN 06, 2011;Build 84
 ;meaningful use hospital measure VTE-5 - Pt Education for Warfarin
ENTRY ;PEP  VTE-5 - Pt Education for Warfarin
 N START,END,BGPIEN,DFN,BGPVST,BGPVDX,BGPVPROB,BGPAGEE,BGPBIRTH,VTE,EXC,NUM,BGPDIS
 N DTYPE1,DTYPE2,WARFIP,BGPADMIT,BGPDD
 ;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)
 ..S BGPAGEE=$$AGE^AUPNPAT(DFN,BGPEDATE)
 ..S BGPBIRTH=$$DOB^AUPNPAT(DFN)
 ..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=""
 ..S DTYPE2=+$P($G(^DGPM(BGPDIS,"IHS")),U,7)
 ..I DTYPE2'="",DTYPE2'=1,DTYPE2'=6,DTYPE2'=50 Q
  ..;Get the admit time & discharge times
 ..S BGPADMIT=$P($G(^DGPM(BGPIEN,0)),U,1)
 ..S BGPDD=$P($G(^DGPM(BGPDIS,0)),U,1)
 ..;Check for a diagnosis of VTE
 ..S VTE=0,EXC=0,NUM=0
 ..S BGPVDX=$$VSTPOVB^BGPMUUT3(DFN,BGPVST,"BGPMU VTE DX")
 ..;S BGPVDX=$$LASTDX^BGPMUUT2(DFN,BGPBIRTH,BGPEDATE,"BGPMU VTE DX")
 ..I +BGPVDX S VTE=1
 ..Q:'VTE
 ..;Check for Warfarin administered as an IP during admission
 ..S WARFIP=$$FIND^BGPMUUT4(DFN,"BGPMU WARFARIN NDCS",$P($G(^DGPM(BGPIEN,0)),U,1),"UD",$P($G(^DGPM(BGPDIS,0)),U,1))
 ..Q:'WARFIP
 ..;Next check for exclusions
 ..S EXC=$$EXCLUDE(DFN,BGPIEN,BGPVST)
 ..;If no exclusions see if they were given the proper Pt Education
 ..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("BGPMU0375",$J,BGPMUTF,"TOT"))
 S DENCT=+$G(^TMP("BGPMU0375",$J,BGPMUTF,"DEN"))
 S NUMCT=+$G(^TMP("BGPMU0375",$J,BGPMUTF,"NUM"))
 S EXCCT=+$G(^TMP("BGPMU0375",$J,BGPMUTF,"EXC"))
 S NOTCT=+$G(^TMP("BGPMU0375",$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("BGPMU0375",$J,BGPMUTF,"DEN")=DENCT
 I EXC'="" D
 .S EXCCT=EXCCT+1 S ^TMP("BGPMU0375",$J,BGPMUTF,"EXC")=EXCCT
 .I BGPMUTF="C" S ^TMP("BGPMU0375",$J,"PAT",BGPMUTF,"EXC",PTCNT)=DFN_U_$P(EXC,U,2)
 I EXC="" D
 .I +NUM=1 D
 ..S NUMCT=NUMCT+1 S ^TMP("BGPMU0375",$J,BGPMUTF,"NUM")=NUMCT
 ..S ^TMP("BGPMU0375",$J,"PAT",BGPMUTF,"NUM",PTCNT)=DFN_U_DATE_U_$P(NUM,U,3)_U_$P(NUM,U,2)_U_$P(BGPVDX,U,2)_";"_$P(WARFIP,U,2)
 .I +NUM=0 D
 ..S NOTCT=NOTCT+1 S ^TMP("BGPMU0375",$J,BGPMUTF,"NOT")=NOTCT
 ..S ^TMP("BGPMU0375",$J,"PAT",BGPMUTF,"NOT",PTCNT)=DFN_U_DATE_U_$P(NUM,U,3)_U_$P(NUM,U,2)_U_$P(BGPVDX,U,2)_";"_$P(WARFIP,U,2)
 S ^TMP("BGPMU0375",$J,BGPMUTF,"TOT")=PTCNT
 S BGPICARE("MU.VTE.0375.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,BGPCLIN,EDATE,DISCHKDT,WARFDIS,VTEICD,VTECPT,VTERCODE
 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 clinical trials
 S BGPCLIN=$$TRIAL^BGPMUH08(DFN,BGPVST)
 I +BGPCLIN S REASON=BGPCLIN Q REASON
 ;Check for no Warfarin as a discharge Med
 S EDATE=$P($G(^DGPM(BGPDIS,0)),U,1)
 S DISCHKDT=$$FMADD^XLFDT(EDATE,1),$P(DISCHKDT,".",2)="0001"
 S WARFDIS=$$FIND^BGPMUUT4(DFN,"BGPMU WARFARIN NDCS",DISCHKDT,"OP")
 I 'WARFDIS S REASON="No Warf Rx" Q REASON
 ;Check if VTE diagnostic procedure performed - exclude if none performed
 ;S VTEICD=$$VSTICD0^BGPMUUT3(DFN,BGPVST,"BGPMU VTE TEST ICD0")  ;not in ORT
 S VTERCODE=$$FIND^BGPMUUT7(DFN,"BGPMU VTE TEST CPT",BGPADMIT,BGPDD)
 S VTECPT=$$VSTCPT^BGPMUUT1(DFN,BGPVST,"BGPMU VTE TEST CPT")
 ;I 'VTECPT&('VTERCODE)&('VTEICD) S REASON="1^No VTE CPT Chk" Q REASON
 I 'VTECPT&('VTERCODE) S REASON="1^No VTE CPT Chk" Q REASON
 Q REASON
NUMER(DFN,BGPVST,BGPIEN,BGPDIS) ;Check to see if pt is in the numerator
 N EDU,ETOPIC,D,Y,LIT,LIT2,%,EIEN,ICD,BGPMU,TNAME,MEDTOP,NUTRTOP,TOPLAST
 ;Compliance Issues: Patient education code of M-[any code] or any code with -M
 ;-AND-
 ;Dietary Advice: any patient education code with -N or -MNT
 ;
 S (%,ETOPIC)=0
 S (MEDTOP,NUTRTOP)=""
 ;Find all the patient ed topics from admission to discharge
 ;Loop through the array and look for M-, -M, -N or -MNT
 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 TOPLAST=$L(TNAME,"-")
 .I MEDTOP=""&(($P(TNAME,"-",1)="M")!($P(TNAME,"-",TOPLAST)="M")!($E($P(TNAME,"-",TOPLAST),1,10)="MEDICATION")) S MEDTOP=1_U_TNAME
 .I NUTRTOP=""&(($P(TNAME,"-",TOPLAST)="MNT")!($P(TNAME,"-",TOPLAST)="MEDICAL NUTRITION THERAPY")) S NUTRTOP=1_U_TNAME
 .I NUTRTOP=""&(($P(TNAME,"-",TOPLAST)="N")!($P(TNAME,"-",TOPLAST)="NUTRITION")) S NUTRTOP=1_U_TNAME
 I +MEDTOP,+NUTRTOP S %=1_U_$P(MEDTOP,U,2)_";"_$P(NUTRTOP,U,2)_U_$P($G(^DGPM(BGPDIS,0)),U,1)
 Q %