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