BGPMUA10.m

BGPMUA10 ; IHS/MSC/MGH - MI measure NQF0067 & NQF0070 ;11-Jul-2011 10:50;DU

 ;;11.1;IHS CLINICAL REPORTING SYSTEM;**1**;JUN 27, 2011;Build 106

 ;Code to collect meaningful use reports

ENTRY1 ;EP Entry point for NQA0067 for CAD and antiplatelet therapy

 N START,END,BGPNUM,BGPDEN,BGPNUM,STRING,OUTCT,NFCT,INCT

 N IEN,INV,VISIT,DATA,VDATE,VALUE,EXCEPT,FIRST,VIEN,EXCEPT,RESULT

 N CNT,DIAB,NUM,EXC,DIAB,OUTENC,NFENC,INENC,CADDX

 S (BGPDEN,BGPNUM,RESULT)=0

 S START=9999999-BGPBDATE,END=9999999-BGPEDATE,VALUE=0

 S START=START_".2359"

 S STRING="",CADDX=0

 S (CAD,EXC,NUM)=0

 ;Pts must be >18 

 ;No need to check further if no age match

 Q:BGPAGEE<18

 S (CNT,OUTCT,NFCT,INCT)=0

 S FIRST=END-0.1 F  S FIRST=$O(^AUPNVSIT("AA",DFN,FIRST)) Q:FIRST=""!($P(FIRST,".",1)>START)  D

 .S IEN=0 F  S IEN=$O(^AUPNVSIT("AA",DFN,FIRST,IEN)) Q:'+IEN  D

 ..;Check provider, Only visits for chosen provider

 ..Q:'$$PRV^BGPMUUT1(IEN,BGPPROV)

 ..S OUTENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU ENCOUNTER OUTPT")

 ..I +OUTENC S OUTCT=OUTCT+1

 ..S NFENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU NURSING FAC EM")

 ..I +NFENC S NFCT=NFCT+1

 ..S INENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU ENC CAD INPATIENT CPT")

 ..I +INENC S INCT=INCT+1

 ..I +OUTENC!(+NFENC)!(+INENC) 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)

 ;Next check to see if the patient is in the denominator

 ;Denominator is that the pt has DX of CAD or cardiac surgery before found visits

 I OUTCT>1!(NFCT>1)!(INCT>0) D

 .S CADDATE=$P($P($G(VIEN(1)),U,2),".")

 .S CAD=$$CAD(DFN,CADDATE)

 .I +CAD D

 ..;If the patient had CAD, check to see if they are in the numerator

 ..S NUM=$$NUM1(DFN,BGPBDATE,BGPEDATE)

 ..;If not in the numerator,see if they are an exception

 ..I +NUM=0 S EXC=$$EXCEPT(.VIEN,DFN,CADDATE,BGPEDATE,CNT)

 ..D TOTAL1(DFN,CAD,NUM,EXC)

 Q

TOTAL1(DFN,CAD,NUM,EXC) ;See where this patient ends up

 N PTCNT,EXCCT,DENCT,NUMCT,NOTNUM,TOTALS,DXTIME,DEN

 S TOTALS=$G(^TMP("BGPMU0067",$J,BGPMUTF,"TOT"))

 S DENCT=+$G(^TMP("BGPMU0067",$J,BGPMUTF,"DEN"))

 S NUMCT=+$G(^TMP("BGPMU0067",$J,BGPMUTF,"NUM"))

 S EXCCT=+$G(^TMP("BGPMU0067",$J,BGPMUTF,"EXC"))

 S NOTNUM=+$G(^TMP("BGPMU0067",$J,BGPMUTF,"NOT"))

 S PTCNT=TOTALS

 S PTCNT=PTCNT+1

 S (DEN,DXTIME)=""

 S DENCT=DENCT+1 S ^TMP("BGPMU0067",$J,BGPMUTF,"DEN")=DENCT

 I $P(CAD,U,3)'="" S DXTIME=$$DATE^BGPMUUTL($P(CAD,U,3))

 S DEN=$P(CAD,U,2)_DXTIME_";EN:"_STRING(1)

 I $D(STRING(2)) S DEN=DEN_";EN:"_STRING(2)

 I +EXC D

 .S EXCCT=EXCCT+1 S ^TMP("BGPMU0067",$J,BGPMUTF,"EXC")=EXCCT

 .I BGPMUTF="C" S ^TMP("BGPMU0067",$J,"PAT",BGPMUTF,"EXC",PTCNT)=DFN_U_DEN_U_"EXCLUDE"

 I +NUM D

 .S NUMCT=NUMCT+1 S ^TMP("BGPMU0067",$J,BGPMUTF,"NUM")=NUMCT

 .I BGPMUTF="C" S ^TMP("BGPMU0067",$J,"PAT",BGPMUTF,"NUM",PTCNT)=DFN_U_DEN_U_"M:MED;"_$P(NUM,U,3)

 I +NUM=0&(EXC=0) D

 .S NOTNUM=NOTNUM+1 S ^TMP("BGPMU0067",$J,BGPMUTF,"NOT")=NOTNUM

 .I BGPMUTF="C" S ^TMP("BGPMU0067",$J,"PAT",BGPMUTF,"NOT",PTCNT)=DFN_U_DEN_U_"NM:"_$P(NUM,U,2)_";"_$P(NUM,U,3)

 S ^TMP("BGPMU0067",$J,BGPMUTF,"TOT")=PTCNT

 ;Setup iCare array for patient

 S BGPICARE("MU.EP.0067.1",BGPMUTF)=1_U_+NUM_U_+EXC_U_DEN_";"_$P(NUM,U,2)_";"_$P(NUM,U,3)

 Q

