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

BGPMUD02.m

Go to the documentation of this file. 
  1. 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
  1.  ;code to collect meaningful use report tobacco use assessment
  1. ENTRY ;EP
  1.  ; expects:
  1.  ;  DFN      = patient code from VA PATIENT file
  1.  ;  BGPBDATE = begin date of report
  1.  ;  BGPEDATE = end date of report
  1.  ;  BGPPROV   = provider code from NEW PERSON file
  1.  ;  BGPMUTF  = timeframe variable - "C"=current year; "P"=previous year; "B"=baseline year
  1.  N BGPDIEN,BGPDIFN,BGP1,BGP2,BGP3,BGPDEN,BGPNUM,BGPDT,BGPAGEE,END,FIRST,IEN,START,VDATE,VIEN
  1.  N BGPHFI
  1.  S BGPDEN=0
  1.  S BGPNUM=0
  1.  S BGPNSTR=""   ; <NDC code> OR <CPT code> ; [date in FM format]
  1.  S BGPDSTR=""
  1.  ;Pts must be 18 and older
  1.  S BGPAGEE=$$AGE^AUPNPAT(DFN,BGPBDATE)
  1.  ;No need to check further on children
  1.  Q:BGPAGEE<18
  1.  ;
  1.  S START=9999999-BGPBDATE,END=9999999-BGPEDATE
  1.  ;look for 2 visits with E&M codes
  1.  ;    OR   1 visit with E&M codes
  1.  S BGP1=""
  1.  S BGP2=""
  1.  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'="")
  1.  .S VIEN=0 F  S VIEN=$O(^AUPNVSIT("AA",DFN,FIRST,VIEN)) Q:'+VIEN  D  Q:($L(BGP2,";")>1)!(BGP1'="")
  1.  ..S BGPDT=$P($P($G(^AUPNVSIT(VIEN,0)),U,1),".",1)
  1.  ..;Check provider, determine if there are visits with E&M codes
  1.  ..I $$PRV^BGPMUUT1(VIEN,BGPPROV) D
  1.  ...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
  1.  ...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
  1.  ;TEST
  1.  ;quit if visits with E&M code(s) not found for given DFN
  1.  Q:(BGP1="")&(BGP2="")
  1.  Q:(BGP1="")&($L(BGP2,";")'>1)
  1.  ;getting here means this patient has been screened for Tobacco Use
  1.  ;
  1.  ;combine BGP1 and BPG2 into one string
  1.  S BGPDSTR=$S(BGP2'="":BGP2_$S(BGP1'="":";"_BGP1,1:""),1:BGP1)
  1.  ;
  1.  ;determine if this patient is a Tobacco User
  1.  N BGPH,BGPHF,BGPTOBN,BGPTOBU
  1.  S BGPHF=0  ;health factor found flag
  1.  S BGPTOBU=1
  1.  D HFA^BGPMUD01(.BGPTOBU)
  1.  S START=9999999-$$FMADD^XLFDT(BGPBDATE,-730)
  1.  S FIRST=END-0.1 F  S FIRST=$O(^AUPNVSIT("AA",DFN,FIRST)) Q:FIRST=""!($P(FIRST,".",1)>START)  D  Q:BGPHF
  1.  .S VIEN=0 F  S VIEN=$O(^AUPNVSIT("AA",DFN,FIRST,VIEN)) Q:'+VIEN  D  Q:BGPHF
  1.  ..S BGPIEN="" F  S BGPIEN=$O(^AUPNVHF("AD",VIEN,BGPIEN)) Q:'+BGPIEN  D
  1.  ...S BGPHNOD=$G(^AUPNVHF(BGPIEN,0))
  1.  ...S BGPHFI=$P(BGPHNOD,U,1)
  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)
  1.  I BGPHF D
  1.  .S BGPDEN=1  ;patient is in the denominator - patient has been screened for Tobacco Use AND is a Tobacco User
  1.  .S BGPDSTR=BGPDSTR_":"_$P(BGPHF,";",2)
  1.  Q:'BGPDEN
  1.  ;
  1.  ;determine if patient is participating in a smoking cessation program (numerator)
  1.  ; BGP3 = [CPT code] ; date in FM format
  1.  S BGP3=""
  1.  S FIRST=END-0.1 F  S FIRST=$O(^AUPNVSIT("AA",DFN,FIRST)) Q:FIRST=""!($P(FIRST,".",1)>START)  D  Q:BGP3>0
  1.  .S VIEN=0 F  S VIEN=$O(^AUPNVSIT("AA",DFN,FIRST,VIEN)) Q:'+VIEN  D  Q:BGP3>0
  1.  ..;S BGPDT=9999999-FIRST  ;convert date to fileman format
  1.  ..S BGPDT=$P($P($G(^AUPNVSIT(VIEN,0)),U,1),".",1)
  1.  ..D EM3(DFN,BGPDT,.BGP3)  ;determine if there is a visit that has a CPT code for Tobacco Use Cessation Counseling
  1.  ..I BGP3>0 S BGPNUM=1 S BGPNSTR=BGP3
  1.  ;determine if patient has medications that are Smoking Cessation Agents
  1.  I 'BGPNUM D
  1.  .S BGP4=0
  1.  .K ^TMP("PS",$J)
  1.  .N BGPI,BGPIFN,BGPRX0
  1.  .S BGP4=$$FIND^BGPMUUT8(DFN,"BGPMU SMOKING CESSATION AGENTS",9999999-START,"",BGPEDATE)
  1.  .;S BGP4=$$FIND^BGPMUUT4(DFN,"BGPMU SMOKING CESSATION AGENTS",9999999-START,"OP",BGPEDATE)
  1.  .S:BGP4>0 BGPNUM=1,BGPNSTR=$P(BGP4,U,2)
  1.  ;D OCL^PSOORRL(DFN,9999999-START,BGPEDATE)  ;collect patient's meds in ^TMP
  1.  ;.S BGPI="" F  S BGPI=$O(^TMP("PS",$J,BGPI)) Q:BGPI=""  D
  1.  ;..S BGPDIFN=$P($G(^TMP("PS",$J,BGPI,0)),U,2)
  1.  ;..S BGPDIEN=$O(^PSDRUG("B",BGPDIFN,""))    ;get pointer to DRUG file
  1.  ;..D NDC(BGPDIEN,.BGP4)
  1.  K ^TMP("PS",$J)
  1.  ; update TOTAL
  1.  D TOTAL(DFN,BGPNUM,BGPMUTF,BGPDSTR,BGPNSTR)
  1.  ;
  1.  ; check these
  1.  K BGPL,BGPLWTS,BGPLHTS,%,X,BGPLWTS1,BGPLHTS1,Y,TERMINAL,NORMAL,FOLLOW,EXCEPT
  1.  Q
  1.  ;
  1. TOTAL(DFN,BGPNUM,BGPMUTF,BGPDSTR,BGPNSTR) ;See where this patient ends up
  1.  ;if we got here, this patient is in the denominator
  1.  N PTCNT,DEN1CT,INCL1CT,NOT1CT,TOTALS,PT1
  1.  S TOTALS=$G(^TMP("BGPMU0028B",$J,BGPMUTF,"TOT"))
  1.  S INCL1CT=+$G(^TMP("BGPMU0028B",$J,BGPMUTF,"INCL",1))
  1.  S NOT1CT=+$G(^TMP("BGPMU0028B",$J,BGPMUTF,"NOT",1))
  1.  S DEN1CT=+$G(^TMP("BGPMU0028B",$J,BGPMUTF,"DEN",1))
  1.  S PTCNT=$P(TOTALS,U,1),PT1=$P(TOTALS,U,2)
  1.  S PTCNT=PTCNT+1
  1.  S PT1=PT1+1
  1.  I BGPDEN D
  1.  .S DEN1CT=DEN1CT+1 S ^TMP("BGPMU0028B",$J,BGPMUTF,"DEN",1)=DEN1CT
  1.  .S ^TMP("BGPMU0028B",$J,BGPMUTF,"DEN","PAT",1,PT1)=DFN_U_BGPDSTR_U_BGPNSTR
  1.  .I BGPNUM D
  1.  ..S INCL1CT=INCL1CT+1
  1.  ..S ^TMP("BGPMU0028B",$J,BGPMUTF,"INCL",1)=INCL1CT
  1.  ..S ^TMP("BGPMU0028B",$J,BGPMUTF,"INCL","PAT",1,PT1)=DFN_U_BGPDSTR_U_BGPNSTR
  1.  .I 'BGPNUM D
  1.  ..S NOT1CT=NOT1CT+1
  1.  ..S ^TMP("BGPMU0028B",$J,BGPMUTF,"NOT",1)=NOT1CT
  1.  ..S ^TMP("BGPMU0028B",$J,BGPMUTF,"NOT","PAT",1,PT1)=DFN_U_BGPDSTR
  1.  S ^TMP("BGPMU0028B",$J,BGPMUTF,"TOT")=PTCNT_U_PT1
  1.  Q
  1.  ;
  1.  ;look for NDC codes related to Tobacco use Cessation Agents
  1. NDC(BGPDIEN,BGP4) ;
  1.  N BGPI,BGPNDC,BGPTMP
  1.  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)
  1.  Q
  1.  ;
  1.  ;look for CPT codes related to Tobacco use Cessation Counseling
  1. EM3(DFN,BGPDT,BGP3) ;
  1.  N BGPCPT,BGPI,BGPTMP1
  1.  S BGPTMP1=""
  1.  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)
  1.  Q
  1.  ;
  1. CPT3 ;;
  1.  ;;BGPMU TOBACCO USE CESS COUNSEL
  1.  ;
  1. NDCT ;;
  1.  ;;BGPMU SMOKING CESSATION AGENTS
  1.  ;
  1. TESTC ;capture input data
  1.  ; call with D:$G(^TMP("BGPMU0028B","TEST")=1 TESTC
  1.  ;  DFN      = patient code from VA PATIENT file
  1.  ;  BGPBDATE = begin date of report
  1.  ;  BGPEDATE = end date of report
  1.  ;  BGPPROV   = provider code from NEW PERSON file
  1.  ;  BGPMUTF  = timeframe variable - "C"=current year; "P"=previous year; "B"=baseline year
  1.  S ^TMP("BGPMU0028B",$J,"J")=$J
  1.  S ^TMP("BGPMU0028B",$J,"DFN")=DFN
  1.  S ^TMP("BGPMU0028B",$J,"BGPBDATE")=BGPBDATE
  1.  S ^TMP("BGPMU0028B",$J,"BGPEDATE")=BGPEDATE
  1.  S ^TMP("BGPMU0028B",$J,"BGPPROV")=BGPPROV
  1.  S ^TMP("BGPMU0028B",$J,"BGPMUTF")=BGPMUTF
  1.  Q
  1.  ;
  1. TESTH ;debug
  1.  ;S U="^"
  1.  ;S DUZ=1
  1.  ;S DT=3110217
  1.  ;S DFN=184
  1.  ;S DFN=158
  1.  ;S BGPBDATE=3100101
  1.  ;S BGPEDATE=3110401
  1.  ;S BGPPROV=2
  1.  ;S BGPMUTF="C"
  1.  ;D ENTRY
  1.  Q