BGPMUG02.m

BGPMUG02 ; IHS/MSC/MMT - MI measure NQF0083 ;20-Aug-2011 14:56;DU

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

 ;Code to collect meaningful use report Heart Failure Beta-Blockers

ENTRY ;EP

 N START,END,STRING,STRING2

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

 N OUTCNT,NFCNT,DEN,NUM,EXC,OUTENC,NFENC,VIENO,VIENNF,LASTVDT

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

 S START=START_".2359"

 S (HFDX,DEN,EXC,NUM)=0

 S (OUTCNT,NFCNT)=0

 ;Pts must be >=18

 ;No need to check further if no age match

 Q:BGPAGEE<18

 S BGPBIRTH=$$DOB^AUPNPAT(DFN)

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

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

 ..;Check provider, Only visits for chosen provider

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

 ..S OUTENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU BP EM")

 ..I +OUTENC D

 ...S OUTCNT=OUTCNT+1

 ...S VDATE=$P($G(^AUPNVSIT(IEN,0)),U,1)

 ...S VIENO(OUTCNT)=IEN_U_VDATE

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

 ..I +NFENC D

 ...S NFCNT=NFCNT+1

 ...S VDATE=$P($G(^AUPNVSIT(IEN,0)),U,1)

 ...S VIENNF(NFCNT)=IEN_U_VDATE

 ..I (+OUTENC!(+NFENC))&($G(LASTVDT)="") S LASTVDT=VDATE

 I OUTCNT>1 S DEN=1,STRING=";EN:"_$$DATE^BGPMUUTL($P(VIENO(1),U,2))_";EN:"_$$DATE^BGPMUUTL($P(VIENO(2),U,2))

 E  I NFCNT>1 S DEN=1,STRING=";EN:"_$$DATE^BGPMUUTL($P(VIENNF(1),U,2))_";EN:"_$$DATE^BGPMUUTL($P(VIENNF(2),U,2))

 Q:'DEN

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

 S HFDX=$$HFDX(DFN,BGPBIRTH,LASTVDT)

 I +HFDX D

 .S DENSTR="HF:"_$$DATE^BGPMUUTL($P(HFDX,U,3))_";LVEF:"_$$DATE^BGPMUUTL($P(HFDX,U,5))_STRING

 .;If the patient has Heart Failure, check to see if they are in the numerator

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

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

 .I +NUM=0 S EXC=$$EXCEPT^BGPMUA06(DFN,BGPBDATE,BGPEDATE)

 .D TOTAL(DFN,HFDX,NUM,EXC)

 Q

TOTAL(DFN,HFDX,NUM,EXC) ;See where this patient ends up

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

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

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

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

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

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

 S PTCNT=TOTALS

 S PTCNT=PTCNT+1

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

 I +NUM D

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

 .I BGPMUTF="C" S ^TMP("BGPMU0083",$J,"PAT",BGPMUTF,"NUM",PTCNT)=DFN_U_DENSTR_U_"M:MED "_$$DATE^BGPMUUTL($P(NUM,U,3))

 I +EXC D

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

 .I BGPMUTF="C" S ^TMP("BGPMU0083",$J,"PAT",BGPMUTF,"EXC",PTCNT)=DFN_U_DENSTR_U_"Excluded"

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

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

 .I BGPMUTF="C" S ^TMP("BGPMU0083",$J,"PAT",BGPMUTF,"NOT",PTCNT)=DFN_U_DENSTR_U_"NM:"

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

 ;Setup iCare array for patient",BGPMUTF)=1_U_+NUM_U_""

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

 Q

