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

BGPMUG05.m

Go to the documentation of this file. 
  1. BGPMUG05 ; IHS/MSC/MMT - MI measure NQF0036 ;20-Aug-2011 14:56;DU
  1.  ;;11.1;IHS CLINICAL REPORTING SYSTEM;**1**;JUN 27, 2011;Build 106
  1.  ;Code to collect meaningful use report for Asthma Medications
  1. ENTRY ;EP
  1.  N START,END,STRING,STRING2
  1.  N IEN,INV,VISIT,DATA,VDATE,VALUE,FIRST,VIEN
  1.  N CNT,DEN,NUM,EXC,ASTHENC,ASTHMA,ASTDT,ASTDX,ASTPL,LASTVDT
  1.  S (NUM,DEN,EXC)=0
  1.  ;Pts must be between 5 and 50 years
  1.  ;No need to check further if no age match
  1.  Q:BGPAGEE<5!(BGPAGEE>50)
  1.  S DEN=$$DEN(DFN,BGPBDATE,BGPEDATE)
  1.  Q:'+DEN
  1.  ;check to see if they are in the numerator
  1.  S NUM=$$NUM(DFN,BGPBDATE,BGPEDATE)
  1.  ;if not in NUM, check to see if excluded
  1.  I '+NUM S EXC=$$EXCLUDE(DFN,BGPBDATE,BGPEDATE)
  1.  D TOTAL(DFN,DEN,NUM,EXC)
  1.  Q
  1. TOTAL(DFN,DEN,NUM,EXC) ;See where this patient ends up
  1.  D:BGPAGEE<12 TOTSUB(1)  ;ages 5-11
  1.  D:BGPAGEE>11 TOTSUB(2)  ;ages 12-50
  1.  D TOTSUB(3)  ;all ages (5-50)
  1.  Q
  1. TOTSUB(DENPOP) ;ADD Patient to a population's totals
  1.  N TOTAL,PTCNT,DENCT,NUMCT,NOTNUM,EXCCT
  1.  S TOTAL=$G(^TMP("BGPMU0036",$J,BGPMUTF,DENPOP,"TOT"))
  1.  S DENCT=+$G(^TMP("BGPMU0036",$J,BGPMUTF,DENPOP,"DEN"))
  1.  S NUMCT=+$G(^TMP("BGPMU0036",$J,BGPMUTF,DENPOP,"NUM"))
  1.  S EXCCT=+$G(^TMP("BGPMU0036",$J,BGPMUTF,DENPOP,"EXC"))
  1.  S NOTNUM=+$G(^TMP("BGPMU0036",$J,BGPMUTF,DENPOP,"NOT"))
  1.  S PTCNT=TOTAL
  1.  S PTCNT=PTCNT+1
  1.  S DENCT=DENCT+1 S ^TMP("BGPMU0036",$J,BGPMUTF,DENPOP,"DEN")=DENCT
  1.  I +NUM D
  1.  .S NUMCT=NUMCT+1 S ^TMP("BGPMU0036",$J,BGPMUTF,DENPOP,"NUM")=NUMCT
  1.  .I BGPMUTF="C" S ^TMP("BGPMU0036",$J,"PAT",BGPMUTF,DENPOP,"NUM",PTCNT)=DFN_U_$P(DEN,U,2)_U_"M:MED "_$$DATE^BGPMUUTL($P(NUM,U,3))
  1.  I +EXC D
  1.  .S EXCCT=EXCCT+1 S ^TMP("BGPMU0036",$J,BGPMUTF,DENPOP,"EXC")=EXCCT
  1.  .I BGPMUTF="C" S ^TMP("BGPMU0036",$J,"PAT",BGPMUTF,DENPOP,"EXC",PTCNT)=DFN_U_$P(DEN,U,2)_U_"Excluded"
  1.  I +NUM=0&(EXC=0) D
  1.  .S NOTNUM=NOTNUM+1 S ^TMP("BGPMU0036",$J,BGPMUTF,DENPOP,"NOT")=NOTNUM
  1.  .I BGPMUTF="C" S ^TMP("BGPMU0036",$J,"PAT",BGPMUTF,DENPOP,"NOT",PTCNT)=DFN_U_$P(DEN,U,2)_U_"NM:"
  1.  S ^TMP("BGPMU0036",$J,BGPMUTF,DENPOP,"TOT")=PTCNT
  1.  ;Setup iCare array for patient only for the 3rd (all encompassing) population
  1.  S:DENPOP=3 BGPICARE("MU.EP.0036.1",BGPMUTF)=1_U_+NUM_U_+EXC_U_$P(DEN,U,2)_U_$P(NUM,U,2)_";"_$P(NUM,U,3)
  1.  Q
  1. ASTHMA(DFN,EDATE) ;Find if patient had a PROBLEM of Asthma on or before the end date
  1.  N ASTHMA
  1.  S ASTHMA=0
  1.  S ASTPL=$$PLTAX^BGPMUUT1(DFN,"BGPMU ASTHMA DX ICD","C")
  1.  ;check date of problem
  1.  I +ASTPL&($P($P(ASTPL,U,3),".")<=EDATE) S ASTHMA=ASTPL Q ASTHMA
  1.  S BGPBIRTH=$$DOB^AUPNPAT(DFN)
  1.  S ASTDX=$$LASTDX^BGPMUUT2(DFN,BGPBIRTH,EDATE,"BGPMU ASTHMA DX ICD")
  1.  I +ASTDX S ASTHMA=ASTDX Q ASTHMA
  1.  Q ASTHMA
  1. NUM(DFN,BGPBDATE,BGPEDATE) ;Look for PRESCRIPTION
  1.  N FOUND
  1.  S FOUND=0
  1.  S FOUND=$$FIND^BGPMUUT8(DFN,"BGPMU ASTHMA GENERAL NDCS",BGPBDATE,"",BGPEDATE)
  1.  Q:+FOUND FOUND
  1.  S FOUND=$$FIND^BGPMUUT8(DFN,"BGPMU ASTHMA INHALED NDCS",BGPBDATE,"",BGPEDATE)
  1.  Q:+FOUND FOUND
  1.  S FOUND=$$FIND^BGPMUUT8(DFN,"BGPMU ASTHMA LEUK NDCS",BGPBDATE,"",BGPEDATE)
  1.  Q FOUND
  1. DEN(DFN,BDATE,EDATE) ;CHECK IF PT IS IN DENOMINATOR
  1.  ;Check for 1 IP or ED visit with a Dx of Asthma
  1.  S START=9999999-$$FMADD^XLFDT(BDATE,-365),END=9999999-EDATE,VALUE=0
  1.  S START=START_".2359"
  1.  ;First check for Asthma Dx
  1.  S ASTHMA=$$ASTHMA(DFN,BGPEDATE)
  1.  G:'+ASTHMA DENMEDS  ;SKIP TO MED CHECK IF NO ASTHMA DX
  1.  S CNT=0
  1.  S FIRST=END-0.1 F  S FIRST=$O(^AUPNVSIT("AA",DFN,FIRST)) Q:FIRST=""!($P(FIRST,".",1)>START)  D
  1.  .S IEN=0 F  S IEN=$O(^AUPNVSIT("AA",DFN,FIRST,IEN)) Q:'+IEN!(CNT>0)  D
  1.  ..;Check provider, Only visits for chosen provider
  1.  ..Q:'$$PRV^BGPMUUT1(IEN,BGPPROV)
  1.  ..S EDENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU ENCOUNTER ED CPT")
  1.  ..I +EDENC D VSTSTORE Q
  1.  ..S IPENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU ACUTE INPT ENC")
  1.  ..I +IPENC D VSTSTORE Q
  1.  I CNT>0 D
  1.  .S DEN=1_U_$$DENSTR1(ASTHMA,.STRING)
  1.  Q:+DEN DEN
  1. DENMEDS ;
  1.  N MEDTAX,INHTAX,LEUKTAX,MEDS,LEUKS,MCNT,LCNT,MEVT
  1.  ;now check for meds
  1.  S MEDTAX=$O(^ATXAX("B","BGPMU ASTHMA GENERAL NDCS",0))
  1.  S BETATAX=$O(^ATXAX("B","BGPMU ASTHMA BETA NDCS",0))
  1.  S INHTAX=$O(^ATXAX("B","BGPMU ASTHMA INHALED NDCS",0))
  1.  S LEUKTAX=$O(^ATXAX("B","BGPMU ASTHMA LEUK NDCS",0))
  1.  K VIEN,STRING,CNT
  1.  S (CNT,MCNT,LCNT,M,E)=0
  1.  S FIRST=END-0.1 F  S FIRST=$O(^AUPNVSIT("AA",DFN,FIRST)) Q:FIRST=""!($P(FIRST,".",1)>START)  D
  1.  .S IEN=0 F  S IEN=$O(^AUPNVSIT("AA",DFN,FIRST,IEN)) Q:'+IEN  D
  1.  ..;Check provider, Only visits for chosen provider
  1.  ..I $$PRV^BGPMUUT1(IEN,BGPPROV) D
  1.  ...S OPENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU ENCOUNTER OUTPT")
  1.  ...I +OPENC D VSTSTORE  ;count it
  1.  ...E  D
  1.  ....S VENC=$$VSTPOV^BGPMUUT3(DFN,IEN,"BGPMU ENC OUTPATIENT ICD")
  1.  ....I +VENC D VSTSTORE
  1.  ..;look for meds
  1.  ..S Y=0 F  S Y=$O(^AUPNVMED("AD",IEN,Y)) Q:Y'=+Y  D
  1.  ...S S=0
  1.  ...Q:'$D(^AUPNVMED(Y,0))
  1.  ...Q:$$UP^XLFSTR($P($G(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
  1.  ...S Z=$P($G(^AUPNVMED(Y,0)),U) ;get drug ien
  1.  ...Q:$P($G(^AUPNVMED(Y,12)),U,2)'=BGPPROV  ;don't check this med if not ordered by EP
  1.  ...I ($$NDC(Z,INHTAX)!($$NDC(Z,BETATAX))),$P(^AUPNVMED(Y,0),U,8)="" D  Q
  1.  ....S M=M+1 ;it is an inhaled steroid that wasn't d/c'ed so 1 dispensing event
  1.  ....S MEVT=$P($G(^AUPNVMED(Y,12)),U)
  1.  ....S MCNT=MCNT+1,MEDS(MCNT)=Z_U_$S(MEVT'="":MEVT,1:$P($P(^AUPNVSIT(IEN,0),U),"."))
  1.  ...I $$NDC(Z,MEDTAX) D
  1.  ....Q:$$NDC(Z,LEUKTAX)  ;don't count if it is a leukotriene
  1.  ....S J=$P(^AUPNVMED(Y,0),U,8)
  1.  ....I J]"" S S=$$FMDIFF^XLFDT($P($P(^AUPNVSIT(IEN,0),U),"."),J,1)
  1.  ....I J="" S S=$P(^AUPNVMED(Y,0),U,7)
  1.  ....S K=S\30 S:K<1 K=1
  1.  ....S M=M+K
  1.  ....S MEVT=$P($G(^AUPNVMED(Y,12)),U)
  1.  ....S MCNT=MCNT+1,MEDS(MCNT)=Z_U_$S(MEVT'="":MEVT,1:$P($P(^AUPNVSIT(IEN,0),U),"."))
  1.  ...I $$NDC(Z,LEUKTAX) D  Q
  1.  ....S J=$P(^AUPNVMED(Y,0),U,8)
  1.  ....I J]"" S S=$$FMDIFF^XLFDT($P($P(^AUPNVSIT(IEN,0),U),"."),J,1)
  1.  ....I J="" S S=$P(^AUPNVMED(Y,0),U,7)
  1.  ....S K=S\30 S:K<1 K=1
  1.  ....S M=M+K,E=E+K
  1.  ....S MEVT=$P($G(^AUPNVMED(Y,12)),U)
  1.  ....S MCNT=MCNT+1,MEDS(MCNT)=Z_U_$S(MEVT'="":MEVT,1:$P($P(^AUPNVSIT(IEN,0),U),"."))
  1.  ....S LCNT=LCNT+1,LEUKS(LCNT)=Z_U_$S(MEVT'="":MEVT,1:$P($P(^AUPNVSIT(IEN,0),U),"."))
  1.  I +ASTHMA,CNT>3,M>1 Q 1_U_$$DENSTR2(.VIEN,.MEDS)  ;had 4 povs and 2 dispensing events
  1.  I M>3,E<M Q 1_U_$$DENSTR3(.VIEN,.MEDS)  ;had 4 meds, not all were leuko
  1.  I +ASTHMA,M>3,E>3 Q 1_U_$$DENSTR4(.VIEN,.LEUKS)  ;had all leuk and 1 dx
  1.  Q ""
  1.  ;
  1. NDC(A,B) ;
  1.  ;a is drug ien
  1.  ;b is taxonomy ien
  1.  S BGPNDC=$P($G(^PSDRUG(A,2)),U,4)
  1.  Q:'BGPNDC 0
  1.  ;Setup the NDC code for a proper lookup in the taxonomy
  1.  S NDCCODE=$$RJ^XLFSTR($P(BGPNDC,"-"),5,0)_$$RJ^XLFSTR($P(BGPNDC,"-",2),4,0)_$$RJ^XLFSTR($P(BGPNDC,"-",3),2,0)
  1.  I NDCCODE]"",B,$D(^ATXAX(B,21,"B",NDCCODE)) Q 1
  1.  Q 0
  1. VSTSTORE ;Store compliant visit into array
  1.  S CNT=CNT+1
  1.  S VDATE=$P($G(^AUPNVSIT(IEN,0)),U,1)
  1.  S VIEN(CNT)=IEN_U_VDATE
  1.  S STRING(CNT)=$$DATE^BGPMUUTL(VDATE)
  1.  Q
  1. DENSTR1(ASTHMA,STRING) ;generate display string for denom criteria 1 - Dx present with IP/ED visit 
  1.  Q "AST:"_$$DATE^BGPMUUTL($P(ASTHMA,U,3))_";EN:"_STRING(1)
  1. DENSTR2(VIEN,MEDS) ;generate display string for denom criteria 2 - 4 povs and 2 dispensing events
  1.  N DENSTR,VI
  1.  S DENSTR="AST:"_$$DATE^BGPMUUTL($P(ASTHMA,U,3))
  1.  S DENSTR=DENSTR_";MED:"_$$DATE^BGPMUUTL($P($G(MEDS(1)),U,2))_$S($G(MEDS(2))'="":";MED:"_$$DATE^BGPMUUTL($P(MEDS(2),U,2)),1:"")
  1.  F VI=1:1:4 D
  1.  .S:$G(STRING(VI))'="" DENSTR=DENSTR_";EN:"_STRING(VI)
  1.  Q DENSTR
  1. DENSTR3(VIEN,MEDS) ;generate display string for denom criteria 3 - 4 meds, not all were leuko
  1.  N DENSTR,MI
  1.  S DENSTR=""
  1.  F MI=1:1:4 D
  1.  .S:$G(MEDS(MI))'="" DENSTR=DENSTR_$S(MI>1:";",1:"")_"MED:"_$$DATE^BGPMUUTL($P(MEDS(MI),U,2))
  1.  Q DENSTR
  1. DENSTR4(VIEN,LEUKS) ;generate display string for denom criteria 4 - all leuk and 1 dx
  1.  N DENSTR
  1.  S DENSTR="AST:"_$$DATE^BGPMUUTL($P(ASTHMA,U,3))
  1.  F MI=1:1:4 D
  1.  .S:$G(MEDS(MI))'="" DENSTR=DENSTR_";MED:"_$$DATE^BGPMUUTL($P(MEDS(MI),U,2))
  1.  Q DENSTR
  1. EXCLUDE(DFN,BGPBDATE,BGPEDATE) ;Look for exclusions
  1.  N EXDX,EXPL
  1.  S EXDX=$$LASTDX^BGPMUUT2(DFN,BGPBDATE,BGPEDATE,"BGPMU ASTHMA EXCLUDES DX ICD")
  1.  I +EXDX Q EXDX
  1.  S EXPL=$$PLTAX^BGPMUUT1(DFN,"BGPMU ASTHMA EXCLUDES DX ICD","C",BGPEDATE)
  1.  Q:+EXPL EXPL
  1.  Q 0