BQITBMI ;PRXM/HC/ALA-Calculate BMI value ; 04 Apr 2006 1:22 PM
;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
;
;**Program Description**
; This program calculates BMI and other measurements for a patient
; and time frame.
Q
;
OBMI(BDFN,TMFRAME) ;EP
NEW BHT,BWT,BDATE,EDATE,HT,WT,HDATE,WDATE,DATE,QFL,IEN,HVISIT,HVSDTM,AGE
NEW BDATE19,CAGE,BDATE50
NEW WVISIT,WVSDTM,BGPBMIH,HIEN,WIEN
;I $G(TMFRAME)="" S TMFRAME="T-60M"
S BHT=$$FIND1^DIC(9999999.07,,"X","HT")
S BWT=$$FIND1^DIC(9999999.07,,"X","WT")
S BDATE=(9999999-DT)
S EDATE=(9999999-$$DATE^BQIUL1(TMFRAME))
S BDATE19=$$DATE^BQIUL1("T-12M")
S BDATE50=$$DATE^BQIUL1("T-24M")
S CAGE=$$AGE^BQIAGE(BDFN) ; patient's current age
; Patients younger than 2 years cannot have BMI calculated.
I CAGE<2 Q ""
S HT="",WT="",HDATE="",WDATE=""
S BDATE=BDATE-.01 ;Make range inclusive
S DATE=BDATE,QFL=0
S TMDATA=$NA(^TMP("BQIBM",UID))
K @TMDATA
FD ; Find data
F S DATE=$O(^AUPNVMSR("AA",BDFN,BHT,DATE)) Q:DATE=""!(DATE>EDATE) D Q:QFL
. S IEN=""
. F S IEN=$O(^AUPNVMSR("AA",BDFN,BHT,DATE,IEN)) Q:IEN=""!(QFL) D
.. ; if the new ENTERED IN ERROR field exists, exclude the record if it is marked as an error
.. I $$VFIELD^DILFD(9000010.01,2) Q:$$GET1^DIQ(9000010.01,IEN_",",2,"I")=1
.. S HT=$P(^AUPNVMSR(IEN,0),U,4),HDATE=DATE
.. S HVISIT=$P(^AUPNVMSR(IEN,0),U,3),HIEN=IEN
.. I $P($G(^AUPNVSIT(HVISIT,0)),U,11)=1 Q
.. S HVSDTM=$P(^AUPNVSIT(HVISIT,0),U,1)
.. ; If patient <19 years only look at the last year
.. I CAGE<19,HVSDTM<BDATE19 S HT="",HDATE="" Q
.. I CAGE>49,HVSDTM<BDATE50 S HT="",HDATE="" Q
.. S @TMDATA@(BDFN,"CRITERIA",HVSDTM,"BMI-Height")=HVISIT
.. S $P(@TMDATA@(BDFN,"CRITERIA",HVSDTM,"BMI-Height"),U,3)=IEN_U_"9000010.01"
.. S $P(@TMDATA@(BDFN,"V",HVSDTM),U,2)=HT
;
S DATE=BDATE,QFL=0
F S DATE=$O(^AUPNVMSR("AA",BDFN,BWT,DATE)) Q:DATE=""!(DATE>EDATE) D Q:QFL
. S IEN=""
. F S IEN=$O(^AUPNVMSR("AA",BDFN,BWT,DATE,IEN)) Q:IEN=""!(QFL) D
.. ; if the new ENTERED IN ERROR field exists, exclude the record if it is marked as an error
.. I $$VFIELD^DILFD(9000010.01,2) Q:$$GET1^DIQ(9000010.01,IEN_",",2,"I")=1
.. S WT=$P(^AUPNVMSR(IEN,0),U,4),WDATE=DATE
.. S WVISIT=$P(^AUPNVMSR(IEN,0),U,3),WIEN=IEN
.. I $P($G(^AUPNVSIT(WVISIT,0)),U,11)=1 Q
.. S WVSDTM=$P(^AUPNVSIT(WVISIT,0),U,1)
.. I WT'="" S AGE=$$AGE^BQIAGE(BDFN,WVSDTM) D
... ; If patient <19 years only look at the last year
... I CAGE<19,WVSDTM<BDATE19 S WT="",WDATE="" Q
... I CAGE>49,WVSDTM<BDATE50 S WT="",WDATE="" Q
... S @TMDATA@(BDFN,"CRITERIA",WVSDTM,"BMI-Weight")=WVISIT
... S $P(@TMDATA@(BDFN,"CRITERIA",WVSDTM,"BMI-Weight"),U,3)=IEN_U_"9000010.01"
... S $P(@TMDATA@(BDFN,"V",WVSDTM),U,1)=WT
;
S VSDTM="",QFL=0,HT="",WT=""
F S VSDTM=$O(@TMDATA@(BDFN,"V",VSDTM),-1) Q:VSDTM="" D Q:QFL
. I CAGE<19,VSDTM<BDATE19 K @TMDATA@(BDFN,"V",VSDTM) Q
. I CAGE>50,VSDTM<BDATE50 K @TMDATA@(BDFN,"V",VSDTM) Q
. S RESULTS=@TMDATA@(BDFN,"V",VSDTM)
. I CAGE<19 D Q
.. S HT=$P(RESULTS,"^",2),WT=$P(RESULTS,"^",1)
.. I HT=""!(WT="") Q
.. S HVISIT=$P(@TMDATA@(BDFN,"CRITERIA",VSDTM,"BMI-Height"),U,1)
.. S HIEN=$P(@TMDATA@(BDFN,"CRITERIA",VSDTM,"BMI-Height"),U,3)
.. S WVISIT=$P(@TMDATA@(BDFN,"CRITERIA",VSDTM,"BMI-Weight"),U,1)
.. S WIEN=$P(@TMDATA@(BDFN,"CRITERIA",VSDTM,"BMI-Weight"),U,3)
.. S QFL=1
. I HT="" D
.. S HT=$P(RESULTS,"^",2) I HT="" Q
.. S HVISIT=$P(@TMDATA@(BDFN,"CRITERIA",VSDTM,"BMI-Height"),U,1)
.. S HIEN=$P(@TMDATA@(BDFN,"CRITERIA",VSDTM,"BMI-Height"),U,3)
.. I WT'="" Q
.. I WT="" S WT=$P(RESULTS,"^",1) I WT="" Q
.. S WVISIT=$P(@TMDATA@(BDFN,"CRITERIA",VSDTM,"BMI-Weight"),U,1)
.. S WIEN=$P(@TMDATA@(BDFN,"CRITERIA",VSDTM,"BMI-Weight"),U,3)
. I WT="" D
.. S WT=$P(RESULTS,"^",1) I WT="" Q
.. S WVISIT=$P(@TMDATA@(BDFN,"CRITERIA",VSDTM,"BMI-Weight"),U,1)
.. S WIEN=$P(@TMDATA@(BDFN,"CRITERIA",VSDTM,"BMI-Weight"),U,3)
.. I HT'="" Q
.. I HT="" S HT=$P(RESULTS,"^",2) I HT="" Q
.. S HVISIT=$P(@TMDATA@(BDFN,"CRITERIA",VSDTM,"BMI-Height"),U,1)
.. S HIEN=$P(@TMDATA@(BDFN,"CRITERIA",VSDTM,"BMI-Height"),U,3)
. I HT'=""&(WT'="") S QFL=1
;
I +HT=0!(+WT=0) Q ""
;
K @TMDATA
S WT=WT*.45359,HT=(HT*.0254),HT=(HT*HT),BGPBMIH=(WT/HT)
S AGE=$$AGE^BQIAGE(BDFN,$P(^AUPNVSIT(WVISIT,0),U,1)\1)
Q BGPBMIH_"^"_AGE_"^"_HVISIT_","_WVISIT_"^"_HIEN_","_WIEN
;
OB(BDFN,BBMI,AGE) ;EP - obese
;Description - Checks if a patient is classified as obese
;Input
; BDFN - Patient IEN
; BBMI - Patient BMI value
; AGE - Age of patient when measure was taken
NEW SEX,R
I $G(BBMI)="" Q 0
I AGE<2 Q 0
S SEX=$P(^DPT(BDFN,0),U,2)
I SEX="" Q 0
S R=0,R=$O(^APCLBMI("H",SEX,AGE,R))
I 'R S R=$O(^APCLBMI("H",SEX,AGE)) I R S R=$O(^APCLBMI("H",SEX,R,""))
I 'R Q 0
I BBMI>$P(^APCLBMI(R,0),U,7)!(BBMI<$P(^APCLBMI(R,0),U,6)) Q "0^Outside Data Check Limits"
I BBMI'<$P(^APCLBMI(R,0),U,5) Q 1
Q 0
;
OW(BDFN,BBMI,AGE) ;EP - overweight
;Description - Checks if a patient is classified as overweight
;Input
; BDFN - Patient IEN
; BBMI - Patient BMI value
; AGE - Age of patient when measure was taken
NEW SEX,R
I $G(BBMI)="" Q 0
I AGE<2 Q 0
S SEX=$P(^DPT(BDFN,0),U,2)
I SEX="" Q 0
S R=0,R=$O(^APCLBMI("H",SEX,AGE,R))
I 'R S R=$O(^APCLBMI("H",SEX,AGE)) I R S R=$O(^APCLBMI("H",SEX,R,""))
I 'R Q 0
I BBMI>$P(^APCLBMI(R,0),U,7)!(BBMI<$P(^APCLBMI(R,0),U,6)) Q "0^Outside Data Check Limits"
I BBMI'<$P(^APCLBMI(R,0),U,4),BBMI<$P(^APCLBMI(R,0),U,5) Q 1
Q 0
;
BP(BDFN,TMFRAME) ;EP -- Blood Pressure for a single patient
; Get the Mean Blood Pressure value for a patient and a time frame
;Input
; BDFN - Patient IEN
; TMFRAME - Time frame in relative date format
;
; Get a list of all BP measures in the time frame
NEW N,TBP,TTBP,BDATE,EDATE,E,%,VISIT,CT,TSYS,TDIA,SYS,VIENS
K TBP,TTBP
S BDATE=(9999999-DT)
S EDATE=(9999999-$$DATE^BQIUL1(TMFRAME))
;
S BTYP=$$FIND1^DIC(9999999.07,,"X","BP")
S BCLN=$$FIND1^DIC(40.7,"","Q","30","C","","ERROR")
S DATE=BDATE-.01,CT=0,QFL=0
F S DATE=$O(^AUPNVMSR("AA",BDFN,BTYP,DATE)) Q:DATE=""!(DATE>EDATE) D Q:QFL
. S IEN=""
. F S IEN=$O(^AUPNVMSR("AA",BDFN,BTYP,DATE,IEN),-1) Q:IEN=""!(QFL) D
.. S VISIT=$P(^AUPNVMSR(IEN,0),U,3) I VISIT="" Q
.. ; if the new ENTERED IN ERROR field exists, exclude the record if it is marked as an error
.. I $$VFIELD^DILFD(9000010.01,2) Q:$$GET1^DIQ(9000010.01,IEN_",",2,"I")=1
.. I $P(^AUPNVSIT(VISIT,0),U,8)=BCLN Q
.. I $P(^AUPNVSIT(VISIT,0),U,11)=1 Q
.. S CT=CT+1
.. S TBP(CT)=$P(^AUPNVSIT(VISIT,0),U,1)\1_U_$P(^AUPNVMSR(IEN,0),U,4)_U_"BP"_U_IEN_";AUPNVMSR"_U_VISIT
; check for multiple BPs in the same visit and use the lowest BP
S N="" F S N=$O(TBP(N)) Q:'N D
. S VISIT=$P(TBP(N),U,5),SYS=$P($P(TBP(N),U,2),"/",1)
. I VISIT=""!(SYS="") Q
. S TTBP(VISIT,SYS)=N
S CT=0,VISIT="",TSYS="",TDIA="",VIENS="",IENS=""
F S VISIT=$O(TTBP(VISIT),-1) Q:VISIT=""!(CT=3) D
. S SYS=$O(TTBP(VISIT,"")),N=TTBP(VISIT,SYS)
. S DIA=$P($P(TBP(N),U,2),"/",2)
. NEW RIEN
. S RIEN=$P($P(TBP(N),U,4),";",1),IENS=IENS_RIEN_","
. S TSYS=TSYS+SYS,TDIA=TDIA+DIA,CT=CT+1,VIENS=VIENS_VISIT_","
K TBP,TTBP
I CT<2 Q ""
Q $J((TSYS/CT),3,0)_U_$J((TDIA/CT),2,0)_U_VIENS_U_IENS
;
ABP(TMFRAME,TPGLOB) ;EP -- Blood Pressure for all patients
; Input
; TMFRAME - Timeframe for search
; TPGLOB - Temporary global
NEW BDATE,EDATE,TMDATA,BTYP,IEN,BCLN,DATE,VISIT,MIEN,DFN,RESULT,TTBP
NEW TDIA,TSYS,DIA,SYS,N,VIENS,CT,IENS,BQBDT
NEW UID
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S BDATE=$$DATE^BQIUL1(TMFRAME),EDATE=DT
S BTYP=$$FIND1^DIC(9999999.07,,"X","BP")
S BCLN=$$FIND1^DIC(40.7,"","Q","30","C","","ERROR")
S TMDATA=$NA(^TMP("BQIBPA",UID))
K @TMDATA
S DATE=BDATE
F S DATE=$O(^AUPNVSIT("B",DATE)) Q:DATE=""!((DATE\1)>EDATE) D
. S VISIT=""
. F S VISIT=$O(^AUPNVSIT("B",DATE,VISIT)) Q:VISIT="" D
.. I $$GET1^DIQ(9000010,VISIT_",",.08,"I")=BCLN Q
.. I $$GET1^DIQ(9000010,VISIT_",",.11,"I")=1 Q
.. S MIEN=""
.. F S MIEN=$O(^AUPNVMSR("AD",VISIT,MIEN),-1) Q:MIEN="" D
... I $$GET1^DIQ(9000010.01,MIEN_",",.01,"I")'=BTYP Q
... ; if the new ENTERED IN ERROR field exists, exclude the record if it is marked as an error
... I $$VFIELD^DILFD(9000010.01,2) Q:$$GET1^DIQ(9000010.01,MIEN_",",2,"I")=1
... S DFN=$$GET1^DIQ(9000010.01,MIEN_",",.02,"I") I DFN="" Q
... S RESULT=$$GET1^DIQ(9000010.01,MIEN_",",.04,"E") I RESULT="" Q
... ;I $G(@TMDATA@(DFN))'<3 Q
... S @TMDATA@(DFN)=$G(@TMDATA@(DFN))+1
... S @TMDATA@(DFN,"V","BP",DATE,MIEN)=VISIT_"^"_$$GET1^DIQ(9000010.01,MIEN_",",.04,"E")
;
S DFN=""
F S DFN=$O(@TMDATA@(DFN)) Q:DFN="" D
. I $G(@TMDATA@(DFN))<2 K @TMDATA@(DFN) Q
. S BQBDT="" K TTBP
. F S BQBDT=$O(@TMDATA@(DFN,"V","BP",BQBDT),-1) Q:BQBDT="" D
.. S N="" F S N=$O(@TMDATA@(DFN,"V","BP",BQBDT,N)) Q:N="" D
... S VISIT=$P(@TMDATA@(DFN,"V","BP",BQBDT,N),U,1),SYS=$P($P(@TMDATA@(DFN,"V","BP",BQBDT,N),U,2),"/",1)
... S TTBP(VISIT,N,SYS)=$P(@TMDATA@(DFN,"V","BP",BQBDT,N),U,2)
. S VISIT="",TSYS=0,TDIA=0,VIENS="",CT=0,IENS=""
. F S VISIT=$O(TTBP(VISIT),-1) Q:VISIT="" D Q:CT>2
.. S MIEN=""
.. F S MIEN=$O(TTBP(VISIT,MIEN),-1) Q:MIEN="" D Q:CT>2
... S SYS=$O(TTBP(VISIT,MIEN,"")),N=TTBP(VISIT,MIEN,SYS)
... S DIA=$P(N,"/",2)
... S TSYS=(TSYS+SYS),TDIA=(TDIA+DIA),CT=CT+1,VIENS=VIENS_VISIT_","
... S IENS=IENS_MIEN_","
. K TTBP
. S @TPGLOB@(DFN)=$J((TSYS/CT),3,0)_U_$J((TDIA/CT),2,0)_U_VIENS_U_IENS
K @TMDATA
Q
;
ABMI(TMFRAME,TPGLOB) ;EP - Get BMIs for all patients
; Input
; TMFRAME - Timeframe for search
; TPGLOB - Temporary global
;
NEW BDATE,EDATE,BHT,BWT,TMDATA,DATE,VISIT,MIEN,BTYP,RESULT,DFN,AGE,H,W,HT,WT
NEW QFL,RESULTS,VSDTM,BMI,CAGE,HVISIT,WVISIT,HVSDTM,WVSDTM,UID
NEW BDATE19,BDATE50
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
;I $G(TMFRAME)="" S TMFRAME="T-60M"
S BDATE19=$$DATE^BQIUL1("T-12M") ; Patients <19 are limited to the past year
S BDATE50=$$DATE^BQIUL1("T-24M")
S BDATE=$$DATE^BQIUL1(TMFRAME),EDATE=DT
S BHT=$$FIND1^DIC(9999999.07,,"X","HT")
S BWT=$$FIND1^DIC(9999999.07,,"X","WT")
S TMDATA=$NA(^TMP("BQIBM",UID))
K @TMDATA
S DATE=EDATE
F S DATE=$O(^AUPNVSIT("B",DATE),-1) Q:DATE=""!((DATE\1)<BDATE) D
. S VISIT=""
. F S VISIT=$O(^AUPNVSIT("B",DATE,VISIT)) Q:VISIT="" D
.. I $$GET1^DIQ(9000010,VISIT_",",.11,"I")=1 Q
.. S MIEN=""
.. F S MIEN=$O(^AUPNVMSR("AD",VISIT,MIEN),-1) Q:MIEN="" D
... S BTYP=$$GET1^DIQ(9000010.01,MIEN_",",.01,"I")
... I BTYP'=BHT,BTYP'=BWT Q
... ; if the new ENTERED IN ERROR field exists, exclude the record if it is marked as an error
... I $$VFIELD^DILFD(9000010.01,2) Q:$$GET1^DIQ(9000010.01,MIEN_",",2,"I")=1
... S DFN=$$GET1^DIQ(9000010.01,MIEN_",",.02,"I") I DFN="" Q
... S CAGE=$$AGE^BQIAGE(DFN)
... ; Patients younger than 2 years cannot have BMI calculated.
... I CAGE<2 Q
... S RESULT=$$GET1^DIQ(9000010.01,MIEN_",",.04,"E") I RESULT="" Q
... S @TMDATA@(DFN)=CAGE
... I BTYP=BHT D
.... S H=RESULT
.... I $P($G(@TMDATA@(DFN,"V",DATE)),"^",2)="" S $P(@TMDATA@(DFN,"V",DATE),"^",2)=H
.... I $P($G(@TMDATA@(DFN,"CRITERIA",DATE,"BMI-Height")),U,1)="" S $P(@TMDATA@(DFN,"CRITERIA",DATE,"BMI-Height"),U,1)=VISIT
.... I $P($G(@TMDATA@(DFN,"CRITERIA",DATE,"BMI-Height")),U,3)="" S $P(@TMDATA@(DFN,"CRITERIA",DATE,"BMI-Height"),U,3)=MIEN_U_"9000010.01"
... I BTYP=BWT D
.... I $P($G(@TMDATA@(DFN,"V",DATE)),"^",1)="" S $P(@TMDATA@(DFN,"V",DATE),"^",1)=RESULT
.... I $P($G(@TMDATA@(DFN,"CRITERIA",DATE,"BMI-Weight")),U,1)="" S $P(@TMDATA@(DFN,"CRITERIA",DATE,"BMI-Weight"),U,1)=VISIT
.... I $P($G(@TMDATA@(DFN,"CRITERIA",DATE,"BMI-Weight")),U,3)="" S $P(@TMDATA@(DFN,"CRITERIA",DATE,"BMI-Weight"),U,3)=MIEN_U_"9000010.01"
;
S DFN=""
F S DFN=$O(@TMDATA@(DFN)) Q:DFN="" D
. S VSDTM="",QFL=0,HT="",WT=""
. F S VSDTM=$O(@TMDATA@(DFN,"V",VSDTM),-1) Q:VSDTM="" D Q:QFL
.. S CAGE=$$AGE^BQIAGE(DFN)
.. I CAGE<19,VSDTM<BDATE19 Q
.. I CAGE>49,VSDTM<BDATE50 Q
.. S RESULTS=@TMDATA@(DFN,"V",VSDTM)
.. I CAGE<19 D Q
... S HT=$P(RESULTS,"^",2),WT=$P(RESULTS,"^",1)
... I HT=""!(WT="") Q
... S HVISIT=$P(@TMDATA@(DFN,"CRITERIA",VSDTM,"BMI-Height"),U,1)
... S HIEN=$P(@TMDATA@(DFN,"CRITERIA",VSDTM,"BMI-Height"),U,3)
... S WVISIT=$P(@TMDATA@(DFN,"CRITERIA",VSDTM,"BMI-Weight"),U,1)
... S WIEN=$P(@TMDATA@(DFN,"CRITERIA",VSDTM,"BMI-Weight"),U,3)
... S QFL=1
... S WT=WT*.45359,HT=(HT*.0254),HT=(HT*HT),BMI=(WT/HT)
... S AGE=$$AGE^BQIAGE(DFN,$P(^AUPNVSIT(WVISIT,0),U,1)\1)
... S @TPGLOB@(DFN)=BMI_"^"_AGE_"^"_CAGE,QFL=1
... S $P(@TPGLOB@(DFN,"CRITERIA","BMI-Height","V",HVISIT,HIEN),U,1)=$P(^AUPNVSIT(HVISIT,0),U,1)
... S $P(@TPGLOB@(DFN,"CRITERIA","BMI-Weight","V",WVISIT,WIEN),U,1)=$P(^AUPNVSIT(WVISIT,0),U,1)
.. I HT="" D
... S HT=$P(RESULTS,"^",2) I HT="" Q
... S HVISIT=$P(@TMDATA@(DFN,"CRITERIA",VSDTM,"BMI-Height"),U,1)
... S HIEN=$P(@TMDATA@(DFN,"CRITERIA",VSDTM,"BMI-Height"),U,3)
... I WT'="" Q
... I WT="" S WT=$P(RESULTS,"^",1) I WT="" Q
... S WVISIT=$P(@TMDATA@(DFN,"CRITERIA",VSDTM,"BMI-Weight"),U,1)
... S WIEN=$P(@TMDATA@(DFN,"CRITERIA",VSDTM,"BMI-Weight"),U,3)
.. I WT="" D
... S WT=$P(RESULTS,"^",1) I WT="" Q
... S WVISIT=$P(@TMDATA@(DFN,"CRITERIA",VSDTM,"BMI-Weight"),U,1)
... S WIEN=$P(@TMDATA@(DFN,"CRITERIA",VSDTM,"BMI-Weight"),U,3)
... ;S AGE=$$AGE^BQIAGE(DFN,VSDTM)
... I HT'="" Q
... I HT="" S HT=$P(RESULTS,"^",2) I HT="" Q
... S HVISIT=$P(@TMDATA@(DFN,"CRITERIA",VSDTM,"BMI-Height"),U,1)
... S HIEN=$P(@TMDATA@(DFN,"CRITERIA",VSDTM,"BMI-Height"),U,3)
.. ;I HT'=""&(WT'="") Q
.. I HT=""!(WT="") Q
.. S WT=WT*.45359,HT=(HT*.0254),HT=(HT*HT),BMI=(WT/HT)
.. S AGE=$$AGE^BQIAGE(DFN,$P(^AUPNVSIT(WVISIT,0),U,1)\1)
.. S @TPGLOB@(DFN)=BMI_"^"_AGE_"^"_CAGE,QFL=1
.. S $P(@TPGLOB@(DFN,"CRITERIA","BMI-Height","V",HVISIT,HIEN),U,1)=$P(^AUPNVSIT(HVISIT,0),U,1)
.. S $P(@TPGLOB@(DFN,"CRITERIA","BMI-Weight","V",WVISIT,WIEN),U,1)=$P(^AUPNVSIT(WVISIT,0),U,1)
K @TMDATA
Q
BQITBMI ;PRXM/HC/ALA-Calculate BMI value ; 04 Apr 2006 1:22 PM
+1 ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
+2 ;
+3 ;**Program Description**
+4 ; This program calculates BMI and other measurements for a patient
+5 ; and time frame.
+6 QUIT
+7 ;
OBMI(BDFN,TMFRAME) ;EP
+1 NEW BHT,BWT,BDATE,EDATE,HT,WT,HDATE,WDATE,DATE,QFL,IEN,HVISIT,HVSDTM,AGE
+2 NEW BDATE19,CAGE,BDATE50
+3 NEW WVISIT,WVSDTM,BGPBMIH,HIEN,WIEN
+4 ;I $G(TMFRAME)="" S TMFRAME="T-60M"
+5 SET BHT=$$FIND1^DIC(9999999.07,,"X","HT")
+6 SET BWT=$$FIND1^DIC(9999999.07,,"X","WT")
+7 SET BDATE=(9999999-DT)
+8 SET EDATE=(9999999-$$DATE^BQIUL1(TMFRAME))
+9 SET BDATE19=$$DATE^BQIUL1("T-12M")
+10 SET BDATE50=$$DATE^BQIUL1("T-24M")
+11 ; patient's current age
SET CAGE=$$AGE^BQIAGE(BDFN)
+12 ; Patients younger than 2 years cannot have BMI calculated.
+13 IF CAGE<2
QUIT ""
+14 SET HT=""
SET WT=""
SET HDATE=""
SET WDATE=""
+15 ;Make range inclusive
SET BDATE=BDATE-.01
+16 SET DATE=BDATE
SET QFL=0
+17 SET TMDATA=$NAME(^TMP("BQIBM",UID))
+18 KILL @TMDATA
FD ; Find data
+1 FOR
SET DATE=$ORDER(^AUPNVMSR("AA",BDFN,BHT,DATE))
IF DATE=""!(DATE>EDATE)
QUIT
Begin DoDot:1
+2 SET IEN=""
+3 FOR
SET IEN=$ORDER(^AUPNVMSR("AA",BDFN,BHT,DATE,IEN))
IF IEN=""!(QFL)
QUIT
Begin DoDot:2
+4 ; if the new ENTERED IN ERROR field exists, exclude the record if it is marked as an error
+5 IF $$VFIELD^DILFD(9000010.01,2)
IF $$GET1^DIQ(9000010.01,IEN_",",2,"I")=1
QUIT
+6 SET HT=$PIECE(^AUPNVMSR(IEN,0),U,4)
SET HDATE=DATE
+7 SET HVISIT=$PIECE(^AUPNVMSR(IEN,0),U,3)
SET HIEN=IEN
+8 IF $PIECE($GET(^AUPNVSIT(HVISIT,0)),U,11)=1
QUIT
+9 SET HVSDTM=$PIECE(^AUPNVSIT(HVISIT,0),U,1)
+10 ; If patient <19 years only look at the last year
+11 IF CAGE<19
IF HVSDTM<BDATE19
SET HT=""
SET HDATE=""
QUIT
+12 IF CAGE>49
IF HVSDTM<BDATE50
SET HT=""
SET HDATE=""
QUIT
+13 SET @TMDATA@(BDFN,"CRITERIA",HVSDTM,"BMI-Height")=HVISIT
+14 SET $PIECE(@TMDATA@(BDFN,"CRITERIA",HVSDTM,"BMI-Height"),U,3)=IEN_U_"9000010.01"
+15 SET $PIECE(@TMDATA@(BDFN,"V",HVSDTM),U,2)=HT
End DoDot:2
End DoDot:1
IF QFL
QUIT
+16 ;
+17 SET DATE=BDATE
SET QFL=0
+18 FOR
SET DATE=$ORDER(^AUPNVMSR("AA",BDFN,BWT,DATE))
IF DATE=""!(DATE>EDATE)
QUIT
Begin DoDot:1
+19 SET IEN=""
+20 FOR
SET IEN=$ORDER(^AUPNVMSR("AA",BDFN,BWT,DATE,IEN))
IF IEN=""!(QFL)
QUIT
Begin DoDot:2
+21 ; if the new ENTERED IN ERROR field exists, exclude the record if it is marked as an error
+22 IF $$VFIELD^DILFD(9000010.01,2)
IF $$GET1^DIQ(9000010.01,IEN_",",2,"I")=1
QUIT
+23 SET WT=$PIECE(^AUPNVMSR(IEN,0),U,4)
SET WDATE=DATE
+24 SET WVISIT=$PIECE(^AUPNVMSR(IEN,0),U,3)
SET WIEN=IEN
+25 IF $PIECE($GET(^AUPNVSIT(WVISIT,0)),U,11)=1
QUIT
+26 SET WVSDTM=$PIECE(^AUPNVSIT(WVISIT,0),U,1)
+27 IF WT'=""
SET AGE=$$AGE^BQIAGE(BDFN,WVSDTM)
Begin DoDot:3
+28 ; If patient <19 years only look at the last year
+29 IF CAGE<19
IF WVSDTM<BDATE19
SET WT=""
SET WDATE=""
QUIT
+30 IF CAGE>49
IF WVSDTM<BDATE50
SET WT=""
SET WDATE=""
QUIT
+31 SET @TMDATA@(BDFN,"CRITERIA",WVSDTM,"BMI-Weight")=WVISIT
+32 SET $PIECE(@TMDATA@(BDFN,"CRITERIA",WVSDTM,"BMI-Weight"),U,3)=IEN_U_"9000010.01"
+33 SET $PIECE(@TMDATA@(BDFN,"V",WVSDTM),U,1)=WT
End DoDot:3
End DoDot:2
End DoDot:1
IF QFL
QUIT
+34 ;
+35 SET VSDTM=""
SET QFL=0
SET HT=""
SET WT=""
+36 FOR
SET VSDTM=$ORDER(@TMDATA@(BDFN,"V",VSDTM),-1)
IF VSDTM=""
QUIT
Begin DoDot:1
+37 IF CAGE<19
IF VSDTM<BDATE19
KILL @TMDATA@(BDFN,"V",VSDTM)
QUIT
+38 IF CAGE>50
IF VSDTM<BDATE50
KILL @TMDATA@(BDFN,"V",VSDTM)
QUIT
+39 SET RESULTS=@TMDATA@(BDFN,"V",VSDTM)
+40 IF CAGE<19
Begin DoDot:2
+41 SET HT=$PIECE(RESULTS,"^",2)
SET WT=$PIECE(RESULTS,"^",1)
+42 IF HT=""!(WT="")
QUIT
+43 SET HVISIT=$PIECE(@TMDATA@(BDFN,"CRITERIA",VSDTM,"BMI-Height"),U,1)
+44 SET HIEN=$PIECE(@TMDATA@(BDFN,"CRITERIA",VSDTM,"BMI-Height"),U,3)
+45 SET WVISIT=$PIECE(@TMDATA@(BDFN,"CRITERIA",VSDTM,"BMI-Weight"),U,1)
+46 SET WIEN=$PIECE(@TMDATA@(BDFN,"CRITERIA",VSDTM,"BMI-Weight"),U,3)
+47 SET QFL=1
End DoDot:2
QUIT
+48 IF HT=""
Begin DoDot:2
+49 SET HT=$PIECE(RESULTS,"^",2)
IF HT=""
QUIT
+50 SET HVISIT=$PIECE(@TMDATA@(BDFN,"CRITERIA",VSDTM,"BMI-Height"),U,1)
+51 SET HIEN=$PIECE(@TMDATA@(BDFN,"CRITERIA",VSDTM,"BMI-Height"),U,3)
+52 IF WT'=""
QUIT
+53 IF WT=""
SET WT=$PIECE(RESULTS,"^",1)
IF WT=""
QUIT
+54 SET WVISIT=$PIECE(@TMDATA@(BDFN,"CRITERIA",VSDTM,"BMI-Weight"),U,1)
+55 SET WIEN=$PIECE(@TMDATA@(BDFN,"CRITERIA",VSDTM,"BMI-Weight"),U,3)
End DoDot:2
+56 IF WT=""
Begin DoDot:2
+57 SET WT=$PIECE(RESULTS,"^",1)
IF WT=""
QUIT
+58 SET WVISIT=$PIECE(@TMDATA@(BDFN,"CRITERIA",VSDTM,"BMI-Weight"),U,1)
+59 SET WIEN=$PIECE(@TMDATA@(BDFN,"CRITERIA",VSDTM,"BMI-Weight"),U,3)
+60 IF HT'=""
QUIT
+61 IF HT=""
SET HT=$PIECE(RESULTS,"^",2)
IF HT=""
QUIT
+62 SET HVISIT=$PIECE(@TMDATA@(BDFN,"CRITERIA",VSDTM,"BMI-Height"),U,1)
+63 SET HIEN=$PIECE(@TMDATA@(BDFN,"CRITERIA",VSDTM,"BMI-Height"),U,3)
End DoDot:2
+64 IF HT'=""&(WT'="")
SET QFL=1
End DoDot:1
IF QFL
QUIT
+65 ;
+66 IF +HT=0!(+WT=0)
QUIT ""
+67 ;
+68 KILL @TMDATA
+69 SET WT=WT*.45359
SET HT=(HT*.0254)
SET HT=(HT*HT)
SET BGPBMIH=(WT/HT)
+70 SET AGE=$$AGE^BQIAGE(BDFN,$PIECE(^AUPNVSIT(WVISIT,0),U,1)\1)
+71 QUIT BGPBMIH_"^"_AGE_"^"_HVISIT_","_WVISIT_"^"_HIEN_","_WIEN
+72 ;
OB(BDFN,BBMI,AGE) ;EP - obese
+1 ;Description - Checks if a patient is classified as obese
+2 ;Input
+3 ; BDFN - Patient IEN
+4 ; BBMI - Patient BMI value
+5 ; AGE - Age of patient when measure was taken
+6 NEW SEX,R
+7 IF $GET(BBMI)=""
QUIT 0
+8 IF AGE<2
QUIT 0
+9 SET SEX=$PIECE(^DPT(BDFN,0),U,2)
+10 IF SEX=""
QUIT 0
+11 SET R=0
SET R=$ORDER(^APCLBMI("H",SEX,AGE,R))
+12 IF 'R
SET R=$ORDER(^APCLBMI("H",SEX,AGE))
IF R
SET R=$ORDER(^APCLBMI("H",SEX,R,""))
+13 IF 'R
QUIT 0
+14 IF BBMI>$PIECE(^APCLBMI(R,0),U,7)!(BBMI<$PIECE(^APCLBMI(R,0),U,6))
QUIT "0^Outside Data Check Limits"
+15 IF BBMI'<$PIECE(^APCLBMI(R,0),U,5)
QUIT 1
+16 QUIT 0
+17 ;
OW(BDFN,BBMI,AGE) ;EP - overweight
+1 ;Description - Checks if a patient is classified as overweight
+2 ;Input
+3 ; BDFN - Patient IEN
+4 ; BBMI - Patient BMI value
+5 ; AGE - Age of patient when measure was taken
+6 NEW SEX,R
+7 IF $GET(BBMI)=""
QUIT 0
+8 IF AGE<2
QUIT 0
+9 SET SEX=$PIECE(^DPT(BDFN,0),U,2)
+10 IF SEX=""
QUIT 0
+11 SET R=0
SET R=$ORDER(^APCLBMI("H",SEX,AGE,R))
+12 IF 'R
SET R=$ORDER(^APCLBMI("H",SEX,AGE))
IF R
SET R=$ORDER(^APCLBMI("H",SEX,R,""))
+13 IF 'R
QUIT 0
+14 IF BBMI>$PIECE(^APCLBMI(R,0),U,7)!(BBMI<$PIECE(^APCLBMI(R,0),U,6))
QUIT "0^Outside Data Check Limits"
+15 IF BBMI'<$PIECE(^APCLBMI(R,0),U,4)
IF BBMI<$PIECE(^APCLBMI(R,0),U,5)
QUIT 1
+16 QUIT 0
+17 ;
BP(BDFN,TMFRAME) ;EP -- Blood Pressure for a single patient
+1 ; Get the Mean Blood Pressure value for a patient and a time frame
+2 ;Input
+3 ; BDFN - Patient IEN
+4 ; TMFRAME - Time frame in relative date format
+5 ;
+6 ; Get a list of all BP measures in the time frame
+7 NEW N,TBP,TTBP,BDATE,EDATE,E,%,VISIT,CT,TSYS,TDIA,SYS,VIENS
+8 KILL TBP,TTBP
+9 SET BDATE=(9999999-DT)
+10 SET EDATE=(9999999-$$DATE^BQIUL1(TMFRAME))
+11 ;
+12 SET BTYP=$$FIND1^DIC(9999999.07,,"X","BP")
+13 SET BCLN=$$FIND1^DIC(40.7,"","Q","30","C","","ERROR")
+14 SET DATE=BDATE-.01
SET CT=0
SET QFL=0
+15 FOR
SET DATE=$ORDER(^AUPNVMSR("AA",BDFN,BTYP,DATE))
IF DATE=""!(DATE>EDATE)
QUIT
Begin DoDot:1
+16 SET IEN=""
+17 FOR
SET IEN=$ORDER(^AUPNVMSR("AA",BDFN,BTYP,DATE,IEN),-1)
IF IEN=""!(QFL)
QUIT
Begin DoDot:2
+18 SET VISIT=$PIECE(^AUPNVMSR(IEN,0),U,3)
IF VISIT=""
QUIT
+19 ; if the new ENTERED IN ERROR field exists, exclude the record if it is marked as an error
+20 IF $$VFIELD^DILFD(9000010.01,2)
IF $$GET1^DIQ(9000010.01,IEN_",",2,"I")=1
QUIT
+21 IF $PIECE(^AUPNVSIT(VISIT,0),U,8)=BCLN
QUIT
+22 IF $PIECE(^AUPNVSIT(VISIT,0),U,11)=1
QUIT
+23 SET CT=CT+1
+24 SET TBP(CT)=$PIECE(^AUPNVSIT(VISIT,0),U,1)\1_U_$PIECE(^AUPNVMSR(IEN,0),U,4)_U_"BP"_U_IEN_";AUPNVMSR"_U_VISIT
End DoDot:2
End DoDot:1
IF QFL
QUIT
+25 ; check for multiple BPs in the same visit and use the lowest BP
+26 SET N=""
FOR
SET N=$ORDER(TBP(N))
IF 'N
QUIT
Begin DoDot:1
+27 SET VISIT=$PIECE(TBP(N),U,5)
SET SYS=$PIECE($PIECE(TBP(N),U,2),"/",1)
+28 IF VISIT=""!(SYS="")
QUIT
+29 SET TTBP(VISIT,SYS)=N
End DoDot:1
+30 SET CT=0
SET VISIT=""
SET TSYS=""
SET TDIA=""
SET VIENS=""
SET IENS=""
+31 FOR
SET VISIT=$ORDER(TTBP(VISIT),-1)
IF VISIT=""!(CT=3)
QUIT
Begin DoDot:1
+32 SET SYS=$ORDER(TTBP(VISIT,""))
SET N=TTBP(VISIT,SYS)
+33 SET DIA=$PIECE($PIECE(TBP(N),U,2),"/",2)
+34 NEW RIEN
+35 SET RIEN=$PIECE($PIECE(TBP(N),U,4),";",1)
SET IENS=IENS_RIEN_","
+36 SET TSYS=TSYS+SYS
SET TDIA=TDIA+DIA
SET CT=CT+1
SET VIENS=VIENS_VISIT_","
End DoDot:1
+37 KILL TBP,TTBP
+38 IF CT<2
QUIT ""
+39 QUIT $JUSTIFY((TSYS/CT),3,0)_U_$JUSTIFY((TDIA/CT),2,0)_U_VIENS_U_IENS
+40 ;
ABP(TMFRAME,TPGLOB) ;EP -- Blood Pressure for all patients
+1 ; Input
+2 ; TMFRAME - Timeframe for search
+3 ; TPGLOB - Temporary global
+4 NEW BDATE,EDATE,TMDATA,BTYP,IEN,BCLN,DATE,VISIT,MIEN,DFN,RESULT,TTBP
+5 NEW TDIA,TSYS,DIA,SYS,N,VIENS,CT,IENS,BQBDT
+6 NEW UID
+7 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+8 SET BDATE=$$DATE^BQIUL1(TMFRAME)
SET EDATE=DT
+9 SET BTYP=$$FIND1^DIC(9999999.07,,"X","BP")
+10 SET BCLN=$$FIND1^DIC(40.7,"","Q","30","C","","ERROR")
+11 SET TMDATA=$NAME(^TMP("BQIBPA",UID))
+12 KILL @TMDATA
+13 SET DATE=BDATE
+14 FOR
SET DATE=$ORDER(^AUPNVSIT("B",DATE))
IF DATE=""!((DATE\1)>EDATE)
QUIT
Begin DoDot:1
+15 SET VISIT=""
+16 FOR
SET VISIT=$ORDER(^AUPNVSIT("B",DATE,VISIT))
IF VISIT=""
QUIT
Begin DoDot:2
+17 IF $$GET1^DIQ(9000010,VISIT_",",.08,"I")=BCLN
QUIT
+18 IF $$GET1^DIQ(9000010,VISIT_",",.11,"I")=1
QUIT
+19 SET MIEN=""
+20 FOR
SET MIEN=$ORDER(^AUPNVMSR("AD",VISIT,MIEN),-1)
IF MIEN=""
QUIT
Begin DoDot:3
+21 IF $$GET1^DIQ(9000010.01,MIEN_",",.01,"I")'=BTYP
QUIT
+22 ; if the new ENTERED IN ERROR field exists, exclude the record if it is marked as an error
+23 IF $$VFIELD^DILFD(9000010.01,2)
IF $$GET1^DIQ(9000010.01,MIEN_",",2,"I")=1
QUIT
+24 SET DFN=$$GET1^DIQ(9000010.01,MIEN_",",.02,"I")
IF DFN=""
QUIT
+25 SET RESULT=$$GET1^DIQ(9000010.01,MIEN_",",.04,"E")
IF RESULT=""
QUIT
+26 ;I $G(@TMDATA@(DFN))'<3 Q
+27 SET @TMDATA@(DFN)=$GET(@TMDATA@(DFN))+1
+28 SET @TMDATA@(DFN,"V","BP",DATE,MIEN)=VISIT_"^"_$$GET1^DIQ(9000010.01,MIEN_",",.04,"E")
End DoDot:3
End DoDot:2
End DoDot:1
+29 ;
+30 SET DFN=""
+31 FOR
SET DFN=$ORDER(@TMDATA@(DFN))
IF DFN=""
QUIT
Begin DoDot:1
+32 IF $GET(@TMDATA@(DFN))<2
KILL @TMDATA@(DFN)
QUIT
+33 SET BQBDT=""
KILL TTBP
+34 FOR
SET BQBDT=$ORDER(@TMDATA@(DFN,"V","BP",BQBDT),-1)
IF BQBDT=""
QUIT
Begin DoDot:2
+35 SET N=""
FOR
SET N=$ORDER(@TMDATA@(DFN,"V","BP",BQBDT,N))
IF N=""
QUIT
Begin DoDot:3
+36 SET VISIT=$PIECE(@TMDATA@(DFN,"V","BP",BQBDT,N),U,1)
SET SYS=$PIECE($PIECE(@TMDATA@(DFN,"V","BP",BQBDT,N),U,2),"/",1)
+37 SET TTBP(VISIT,N,SYS)=$PIECE(@TMDATA@(DFN,"V","BP",BQBDT,N),U,2)
End DoDot:3
End DoDot:2
+38 SET VISIT=""
SET TSYS=0
SET TDIA=0
SET VIENS=""
SET CT=0
SET IENS=""
+39 FOR
SET VISIT=$ORDER(TTBP(VISIT),-1)
IF VISIT=""
QUIT
Begin DoDot:2
+40 SET MIEN=""
+41 FOR
SET MIEN=$ORDER(TTBP(VISIT,MIEN),-1)
IF MIEN=""
QUIT
Begin DoDot:3
+42 SET SYS=$ORDER(TTBP(VISIT,MIEN,""))
SET N=TTBP(VISIT,MIEN,SYS)
+43 SET DIA=$PIECE(N,"/",2)
+44 SET TSYS=(TSYS+SYS)
SET TDIA=(TDIA+DIA)
SET CT=CT+1
SET VIENS=VIENS_VISIT_","
+45 SET IENS=IENS_MIEN_","
End DoDot:3
IF CT>2
QUIT
End DoDot:2
IF CT>2
QUIT
+46 KILL TTBP
+47 SET @TPGLOB@(DFN)=$JUSTIFY((TSYS/CT),3,0)_U_$JUSTIFY((TDIA/CT),2,0)_U_VIENS_U_IENS
End DoDot:1
+48 KILL @TMDATA
+49 QUIT
+50 ;
ABMI(TMFRAME,TPGLOB) ;EP - Get BMIs for all patients
+1 ; Input
+2 ; TMFRAME - Timeframe for search
+3 ; TPGLOB - Temporary global
+4 ;
+5 NEW BDATE,EDATE,BHT,BWT,TMDATA,DATE,VISIT,MIEN,BTYP,RESULT,DFN,AGE,H,W,HT,WT
+6 NEW QFL,RESULTS,VSDTM,BMI,CAGE,HVISIT,WVISIT,HVSDTM,WVSDTM,UID
+7 NEW BDATE19,BDATE50
+8 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+9 ;I $G(TMFRAME)="" S TMFRAME="T-60M"
+10 ; Patients <19 are limited to the past year
SET BDATE19=$$DATE^BQIUL1("T-12M")
+11 SET BDATE50=$$DATE^BQIUL1("T-24M")
+12 SET BDATE=$$DATE^BQIUL1(TMFRAME)
SET EDATE=DT
+13 SET BHT=$$FIND1^DIC(9999999.07,,"X","HT")
+14 SET BWT=$$FIND1^DIC(9999999.07,,"X","WT")
+15 SET TMDATA=$NAME(^TMP("BQIBM",UID))
+16 KILL @TMDATA
+17 SET DATE=EDATE
+18 FOR
SET DATE=$ORDER(^AUPNVSIT("B",DATE),-1)
IF DATE=""!((DATE\1)<BDATE)
QUIT
Begin DoDot:1
+19 SET VISIT=""
+20 FOR
SET VISIT=$ORDER(^AUPNVSIT("B",DATE,VISIT))
IF VISIT=""
QUIT
Begin DoDot:2
+21 IF $$GET1^DIQ(9000010,VISIT_",",.11,"I")=1
QUIT
+22 SET MIEN=""
+23 FOR
SET MIEN=$ORDER(^AUPNVMSR("AD",VISIT,MIEN),-1)
IF MIEN=""
QUIT
Begin DoDot:3
+24 SET BTYP=$$GET1^DIQ(9000010.01,MIEN_",",.01,"I")
+25 IF BTYP'=BHT
IF BTYP'=BWT
QUIT
+26 ; if the new ENTERED IN ERROR field exists, exclude the record if it is marked as an error
+27 IF $$VFIELD^DILFD(9000010.01,2)
IF $$GET1^DIQ(9000010.01,MIEN_",",2,"I")=1
QUIT
+28 SET DFN=$$GET1^DIQ(9000010.01,MIEN_",",.02,"I")
IF DFN=""
QUIT
+29 SET CAGE=$$AGE^BQIAGE(DFN)
+30 ; Patients younger than 2 years cannot have BMI calculated.
+31 IF CAGE<2
QUIT
+32 SET RESULT=$$GET1^DIQ(9000010.01,MIEN_",",.04,"E")
IF RESULT=""
QUIT
+33 SET @TMDATA@(DFN)=CAGE
+34 IF BTYP=BHT
Begin DoDot:4
+35 SET H=RESULT
+36 IF $PIECE($GET(@TMDATA@(DFN,"V",DATE)),"^",2)=""
SET $PIECE(@TMDATA@(DFN,"V",DATE),"^",2)=H
+37 IF $PIECE($GET(@TMDATA@(DFN,"CRITERIA",DATE,"BMI-Height")),U,1)=""
SET $PIECE(@TMDATA@(DFN,"CRITERIA",DATE,"BMI-Height"),U,1)=VISIT
+38 IF $PIECE($GET(@TMDATA@(DFN,"CRITERIA",DATE,"BMI-Height")),U,3)=""
SET $PIECE(@TMDATA@(DFN,"CRITERIA",DATE,"BMI-Height"),U,3)=MIEN_U_"9000010.01"
End DoDot:4
+39 IF BTYP=BWT
Begin DoDot:4
+40 IF $PIECE($GET(@TMDATA@(DFN,"V",DATE)),"^",1)=""
SET $PIECE(@TMDATA@(DFN,"V",DATE),"^",1)=RESULT
+41 IF $PIECE($GET(@TMDATA@(DFN,"CRITERIA",DATE,"BMI-Weight")),U,1)=""
SET $PIECE(@TMDATA@(DFN,"CRITERIA",DATE,"BMI-Weight"),U,1)=VISIT
+42 IF $PIECE($GET(@TMDATA@(DFN,"CRITERIA",DATE,"BMI-Weight")),U,3)=""
SET $PIECE(@TMDATA@(DFN,"CRITERIA",DATE,"BMI-Weight"),U,3)=MIEN_U_"9000010.01"
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+43 ;
+44 SET DFN=""
+45 FOR
SET DFN=$ORDER(@TMDATA@(DFN))
IF DFN=""
QUIT
Begin DoDot:1
+46 SET VSDTM=""
SET QFL=0
SET HT=""
SET WT=""
+47 FOR
SET VSDTM=$ORDER(@TMDATA@(DFN,"V",VSDTM),-1)
IF VSDTM=""
QUIT
Begin DoDot:2
+48 SET CAGE=$$AGE^BQIAGE(DFN)
+49 IF CAGE<19
IF VSDTM<BDATE19
QUIT
+50 IF CAGE>49
IF VSDTM<BDATE50
QUIT
+51 SET RESULTS=@TMDATA@(DFN,"V",VSDTM)
+52 IF CAGE<19
Begin DoDot:3
+53 SET HT=$PIECE(RESULTS,"^",2)
SET WT=$PIECE(RESULTS,"^",1)
+54 IF HT=""!(WT="")
QUIT
+55 SET HVISIT=$PIECE(@TMDATA@(DFN,"CRITERIA",VSDTM,"BMI-Height"),U,1)
+56 SET HIEN=$PIECE(@TMDATA@(DFN,"CRITERIA",VSDTM,"BMI-Height"),U,3)
+57 SET WVISIT=$PIECE(@TMDATA@(DFN,"CRITERIA",VSDTM,"BMI-Weight"),U,1)
+58 SET WIEN=$PIECE(@TMDATA@(DFN,"CRITERIA",VSDTM,"BMI-Weight"),U,3)
+59 SET QFL=1
+60 SET WT=WT*.45359
SET HT=(HT*.0254)
SET HT=(HT*HT)
SET BMI=(WT/HT)
+61 SET AGE=$$AGE^BQIAGE(DFN,$PIECE(^AUPNVSIT(WVISIT,0),U,1)\1)
+62 SET @TPGLOB@(DFN)=BMI_"^"_AGE_"^"_CAGE
SET QFL=1
+63 SET $PIECE(@TPGLOB@(DFN,"CRITERIA","BMI-Height","V",HVISIT,HIEN),U,1)=$PIECE(^AUPNVSIT(HVISIT,0),U,1)
+64 SET $PIECE(@TPGLOB@(DFN,"CRITERIA","BMI-Weight","V",WVISIT,WIEN),U,1)=$PIECE(^AUPNVSIT(WVISIT,0),U,1)
End DoDot:3
QUIT
+65 IF HT=""
Begin DoDot:3
+66 SET HT=$PIECE(RESULTS,"^",2)
IF HT=""
QUIT
+67 SET HVISIT=$PIECE(@TMDATA@(DFN,"CRITERIA",VSDTM,"BMI-Height"),U,1)
+68 SET HIEN=$PIECE(@TMDATA@(DFN,"CRITERIA",VSDTM,"BMI-Height"),U,3)
+69 IF WT'=""
QUIT
+70 IF WT=""
SET WT=$PIECE(RESULTS,"^",1)
IF WT=""
QUIT
+71 SET WVISIT=$PIECE(@TMDATA@(DFN,"CRITERIA",VSDTM,"BMI-Weight"),U,1)
+72 SET WIEN=$PIECE(@TMDATA@(DFN,"CRITERIA",VSDTM,"BMI-Weight"),U,3)
End DoDot:3
+73 IF WT=""
Begin DoDot:3
+74 SET WT=$PIECE(RESULTS,"^",1)
IF WT=""
QUIT
+75 SET WVISIT=$PIECE(@TMDATA@(DFN,"CRITERIA",VSDTM,"BMI-Weight"),U,1)
+76 SET WIEN=$PIECE(@TMDATA@(DFN,"CRITERIA",VSDTM,"BMI-Weight"),U,3)
+77 ;S AGE=$$AGE^BQIAGE(DFN,VSDTM)
+78 IF HT'=""
QUIT
+79 IF HT=""
SET HT=$PIECE(RESULTS,"^",2)
IF HT=""
QUIT
+80 SET HVISIT=$PIECE(@TMDATA@(DFN,"CRITERIA",VSDTM,"BMI-Height"),U,1)
+81 SET HIEN=$PIECE(@TMDATA@(DFN,"CRITERIA",VSDTM,"BMI-Height"),U,3)
End DoDot:3
+82 ;I HT'=""&(WT'="") Q
+83 IF HT=""!(WT="")
QUIT
+84 SET WT=WT*.45359
SET HT=(HT*.0254)
SET HT=(HT*HT)
SET BMI=(WT/HT)
+85 SET AGE=$$AGE^BQIAGE(DFN,$PIECE(^AUPNVSIT(WVISIT,0),U,1)\1)
+86 SET @TPGLOB@(DFN)=BMI_"^"_AGE_"^"_CAGE
SET QFL=1
+87 SET $PIECE(@TPGLOB@(DFN,"CRITERIA","BMI-Height","V",HVISIT,HIEN),U,1)=$PIECE(^AUPNVSIT(HVISIT,0),U,1)
+88 SET $PIECE(@TPGLOB@(DFN,"CRITERIA","BMI-Weight","V",WVISIT,WIEN),U,1)=$PIECE(^AUPNVSIT(WVISIT,0),U,1)
End DoDot:2
IF QFL
QUIT
End DoDot:1
+89 KILL @TMDATA
+90 QUIT
