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

BGPMUA01.m

Go to the documentation of this file. 
  1. BGPMUA01 ; IHS/MSC/MGH - MI measure NQF0421 ;22-Mar-2011 09:57;DU
  1.  ;;12.1;IHS CLINICAL REPORTING;;MAY 17, 2012;Build 66
  1.  ;Code to collect meaningful use report adult weight and followup 0421
  1. ENTRY ;EP
  1.  N START,END,BGPDEN1,BGPDEN1A,BGPDEN2,BGPDEN2A,BGPNUM1,BGPNUM1A,BGPNUM2,BGPNUM2A
  1.  N IEN,INV,VISIT,WTIEN,DATA,VDATE,BGPSIX,FIRST,NORMAL,VIEN
  1.  N BGPN1,BGPN3,DEN,EXC
  1.  S (BGPDEN1,BGPDEN1A,BGPDEN2,BGPDEN2A,BGPNUM1,BGPNUM1A,BGPNUM2,BGPNUM2A)=0
  1.  S START=9999999-BGPBDATE,END=9999999-BGPEDATE
  1.  ;Pts must be 18 and older
  1.  ;No need to check further on children
  1.  Q:BGPAGEE<19
  1.  S DEN="",VIEN=0,EXC=0,VIEN=0
  1.  S FIRST=END-0.1 F  S FIRST=$O(^AUPNVSIT("AA",DFN,FIRST)) Q:FIRST=""!($P(FIRST,".",1)>START)!(+VIEN)  D
  1.  .S IEN=0 F  S IEN=$O(^AUPNVSIT("AA",DFN,FIRST,IEN)) Q:'+IEN!(+VIEN)  D
  1.  ..;Check provider, Only visits for chosen provider
  1.  ..Q:'$$PRV^BGPMUUT1(IEN,BGPPROV)
  1.  ..;Quit if the visit does not have a valid E&M code
  1.  ..Q:'$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU BMI ENCOUNTER EM")
  1.  ..S DATA=$G(^AUPNVSIT(IEN,0))
  1.  ..S VDATE=$P($G(^AUPNVSIT(IEN,0)),U,1),VIEN=IEN
  1.  ..S DEN="EN:"_$$DATE^BGPMUUTL(VDATE)
  1.  I +VIEN D
  1.  .S NUM=$$NUM(DFN,BGPBDATE,BGPEDATE)
  1.  .;If not in numerator, see if they are an exception
  1.  .I +NUM=0 S EXC=$$EXCLUDE(DFN,BGPBDATE,BGPEDATE,BGPAGEE)
  1.  .D TOTAL(DFN,DEN,NUM,EXC)
  1.  Q
  1. EXCLUDE(DFN,BGPBDATE,BGPEDATE,BGPAGEE) ;Find exclusions
  1.  ;Set a new begin date of 6 most prior to the visit to find exclusons and wt
  1.  N X1,X2,EXC,X,STRING,TERMINAL,PREG,REF
  1.  S STRING=""
  1.  S X1=BGPBDATE,X2=-180 D C^%DTC S BGPSIX=X
  1.  ;Quit if the patient has a terminal diagnosis in last 6mos
  1.  S EXC=0
  1.  S TERMINAL=$$LASTDX^BGPMUUT2(DFN,BGPSIX,BGPEDATE,"BGPMU TERMINAL")
  1.  I +TERMINAL=1 S EXC=1_U_"Excluded"
  1.  ;See if the patient has a pregnancy diagnosis
  1.  S PREG=0
  1.  I BGPSEX="F"&(BGPAGEE<55) S PREG=$$LASTDX^BGPMUUT2(DFN,BGPSIX,BGPEDATE,"BGPMU PREGNANCY")
  1.  I +PREG=1 S EXC=1_U_"Excluded"
  1.  ;Quit if patient refused ht or wt in time frame
  1.  ;10/26/11 - no longer limiting to look back 6 months, ONLY in report period - per Dr. Advani
  1.  S REF=$$REF(DFN,BGPBDATE,BGPEDATE)
  1.  I +REF=1 S EXC=1_U_"Excluded"
  1.  Q EXC
  1. NUM(DFN,BGPBDATE,BGPEDATE) ;see it pt in numerator
  1.  N BGPBN,BGPBMI,BGPN3,NORMAL,FOLLOW,BMI,STRING
  1.  S BMI=0
  1.  S BGPBMI=$$BMI(DFN,BGPBDATE,BGPEDATE,BGPAGEE),BGPN1=$S(BGPBMI]"":1,1:0)
  1.  S BGPBN=$$ROUND($P(BGPBMI,U,1),2)
  1.  ;See if the BMI is abnormal
  1.  I +BGPBMI=0 S BMI=0,STRING="NM:"
  1.  I +BGPBMI>0 D
  1.  .S BGPN3=$$OW(DFN,BGPBN,BGPAGEE)
  1.  .I BGPN3=0 S BMI=1,STRING="M:"_BGPBN_" "_$P(BGPBMI,U,2)
  1.  .I BGPN3=1 D
  1.  ..S NORMAL=0
  1.  ..S FOLLOW=$$FOLLOWUP(DFN,BGPBDATE,BGPEDATE)
  1.  ..I +FOLLOW=0 S BMI=0,STRING="NM:"_BGPBN_" "_$P(BGPBMI,U,2)
  1.  ..I +FOLLOW>0 S BMI=1,STRING="M:"_BGPBN_" "_$P(BGPBMI,U,2)_";"_$P(FOLLOW,U,2)_U_$P(FOLLOW,U,3)
  1.  Q BMI_U_STRING
  1. TOTAL(DFN,DEN,NUM,EXC) ;See where this patient ends up
  1.  N PTCNT,EXCCT1,EXCCT2,DEN1CT,NUM1CT,DEN2CT,NUM2CT,NOT1CT,NOT2CT,TOTALS,PT1,PT2
  1.  S TOTALS=$G(^TMP("BGPMU0421",$J,BGPMUTF,"TOT"))
  1.  S EXCCT1=+$G(^TMP("BGPMU0421",$J,BGPMUTF,"EXC",1))
  1.  S DEN1CT=+$G(^TMP("BGPMU0421",$J,BGPMUTF,"DEN",1))
  1.  S NUM1CT=+$G(^TMP("BGPMU0421",$J,BGPMUTF,"NUM",1))
  1.  S NOT1CT=+$G(^TMP("BGPMU0421",$J,BGPMUTF,"NOT",1))
  1.  S DEN2CT=+$G(^TMP("BGPMU0421",$J,BGPMUTF,"DEN",2))
  1.  S NUM2CT=+$G(^TMP("BGPMU0421",$J,BGPMUTF,"NUM",2))
  1.  S NOT2CT=+$G(^TMP("BGPMU0421",$J,BGPMUTF,"NOT",2))
  1.  S EXCCT2=+$G(^TMP("BGPMU0421",$J,BGPMUTF,"EXC",2))
  1.  S PTCNT=$P(TOTALS,U,1),PT1=$P(TOTALS,U,2),PT2=$P(TOTALS,U,3)
  1.  S PTCNT=PTCNT+1
  1.  I BGPAGEE>64 D
  1.  .S PT1=PT1+1
  1.  .S DEN1CT=DEN1CT+1 S ^TMP("BGPMU0421",$J,BGPMUTF,"DEN",1)=DEN1CT
  1.  .I +NUM D
  1.  ..S NUM1CT=NUM1CT+1 S ^TMP("BGPMU0421",$J,BGPMUTF,"NUM",1)=NUM1CT
  1.  ..I BGPMUTF="C" S ^TMP("BGPMU0421",$J,"PAT",BGPMUTF,1,"NUM",PT1)=DFN_U_DEN_U_NUM
  1.  .I +EXC D
  1.  ..S EXCCT1=EXCCT1+1 S ^TMP("BGPMU0421",$J,BGPMUTF,"EXC",1)=EXCCT1
  1.  ..I BGPMUTF="C" S ^TMP("BGPMU0421",$J,"PAT",BGPMUTF,1,"EXC",PT1)=DFN_U_DEN_U_EXC
  1.  .I +NUM=0&(+EXC=0) D
  1.  ..S NOT1CT=NOT1CT+1 S ^TMP("BGPMU0421",$J,BGPMUTF,"NOT",1)=NOT1CT
  1.  ..I BGPMUTF="C" S ^TMP("BGPMU0421",$J,"PAT",BGPMUTF,1,"NOT",PT1)=DFN_U_DEN_U_NUM
  1.  I BGPAGEE<65 D
  1.  .S PT2=PT2+1
  1.  .S DEN2CT=DEN2CT+1 S ^TMP("BGPMU0421",$J,BGPMUTF,"DEN",2)=DEN2CT
  1.  .I +NUM D
  1.  ..S NUM2CT=NUM2CT+1 S ^TMP("BGPMU0421",$J,BGPMUTF,"NUM",2)=NUM2CT
  1.  ..I BGPMUTF="C" S ^TMP("BGPMU0421",$J,"PAT",BGPMUTF,2,"NUM",PT2)=DFN_U_DEN_U_NUM
  1.  .I +EXC D
  1.  ..S EXCCT2=EXCCT2+1 S ^TMP("BGPMU0421",$J,BGPMUTF,"EXC",2)=EXCCT2
  1.  ..I BGPMUTF="C" S ^TMP("BGPMU0421",$J,"PAT",BGPMUTF,2,"EXC",PT2)=DFN_U_DEN_U_EXC
  1.  .I +NUM=0&(+EXC=0) D
  1.  ..S NOT2CT=NOT2CT+1 S ^TMP("BGPMU0421",$J,BGPMUTF,"NOT",2)=NOT2CT
  1.  ..I BGPMUTF="C" S ^TMP("BGPMU0421",$J,"PAT",BGPMUTF,2,"NOT",PT2)=DFN_U_DEN_U_NUM
  1.  S ^TMP("BGPMU0421",$J,BGPMUTF,"TOT")=PTCNT_U_PT1_U_PT2
  1.  ;Setup iCare array for patient
  1.  I BGPAGEE>64 S BGPICARE("MU.EP.0421.1",BGPMUTF)='EXC_U_+NUM_U_+EXC_U_$P(DEN,U,2)_";"_$P(NUM,U,2)_U_$P(EXC,U,2)
  1.  E  S BGPICARE("MU.EP.0421.3",BGPMUTF)='EXC_U_+NUM_U_+EXC_U_$P(DEN,U,2)_";"_$P(NUM,U,2)_U_$P(EXC,U,2)
  1.  Q
  1. OW(PAT,BMI,AGE) ;EP overweight or underweight
  1.  N RET
  1.  S RET=0
  1.  I $G(BMI)="" Q 0
  1.  I AGE>64 D
  1.  .I BMI>30!(BMI<22) S RET=1
  1.  E  D
  1.  .I BMI>25!(BMI<18.5) S RET=1
  1.  Q RET
  1. HT(DFN,BGPWDATE) ;EP
  1.  I 'P Q ""
  1.  KILL %,BGPDOB,BGPARRY,BGPHT,E,X1,X2,X,BGPMUAGE,BGPHPTR,BGPMDT,BGPHIEN,BGPHDT
  1.  S BGPHT=0
  1.  Q:'+BGPWDATE BGPHT
  1.  S BGPHPTR=$O(^AUTTMSR("B","HT",0))
  1.  S BGPHDT=9999999-(BGPWDATE+1),BGPHT=0
  1.  S BGPHDT=$O(^AUPNVMSR("AA",DFN,BGPHPTR,BGPHDT))
  1.  Q:'+BGPHDT 0
  1.  S BGPHIEN="" S BGPHIEN=$O(^AUPNVMSR("AA",DFN,BGPHPTR,BGPHDT,BGPHIEN)) Q:'+BGPHIEN  D
  1.  .S BGPHT=$P($G(^AUPNVMSR(BGPHIEN,0)),U,4)
  1.  Q:'+BGPHT 0
  1.  S BGPDOB=$P(^DPT(DFN,0),U,3)
  1.  S X1=9999999-BGPHDT,X2=BGPDOB D ^%DTC S BGPMDT=X
  1.  S X2=BGPDOB,X1=BGPEDATE D ^%DTC S BGPMUAGE=X
  1.  Q:(BGPMDT<6571)&(BGPMUAGE>6571) 0
  1.  Q BGPHT
  1. WT(P,BDATE,EDATE) ;EP
  1.  I 'P Q ""
  1.  KILL %,E,BGPLW,X,BGPLN,BGPL,BGPLD,BGPLZ,BGPLX,BGPDT
  1.  S (BGPLW,BGPDT)=""
  1.  K BGPL S BGPLW="" S BGPLX=P_"^LAST 24 MEAS WT;DURING "_BDATE_"-"_EDATE S E=$$START1^APCLDF(BGPLX,"BGPL(")
  1.  S BGPLN=0 F  S BGPLN=$O(BGPL(BGPLN)) Q:'+BGPLN!(+BGPLW)  D
  1.  .S BGPLZ=$P(BGPL(BGPLN),U,5)
  1.  .S BGPLW=$P(BGPL(BGPLN),U,2),BGPDT=$P(BGPL(BGPLN),U,1)
  1.  Q BGPLW_U_BGPDT
  1.  ;
  1. BMI(P,BDATE,EDATE,AGE) ;EP
  1.  N BGPBMIH,HDATE,SDATE,WDATE,E2DATE
  1.  KILL %,W,H,B,D,%DT
  1.  S BGPBMIH=0,WDATE=""
  1.  I AGE>18,AGE<51 D
  1.  .S SDATE=$$FMADD^XLFDT(BDATE,-180),SDATE=$$FMTE^XLFDT(SDATE),E2DATE=$$FMTE^XLFDT(EDATE)
  1.  .S W=$$WT(P,SDATE,E2DATE)
  1.  .I +W D
  1.  ..S WDATE=$P(W,U,2)
  1.  ..S H=$$HT(P,WDATE)
  1.  ..I +H D
  1.  ...S W=+W
  1.  ...S W=W*.45359,H=(H*.0254),H=(H*H),BGPBMIH=(W/H)
  1.  I AGE>50 D
  1.  .S SDATE=$$FMADD^XLFDT(EDATE,-180),SDATE=$$FMTE^XLFDT(SDATE),E2DATE=$$FMTE^XLFDT(EDATE)
  1.  .S W=$$WT(P,SDATE,E2DATE)
  1.  .I +W D
  1.  ..S WDATE=$P(W,U,2)
  1.  ..S H=$$HT(P,WDATE)
  1.  ..I +H D
  1.  ...S W=+W
  1.  ...S W=W*.45359,H=(H*.0254),H=(H*H),BGPBMIH=(W/H)
  1.  I WDATE'="" S WDATE=$$DATE^BGPMUUTL(WDATE)
  1.  Q BGPBMIH_U_WDATE
  1. REF(PAT,BDATE,EDATE) ;EP - get ht/wt refusal in time frame, same date for 18 and under
  1.  N R S R=0
  1.  I $G(BDATE)="" S BDATE=$P(^DPT(PAT,0),U,3)  ;if no date then set to DOB
  1.  S X=$$REFUSAL^BGP0UTL1(PAT,9999999.07,$O(^AUTTMSR("B","HT",0)),BDATE,EDATE) I X S R=1_U_"HT"_U_$P(X,U,2)
  1.  S Y=$$REFUSAL^BGP0UTL1(PAT,9999999.07,$O(^AUTTMSR("B","WT",0)),BDATE,EDATE) I Y S R=1_U_"WT"_U_$P(X,U,2)
  1.  I X="",Y="" Q 0
  1.  Q R
  1. FOLLOWUP(DFN,BDATE,EDATE) ;Find out of followup was done
  1.  N CODE,DX,ED,CON,NEWDT,RET
  1.  S RET=0
  1.  S NEWDT=$$FMADD^XLFDT(BDATE,-180)
  1.  ;Check for CPTs for followup
  1.  S CODE=$$CPT^BGPMUUT1(DFN,NEWDT,EDATE,"BGPMU BMI FOLLOWUP CPTS")
  1.  I +CODE S RET=+CODE_U_$P(CODE,U,2)_" "_$$DATE^BGPMUUTL($P(CODE,U,3))
  1.  ;Check for ICD for followup
  1.  S DX=$$LASTDX^BGPMUUT2(DFN,NEWDT,EDATE,"BGPMU BMI FOLLOWUP ICD")
  1.  I +DX S RET=+DX_U_$P(DX,U,2)_" "_$$DATE^BGPMUUTL($P(DX,U,3))
  1.  ;Check for patient ed codes
  1.  ;S NEWDT=$$FMADD^XLFDT(EDATE,-365)
  1.  ;S ED=$$PED(DFN,NEWDT,EDATE)
  1.  ;I +ED Q ED
  1.  ;Check for consult
  1.  ;S CONSULT=$$CONSULT(DFN,NEWDT,EDATE)
  1.  ;I +CONSULT Q CONSULT
  1.  ;Did not find any followup
  1.  Q RET
  1. CONSULT(DFN,BDATE,EDATE) ;Check for nutrition consult in the last year
  1.  N DATA,PRM,ENT,CONSULT,BEGIN,END,CTYPE,CNAME,I,TYPE,%DT
  1.  S CONSULT=0
  1.  S BEGIN=BDATE+1
  1.  S BEGIN=9999999-BDATE,END=9999999-EDATE
  1.  S PRM="BGPMU DIETARY CONSULT",ENT="DIV^SYS"
  1.  D GETLST^XPAR(.DATA,ENT,PRM,"I")
  1.  I $D(DATA) D
  1.  .S I=0 F  S I=$O(DATA(I)) Q:'+I!(CONSULT'=0)  D
  1.  ..S TYPE=$G(DATA(I))
  1.  ..S %DT="" F  S %DT=$O(^GMR(123,"AD",DFN,%DT)) Q:%DT=""!(CONSULT'=0)  Q:DT>BEGIN!(END<%DT)  D
  1.  ...S IEN="" F  S IEN=$O(^GMR(123,"AD",DFN,%DT,IEN)) Q:IEN=""  D
  1.  ....I $P($G(^GMR(123,IEN,0)),U,5)=TYPE D
  1.  .....S CTYPE=$P($G(^GMR(123,IEN,0)),U,5),CNAME=$P($G(^GMR(123.5,CTYPE,0)),U,1)
  1.  .....S CONSULT=1_U_CNAME
  1.  Q CONSULT
  1. PED(P,BDATE,EDATE) ;EP
  1.  K BGPG
  1.  N Y,X,D,T
  1.  S Y="BGPGMU("
  1.  S X=P_"^ALL EDUC;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)
  1.  I '$D(BGPGMU) Q 0
  1.  S (X,D)=0,%=0,T="" F  S X=$O(BGPGMU(X)) Q:X'=+X!(%'=0)  D
  1.  .S T=$P(^AUPNVPED(+$P(BGPGMU(X),U,4),0),U)
  1.  .Q:'T
  1.  .Q:'$D(^AUTTEDT(T,0))
  1.  .S T=$P(^AUTTEDT(T,0),U,2)
  1.  .I $P(T,"-")="OBS" S %=1_U_T_U_$P(BGPGMU(X),U) Q
  1.  .I $P(T,"-",2)="OBS" S %=1_U_T_U_$P(BGPGMU(X),U) Q
  1.  .I $P(T,"-")="278.0" S %=1_U_T_U_$P(BGPGMU(X),U) Q
  1.  .I $P(T,"-")="278.00" S %=1_U_T_U_$P(BGPGMU(X),U) Q
  1.  .I $P(T,"-")="278.01" S %=1_U_T_U_$P(BGPGMU(X),U) Q
  1.  .I $P(T,"-")="783.22" S %=1_U_T_U_$P(BGPGMU(X),U) Q
  1.  K BGPGMU
  1.  Q %
  1. ROUND(VAL,SD) ;EP
  1.  Q:VAL'=+VAL!($G(SD)=0) VAL
  1.  Q +$J(VAL,0,$S($D(SD):SD,VAL<1:2,VAL<10:2,1:2))