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

BGPMUF05.m

Go to the documentation of this file. 
  1. BGPMUF05 ; IHS/MSC/MGH - MI measure NQF0075 ;02-Aug-2011 14:56;DU
  1.  ;;11.1;IHS CLINICAL REPORTING SYSTEM;**1**;JUN 27, 2011;Build 106
  1.  ;Code to collect meaningful use report for IVD Lipid/LDL
  1. ENTRY ;EP
  1.  N START,END,BGPNUM,BGPDEN,BGPNUM,STRING,OUTCT,NFCT,INCT
  1.  N IEN,INV,VISIT,DATA,VDATE,VALUE,FIRST,VIEN,RESULT,IVDSTRT,IVDEND
  1.  N CNT,IVD,NUM,OUTENC,NFENC,VENC,IVDDX
  1.  S (BGPDEN,BGPNUM,RESULT)=0
  1.  S IVDSTRT=$$FMADD^XLFDT(BGPEDATE,-730),IVDEND=$$FMADD^XLFDT(BGPEDATE,-426)
  1.  S STRING="",IVDDX=0
  1.  S (IVD,NUM1,NUM2)=0
  1.  ;Pts must be >18
  1.  ;No need to check further if no age match
  1.  Q:BGPAGEE<18
  1.  S CNT=0
  1.  ;First check for IVD DX as an outpatient since this is more common 
  1.  S START=9999999-IVDSTRT,END=9999999-BGPEDATE,VALUE=0
  1.  S FIRST=END-0.1 F  S FIRST=$O(^AUPNVSIT("AA",DFN,FIRST)) Q:FIRST=""!($P(FIRST,".",1)>START)!(+IVD)  D
  1.  .S IEN=0 F  S IEN=$O(^AUPNVSIT("AA",DFN,FIRST,IEN)) Q:'+IEN!(+IVD)  D
  1.  ..;Check provider, Only visits for chosen provider
  1.  ..Q:'$$PRV^BGPMUUT1(IEN,BGPPROV)
  1.  ..S OUTENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU ENCOUNTER OUTPT")
  1.  ..I +OUTENC D VSTSTORE Q
  1.  ..S NFENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU ACUTE INPT ENC")
  1.  ..I +NFENC D VSTSTORE Q
  1.  ..S VENC=$$VSTPOV^BGPMUUT3(DFN,IEN,"BGPMU ENC OUTPATIENT ICD")
  1.  ..I +VENC D VSTSTORE Q
  1.  ;skip to numerator checking if IVD Dx found
  1.  I +IVD G NUMCHKS
  1.  ;check for other procedures or diagnoses
  1.  S CNT=0
  1.  S START=9999999-IVDSTRT,END=9999999-IVDEND,VALUE=0
  1.  S FIRST=END-0.1 F  S FIRST=$O(^AUPNVSIT("AA",DFN,FIRST)) Q:FIRST=""!($P(FIRST,".",1)>START)!(+IVD)  D
  1.  .S IEN=0 F  S IEN=$O(^AUPNVSIT("AA",DFN,FIRST,IEN)) Q:'+IEN!(+IVD)  D
  1.  ..;Check provider, Only visits for chosen provider
  1.  ..Q:'$$PRV^BGPMUUT1(IEN,BGPPROV)
  1.  ..S NFENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU ACUTE INPT ENC")
  1.  ..I +NFENC D
  1.  ...S VDATE=$P($G(^AUPNVSIT(IEN,0)),U,1)
  1.  ...S CNT=CNT+1
  1.  ...S VIEN(CNT)=IEN_U_VDATE_U_$$DATE^BGPMUUTL(VDATE)
  1.  ...S STRING(CNT)=$$DATE^BGPMUUTL(VDATE)
  1.  ...S IVD=$$INPTDEN(DFN,IEN,IVDSTRT,IVDEND)
  1. NUMCHKS ;If the patient had IVD, check to see if they are in the numerator
  1.  Q:'IVD
  1.  S NUM1=$$NUM1(DFN,BGPBDATE,BGPEDATE)
  1.  ; if patient not in NUM1 then they don't have requisite tests and therefore cannot be in NUM2
  1.  I +NUM1 S NUM2=$$NUM2(DFN,BGPBDATE,BGPEDATE)
  1.  D TOTAL1(DFN,IVD,NUM1,NUM2)
  1.  Q
  1. VSTSTORE ;Store compliant visit into array
  1.  S VDATE=$P($G(^AUPNVSIT(IEN,0)),U,1)
  1.  S CNT=CNT+1
  1.  S VIEN(CNT)=IEN_U_VDATE_U_$$DATE^BGPMUUTL(VDATE)
  1.  S STRING(CNT)=$$DATE^BGPMUUTL(VDATE)
  1.  S IVD=$$OUTPTDEN(DFN,IEN)
  1.  Q
  1. TOTAL1(DFN,IVD,NUM1,NUM2) ;See where this patient ends up
  1.  N PTCNT,DENCT,NUM1CT,NUM2CT,NOTNUM1,NOTNUM2,TOTALS,DXTIME,DEN
  1.  S TOTALS=$G(^TMP("BGPMU0075",$J,BGPMUTF,"TOT"))
  1.  S DENCT=+$G(^TMP("BGPMU0075",$J,BGPMUTF,"DEN"))
  1.  S NUM1CT=+$G(^TMP("BGPMU0075",$J,BGPMUTF,"NUM",1))
  1.  S NOTNUM1=+$G(^TMP("BGPMU0075",$J,BGPMUTF,"NOT",1))
  1.  S NUM2CT=+$G(^TMP("BGPMU0075",$J,BGPMUTF,"NUM",2))
  1.  S NOTNUM2=+$G(^TMP("BGPMU0075",$J,BGPMUTF,"NOT",2))
  1.  S PTCNT=TOTALS
  1.  S PTCNT=PTCNT+1
  1.  S (DEN,DXTIME)=""
  1.  S DENCT=DENCT+1 S ^TMP("BGPMU0075",$J,BGPMUTF,"DEN")=DENCT
  1.  I $P(IVD,U,3)'="" S DXTIME=$$DATE^BGPMUUTL($P(IVD,U,3))
  1.  S DEN=$P(IVD,U,2)_DXTIME_";EN:"_STRING(1)
  1.  I +NUM1 D
  1.  .S NUM1CT=NUM1CT+1 S ^TMP("BGPMU0075",$J,BGPMUTF,"NUM",1)=NUM1CT
  1.  .I BGPMUTF="C" S ^TMP("BGPMU0075",$J,"PAT",BGPMUTF,"NUM",1,PTCNT)=DFN_U_DEN_U_$P(NUM1,U,2)_U_$P(NUM1,U,3)
  1.  I +NUM1=0 D
  1.  .S NOTNUM1=NOTNUM1+1 S ^TMP("BGPMU0075",$J,BGPMUTF,"NOT",1)=NOTNUM1
  1.  .I BGPMUTF="C" S ^TMP("BGPMU0075",$J,"PAT",BGPMUTF,"NOT",1,PTCNT)=DFN_U_DEN
  1.  I +NUM2=1!(+NUM2=3) D
  1.  .S NUM2CT=NUM2CT+1 S ^TMP("BGPMU0075",$J,BGPMUTF,"NUM",2)=NUM2CT
  1.  .I BGPMUTF="C" S ^TMP("BGPMU0075",$J,"PAT",BGPMUTF,"NUM",2,PTCNT)=DFN_U_DEN_U_$P(NUM2,U,2)_U_$P(NUM2,U,3)
  1.  I +NUM2=0!(+NUM2=2) D
  1.  .S NOTNUM2=NOTNUM2+1 S ^TMP("BGPMU0075",$J,BGPMUTF,"NOT",2)=NOTNUM2
  1.  .I BGPMUTF="C" S ^TMP("BGPMU0075",$J,"PAT",BGPMUTF,"NOT",2,PTCNT)=DFN_U_DEN_U_$P(NUM2,U,2)_U_$P(NUM2,U,3)
  1.  S ^TMP("BGPMU0075",$J,BGPMUTF,"TOT")=PTCNT
  1.  ;Setup iCare array for patient
  1.  S BGPICARE("MU.EP.0075.1",BGPMUTF)=1_U_+NUM1_U_""_U_DEN_";"_$P(NUM1,U,2)_";"_$P(NUM1,U,3)
  1.  S BGPICARE("MU.EP.0075.2",BGPMUTF)=1_U_((+NUM2=1)!(+NUM2=3))_U_""_U_DEN_";"_$P(NUM2,U,2)_";"_$P(NUM2,U,3)
  1.  Q
  1. OUTPTDEN(DFN,VIEN) ; Get the denominator
  1.  N RESULT,IVDA,IVDB,IVDDX,DOB
  1.  S RESULT=0
  1.  ;Check for IVD Dx
  1.  S DOB=$$GET1^DIQ(2,DFN,.03,"I")
  1.  S IVDA=$$VSTPOV^BGPMUUT3(DFN,VIEN,"BGPMU IVD DX")
  1.  ; PROBLEM check not in ORT - S IVDB=$$PLTAX^BGPMUUT1(DFN,"BGPMU IVD DX","A",END)
  1.  I +IVDA S IVDDX=IVDA
  1.  ;I +IVDB S IVDDX=IVDB
  1.  ;I +IVDA!(+IVDB) S RESULT=1_U_"IVD:"_$P(IVDDX,U,2)_U_$P(IVDDX,U,3) Q RESULT
  1.  I +IVDA S RESULT=1_U_"IVD:"_U_$P(IVDDX,U,3) Q RESULT
  1.  Q RESULT
  1. INPTDEN(DFN,VIEN,START,END) ;Evaluate Inpatient visit denominator criteria
  1.  N RESULT,PTCA,PTCAP,AMI,CABG,CABGP
  1.  S RESULT=0
  1.  ;Check for PTCA Codes (14 to 24 months hence)
  1.  S PTCA=$$CPT^BGPMUUT1(DFN,IVDSTRT,IVDEND,"BGPMU PTCA CPT")
  1.  ;I +PTCA S RESULT=1_U_"PTCA:"_$P(PTCA,U,2)_U_$P(PTCA,U,3) Q RESULT
  1.  I +PTCA S RESULT=1_U_"PTCA:"_U_$P(PTCA,U,3) Q RESULT
  1.  S PTCAP=$$LASTPRC^BGPMUUT2(DFN,IVDSTRT,IVDEND,"BGPMU PTCA PROCEDURE")
  1.  I +PTCAP S RESULT=1_U_"PTCA:"_U_$P(PTCAP,U,3) Q RESULT
  1.  ;Check for AMI Dx (during visit)
  1.  S AMI=$$VSTPOV^BGPMUUT3(DFN,VIEN,"BGPMU ACUTE MI DX")
  1.  I +AMI S RESULT=1_U_"AMI:"_U_$P(AMI,U,3) Q RESULT
  1.  ;Check for CABG procedure (during visit)
  1.  S CABG=$$VSTCPT^BGPMUUT1(DFN,VIEN,"BGPMU CABG CPT")
  1.  I +CABG S RESULT=1_U_"CABG:"_U_$P(CABG,U,3) Q RESULT
  1.  S CABGP=$$VSTICD0^BGPMUUT3(DFN,VIEN,"BGPMU CABG PROCEDURE")
  1.  I +CABGP S RESULT=1_U_"CABG:"_U_$P(CABGP,U,3) Q RESULT
  1.  Q RESULT
  1. NUM1(DFN,BGPBDATE,BGPEDATE) ;check for LDL Performed
  1.  N FOUND,BGPLDL,BGPHDL,BGPCHOL,BGPTRIG,DATA
  1.  N LDLVAL,HDLVAL,CHOLVAL,TRIGVAL,VAL
  1.  S FOUND=0
  1.  S BGPLDL=$$LOINC^BGPMUUT2(DFN,BGPBDATE,BGPEDATE,"BGPMU IVD LDL LOINC")
  1.  I +BGPLDL D
  1.  .S LDLVAL=$P($G(^AUPNVLAB($P(BGPLDL,U,2),0)),U,4)
  1.  .S FOUND=1_U_$P(BGPLDL,U)_U_"LDL "_LDLVAL
  1.  Q:+FOUND FOUND
  1.  ;check for LDL via CPT codes in LAB
  1.  D LABCPT^BGPMUUT5(.DATA,DFN,"BGPMU LAB CPT LDL",BGPBDATE,BGPEDATE)
  1.  S VAL="" S VAL=$O(DATA(VAL))
  1.  I +VAL D
  1.  .S LDLVAL=$G(DATA(VAL))
  1.  .S FOUND=1_U_(9999999-VAL)_U_"LDL "_LDLVAL
  1.  Q:+FOUND FOUND
  1.  ;NOW CHECK FOR THE TRIAD OF TESTS INDIVIDUALLY via LOINC and CPT
  1.  S BGPHDL=$$LOINC^BGPMUUT2(DFN,BGPBDATE,BGPEDATE,"BGPMU HDL LOINC")
  1.  I +BGPHDL D
  1.  .S HDLVAL=$P($G(^AUPNVLAB($P(BGPHDL,U,2),0)),U,4)
  1.  E  D
  1.  .;check for HDL via CPT codes in LAB
  1.  .D LABCPT^BGPMUUT5(.DATA,DFN,"BGPMU LAB CPT HDL",BGPBDATE,BGPEDATE)
  1.  .S VAL="" S VAL=$O(DATA(VAL))
  1.  .I +VAL D
  1.  ..S HDLVAL=$G(DATA(VAL))
  1.  ..S BGPHDL=(9999999-VAL)
  1.  S BGPCHOL=$$LOINC^BGPMUUT2(DFN,BGPBDATE,BGPEDATE,"BGPMU CHOLESTEROL LOINC")
  1.  I +BGPCHOL D
  1.  .S CHOLVAL=$P($G(^AUPNVLAB($P(BGPCHOL,U,2),0)),U,4)
  1.  E  D
  1.  .;check for CHOLESTEROL via CPT codes in LAB
  1.  .D LABCPT^BGPMUUT5(.DATA,DFN,"BGPMU LAB CPT CHOLESTEROL",BGPBDATE,BGPEDATE)
  1.  .S VAL="" S VAL=$O(DATA(VAL))
  1.  .I +VAL D
  1.  ..S CHOLVAL=$G(DATA(VAL))
  1.  ..S BGPCHOL=(9999999-VAL)
  1.  S BGPTRIG=$$LOINC^BGPMUUT2(DFN,BGPBDATE,BGPEDATE,"BGPMU TRIGLYCERIDES LOINC")
  1.  I +BGPTRIG D
  1.  .S TRIGVAL=$P($G(^AUPNVLAB($P(BGPTRIG,U,2),0)),U,4)
  1.  E  D
  1.  .;check for TRIGLYCERIDES via CPT codes in LAB
  1.  .D LABCPT^BGPMUUT5(.DATA,DFN,"BGPMU LAB CPT TRIGLYCERIDES",BGPBDATE,BGPEDATE)
  1.  .S VAL="" S VAL=$O(DATA(VAL))
  1.  .I +VAL D
  1.  ..S TRIGVAL=$G(DATA(VAL))
  1.  ..S BGPTRIG=(9999999-VAL)
  1.  I +BGPHDL&(+BGPCHOL)&(+BGPTRIG) D
  1.  .S FOUND=2_U_$P(BGPHDL,U)_";"_$P(BGPCHOL,U)_";"_$P(BGPTRIG,U)_U_"HDL "_HDLVAL_";"_"CHL "_CHOLVAL_";"_"TRI "_TRIGVAL
  1.  Q FOUND
  1. NUM2(DFN,BGPBDATE,BGPEDATE) ;check for good LAB VALUES
  1.  N FOUND,BGPLDL,BGPHDL,BGPCHOL,BGPTRIG,LIEN,DATA
  1.  N LDLVAL,HDLVAL,CHOLVAL,TRIGVAL,VAL
  1.  S FOUND=0
  1.  S (LDLVAL,HDLVAL,CHOLVAL,TRIGVAL)=0
  1.  S BGPLDL=$$LOINC^BGPMUUT2(DFN,BGPBDATE,BGPEDATE,"BGPMU IVD LDL LOINC")
  1.  I +BGPLDL D
  1.  .S LIEN=$P(BGPLDL,U,2)
  1.  .S LDLVAL=$P($G(^AUPNVLAB(LIEN,0)),U,4)
  1.  .I (LDLVAL'="") D
  1.  ..I (LDLVAL<100) D
  1.  ...S FOUND=1_U_$P(BGPLDL,U)_U_"LDL "_LDLVAL
  1.  ..E  S FOUND=0_U_$P(BGPLDL,U)_U_"LDL "_LDLVAL
  1.  Q:+FOUND FOUND
  1.  ;check for LDL via CPT codes in LAB
  1.  D LABCPT^BGPMUUT5(.DATA,DFN,"BGPMU LAB CPT LDL",BGPBDATE,BGPEDATE)
  1.  S VAL="" S VAL=$O(DATA(VAL))
  1.  I +VAL D
  1.  .S LDLVAL=$G(DATA(VAL))
  1.  .I (LDLVAL'="") D
  1.  ..I (LDLVAL<100) D
  1.  ...S FOUND=1_U_(9999999-VAL)_U_"LDL "_LDLVAL
  1.  ..E  S FOUND=0_U_(9999999-VAL)_U_"LDL "_LDLVAL
  1.  Q:+FOUND FOUND
  1.  ;NOW CHECK FOR THE TRIAD OF TESTS INDIVIDUALLY via LOINC and CPT
  1.  S BGPHDL=$$LOINC^BGPMUUT2(DFN,BGPBDATE,BGPEDATE,"BGPMU HDL LOINC")
  1.  I +BGPHDL D
  1.  .S HDLVAL=$P($G(^AUPNVLAB($P(BGPHDL,U,2),0)),U,4)
  1.  E  D
  1.  .;check for HDL via CPT codes in LAB
  1.  .D LABCPT^BGPMUUT5(.DATA,DFN,"BGPMU LAB CPT HDL",BGPBDATE,BGPEDATE)
  1.  .S VAL="" S VAL=$O(DATA(VAL))
  1.  .I +VAL D
  1.  ..S HDLVAL=$G(DATA(VAL))
  1.  ..S BGPHDL=(9999999-VAL)
  1.  S BGPCHOL=$$LOINC^BGPMUUT2(DFN,BGPBDATE,BGPEDATE,"BGPMU CHOLESTEROL LOINC")
  1.  I +BGPCHOL D
  1.  .S CHOLVAL=$P($G(^AUPNVLAB($P(BGPCHOL,U,2),0)),U,4)
  1.  E  D
  1.  .;check for CHOLESTEROL via CPT codes in LAB
  1.  .D LABCPT^BGPMUUT5(.DATA,DFN,"BGPMU LAB CPT CHOLESTEROL",BGPBDATE,BGPEDATE)
  1.  .S VAL="" S VAL=$O(DATA(VAL))
  1.  .I +VAL D
  1.  ..S CHOLVAL=$G(DATA(VAL))
  1.  ..S BGPCHOL=(9999999-VAL)
  1.  S BGPTRIG=$$LOINC^BGPMUUT2(DFN,BGPBDATE,BGPEDATE,"BGPMU TRIGLYCERIDES LOINC")
  1.  I +BGPTRIG D
  1.  .S TRIGVAL=$P($G(^AUPNVLAB($P(BGPTRIG,U,2),0)),U,4)
  1.  E  D
  1.  .;check for TRIGLYCERIDES via CPT codes in LAB
  1.  .D LABCPT^BGPMUUT5(.DATA,DFN,"BGPMU LAB CPT TRIGLYCERIDES",BGPBDATE,BGPEDATE)
  1.  .S VAL="" S VAL=$O(DATA(VAL))
  1.  .I +VAL D
  1.  ..S TRIGVAL=$G(DATA(VAL))
  1.  ..S BGPTRIG=(9999999-VAL)
  1.  I +BGPHDL&(+BGPCHOL)&(+BGPTRIG) D
  1.  .I ((TRIGVAL'="")&(TRIGVAL<400))&(((CHOLVAL-HDLVAL-TRIGVAL)/5)<100) D
  1.  ..S FOUND=3_U_$P(BGPHDL,U)_";"_$P(BGPCHOL,U)_";"_$P(BGPTRIG,U)_U_"HDL "_HDLVAL_";"_"CHL "_CHOLVAL_";"_"TRI "_TRIGVAL
  1.  .E  S FOUND=2_U_$P(BGPHDL,U)_";"_$P(BGPCHOL,U)_";"_$P(BGPTRIG,U)_U_"HDL "_HDLVAL_";"_"CHL "_CHOLVAL_";"_"TRI "_TRIGVAL
  1.  Q FOUND