CAD(DFN,CADDATE)    ; Get the denominator

 N RESULT,CADA,CADB,CADDX,CADSUR,DOB

 S RESULT=0

 ;Check for coronary artery disease

 S DOB=$$GET1^DIQ(2,DFN,.03,"I")

 S CADA=$$LASTDX^BGPMUUT2(DFN,"",CADDATE,"BGPMU CAD DX")

 S CADB=$$PLTAX^BGPMUUT1(DFN,"BGPMU CAD DX","C",CADDATE)

 I +CADA S CADDX=CADA

 I +CADB S CADDX=CADB

 I +CADA!(+CADB) S RESULT=1_U_"CAD:"_U_$P(CADDX,U,3) Q RESULT

 ;Check for cardiac surgery

 S CADSUR=$$CPT^BGPMUUT1(DFN,DOB,CADDATE,"BGPMU CARDIAC SURGERY CPT")

 I +CADSUR S RESULT=1_U_"CSP:"_U_$P(CADSUR,U,3)

 Q RESULT

EXCEPT(VIEN,DFN,CADDATE,BGPEDATE,CNT)   ;Find exceptions

 N FOUND,BLEED,BLEED1,REF,ALLER

 ;Check for bleeding disorder

 S (BLEED,BLEED1,ALLER,REF,FOUND)=0

 S BLEED=$$LASTDX^BGPMUUT2(DFN,"",CADDATE,"BGPMU BLEEDING COAGULATION DX")

 I +BLEED S FOUND=1_U_$P(BLEED,U,2)_U_$P(BLEED,U,3) Q FOUND

 S BLEED1=$$PLTAX^BGPMUUT1(DFN,"BGPMU BLEEDING COAGULATION DX","A")

 I +BLEED1 S FOUND=1_U_$P(BLEED1,U,2)_U_$P(BLEED1,U,3) Q FOUND

 ;Next check for allergy

 S ALLER=$$ALLER("BL117","")

 I +ALLER S FOUND=1_U_$P(ALLER,U,1)

 ;Check for refusals

 S TAX="BGPMU ANTIPLATELET NDCS"

 S REF=$$REF(.VIEN,TAX,BGPEDATE)

 I +REF S FOUND=1_U_$P(REF,U,1)

 Q FOUND

