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