HFDX(DFN,BDATE,EDATE) ;look for Heart Failure Dx AND LVEF < 40%

 N FOUND,DXHF,PLHF,DX1,DX2,CEF,IEN,INV,MTYPE,RESULT,RDATE

 S FOUND=0,DX1=0,DX2=0,CEF=0

 ;Check for the patient having a DX or Problem of Heart Failure (ever)

 S DXHF=$$LASTDX^BGPMUUT2(DFN,BGPBIRTH,EDATE,"BGPMU HEART FAILURE DX")

 I +DXHF S DX1=DXHF

 E  D

 .S PLHF=$$PLTAX^BGPMUUT1(DFN,"BGPMU HEART FAILURE DX","C",EDATE)

 .I +PLHF S DX1=PLHF

 Q:DX1=0 0

 ;Now check for LVEF < 40%

 ;S MTYP="" S MTYP=$O(^AUTTMSR("B","HT",MTYP))  ;ZSAT: for testing; delete this line, keep next line

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

 Q:MTYP="" 0

 S INV=9999999-EDATE

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

 .S RDATE=9999999-INV

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

 ..S FOUND=1

 ..S RESULT=$P($G(^AUPNVMSR(IEN,0)),U,4)

 ..;I RESULT<80 S CEF=1_U_U_RDATE   ;ZSAT: testing; delete this line; keep next line

 ..I RESULT<40 S CEF=1_U_RESULT_U_RDATE

 I +CEF D

 .S FOUND=1_U_$P(DX1,U,2)_U_$P(DX1,U,3)_U_$P(CEF,U,2)_U_$P(CEF,U,3)

 Q FOUND

NUM(DFN,BGPBDATE,BGPEDATE) ;Look for Beta-blocker MED

 N FOUND,PMED

 S FOUND=0

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

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

 Q FOUND

EXCEPT(DFN,BDATE,EDATE) ;See if this patient has exceptions

 N RESULT,ARRY,HYPO,ASTHMA,BRADY,PACE,PACE2,AVBLOCK,MED

 S RESULT=0

 ;Check for arrythmia

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

 I +ARRY S RESULT=ARRY Q RESULT

 ;Check for hypotension

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

 I +HYPO S RESULT=HYPO Q RESULT

 ;Check for asthma

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

 I +ASTHMA S RESULT=ASTHMA Q RESULT

 ;Check for bradycardia

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

 I +BRADY S RESULT=BRADY Q RESULT

 ;Check for av block and NOT on cardiac pacemaker

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

 I +AVBLOCK D  Q:+RESULT RESULT

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

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

 .I +PACE=0&(+PACE2=0) S RESULT=AVBLOCK

 ;Next check for allergy

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

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

 ;Check for refusal of Betablockers

 S MED=$$MEDREF^BGPMUUT2(DFN,BDATE,EDATE_".2359","BGPMU BETABLOCKER NDCS")

 I +MED S RESULT=MED Q RESULT

 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

BGPMUG02  ; IHS/MSC/MMT - MI measure NQF0083 ;20-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 Heart Failure Beta-Blockers

ENTRY     ;EP

 +1        NEW START,END,STRING,STRING2

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

 +3        NEW OUTCNT,NFCNT,DEN,NUM,EXC,OUTENC,NFENC,VIENO,VIENNF,LASTVDT

 +4        SET START=9999999-BGPBDATE

           SET END=9999999-BGPEDATE

           SET VALUE=0

 +5        SET START=START_".2359"

 +6        SET (HFDX,DEN,EXC,NUM)=0

 +7        SET (OUTCNT,NFCNT)=0

 +8       ;Pts must be >=18

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

 +10       IF BGPAGEE<18

               QUIT 

 +11       SET BGPBIRTH=$$DOB^AUPNPAT(DFN)

 +12       SET FIRST=END-0.1

           FOR 

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

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

                   QUIT 

               Begin DoDot:1

 +13               SET IEN=0

                   FOR 

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

                       IF '+IEN!(OUTCNT>1)!(NFCNT>1)

                           QUIT 

                       Begin DoDot:2

 +14      ;Check provider, Only visits for chosen provider

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

                               QUIT 

 +16                       SET OUTENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU BP EM")

 +17                       IF +OUTENC

                               Begin DoDot:3

 +18                               SET OUTCNT=OUTCNT+1

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

 +20                               SET VIENO(OUTCNT)=IEN_U_VDATE

                               End DoDot:3

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

 +22                       IF +NFENC

                               Begin DoDot:3

 +23                               SET NFCNT=NFCNT+1

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

 +25                               SET VIENNF(NFCNT)=IEN_U_VDATE

                               End DoDot:3

 +26                       IF (+OUTENC!(+NFENC))&($GET(LASTVDT)="")

                               SET LASTVDT=VDATE

                       End DoDot:2

               End DoDot:1

 +27       IF OUTCNT>1

               SET DEN=1

               SET STRING=";EN:"_$$DATE^BGPMUUTL($PIECE(VIENO(1),U,2))_";EN:"_$$DATE^BGPMUUTL($PIECE(VIENO(2),U,2))

 +28      IF '$TEST

               IF NFCNT>1

                   SET DEN=1

                   SET STRING=";EN:"_$$DATE^BGPMUUTL($PIECE(VIENNF(1),U,2))_";EN:"_$$DATE^BGPMUUTL($PIECE(VIENNF(2),U,2))

 +29       IF 'DEN

               QUIT 

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

 +31       SET HFDX=$$HFDX(DFN,BGPBIRTH,LASTVDT)

 +32       IF +HFDX

               Begin DoDot:1

 +33               SET DENSTR="HF:"_$$DATE^BGPMUUTL($PIECE(HFDX,U,3))_";LVEF:"_$$DATE^BGPMUUTL($PIECE(HFDX,U,5))_STRING

 +34      ;If the patient has Heart Failure, check to see if they are in the numerator

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

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

 +37               IF +NUM=0

                       SET EXC=$$EXCEPT^BGPMUA06(DFN,BGPBDATE,BGPEDATE)

 +38               DO TOTAL(DFN,HFDX,NUM,EXC)

               End DoDot:1

 +39       QUIT 

