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

PXRMBMI.m

Go to the documentation of this file.
  1. 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
  1. ;================================
  1. BMI(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;Multi-occurrence computed
  1. ;finding for BMI.
  1. N BMI,HDATE,HT,IND,TDATE,WHL,WT
  1. ;Get the list of weight and height measurements.
  1. D WANDHL(DFN,NGET,BDT,EDT,.NFOUND,.WHL)
  1. F IND=1:1:NFOUND D
  1. . S TDATE=$P(WHL(IND),U,1),WT=$P(WHL(IND),U,2)
  1. . S HT=$P(WHL(IND),U,3),HDATE=$P(WHL(IND),U,4)
  1. . S TEST(IND)=1,DATE(IND)=TDATE
  1. . S TEXT(IND)="height measured "_$$EDATE^PXRMDATE(HDATE)
  1. . S BMI=WT/(HT*HT)
  1. . S BMI=$FN(BMI,"",1)
  1. . S (DATA(IND,"VALUE"),DATA(IND,"BMI"))=BMI
  1. Q
  1. ;
  1. ;================================
  1. BSA(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;Multi-occurrence computed
  1. ;finding for BSA. The coefficients have been adjusted for heights
  1. ;in cm and weights in kg expect for Boyd where the weight is grams.
  1. ;The default is to use the Mosteller formula.
  1. N BSA,FORMULA,HDATE,HT,IND,TDATE,TYPE,WHL,WT
  1. S TYPE=$S(TEST="":"M",TEST="M":"M",TEST="D":"D",TEST="H":"H",TEST="G":"G",TEST="B":"B",1:"M")
  1. 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"
  1. ;Get the list of weight and height measurements.
  1. D WANDHL(DFN,NGET,BDT,EDT,.NFOUND,.WHL)
  1. F IND=1:1:NFOUND D
  1. . S TDATE=$P(WHL(IND),U,1),WT=$P(WHL(IND),U,2)
  1. . S HT=$P(WHL(IND),U,3),HDATE=$P(WHL(IND),U,4)
  1. . S TEST(IND)=1,DATE(IND)=TDATE
  1. . I TYPE="M" S BSA=$$SQRT^XLFMTH((WT*HT)/36)
  1. . I TYPE="D" S BSA=.20247*$$PWR^XLFMTH(HT,.725)*$$PWR^XLFMTH(WT,.425)
  1. . I TYPE="H" S BSA=.15058*$$PWR^XLFMTH(HT,.3964)*$$PWR^XLFMTH(WT,.5378)
  1. . I TYPE="G" S BSA=.164*$$PWR^XLFMTH(HT,.42246)*$$PWR^XLFMTH(WT,.51456)
  1. . I TYPE="B" D
  1. .. N WEXP
  1. .. S WT=1000*WT
  1. .. S WEXP=.7285-(.0188*$$LOG^XLFMTH(WT))
  1. .. S BSA=.001277*$$PWR^XLFMTH(HT,.3)*$$PWR^XLFMTH(WT,WEXP)
  1. . S BSA=$FN(BSA,"",2)
  1. . S (DATA(IND,"VALUE"),DATA(IND,"BSA"))=BSA
  1. . S TEXT(IND)=FORMULA_", height measured "_$$EDATE^PXRMDATE(HDATE)
  1. Q
  1. ;
  1. ;================================
  1. 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).
  1. ;If no height is found return -1.
  1. N BCKDATE,DAS,DIFFL,DIFFS,DONE,FWDDATE,TEMP
  1. S (DONE,HDATE)=0,HT=-1
  1. ;Check for height measured on same date and time.
  1. S DAS=$O(^PXRMINDX(120.5,"PI",DFN,8,WDATE,""))
  1. I DAS'="" D
  1. . D GETDATA^PXRMVITL(DAS,.TEMP)
  1. . I TEMP("RATE")'=+TEMP("RATE") Q
  1. . S HT=+(TEMP("RATE")*0.0254),HDATE=WDATE,DONE=1
  1. I 'DONE S (BCKDATE,FWDDATE)=WDATE
  1. F Q:DONE D
  1. . S BCKDATE=+$O(^PXRMINDX(120.5,"PI",DFN,8,BCKDATE),-1)
  1. . S FWDDATE=+$O(^PXRMINDX(120.5,"PI",DFN,8,FWDDATE))
  1. . I (BCKDATE=0),(FWDDATE=0) S DONE=1 Q
  1. . I BCKDATE>0 S DIFFS=$$FMDIFF^XLFDT(WDATE,BCKDATE,2),DIFFL(DIFFS,BCKDATE)=""
  1. . I FWDDATE>0 S DIFFS=$$FMDIFF^XLFDT(FWDDATE,WDATE,2),DIFFL(DIFFS,FWDDATE)=""
  1. . S DIFFS=$O(DIFFL("")),HDATE=$O(DIFFL(DIFFS,""))
  1. . I HDATE=0 Q
  1. . S DAS=$O(^PXRMINDX(120.5,"PI",DFN,8,HDATE,""))
  1. . D GETDATA^PXRMVITL(DAS,.TEMP)
  1. . I (TEMP("RATE")'=+TEMP("RATE"))!(TEMP("RATE")=0) K DIFFL(DIFFS,HDATE) Q
  1. . S HT=+(TEMP("RATE")*0.0254)
  1. . S DONE=1
  1. Q
  1. ;
  1. ;================================
  1. WANDHL(DFN,NGET,BDT,EDT,NFOUND,WHL) ;Return an ordered and
  1. ;paired list of weight and height measurements. Weight is in kilograms
  1. ;and height is in meters.
  1. N DAS,DIFFL,DIFFS,DONE,HT,HDATE,NOCC
  1. N SDIR,TDATE,TEMP,WLIST,WT
  1. S SDIR=$S(NGET>0:-1,1:1)
  1. S NOCC=$S(NGET>0:NGET,1:-NGET)
  1. ;Get a list of weight measurements in the date range.
  1. S TDATE=BDT-.000001
  1. F S TDATE=+$O(^PXRMINDX(120.5,"PI",DFN,9,TDATE)) Q:(TDATE=0)!(TDATE>EDT) D
  1. . S DAS=$O(^PXRMINDX(120.5,"PI",DFN,9,TDATE,""))
  1. . S WLIST(TDATE)=DAS
  1. ;Get up to NOCC BMI values.
  1. S TDATE="",(DONE,NFOUND)=0
  1. F S TDATE=$O(WLIST(TDATE),SDIR) Q:(DONE)!(TDATE="") D
  1. . S DAS=WLIST(TDATE)
  1. . K TEMP
  1. . D GETDATA^PXRMVITL(DAS,.TEMP)
  1. . I TEMP("RATE")'=+TEMP("RATE") Q
  1. . S WT=+TEMP("RATE")*0.4535924
  1. .;Find the closest height measurement.
  1. . D GHEIGHT(DFN,TDATE,.HT,.HDATE)
  1. . I HT=-1 Q
  1. . S NFOUND=NFOUND+1
  1. . S WHL(NFOUND)=TDATE_U_WT_U_HT_U_HDATE
  1. . I NFOUND=NOCC S DONE=1
  1. Q
  1. ;