ALLER(CLASS,DRUG)   ;Check for allergies

 N AA,BB,X,Y,TEST,INAC

 S (AA,TEST)=0

 F  S AA=$O(^GMR(120.8,"B",DFN,AA)) Q:AA'>0!(+TEST=1)  D

 .I $P(^GMR(120.8,AA,0),"^",16)'=1 Q    ;Quit if not verified

 .I $D(^GMR(120.8,AA,"ER")),$P(^GMR(120.8,AA,"ER"),"^",1)=1 Q

 .S INAC=$$INACTIVE^GMRADSP6(AA)

 .Q:+INAC    ;Quit if inactive

 .I DRUG'="" D

 ..S X=$P(^GMR(120.8,AA,0),"^",2) X ^%ZOSF("UPPERCASE")

 ..I (X[DRUG) S TEST="1^"_X

 .S BB=0

 .F  S BB=$O(^GMR(120.8,AA,3,"B",BB)) Q:BB'>0  D

 ..I $P(^PS(50.605,BB,0),"^",1)=CLASS S TEST="1^"_CLASS

 Q TEST

REF(VIEN,TAX,BGPEDATE)  ;Look for refusals

 N MED,VST,EVT,X

 S MED=0

 S X=999 F  S X=$O(VIEN(X),-1) Q:X=""!(+MED=1)  D

 .S VST=$P(VIEN(X),U,1)

 .S EVT=$P($P($G(^AUPNVSIT(VST,0)),U,1),".",1)

 .S MED=$$MEDREF^BGPMUUT2(DFN,EVT,BGPEDATE,TAX)

 Q MED

NUM1(DFN,BGPBDATE,BGPEDATE)     ;check for meds in numerator

 N FOUND,PMED

 S FOUND=0

 S PMED=$$FIND^BGPMUUT8(DFN,"BGPMU ANTIPLATELET NDCS",BGPBDATE,"",BGPEDATE)

 I +PMED S FOUND=2_U_$P(PMED,U,2)_U_$P(PMED,U,3)

 Q FOUND

ENTRY2 ;EP Entry point for NQA0070 for CAD and beta blockers

 N START,END,BGPNUM,BGPDEN,BGPNUM,STRING,OUTCT,NFCT,INCT

 N IEN,INV,VISIT,DATA,VDATE,VALUE,EXCEPT,FIRST,VIEN,EXCEPT,RESULT

 N CNT,DIAB,NUM,EXC,DIAB,OUTENC,NFENC,INENC,CADDX

 S (BGPDEN,BGPNUM,RESULT)=0

 S START=9999999-BGPBDATE,END=9999999-BGPEDATE,VALUE=0

 S START=START_".2359"

 S STRING="",CADDX=0

 S (CAD,EXC,NUM)=0

 ;Pts must be >18 

 ;No need to check further if no age match

 Q:BGPAGEE<18

 S (CNT,OUTCT,NFCT,INCT)=0

 S FIRST=END-0.1 F  S FIRST=$O(^AUPNVSIT("AA",DFN,FIRST)) Q:FIRST=""!($P(FIRST,".",1)>START)  D

 .S IEN=0 F  S IEN=$O(^AUPNVSIT("AA",DFN,FIRST,IEN)) Q:'+IEN  D

 ..;Check provider, Only visits for chosen provider

 ..Q:'$$PRV^BGPMUUT1(IEN,BGPPROV)

 ..S OUTENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU ENCOUNTER OUTPT")

 ..I +OUTENC S OUTCT=OUTCT+1

 ..S NFENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU NURSING FAC EM")

 ..I +NFENC S NFCT=NFCT+1

 ..S INENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU ENC CAD INPATIENT CPT")

 ..I +INENC S INCT=INCT+1

 ..I +OUTENC!(+NFENC)!(+INENC) 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)

 ;Next check to see if the patient is in the denominator

 ;Denominator is that the pt has DX of CAD or cardiac surgery before found visits

 I OUTCT>1!(NFCT>1)!(INCT>0) D

 .S CADDATE=$P($P($G(VIEN(1)),U,2),".")

 .S CAD=$$CADMI(DFN,CADDATE,CNT)

 .I +CAD D

 ..;If the patient had CAD, check to see if they are in the numerator

 ..S NUM=$$NUM2(DFN,BGPBDATE,BGPEDATE)

 ..;If not in the numerator,see if they are an exception

 ..I +NUM=0 S EXC=$$EXCEPT2(.VIEN,DFN,CADDATE,BGPEDATE,CNT)

 ..D TOTAL2(DFN,CAD,NUM,EXC)

 Q