TOTAL(DFN,HFDX,NUM,EXC) ;See where this patient ends up

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

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

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

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

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

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

 +7        SET PTCNT=TOTALS

 +8        SET PTCNT=PTCNT+1

 +9        SET DENCT=DENCT+1

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

 +10       IF +NUM

               Begin DoDot:1

 +11               SET NUMCT=NUMCT+1

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

 +12               IF BGPMUTF="C"

                       SET ^TMP("BGPMU0083",$JOB,"PAT",BGPMUTF,"NUM",PTCNT)=DFN_U_DENSTR_U_"M:MED "_$$DATE^BGPMUUTL($PIECE(NUM,U,3))

               End DoDot:1

 +13       IF +EXC

               Begin DoDot:1

 +14               SET EXCCT=EXCCT+1

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

 +15               IF BGPMUTF="C"

                       SET ^TMP("BGPMU0083",$JOB,"PAT",BGPMUTF,"EXC",PTCNT)=DFN_U_DENSTR_U_"Excluded"

               End DoDot:1

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

               Begin DoDot:1

 +17               SET NOTNUM=NOTNUM+1

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

 +18               IF BGPMUTF="C"

                       SET ^TMP("BGPMU0083",$JOB,"PAT",BGPMUTF,"NOT",PTCNT)=DFN_U_DENSTR_U_"NM:"

               End DoDot:1

 +19       SET ^TMP("BGPMU0083",$JOB,BGPMUTF,"TOT")=PTCNT

 +20      ;Setup iCare array for patient",BGPMUTF)=1_U_+NUM_U_""

 +21       SET BGPICARE("MU.EP.0083.1",BGPMUTF)=1_U_+NUM_U_+EXC_U_DENSTR_";"_$PIECE(NUM,U,2)_";"_$PIECE(NUM,U,3)

 +22       QUIT 

HFDX(DFN,BDATE,EDATE) ;look for Heart Failure Dx AND LVEF < 40%

 +1        NEW FOUND,DXHF,PLHF,DX1,DX2,CEF,IEN,INV,MTYPE,RESULT,RDATE

 +2        SET FOUND=0

           SET DX1=0

           SET DX2=0

           SET CEF=0

 +3       ;Check for the patient having a DX or Problem of Heart Failure (ever)

 +4        SET DXHF=$$LASTDX^BGPMUUT2(DFN,BGPBIRTH,EDATE,"BGPMU HEART FAILURE DX")

 +5        IF +DXHF

               SET DX1=DXHF

 +6       IF '$TEST

               Begin DoDot:1

 +7                SET PLHF=$$PLTAX^BGPMUUT1(DFN,"BGPMU HEART FAILURE DX","C",EDATE)

 +8                IF +PLHF

                       SET DX1=PLHF

               End DoDot:1

 +9        IF DX1=0

               QUIT 0

 +10      ;Now check for LVEF < 40%

 +11      ;S MTYP="" S MTYP=$O(^AUTTMSR("B","HT",MTYP))  ;ZSAT: for testing; delete this line, keep next line

 +12       SET MTYP=""

           SET MTYP=$ORDER(^AUTTMSR("B","CEF",MTYP))

 +13       IF MTYP=""

               QUIT 0

 +14       SET INV=9999999-EDATE

 +15       FOR 

               SET INV=$ORDER(^AUPNVMSR("AA",DFN,MTYP,INV))

               IF '+INV!(+FOUND)

                   QUIT 

               Begin DoDot:1

 +16               SET RDATE=9999999-INV

 +17               SET IEN=0

                   FOR 

                       SET IEN=$ORDER(^AUPNVMSR("AA",DFN,MTYP,INV,IEN))

                       IF IEN=""!(+FOUND)

                           QUIT 

                       Begin DoDot:2

 +18                       SET FOUND=1

 +19                       SET RESULT=$PIECE($GET(^AUPNVMSR(IEN,0)),U,4)

 +20      ;I RESULT<80 S CEF=1_U_U_RDATE   ;ZSAT: testing; delete this line; keep next line

 +21                       IF RESULT<40

                               SET CEF=1_U_RESULT_U_RDATE

                       End DoDot:2

               End DoDot:1

 +22       IF +CEF

               Begin DoDot:1

 +23               SET FOUND=1_U_$PIECE(DX1,U,2)_U_$PIECE(DX1,U,3)_U_$PIECE(CEF,U,2)_U_$PIECE(CEF,U,3)

               End DoDot:1

 +24       QUIT FOUND

