BGPMUD02 ; IHS/MSC/SAT - MU measure NQF0028B ;28-Dec-2010 16:14;DU
;;11.1;IHS CLINICAL REPORTING SYSTEM;**1**;JUN 27, 2011;Build 106
;code to collect meaningful use report tobacco use assessment
ENTRY ;EP
; expects:
; DFN = patient code from VA PATIENT file
; BGPBDATE = begin date of report
; BGPEDATE = end date of report
; BGPPROV = provider code from NEW PERSON file
; BGPMUTF = timeframe variable - "C"=current year; "P"=previous year; "B"=baseline year
N BGPDIEN,BGPDIFN,BGP1,BGP2,BGP3,BGPDEN,BGPNUM,BGPDT,BGPAGEE,END,FIRST,IEN,START,VDATE,VIEN
N BGPHFI
S BGPDEN=0
S BGPNUM=0
S BGPNSTR="" ; <NDC code> OR <CPT code> ; [date in FM format]
S BGPDSTR=""
;Pts must be 18 and older
S BGPAGEE=$$AGE^AUPNPAT(DFN,BGPBDATE)
;No need to check further on children
Q:BGPAGEE<18
;
S START=9999999-BGPBDATE,END=9999999-BGPEDATE
;look for 2 visits with E&M codes
; OR 1 visit with E&M codes
S BGP1=""
S BGP2=""
S FIRST=END-0.1 F S FIRST=$O(^AUPNVSIT("AA",DFN,FIRST)) Q:FIRST=""!($P(FIRST,".",1)>START) D Q:($L(BGP2,";")>1)!(BGP1'="")
.S VIEN=0 F S VIEN=$O(^AUPNVSIT("AA",DFN,FIRST,VIEN)) Q:'+VIEN D Q:($L(BGP2,";")>1)!(BGP1'="")
..S BGPDT=$P($P($G(^AUPNVSIT(VIEN,0)),U,1),".",1)
..;Check provider, determine if there are visits with E&M codes
..I $$PRV^BGPMUUT1(VIEN,BGPPROV) D
...D EM2^BGPMUD01(DFN,VIEN,.BGP2,BGPDT) ;determine if there are visits that have at least one of the E&M codes where 2 are necessary
...D EM1^BGPMUD01(DFN,VIEN,.BGP1,BGPDT) ;determine if there are visits that have at least one of the E&M codes where only 1 is necessary
;TEST
;quit if visits with E&M code(s) not found for given DFN
Q:(BGP1="")&(BGP2="")
Q:(BGP1="")&($L(BGP2,";")'>1)
;getting here means this patient has been screened for Tobacco Use
;
;combine BGP1 and BPG2 into one string
S BGPDSTR=$S(BGP2'="":BGP2_$S(BGP1'="":";"_BGP1,1:""),1:BGP1)
;
;determine if this patient is a Tobacco User
N BGPH,BGPHF,BGPTOBN,BGPTOBU
S BGPHF=0 ;health factor found flag
S BGPTOBU=1
D HFA^BGPMUD01(.BGPTOBU)
S START=9999999-$$FMADD^XLFDT(BGPBDATE,-730)
S FIRST=END-0.1 F S FIRST=$O(^AUPNVSIT("AA",DFN,FIRST)) Q:FIRST=""!($P(FIRST,".",1)>START) D Q:BGPHF
.S VIEN=0 F S VIEN=$O(^AUPNVSIT("AA",DFN,FIRST,VIEN)) Q:'+VIEN D Q:BGPHF
..S BGPIEN="" F S BGPIEN=$O(^AUPNVHF("AD",VIEN,BGPIEN)) Q:'+BGPIEN D
...S BGPHNOD=$G(^AUPNVHF(BGPIEN,0))
...S BGPHFI=$P(BGPHNOD,U,1)
...S BGPH="" F S BGPH=$O(BGPTOBU(BGPH)) Q:BGPH="" Q:BGPHF I BGPHFI=BGPH S BGPHF=1_";"_$P($P($G(^AUPNVHF(BGPIEN,12)),U,1),".",1)
I BGPHF D
.S BGPDEN=1 ;patient is in the denominator - patient has been screened for Tobacco Use AND is a Tobacco User
.S BGPDSTR=BGPDSTR_":"_$P(BGPHF,";",2)
Q:'BGPDEN
;
;determine if patient is participating in a smoking cessation program (numerator)
; BGP3 = [CPT code] ; date in FM format
S BGP3=""
S FIRST=END-0.1 F S FIRST=$O(^AUPNVSIT("AA",DFN,FIRST)) Q:FIRST=""!($P(FIRST,".",1)>START) D Q:BGP3>0
.S VIEN=0 F S VIEN=$O(^AUPNVSIT("AA",DFN,FIRST,VIEN)) Q:'+VIEN D Q:BGP3>0
..;S BGPDT=9999999-FIRST ;convert date to fileman format
..S BGPDT=$P($P($G(^AUPNVSIT(VIEN,0)),U,1),".",1)
..D EM3(DFN,BGPDT,.BGP3) ;determine if there is a visit that has a CPT code for Tobacco Use Cessation Counseling
..I BGP3>0 S BGPNUM=1 S BGPNSTR=BGP3
;determine if patient has medications that are Smoking Cessation Agents
I 'BGPNUM D
.S BGP4=0
.K ^TMP("PS",$J)
.N BGPI,BGPIFN,BGPRX0
.S BGP4=$$FIND^BGPMUUT8(DFN,"BGPMU SMOKING CESSATION AGENTS",9999999-START,"",BGPEDATE)
.;S BGP4=$$FIND^BGPMUUT4(DFN,"BGPMU SMOKING CESSATION AGENTS",9999999-START,"OP",BGPEDATE)
.S:BGP4>0 BGPNUM=1,BGPNSTR=$P(BGP4,U,2)
;D OCL^PSOORRL(DFN,9999999-START,BGPEDATE) ;collect patient's meds in ^TMP
;.S BGPI="" F S BGPI=$O(^TMP("PS",$J,BGPI)) Q:BGPI="" D
;..S BGPDIFN=$P($G(^TMP("PS",$J,BGPI,0)),U,2)
;..S BGPDIEN=$O(^PSDRUG("B",BGPDIFN,"")) ;get pointer to DRUG file
;..D NDC(BGPDIEN,.BGP4)
K ^TMP("PS",$J)
; update TOTAL
D TOTAL(DFN,BGPNUM,BGPMUTF,BGPDSTR,BGPNSTR)
;
; check these
K BGPL,BGPLWTS,BGPLHTS,%,X,BGPLWTS1,BGPLHTS1,Y,TERMINAL,NORMAL,FOLLOW,EXCEPT
Q
;
TOTAL(DFN,BGPNUM,BGPMUTF,BGPDSTR,BGPNSTR) ;See where this patient ends up
;if we got here, this patient is in the denominator
N PTCNT,DEN1CT,INCL1CT,NOT1CT,TOTALS,PT1
S TOTALS=$G(^TMP("BGPMU0028B",$J,BGPMUTF,"TOT"))
S INCL1CT=+$G(^TMP("BGPMU0028B",$J,BGPMUTF,"INCL",1))
S NOT1CT=+$G(^TMP("BGPMU0028B",$J,BGPMUTF,"NOT",1))
S DEN1CT=+$G(^TMP("BGPMU0028B",$J,BGPMUTF,"DEN",1))
S PTCNT=$P(TOTALS,U,1),PT1=$P(TOTALS,U,2)
S PTCNT=PTCNT+1
S PT1=PT1+1
I BGPDEN D
.S DEN1CT=DEN1CT+1 S ^TMP("BGPMU0028B",$J,BGPMUTF,"DEN",1)=DEN1CT
.S ^TMP("BGPMU0028B",$J,BGPMUTF,"DEN","PAT",1,PT1)=DFN_U_BGPDSTR_U_BGPNSTR
.I BGPNUM D
..S INCL1CT=INCL1CT+1
..S ^TMP("BGPMU0028B",$J,BGPMUTF,"INCL",1)=INCL1CT
..S ^TMP("BGPMU0028B",$J,BGPMUTF,"INCL","PAT",1,PT1)=DFN_U_BGPDSTR_U_BGPNSTR
.I 'BGPNUM D
..S NOT1CT=NOT1CT+1
..S ^TMP("BGPMU0028B",$J,BGPMUTF,"NOT",1)=NOT1CT
..S ^TMP("BGPMU0028B",$J,BGPMUTF,"NOT","PAT",1,PT1)=DFN_U_BGPDSTR
S ^TMP("BGPMU0028B",$J,BGPMUTF,"TOT")=PTCNT_U_PT1
Q
;
;look for NDC codes related to Tobacco use Cessation Agents
NDC(BGPDIEN,BGP4) ;
N BGPI,BGPNDC,BGPTMP
F BGPI=1:1 Q:BGP4>0 S BGPTMP=$P($T(NDCT+BGPI),";;",2) Q:BGPTMP="" S BGPNDC=$$NDC^BGPMUUT4(BGPDIEN,BGPTMP) I BGPNDC S BGP4=U_$P(BGPNDC,U,2)_U_$P($P(BGPNDC,U,3),".",1)
Q
;
;look for CPT codes related to Tobacco use Cessation Counseling
EM3(DFN,BGPDT,BGP3) ;
N BGPCPT,BGPI,BGPTMP1
S BGPTMP1=""
F BGPI=1:1 Q:BGP3>0 S BGPTMP1=$P($T(CPT3+BGPI),";;",2) Q:BGPTMP1="" S BGPCPT=$$VSTCPT^BGPMUUT1(DFN,VIEN,BGPTMP1) I BGPCPT S BGP3=$P(BGPCPT,U,2)_";"_$P($P(BGPCPT,U,3),".",1)
Q
;
CPT3 ;;
;;BGPMU TOBACCO USE CESS COUNSEL
;
NDCT ;;
;;BGPMU SMOKING CESSATION AGENTS
;
TESTC ;capture input data
; call with D:$G(^TMP("BGPMU0028B","TEST")=1 TESTC
; DFN = patient code from VA PATIENT file
; BGPBDATE = begin date of report
; BGPEDATE = end date of report
; BGPPROV = provider code from NEW PERSON file
; BGPMUTF = timeframe variable - "C"=current year; "P"=previous year; "B"=baseline year
S ^TMP("BGPMU0028B",$J,"J")=$J
S ^TMP("BGPMU0028B",$J,"DFN")=DFN
S ^TMP("BGPMU0028B",$J,"BGPBDATE")=BGPBDATE
S ^TMP("BGPMU0028B",$J,"BGPEDATE")=BGPEDATE
S ^TMP("BGPMU0028B",$J,"BGPPROV")=BGPPROV
S ^TMP("BGPMU0028B",$J,"BGPMUTF")=BGPMUTF
Q
;
TESTH ;debug
;S U="^"
;S DUZ=1
;S DT=3110217
;S DFN=184
;S DFN=158
;S BGPBDATE=3100101
;S BGPEDATE=3110401
;S BGPPROV=2
;S BGPMUTF="C"
;D ENTRY
Q
BGPMUD02 ; IHS/MSC/SAT - MU measure NQF0028B ;28-Dec-2010 16:14;DU
+1 ;;11.1;IHS CLINICAL REPORTING SYSTEM;**1**;JUN 27, 2011;Build 106
+2 ;code to collect meaningful use report tobacco use assessment
ENTRY ;EP
+1 ; expects:
+2 ; DFN = patient code from VA PATIENT file
+3 ; BGPBDATE = begin date of report
+4 ; BGPEDATE = end date of report
+5 ; BGPPROV = provider code from NEW PERSON file
+6 ; BGPMUTF = timeframe variable - "C"=current year; "P"=previous year; "B"=baseline year
+7 NEW BGPDIEN,BGPDIFN,BGP1,BGP2,BGP3,BGPDEN,BGPNUM,BGPDT,BGPAGEE,END,FIRST,IEN,START,VDATE,VIEN
+8 NEW BGPHFI
+9 SET BGPDEN=0
+10 SET BGPNUM=0
+11 ; <NDC code> OR <CPT code> ; [date in FM format]
SET BGPNSTR=""
+12 SET BGPDSTR=""
+13 ;Pts must be 18 and older
+14 SET BGPAGEE=$$AGE^AUPNPAT(DFN,BGPBDATE)
+15 ;No need to check further on children
+16 IF BGPAGEE<18
QUIT
+17 ;
+18 SET START=9999999-BGPBDATE
SET END=9999999-BGPEDATE
+19 ;look for 2 visits with E&M codes
+20 ; OR 1 visit with E&M codes
+21 SET BGP1=""
+22 SET BGP2=""
+23 SET FIRST=END-0.1
FOR
SET FIRST=$ORDER(^AUPNVSIT("AA",DFN,FIRST))
IF FIRST=""!($PIECE(FIRST,".",1)>START)
QUIT
Begin DoDot:1
+24 SET VIEN=0
FOR
SET VIEN=$ORDER(^AUPNVSIT("AA",DFN,FIRST,VIEN))
IF '+VIEN
QUIT
Begin DoDot:2
+25 SET BGPDT=$PIECE($PIECE($GET(^AUPNVSIT(VIEN,0)),U,1),".",1)
+26 ;Check provider, determine if there are visits with E&M codes
+27 IF $$PRV^BGPMUUT1(VIEN,BGPPROV)
Begin DoDot:3
+28 ;determine if there are visits that have at least one of the E&M codes where 2 are necessary
DO EM2^BGPMUD01(DFN,VIEN,.BGP2,BGPDT)
+29 ;determine if there are visits that have at least one of the E&M codes where only 1 is necessary
DO EM1^BGPMUD01(DFN,VIEN,.BGP1,BGPDT)
End DoDot:3
End DoDot:2
IF ($LENGTH(BGP2,";")>1)!(BGP1'="")
QUIT
End DoDot:1
IF ($LENGTH(BGP2,";")>1)!(BGP1'="")
QUIT
+30 ;TEST
+31 ;quit if visits with E&M code(s) not found for given DFN
+32 IF (BGP1="")&(BGP2="")
QUIT
+33 IF (BGP1="")&($LENGTH(BGP2,";")'>1)
QUIT
+34 ;getting here means this patient has been screened for Tobacco Use
+35 ;
+36 ;combine BGP1 and BPG2 into one string
+37 SET BGPDSTR=$SELECT(BGP2'="":BGP2_$SELECT(BGP1'="":";"_BGP1,1:""),1:BGP1)
+38 ;
+39 ;determine if this patient is a Tobacco User
+40 NEW BGPH,BGPHF,BGPTOBN,BGPTOBU
+41 ;health factor found flag
SET BGPHF=0
+42 SET BGPTOBU=1
+43 DO HFA^BGPMUD01(.BGPTOBU)
+44 SET START=9999999-$$FMADD^XLFDT(BGPBDATE,-730)
+45 SET FIRST=END-0.1
FOR
SET FIRST=$ORDER(^AUPNVSIT("AA",DFN,FIRST))
IF FIRST=""!($PIECE(FIRST,".",1)>START)
QUIT
Begin DoDot:1
+46 SET VIEN=0
FOR
SET VIEN=$ORDER(^AUPNVSIT("AA",DFN,FIRST,VIEN))
IF '+VIEN
QUIT
Begin DoDot:2
+47 SET BGPIEN=""
FOR
SET BGPIEN=$ORDER(^AUPNVHF("AD",VIEN,BGPIEN))
IF '+BGPIEN
QUIT
Begin DoDot:3
+48 SET BGPHNOD=$GET(^AUPNVHF(BGPIEN,0))
+49 SET BGPHFI=$PIECE(BGPHNOD,U,1)
+50 SET BGPH=""
FOR
SET BGPH=$ORDER(BGPTOBU(BGPH))
IF BGPH=""
QUIT
IF BGPHF
QUIT
IF BGPHFI=BGPH
SET BGPHF=1_";"_$PIECE($PIECE($GET(^AUPNVHF(BGPIEN,12)),U,1),".",1)
End DoDot:3
End DoDot:2
IF BGPHF
QUIT
End DoDot:1
IF BGPHF
QUIT
+51 IF BGPHF
Begin DoDot:1
+52 ;patient is in the denominator - patient has been screened for Tobacco Use AND is a Tobacco User
SET BGPDEN=1
+53 SET BGPDSTR=BGPDSTR_":"_$PIECE(BGPHF,";",2)
End DoDot:1
+54 IF 'BGPDEN
QUIT
+55 ;
+56 ;determine if patient is participating in a smoking cessation program (numerator)
+57 ; BGP3 = [CPT code] ; date in FM format
+58 SET BGP3=""
+59 SET FIRST=END-0.1
FOR
SET FIRST=$ORDER(^AUPNVSIT("AA",DFN,FIRST))
IF FIRST=""!($PIECE(FIRST,".",1)>START)
QUIT
Begin DoDot:1
+60 SET VIEN=0
FOR
SET VIEN=$ORDER(^AUPNVSIT("AA",DFN,FIRST,VIEN))
IF '+VIEN
QUIT
Begin DoDot:2
+61 ;S BGPDT=9999999-FIRST ;convert date to fileman format
+62 SET BGPDT=$PIECE($PIECE($GET(^AUPNVSIT(VIEN,0)),U,1),".",1)
+63 ;determine if there is a visit that has a CPT code for Tobacco Use Cessation Counseling
DO EM3(DFN,BGPDT,.BGP3)
+64 IF BGP3>0
SET BGPNUM=1
SET BGPNSTR=BGP3
End DoDot:2
IF BGP3>0
QUIT
End DoDot:1
IF BGP3>0
QUIT
+65 ;determine if patient has medications that are Smoking Cessation Agents
+66 IF 'BGPNUM
Begin DoDot:1
+67 SET BGP4=0
+68 KILL ^TMP("PS",$JOB)
+69 NEW BGPI,BGPIFN,BGPRX0
+70 SET BGP4=$$FIND^BGPMUUT8(DFN,"BGPMU SMOKING CESSATION AGENTS",9999999-START,"",BGPEDATE)
+71 ;S BGP4=$$FIND^BGPMUUT4(DFN,"BGPMU SMOKING CESSATION AGENTS",9999999-START,"OP",BGPEDATE)
+72 IF BGP4>0
SET BGPNUM=1
SET BGPNSTR=$PIECE(BGP4,U,2)
End DoDot:1
+73 ;D OCL^PSOORRL(DFN,9999999-START,BGPEDATE) ;collect patient's meds in ^TMP
+74 ;.S BGPI="" F S BGPI=$O(^TMP("PS",$J,BGPI)) Q:BGPI="" D
+75 ;..S BGPDIFN=$P($G(^TMP("PS",$J,BGPI,0)),U,2)
+76 ;..S BGPDIEN=$O(^PSDRUG("B",BGPDIFN,"")) ;get pointer to DRUG file
+77 ;..D NDC(BGPDIEN,.BGP4)
+78 KILL ^TMP("PS",$JOB)
+79 ; update TOTAL
+80 DO TOTAL(DFN,BGPNUM,BGPMUTF,BGPDSTR,BGPNSTR)
+81 ;
+82 ; check these
+83 KILL BGPL,BGPLWTS,BGPLHTS,%,X,BGPLWTS1,BGPLHTS1,Y,TERMINAL,NORMAL,FOLLOW,EXCEPT
+84 QUIT
+85 ;
TOTAL(DFN,BGPNUM,BGPMUTF,BGPDSTR,BGPNSTR) ;See where this patient ends up
+1 ;if we got here, this patient is in the denominator
+2 NEW PTCNT,DEN1CT,INCL1CT,NOT1CT,TOTALS,PT1
+3 SET TOTALS=$GET(^TMP("BGPMU0028B",$JOB,BGPMUTF,"TOT"))
+4 SET INCL1CT=+$GET(^TMP("BGPMU0028B",$JOB,BGPMUTF,"INCL",1))
+5 SET NOT1CT=+$GET(^TMP("BGPMU0028B",$JOB,BGPMUTF,"NOT",1))
+6 SET DEN1CT=+$GET(^TMP("BGPMU0028B",$JOB,BGPMUTF,"DEN",1))
+7 SET PTCNT=$PIECE(TOTALS,U,1)
SET PT1=$PIECE(TOTALS,U,2)
+8 SET PTCNT=PTCNT+1
+9 SET PT1=PT1+1
+10 IF BGPDEN
Begin DoDot:1
+11 SET DEN1CT=DEN1CT+1
SET ^TMP("BGPMU0028B",$JOB,BGPMUTF,"DEN",1)=DEN1CT
+12 SET ^TMP("BGPMU0028B",$JOB,BGPMUTF,"DEN","PAT",1,PT1)=DFN_U_BGPDSTR_U_BGPNSTR
+13 IF BGPNUM
Begin DoDot:2
+14 SET INCL1CT=INCL1CT+1
+15 SET ^TMP("BGPMU0028B",$JOB,BGPMUTF,"INCL",1)=INCL1CT
+16 SET ^TMP("BGPMU0028B",$JOB,BGPMUTF,"INCL","PAT",1,PT1)=DFN_U_BGPDSTR_U_BGPNSTR
End DoDot:2
+17 IF 'BGPNUM
Begin DoDot:2
+18 SET NOT1CT=NOT1CT+1
+19 SET ^TMP("BGPMU0028B",$JOB,BGPMUTF,"NOT",1)=NOT1CT
+20 SET ^TMP("BGPMU0028B",$JOB,BGPMUTF,"NOT","PAT",1,PT1)=DFN_U_BGPDSTR
End DoDot:2
End DoDot:1
+21 SET ^TMP("BGPMU0028B",$JOB,BGPMUTF,"TOT")=PTCNT_U_PT1
+22 QUIT
+23 ;
+24 ;look for NDC codes related to Tobacco use Cessation Agents
NDC(BGPDIEN,BGP4) ;
+1 NEW BGPI,BGPNDC,BGPTMP
+2 FOR BGPI=1:1
IF BGP4>0
QUIT
SET BGPTMP=$PIECE($TEXT(NDCT+BGPI),";;",2)
IF BGPTMP=""
QUIT
SET BGPNDC=$$NDC^BGPMUUT4(BGPDIEN,BGPTMP)
IF BGPNDC
SET BGP4=U_$PIECE(BGPNDC,U,2)_U_$PIECE($PIECE(BGPNDC,U,3),".",1)
+3 QUIT
+4 ;
+5 ;look for CPT codes related to Tobacco use Cessation Counseling
EM3(DFN,BGPDT,BGP3) ;
+1 NEW BGPCPT,BGPI,BGPTMP1
+2 SET BGPTMP1=""
+3 FOR BGPI=1:1
IF BGP3>0
QUIT
SET BGPTMP1=$PIECE($TEXT(CPT3+BGPI),";;",2)
IF BGPTMP1=""
QUIT
SET BGPCPT=$$VSTCPT^BGPMUUT1(DFN,VIEN,BGPTMP1)
IF BGPCPT
SET BGP3=$PIECE(BGPCPT,U,2)_";"_$PIECE($PIECE(BGPCPT,U,3),".",1)
+4 QUIT
+5 ;
CPT3 ;;
+1 ;;BGPMU TOBACCO USE CESS COUNSEL
+2 ;
NDCT ;;
+1 ;;BGPMU SMOKING CESSATION AGENTS
+2 ;
TESTC ;capture input data
+1 ; call with D:$G(^TMP("BGPMU0028B","TEST")=1 TESTC
+2 ; DFN = patient code from VA PATIENT file
+3 ; BGPBDATE = begin date of report
+4 ; BGPEDATE = end date of report
+5 ; BGPPROV = provider code from NEW PERSON file
+6 ; BGPMUTF = timeframe variable - "C"=current year; "P"=previous year; "B"=baseline year
+7 SET ^TMP("BGPMU0028B",$JOB,"J")=$JOB
+8 SET ^TMP("BGPMU0028B",$JOB,"DFN")=DFN
+9 SET ^TMP("BGPMU0028B",$JOB,"BGPBDATE")=BGPBDATE
+10 SET ^TMP("BGPMU0028B",$JOB,"BGPEDATE")=BGPEDATE
+11 SET ^TMP("BGPMU0028B",$JOB,"BGPPROV")=BGPPROV
+12 SET ^TMP("BGPMU0028B",$JOB,"BGPMUTF")=BGPMUTF
+13 QUIT
+14 ;
TESTH ;debug
+1 ;S U="^"
+2 ;S DUZ=1
+3 ;S DT=3110217
+4 ;S DFN=184
+5 ;S DFN=158
+6 ;S BGPBDATE=3100101
+7 ;S BGPEDATE=3110401
+8 ;S BGPPROV=2
+9 ;S BGPMUTF="C"
+10 ;D ENTRY
+11 QUIT