TOTAL2(DFN,CAD,NUM,EXC) ;See where this patient ends up

 N PTCNT,EXCCT,DENCT,NUMCT,NOTNUM,TOTALS,DXTIME,DEN

 S TOTALS=$G(^TMP("BGPMU0070",$J,BGPMUTF,"TOT"))

 S DENCT=+$G(^TMP("BGPMU0070",$J,BGPMUTF,"DEN"))

 S NUMCT=+$G(^TMP("BGPMU0070",$J,BGPMUTF,"NUM"))

 S EXCCT=+$G(^TMP("BGPMU0070",$J,BGPMUTF,"EXC"))

 S NOTNUM=+$G(^TMP("BGPMU0070",$J,BGPMUTF,"NOT"))

 S PTCNT=TOTALS

 S PTCNT=PTCNT+1

 S (DEN,DXTIME)=""

 S DENCT=DENCT+1 S ^TMP("BGPMU0070",$J,BGPMUTF,"DEN")=DENCT

 I $P(CAD,U,3)'="" S DXTIME=$$DATE^BGPMUUTL($P(CAD,U,3))

 S DEN=$P(CAD,U,2)_DXTIME_";EN:"_STRING(1)

 I $D(STRING(2)) S DEN=DEN_";EN:"_STRING(2)

 I +EXC D

 .S EXCCT=EXCCT+1 S ^TMP("BGPMU0070",$J,BGPMUTF,"EXC")=EXCCT

 .I BGPMUTF="C" S ^TMP("BGPMU0070",$J,"PAT",BGPMUTF,"EXC",PTCNT)=DFN_U_DEN_U_"EXCLUDE"

 I +NUM D

 .S NUMCT=NUMCT+1 S ^TMP("BGPMU0070",$J,BGPMUTF,"NUM")=NUMCT

 .I BGPMUTF="C" S ^TMP("BGPMU0070",$J,"PAT",BGPMUTF,"NUM",PTCNT)=DFN_U_DEN_U_"M:MED;"_$P(NUM,U,3)

 I +NUM=0&(EXC=0) D

 .S NOTNUM=NOTNUM+1 S ^TMP("BGPMU0070",$J,BGPMUTF,"NOT")=NOTNUM

 .I BGPMUTF="C" S ^TMP("BGPMU0070",$J,"PAT",BGPMUTF,"NOT",PTCNT)=DFN_U_DEN_U_"NM:"_$P(NUM,U,2)_";"_$P(NUM,U,3)

 S ^TMP("BGPMU0070",$J,BGPMUTF,"TOT")=PTCNT

 ;Setup iCare array for patient

 S BGPICARE("MU.EP.0070.1",BGPMUTF)=1_U_+NUM_U_+EXC_U_DEN_";"_$P(NUM,U,2)_";"_$P(NUM,U,3)

 Q

CADMI(DFN,CADDATE,CNT)    ; Get the denominator

 N RESULT,CADA,CADB,CADDX,CADSUR,DOB,MIFND,I

 S RESULT=0,MIFND=0,CADDX=0

 S DOB=$$GET1^DIQ(2,DFN,.03,"I")

 ;Check for coronary artery disease

 S I=CNT+1 F  S I=$O(VIEN(I),-1) Q:I=""!(+RESULT)  D

 .S CADDATE=$P($G(VIEN(I)),U,2)

 .S CADA=$$LASTDX^BGPMUUT2(DFN,"",CADDATE,"BGPMU CAD-NO MI DX")

 .S CADB=$$PLTAX^BGPMUUT1(DFN,"BGPMU CAD-NO MI DX","C",CADDATE)

 .I +CADA S CADDX=1_U_"CAD:"_U_$P(CADA,U,3)

 .I +CADB S CADDX=1_U_"CAD:"_U_$P(CADB,U,3)

 .;Check for cardiac surgery 

 .I +CADDX=0 D

 ..S CADSUR=$$CPT^BGPMUUT1(DFN,DOB,CADDATE,"BGPMU CARDIAC SURGERY CPT")

 ..I +CADSUR S CADDX=1_U_"CSP:"_U_$P(CADSUR,U,3)

 .;If pt has CAD or cardiac surgery, find previous heart attack

 .I +CADDX D

 ..S MIFND=$$MI(DFN,CADDATE)

 ..I +MIFND D

 ...I $P(MIFND,U,3)<CADDATE S RESULT=CADDX

 Q RESULT

MI(DFN,CADDATE)  ;Find MI diagnoses only inactive problem

 N FOUND,MIA,MIB

 S FOUND=0

 ; MIA=$$LASTDX^BGPMUUT2(DFN,"",CADDATE,"BGPMU MI DX")

 S MIB=$$PLTAX^BGPMUUT1(DFN,"BGPMU MI DX","I",CADDATE)

 ;I +MIA S FOUND=1_U_$P(MIA,U,2)_U_$P(MIA,U,3)

 I +MIB S FOUND=1_U_$P(MIB,U,2)_U_$P(MIB,U,3)

 Q FOUND