NUM(DFN,BGPBDATE,BGPEDATE) ;Look for Beta-blocker MED

 +1        NEW FOUND,PMED

 +2        SET FOUND=0

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

 +4        IF +PMED

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

 +5        QUIT FOUND

EXCEPT(DFN,BDATE,EDATE) ;See if this patient has exceptions

 +1        NEW RESULT,ARRY,HYPO,ASTHMA,BRADY,PACE,PACE2,AVBLOCK,MED

 +2        SET RESULT=0

 +3       ;Check for arrythmia

 +4        SET ARRY=$$DXCK(DFN,"BGPMU ARRHYTHMIA DX",EDATE)

 +5        IF +ARRY

               SET RESULT=ARRY

               QUIT RESULT

 +6       ;Check for hypotension

 +7        SET HYPO=$$DXCK(DFN,"BGPMU HYPOTENSION DX",EDATE)

 +8        IF +HYPO

               SET RESULT=HYPO

               QUIT RESULT

 +9       ;Check for asthma

 +10       SET ASTHMA=$$DXCK(DFN,"BGPMU ASTHMA DX ICD",EDATE)

 +11       IF +ASTHMA

               SET RESULT=ASTHMA

               QUIT RESULT

 +12      ;Check for bradycardia

 +13       SET BRADY=$$DXCK(DFN,"BGPMU BRADYCARDIA DX",EDATE)

 +14       IF +BRADY

               SET RESULT=BRADY

               QUIT RESULT

 +15      ;Check for av block and NOT on cardiac pacemaker

 +16       SET AVBLOCK=$$DXCK(DFN,"BGPMU AV BLOCK DX",EDATE)

 +17       IF +AVBLOCK

               Begin DoDot:1

 +18               SET PACE=$$LASTPRC^BGPMUUT2(DFN,"",BGPEDATE,"BGPMU CARDIAC PACER ICD0")

 +19               SET PACE2=$$DXCK(DFN,"BGPMU CARDIAC PACER IN SITU DX",EDATE)

 +20               IF +PACE=0&(+PACE2=0)

                       SET RESULT=AVBLOCK

               End DoDot:1

               IF +RESULT

                   QUIT RESULT

 +21      ;Next check for allergy

 +22       SET ALLER=$$ALLER^BGPMUA10("CV100","")

 +23       IF +ALLER

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

               QUIT RESULT

 +24      ;Check for refusal of Betablockers

 +25       SET MED=$$MEDREF^BGPMUUT2(DFN,BDATE,EDATE_".2359","BGPMU BETABLOCKER NDCS")

 +26       IF +MED

               SET RESULT=MED

               QUIT RESULT

 +27       QUIT RESULT

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

 +1        NEW A1,A2,FOUND

 +2        SET FOUND=0

 +3        SET A1=$$LASTDX^BGPMUUT2(DFN,"",CKDATE,TAX)

 +4        IF +A1

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

               QUIT FOUND

 +5        SET A2=$$PLTAX^BGPMUUT1(DFN,TAX,"C")

 +6        IF +A2

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

 +7        QUIT FOUND