- PXRMBMI ;SLC/PKR - National BMI and BSA computed finding. ;08/21/2019
- ;;2.0;CLINICAL REMINDERS;**12,18,42**;Feb 04, 2005;Build 245
- ;================================
- BMI(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;Multi-occurrence computed
- ;finding for BMI.
- N BMI,HDATE,HT,IND,TDATE,WHL,WT
- ;Get the list of weight and height measurements.
- D WANDHL(DFN,NGET,BDT,EDT,.NFOUND,.WHL)
- F IND=1:1:NFOUND D
- . S TDATE=$P(WHL(IND),U,1),WT=$P(WHL(IND),U,2)
- . S HT=$P(WHL(IND),U,3),HDATE=$P(WHL(IND),U,4)
- . S TEST(IND)=1,DATE(IND)=TDATE
- . S TEXT(IND)="height measured "_$$EDATE^PXRMDATE(HDATE)
- . S BMI=WT/(HT*HT)
- . S BMI=$FN(BMI,"",1)
- . S (DATA(IND,"VALUE"),DATA(IND,"BMI"))=BMI
- Q
- ;
- ;================================
- BSA(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;Multi-occurrence computed
- ;finding for BSA. The coefficients have been adjusted for heights
- ;in cm and weights in kg expect for Boyd where the weight is grams.
- ;The default is to use the Mosteller formula.
- N BSA,FORMULA,HDATE,HT,IND,TDATE,TYPE,WHL,WT
- S TYPE=$S(TEST="":"M",TEST="M":"M",TEST="D":"D",TEST="H":"H",TEST="G":"G",TEST="B":"B",1:"M")
- S FORMULA=$S(TYPE="M":"Mosteller",TYPE="B":"Boyd",TYPE="D":"DuBois and Dubois",TYPE="H":"Haycock",TYPE="G":"Gehan and George",1:"Mosteller")_" formula"
- ;Get the list of weight and height measurements.
- D WANDHL(DFN,NGET,BDT,EDT,.NFOUND,.WHL)
- F IND=1:1:NFOUND D
- . S TDATE=$P(WHL(IND),U,1),WT=$P(WHL(IND),U,2)
- . S HT=$P(WHL(IND),U,3),HDATE=$P(WHL(IND),U,4)
- . S TEST(IND)=1,DATE(IND)=TDATE
- . I TYPE="M" S BSA=$$SQRT^XLFMTH((WT*HT)/36)
- . I TYPE="D" S BSA=.20247*$$PWR^XLFMTH(HT,.725)*$$PWR^XLFMTH(WT,.425)
- . I TYPE="H" S BSA=.15058*$$PWR^XLFMTH(HT,.3964)*$$PWR^XLFMTH(WT,.5378)
- . I TYPE="G" S BSA=.164*$$PWR^XLFMTH(HT,.42246)*$$PWR^XLFMTH(WT,.51456)
- . I TYPE="B" D
- .. N WEXP
- .. S WT=1000*WT
- .. S WEXP=.7285-(.0188*$$LOG^XLFMTH(WT))
- .. S BSA=.001277*$$PWR^XLFMTH(HT,.3)*$$PWR^XLFMTH(WT,WEXP)
- . S BSA=$FN(BSA,"",2)
- . S (DATA(IND,"VALUE"),DATA(IND,"BSA"))=BSA
- . S TEXT(IND)=FORMULA_", height measured "_$$EDATE^PXRMDATE(HDATE)
- Q
- ;
- ;================================
- GHEIGHT(DFN,WDATE,HT,HDATE) ;Return the height measurement taken on the
- ;date closest to WDATE (WDATE is the date of the weight measurement).
- ;If no height is found return -1.
- N BCKDATE,DAS,DIFFL,DIFFS,DONE,FWDDATE,TEMP
- S (DONE,HDATE)=0,HT=-1
- ;Check for height measured on same date and time.
- S DAS=$O(^PXRMINDX(120.5,"PI",DFN,8,WDATE,""))
- I DAS'="" D
- . D GETDATA^PXRMVITL(DAS,.TEMP)
- . I TEMP("RATE")'=+TEMP("RATE") Q
- . S HT=+(TEMP("RATE")*0.0254),HDATE=WDATE,DONE=1
- I 'DONE S (BCKDATE,FWDDATE)=WDATE
- F Q:DONE D
- . S BCKDATE=+$O(^PXRMINDX(120.5,"PI",DFN,8,BCKDATE),-1)
- . S FWDDATE=+$O(^PXRMINDX(120.5,"PI",DFN,8,FWDDATE))
- . I (BCKDATE=0),(FWDDATE=0) S DONE=1 Q
- . I BCKDATE>0 S DIFFS=$$FMDIFF^XLFDT(WDATE,BCKDATE,2),DIFFL(DIFFS,BCKDATE)=""
- . I FWDDATE>0 S DIFFS=$$FMDIFF^XLFDT(FWDDATE,WDATE,2),DIFFL(DIFFS,FWDDATE)=""
- . S DIFFS=$O(DIFFL("")),HDATE=$O(DIFFL(DIFFS,""))
- . I HDATE=0 Q
- . S DAS=$O(^PXRMINDX(120.5,"PI",DFN,8,HDATE,""))
- . D GETDATA^PXRMVITL(DAS,.TEMP)
- . I (TEMP("RATE")'=+TEMP("RATE"))!(TEMP("RATE")=0) K DIFFL(DIFFS,HDATE) Q
- . S HT=+(TEMP("RATE")*0.0254)
- . S DONE=1
- Q
- ;
- ;================================
- WANDHL(DFN,NGET,BDT,EDT,NFOUND,WHL) ;Return an ordered and
- ;paired list of weight and height measurements. Weight is in kilograms
- ;and height is in meters.
- N DAS,DIFFL,DIFFS,DONE,HT,HDATE,NOCC
- N SDIR,TDATE,TEMP,WLIST,WT
- S SDIR=$S(NGET>0:-1,1:1)
- S NOCC=$S(NGET>0:NGET,1:-NGET)
- ;Get a list of weight measurements in the date range.
- S TDATE=BDT-.000001
- F S TDATE=+$O(^PXRMINDX(120.5,"PI",DFN,9,TDATE)) Q:(TDATE=0)!(TDATE>EDT) D
- . S DAS=$O(^PXRMINDX(120.5,"PI",DFN,9,TDATE,""))
- . S WLIST(TDATE)=DAS
- ;Get up to NOCC BMI values.
- S TDATE="",(DONE,NFOUND)=0
- F S TDATE=$O(WLIST(TDATE),SDIR) Q:(DONE)!(TDATE="") D
- . S DAS=WLIST(TDATE)
- . K TEMP
- . D GETDATA^PXRMVITL(DAS,.TEMP)
- . I TEMP("RATE")'=+TEMP("RATE") Q
- . S WT=+TEMP("RATE")*0.4535924
- .;Find the closest height measurement.
- . D GHEIGHT(DFN,TDATE,.HT,.HDATE)
- . I HT=-1 Q
- . S NFOUND=NFOUND+1
- . S WHL(NFOUND)=TDATE_U_WT_U_HT_U_HDATE
- . I NFOUND=NOCC S DONE=1
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMBMI 4283 printed Feb 18, 2025@23:09:26 Page 2
- PXRMBMI ;SLC/PKR - National BMI and BSA computed finding. ;08/21/2019
- +1 ;;2.0;CLINICAL REMINDERS;**12,18,42**;Feb 04, 2005;Build 245
- +2 ;================================
- BMI(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;Multi-occurrence computed
- +1 ;finding for BMI.
- +2 NEW BMI,HDATE,HT,IND,TDATE,WHL,WT
- +3 ;Get the list of weight and height measurements.
- +4 DO WANDHL(DFN,NGET,BDT,EDT,.NFOUND,.WHL)
- +5 FOR IND=1:1:NFOUND
- Begin DoDot:1
- +6 SET TDATE=$PIECE(WHL(IND),U,1)
- SET WT=$PIECE(WHL(IND),U,2)
- +7 SET HT=$PIECE(WHL(IND),U,3)
- SET HDATE=$PIECE(WHL(IND),U,4)
- +8 SET TEST(IND)=1
- SET DATE(IND)=TDATE
- +9 SET TEXT(IND)="height measured "_$$EDATE^PXRMDATE(HDATE)
- +10 SET BMI=WT/(HT*HT)
- +11 SET BMI=$FNUMBER(BMI,"",1)
- +12 SET (DATA(IND,"VALUE"),DATA(IND,"BMI"))=BMI
- End DoDot:1
- +13 QUIT
- +14 ;
- +15 ;================================
- BSA(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;Multi-occurrence computed
- +1 ;finding for BSA. The coefficients have been adjusted for heights
- +2 ;in cm and weights in kg expect for Boyd where the weight is grams.
- +3 ;The default is to use the Mosteller formula.
- +4 NEW BSA,FORMULA,HDATE,HT,IND,TDATE,TYPE,WHL,WT
- +5 SET TYPE=$SELECT(TEST="":"M",TEST="M":"M",TEST="D":"D",TEST="H":"H",TEST="G":"G",TEST="B":"B",1:"M")
- +6 SET FORMULA=$SELECT(TYPE="M":"Mosteller",TYPE="B":"Boyd",TYPE="D":"DuBois and Dubois",TYPE="H":"Haycock",TYPE="G":"Gehan and George",1:"Mosteller")_" formula"
- +7 ;Get the list of weight and height measurements.
- +8 DO WANDHL(DFN,NGET,BDT,EDT,.NFOUND,.WHL)
- +9 FOR IND=1:1:NFOUND
- Begin DoDot:1
- +10 SET TDATE=$PIECE(WHL(IND),U,1)
- SET WT=$PIECE(WHL(IND),U,2)
- +11 SET HT=$PIECE(WHL(IND),U,3)
- SET HDATE=$PIECE(WHL(IND),U,4)
- +12 SET TEST(IND)=1
- SET DATE(IND)=TDATE
- +13 IF TYPE="M"
- SET BSA=$$SQRT^XLFMTH((WT*HT)/36)
- +14 IF TYPE="D"
- SET BSA=.20247*$$PWR^XLFMTH(HT,.725)*$$PWR^XLFMTH(WT,.425)
- +15 IF TYPE="H"
- SET BSA=.15058*$$PWR^XLFMTH(HT,.3964)*$$PWR^XLFMTH(WT,.5378)
- +16 IF TYPE="G"
- SET BSA=.164*$$PWR^XLFMTH(HT,.42246)*$$PWR^XLFMTH(WT,.51456)
- +17 IF TYPE="B"
- Begin DoDot:2
- +18 NEW WEXP
- +19 SET WT=1000*WT
- +20 SET WEXP=.7285-(.0188*$$LOG^XLFMTH(WT))
- +21 SET BSA=.001277*$$PWR^XLFMTH(HT,.3)*$$PWR^XLFMTH(WT,WEXP)
- End DoDot:2
- +22 SET BSA=$FNUMBER(BSA,"",2)
- +23 SET (DATA(IND,"VALUE"),DATA(IND,"BSA"))=BSA
- +24 SET TEXT(IND)=FORMULA_", height measured "_$$EDATE^PXRMDATE(HDATE)
- End DoDot:1
- +25 QUIT
- +26 ;
- +27 ;================================
- GHEIGHT(DFN,WDATE,HT,HDATE) ;Return the height measurement taken on the
- +1 ;date closest to WDATE (WDATE is the date of the weight measurement).
- +2 ;If no height is found return -1.
- +3 NEW BCKDATE,DAS,DIFFL,DIFFS,DONE,FWDDATE,TEMP
- +4 SET (DONE,HDATE)=0
- SET HT=-1
- +5 ;Check for height measured on same date and time.
- +6 SET DAS=$ORDER(^PXRMINDX(120.5,"PI",DFN,8,WDATE,""))
- +7 IF DAS'=""
- Begin DoDot:1
- +8 DO GETDATA^PXRMVITL(DAS,.TEMP)
- +9 IF TEMP("RATE")'=+TEMP("RATE")
- QUIT
- +10 SET HT=+(TEMP("RATE")*0.0254)
- SET HDATE=WDATE
- SET DONE=1
- End DoDot:1
- +11 IF 'DONE
- SET (BCKDATE,FWDDATE)=WDATE
- +12 FOR
- if DONE
- QUIT
- Begin DoDot:1
- +13 SET BCKDATE=+$ORDER(^PXRMINDX(120.5,"PI",DFN,8,BCKDATE),-1)
- +14 SET FWDDATE=+$ORDER(^PXRMINDX(120.5,"PI",DFN,8,FWDDATE))
- +15 IF (BCKDATE=0)
- IF (FWDDATE=0)
- SET DONE=1
- QUIT
- +16 IF BCKDATE>0
- SET DIFFS=$$FMDIFF^XLFDT(WDATE,BCKDATE,2)
- SET DIFFL(DIFFS,BCKDATE)=""
- +17 IF FWDDATE>0
- SET DIFFS=$$FMDIFF^XLFDT(FWDDATE,WDATE,2)
- SET DIFFL(DIFFS,FWDDATE)=""
- +18 SET DIFFS=$ORDER(DIFFL(""))
- SET HDATE=$ORDER(DIFFL(DIFFS,""))
- +19 IF HDATE=0
- QUIT
- +20 SET DAS=$ORDER(^PXRMINDX(120.5,"PI",DFN,8,HDATE,""))
- +21 DO GETDATA^PXRMVITL(DAS,.TEMP)
- +22 IF (TEMP("RATE")'=+TEMP("RATE"))!(TEMP("RATE")=0)
- KILL DIFFL(DIFFS,HDATE)
- QUIT
- +23 SET HT=+(TEMP("RATE")*0.0254)
- +24 SET DONE=1
- End DoDot:1
- +25 QUIT
- +26 ;
- +27 ;================================
- WANDHL(DFN,NGET,BDT,EDT,NFOUND,WHL) ;Return an ordered and
- +1 ;paired list of weight and height measurements. Weight is in kilograms
- +2 ;and height is in meters.
- +3 NEW DAS,DIFFL,DIFFS,DONE,HT,HDATE,NOCC
- +4 NEW SDIR,TDATE,TEMP,WLIST,WT
- +5 SET SDIR=$SELECT(NGET>0:-1,1:1)
- +6 SET NOCC=$SELECT(NGET>0:NGET,1:-NGET)
- +7 ;Get a list of weight measurements in the date range.
- +8 SET TDATE=BDT-.000001
- +9 FOR
- SET TDATE=+$ORDER(^PXRMINDX(120.5,"PI",DFN,9,TDATE))
- if (TDATE=0)!(TDATE>EDT)
- QUIT
- Begin DoDot:1
- +10 SET DAS=$ORDER(^PXRMINDX(120.5,"PI",DFN,9,TDATE,""))
- +11 SET WLIST(TDATE)=DAS
- End DoDot:1
- +12 ;Get up to NOCC BMI values.
- +13 SET TDATE=""
- SET (DONE,NFOUND)=0
- +14 FOR
- SET TDATE=$ORDER(WLIST(TDATE),SDIR)
- if (DONE)!(TDATE="")
- QUIT
- Begin DoDot:1
- +15 SET DAS=WLIST(TDATE)
- +16 KILL TEMP
- +17 DO GETDATA^PXRMVITL(DAS,.TEMP)
- +18 IF TEMP("RATE")'=+TEMP("RATE")
- QUIT
- +19 SET WT=+TEMP("RATE")*0.4535924
- +20 ;Find the closest height measurement.
- +21 DO GHEIGHT(DFN,TDATE,.HT,.HDATE)
- +22 IF HT=-1
- QUIT
- +23 SET NFOUND=NFOUND+1
- +24 SET WHL(NFOUND)=TDATE_U_WT_U_HT_U_HDATE
- +25 IF NFOUND=NOCC
- SET DONE=1
- End DoDot:1
- +26 QUIT
- +27 ;