EXCEPT2(VIEN,DFN,CADDATE,BGPEDATE,CNT)   ;Find exceptions

 N RESULT,ARRY,HYPO,ASTHMA,BRADY,ATRESIA,MONITOR,PACE,PACE1,AVBLOCK

 ;Check for arrythmia

 S RESULT=0

 S ARRY=$$DXCK(DFN,"BGPMU ARRHYTHMIA DX",CADDATE)

 I +ARRY S RESULT=ARRY Q RESULT

 ;Check for hypotension

 S HYPO=$$DXCK(DFN,"BGPMU HYPOTENSION DX",CADDATE)

 I +HYPO S RESULT=HYPO Q RESULT

 ;Check for asthma

 S ASTHMA=$$DXCK(DFN,"BGPMU ASTHMA DX ICD",CADDATE)

 I +ASTHMA S RESULT=ASTHMA Q RESULT

 ;Check for bradycardia

 S BRADY=$$DXCK(DFN,"BGPMU BRADYCARDIA DX",CADDATE)

 I +BRADY S RESULT=BRADY Q RESULT

 ;Check for atresia and stenosis of the aorta

 S ATRESIA=$$DXCK(DFN,"BGPMU ATRESIA STENOSIS DX",CADDATE)

 I +ATRESIA S RESULT=ATRESIA Q RESULT

 ;Check for av block

 S AVBLOCK=$$DXCK(DFN,"BGPMU AV BLOCK DX",CADDATE)

 I +AVBLOCK D

 .S PACE=$$LASTPRC^BGPMUUT2(DFN,"",BGPEDATE,"BGPMU CARDIAC PACER ICD0")

 .S PACE1=$$DXCK(DFN,"BGPMU CARDIAC PACER IN SITU DX",BGPEDATE)

 .I PACE=0&(PACE1=0) S RESULT=AVBLOCK

 I +RESULT Q RESULT

 ;Check for monitoring

 S MONITOR=$$LASTPRC^BGPMUUT2(DFN,BGPBDATE,BGPEDATE,"BGPMU CARDIAC MONITORING ICD0")

 I +MONITOR S RESULT=MONITOR Q RESULT

 S MONITOR=$$CPT^BGPMUUT1(DFN,BGPBDATE,BGPEDATE,"BGPMU CARDIAC MONITORING CPT")

 I +MONITOR S RESULT=MONITOR Q RESULT

 ;Next check for allergy

 S ALLER=$$ALLER("CV100","")

 I +ALLER S RESULT=1_U_$P(ALLER,U,1) Q RESULT

 ;Check for refusals

 S TAX="BGPMU BETABLOCKER NDCS"

 S REF=$$REF(.VIEN,TAX,BGPEDATE)

 I +REF S RESULT=1_U_$P(REF,U,1) Q RESULT

 S RESULT=$$PULSE(DFN)

 Q RESULT

DXCK(DFN,TAX,CKDATE)  ;Find dx on problem list or POV

 N A1,A2,FOUND

 S FOUND=0

 S A1=$$LASTDX^BGPMUUT2(DFN,"",CKDATE,TAX)

 I +A1 S FOUND=1_U_$P(A1,U,2)_U_$P(A1,U,3) Q FOUND

 S A2=$$PLTAX^BGPMUUT1(DFN,TAX,"C")

 I +A2 S FOUND=1_U_$P(A2,U,2)_U_$P(A2,U,3)

 Q FOUND

NUM2(DFN,BGPBDATE,BGPEDATE)     ;check for meds in numerator

 N FOUND,PMED

 S FOUND=0

 S PMED=$$FIND^BGPMUUT8(DFN,"BGPMU BETABLOCKER NDCS",BGPBDATE,"",BGPEDATE)

 I +PMED S FOUND=2_U_$P(PMED,U,2)_U_$P(PMED,U,3)

 Q FOUND

PULSE(DFN)  ;Search for any 2 consecutive pulse measurements less than 50

 N FOUND,X,PU,MTYP,IEN,SAVE,CNT,X,YR2

 S FOUND=0,CNT=0,SAVE=0

 S MTYP="" S MTYP=$O(^AUTTMSR("B","PU",MTYP))

 N X1,X2,X S X1=BGPEDATE,X2=-672 D C^%DTC S YR2=X

 S X=9999999-BGPEDATE,END=9999999-YR2

 F  S X=$O(^AUPNVMSR("AA",DFN,MTYP,X)) Q:X=""!(+FOUND)!(X>END)  D

 .S IEN="" F  S IEN=$O(^AUPNVMSR("AA",DFN,MTYP,X,IEN)) Q:IEN=""!(+FOUND)  D

 ..S VST=$P($G(^AUPNVMSR(IEN,0)),U,3)

 ..I $P($G(^AUPNVMSR(IEN,0)),U,4)<50 D

 ...I SAVE=0 S SAVE=VST

 ...I SAVE=VST Q

 ...I SAVE'=VST S FOUND=1_U_"PULSE"

 ..I $P($G(^AUPNVMSR(IEN,0)),U,4)>49 D

 ...I SAVE>0&(SAVE'=VST) S SAVE=0

 Q FOUND

BGPMUA10  ; IHS/MSC/MGH - MI measure NQF0067 & NQF0070 ;11-Jul-2011 10:50;DU

 +1       ;;11.1;IHS CLINICAL REPORTING SYSTEM;**1**;JUN 27, 2011;Build 106

 +2       ;Code to collect meaningful use reports

ENTRY1    ;EP Entry point for NQA0067 for CAD and antiplatelet therapy

 +1        NEW START,END,BGPNUM,BGPDEN,BGPNUM,STRING,OUTCT,NFCT,INCT

 +2        NEW IEN,INV,VISIT,DATA,VDATE,VALUE,EXCEPT,FIRST,VIEN,EXCEPT,RESULT

 +3        NEW CNT,DIAB,NUM,EXC,DIAB,OUTENC,NFENC,INENC,CADDX

 +4        SET (BGPDEN,BGPNUM,RESULT)=0

 +5        SET START=9999999-BGPBDATE

           SET END=9999999-BGPEDATE

           SET VALUE=0

 +6        SET START=START_".2359"

 +7        SET STRING=""

           SET CADDX=0

 +8        SET (CAD,EXC,NUM)=0

 +9       ;Pts must be >18 

 +10      ;No need to check further if no age match

 +11       IF BGPAGEE<18

               QUIT 

 +12       SET (CNT,OUTCT,NFCT,INCT)=0

 +13       SET FIRST=END-0.1

           FOR 

               SET FIRST=$ORDER(^AUPNVSIT("AA",DFN,FIRST))

               IF FIRST=""!($PIECE(FIRST,".",1)>START)

                   QUIT 

               Begin DoDot:1

 +14               SET IEN=0

                   FOR 

                       SET IEN=$ORDER(^AUPNVSIT("AA",DFN,FIRST,IEN))

                       IF '+IEN

                           QUIT 

                       Begin DoDot:2

 +15      ;Check provider, Only visits for chosen provider

 +16                       IF '$$PRV^BGPMUUT1(IEN,BGPPROV)

                               QUIT 

 +17                       SET OUTENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU ENCOUNTER OUTPT")

 +18                       IF +OUTENC

                               SET OUTCT=OUTCT+1

 +19                       SET NFENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU NURSING FAC EM")

 +20                       IF +NFENC

                               SET NFCT=NFCT+1

 +21                       SET INENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU ENC CAD INPATIENT CPT")

 +22                       IF +INENC

                               SET INCT=INCT+1

 +23                       IF +OUTENC!(+NFENC)!(+INENC)

                               Begin DoDot:3

 +24                               SET VDATE=$PIECE($GET(^AUPNVSIT(IEN,0)),U,1)

 +25                               SET CNT=CNT+1

 +26                               SET VIEN(CNT)=IEN_U_VDATE_U_$$DATE^BGPMUUTL(VDATE)

 +27                               SET STRING(CNT)=$$DATE^BGPMUUTL(VDATE)

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +28      ;Next check to see if the patient is in the denominator

 +29      ;Denominator is that the pt has DX of CAD or cardiac surgery before found visits

 +30       IF OUTCT>1!(NFCT>1)!(INCT>0)

               Begin DoDot:1

 +31               SET CADDATE=$PIECE($PIECE($GET(VIEN(1)),U,2),".")

 +32               SET CAD=$$CAD(DFN,CADDATE)

 +33               IF +CAD

                       Begin DoDot:2

 +34      ;If the patient had CAD, check to see if they are in the numerator

 +35                       SET NUM=$$NUM1(DFN,BGPBDATE,BGPEDATE)

 +36      ;If not in the numerator,see if they are an exception

 +37                       IF +NUM=0

                               SET EXC=$$EXCEPT(.VIEN,DFN,CADDATE,BGPEDATE,CNT)

 +38                       DO TOTAL1(DFN,CAD,NUM,EXC)

                       End DoDot:2

               End DoDot:1

 +39       QUIT 

TOTAL1(DFN,CAD,NUM,EXC) ;See where this patient ends up

 +1        NEW PTCNT,EXCCT,DENCT,NUMCT,NOTNUM,TOTALS,DXTIME,DEN

 +2        SET TOTALS=$GET(^TMP("BGPMU0067",$JOB,BGPMUTF,"TOT"))

 +3        SET DENCT=+$GET(^TMP("BGPMU0067",$JOB,BGPMUTF,"DEN"))

 +4        SET NUMCT=+$GET(^TMP("BGPMU0067",$JOB,BGPMUTF,"NUM"))

 +5        SET EXCCT=+$GET(^TMP("BGPMU0067",$JOB,BGPMUTF,"EXC"))

 +6        SET NOTNUM=+$GET(^TMP("BGPMU0067",$JOB,BGPMUTF,"NOT"))

 +7        SET PTCNT=TOTALS

 +8        SET PTCNT=PTCNT+1

 +9        SET (DEN,DXTIME)=""

 +10       SET DENCT=DENCT+1

           SET ^TMP("BGPMU0067",$JOB,BGPMUTF,"DEN")=DENCT

 +11       IF $PIECE(CAD,U,3)'=""

               SET DXTIME=$$DATE^BGPMUUTL($PIECE(CAD,U,3))

 +12       SET DEN=$PIECE(CAD,U,2)_DXTIME_";EN:"_STRING(1)

 +13       IF $DATA(STRING(2))

               SET DEN=DEN_";EN:"_STRING(2)

 +14       IF +EXC

               Begin DoDot:1

 +15               SET EXCCT=EXCCT+1

                   SET ^TMP("BGPMU0067",$JOB,BGPMUTF,"EXC")=EXCCT

 +16               IF BGPMUTF="C"

                       SET ^TMP("BGPMU0067",$JOB,"PAT",BGPMUTF,"EXC",PTCNT)=DFN_U_DEN_U_"EXCLUDE"

               End DoDot:1

 +17       IF +NUM

               Begin DoDot:1

 +18               SET NUMCT=NUMCT+1

                   SET ^TMP("BGPMU0067",$JOB,BGPMUTF,"NUM")=NUMCT

 +19               IF BGPMUTF="C"

                       SET ^TMP("BGPMU0067",$JOB,"PAT",BGPMUTF,"NUM",PTCNT)=DFN_U_DEN_U_"M:MED;"_$PIECE(NUM,U,3)

               End DoDot:1

 +20       IF +NUM=0&(EXC=0)

               Begin DoDot:1

 +21               SET NOTNUM=NOTNUM+1

                   SET ^TMP("BGPMU0067",$JOB,BGPMUTF,"NOT")=NOTNUM

 +22               IF BGPMUTF="C"

                       SET ^TMP("BGPMU0067",$JOB,"PAT",BGPMUTF,"NOT",PTCNT)=DFN_U_DEN_U_"NM:"_$PIECE(NUM,U,2)_";"_$PIECE(NUM,U,3)

               End DoDot:1

 +23       SET ^TMP("BGPMU0067",$JOB,BGPMUTF,"TOT")=PTCNT

 +24      ;Setup iCare array for patient

 +25       SET BGPICARE("MU.EP.0067.1",BGPMUTF)=1_U_+NUM_U_+EXC_U_DEN_";"_$PIECE(NUM,U,2)_";"_$PIECE(NUM,U,3)

 +26       QUIT 

CAD(DFN,CADDATE) ; Get the denominator

 +1        NEW RESULT,CADA,CADB,CADDX,CADSUR,DOB

 +2        SET RESULT=0

 +3       ;Check for coronary artery disease

 +4        SET DOB=$$GET1^DIQ(2,DFN,.03,"I")

 +5        SET CADA=$$LASTDX^BGPMUUT2(DFN,"",CADDATE,"BGPMU CAD DX")

 +6        SET CADB=$$PLTAX^BGPMUUT1(DFN,"BGPMU CAD DX","C",CADDATE)

 +7        IF +CADA

               SET CADDX=CADA

 +8        IF +CADB

               SET CADDX=CADB

 +9        IF +CADA!(+CADB)

               SET RESULT=1_U_"CAD:"_U_$PIECE(CADDX,U,3)

               QUIT RESULT

 +10      ;Check for cardiac surgery

 +11       SET CADSUR=$$CPT^BGPMUUT1(DFN,DOB,CADDATE,"BGPMU CARDIAC SURGERY CPT")

 +12       IF +CADSUR

               SET RESULT=1_U_"CSP:"_U_$PIECE(CADSUR,U,3)

 +13       QUIT RESULT

EXCEPT(VIEN,DFN,CADDATE,BGPEDATE,CNT) ;Find exceptions

 +1        NEW FOUND,BLEED,BLEED1,REF,ALLER

 +2       ;Check for bleeding disorder

 +3        SET (BLEED,BLEED1,ALLER,REF,FOUND)=0

 +4        SET BLEED=$$LASTDX^BGPMUUT2(DFN,"",CADDATE,"BGPMU BLEEDING COAGULATION DX")

 +5        IF +BLEED

               SET FOUND=1_U_$PIECE(BLEED,U,2)_U_$PIECE(BLEED,U,3)

               QUIT FOUND

 +6        SET BLEED1=$$PLTAX^BGPMUUT1(DFN,"BGPMU BLEEDING COAGULATION DX","A")

 +7        IF +BLEED1

               SET FOUND=1_U_$PIECE(BLEED1,U,2)_U_$PIECE(BLEED1,U,3)

               QUIT FOUND

 +8       ;Next check for allergy

 +9        SET ALLER=$$ALLER("BL117","")

 +10       IF +ALLER

               SET FOUND=1_U_$PIECE(ALLER,U,1)

 +11      ;Check for refusals

 +12       SET TAX="BGPMU ANTIPLATELET NDCS"

 +13       SET REF=$$REF(.VIEN,TAX,BGPEDATE)

 +14       IF +REF

               SET FOUND=1_U_$PIECE(REF,U,1)

 +15       QUIT FOUND

ALLER(CLASS,DRUG) ;Check for allergies

 +1        NEW AA,BB,X,Y,TEST,INAC

 +2        SET (AA,TEST)=0

 +3        FOR 

               SET AA=$ORDER(^GMR(120.8,"B",DFN,AA))

               IF AA'>0!(+TEST=1)

                   QUIT 

               Begin DoDot:1

 +4       ;Quit if not verified

                   IF $PIECE(^GMR(120.8,AA,0),"^",16)'=1

                       QUIT 

 +5                IF $DATA(^GMR(120.8,AA,"ER"))

                       IF $PIECE(^GMR(120.8,AA,"ER"),"^",1)=1

                           QUIT 

 +6                SET INAC=$$INACTIVE^GMRADSP6(AA)

 +7       ;Quit if inactive

                   IF +INAC

                       QUIT 

 +8                IF DRUG'=""

                       Begin DoDot:2

 +9                        SET X=$PIECE(^GMR(120.8,AA,0),"^",2)

                           XECUTE ^%ZOSF("UPPERCASE")

 +10                       IF (X[DRUG)

                               SET TEST="1^"_X

                       End DoDot:2

 +11               SET BB=0

 +12               FOR 

                       SET BB=$ORDER(^GMR(120.8,AA,3,"B",BB))

                       IF BB'>0

                           QUIT 

                       Begin DoDot:2

 +13                       IF $PIECE(^PS(50.605,BB,0),"^",1)=CLASS

                               SET TEST="1^"_CLASS

                       End DoDot:2

               End DoDot:1

 +14       QUIT TEST

REF(VIEN,TAX,BGPEDATE) ;Look for refusals

 +1        NEW MED,VST,EVT,X

 +2        SET MED=0

 +3        SET X=999

           FOR 

               SET X=$ORDER(VIEN(X),-1)

               IF X=""!(+MED=1)

                   QUIT 

               Begin DoDot:1

 +4                SET VST=$PIECE(VIEN(X),U,1)

 +5                SET EVT=$PIECE($PIECE($GET(^AUPNVSIT(VST,0)),U,1),".",1)

 +6                SET MED=$$MEDREF^BGPMUUT2(DFN,EVT,BGPEDATE,TAX)

               End DoDot:1

 +7        QUIT MED

NUM1(DFN,BGPBDATE,BGPEDATE) ;check for meds in numerator

 +1        NEW FOUND,PMED

 +2        SET FOUND=0

 +3        SET PMED=$$FIND^BGPMUUT8(DFN,"BGPMU ANTIPLATELET NDCS",BGPBDATE,"",BGPEDATE)

 +4        IF +PMED

               SET FOUND=2_U_$PIECE(PMED,U,2)_U_$PIECE(PMED,U,3)

 +5        QUIT FOUND

ENTRY2    ;EP Entry point for NQA0070 for CAD and beta blockers

 +1        NEW START,END,BGPNUM,BGPDEN,BGPNUM,STRING,OUTCT,NFCT,INCT

 +2        NEW IEN,INV,VISIT,DATA,VDATE,VALUE,EXCEPT,FIRST,VIEN,EXCEPT,RESULT

 +3        NEW CNT,DIAB,NUM,EXC,DIAB,OUTENC,NFENC,INENC,CADDX

 +4        SET (BGPDEN,BGPNUM,RESULT)=0

 +5        SET START=9999999-BGPBDATE

           SET END=9999999-BGPEDATE

           SET VALUE=0

 +6        SET START=START_".2359"

 +7        SET STRING=""

           SET CADDX=0

 +8        SET (CAD,EXC,NUM)=0

 +9       ;Pts must be >18 

 +10      ;No need to check further if no age match

 +11       IF BGPAGEE<18

               QUIT 

 +12       SET (CNT,OUTCT,NFCT,INCT)=0

 +13       SET FIRST=END-0.1

           FOR 

               SET FIRST=$ORDER(^AUPNVSIT("AA",DFN,FIRST))

               IF FIRST=""!($PIECE(FIRST,".",1)>START)

                   QUIT 

               Begin DoDot:1

 +14               SET IEN=0

                   FOR 

                       SET IEN=$ORDER(^AUPNVSIT("AA",DFN,FIRST,IEN))

                       IF '+IEN

                           QUIT 

                       Begin DoDot:2

 +15      ;Check provider, Only visits for chosen provider