source: qrda/C0Q/trunk/p/C0QRMBMI.m@ 1700

Last change on this file since 1700 was 1487, checked in by Sam Habiel, 12 years ago

computered finding for BMI percentile; updated init routine
File size: 5.1 KB
Line 
1C0QRMBMI ; SLC/PKR - National BMI and BSA computed finding; 7/16/12 3:36pm
2 ;;1.0;QUALITY MEASURES;**1**;
3 ;
4 ; VEN/SMH - on July 16 2012
5 ; Added PBMI as a new Computed Finding -- essentially the same as BMI
6 ; PBMI = Percentile BMI;
7 ;
8 ; Copy of Routine PXRMBMI stolen from Patrick Reddington
9 ;
10 ;================================
11BMI(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;Multi-occurrence computed
12 ;finding for BMI.
13 N BMI,HDATE,HT,IND,TDATE,WHL,WT
14 ;Get the list of weight and height measurements.
15 D WANDHL(DFN,NGET,BDT,EDT,.NFOUND,.WHL)
16 F IND=1:1:NFOUND D
17 . S TDATE=$P(WHL(IND),U,1),WT=$P(WHL(IND),U,2)
18 . S HT=$P(WHL(IND),U,3),HDATE=$P(WHL(IND),U,4)
19 . S TEST(IND)=1,DATE(IND)=TDATE
20 . S TEXT(IND)="height measured "_$$EDATE^PXRMDATE(HDATE)
21 . S BMI=WT/(HT*HT)
22 . S BMI=$FN(BMI,"",1)
23 . S (DATA(IND,"VALUE"),DATA(IND,"BMI"))=BMI
24 Q
25 ;
26 ; VEN/SMH -> Begin addition to routine
27PBMI(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ; Multi-occurrence computed
28 ; finding for BMI percentile
29 N BMI,HDATE,HT,IND,TDATE,WHL,WT,BMI
30 ;Get the list of weight and height measurements.
31 D WANDHL(DFN,NGET,BDT,EDT,.NFOUND,.WHL)
32 F IND=1:1:NFOUND D
33 . S TDATE=$P(WHL(IND),U,1),WT=$P(WHL(IND),U,2)
34 . S HT=$P(WHL(IND),U,3),HDATE=$P(WHL(IND),U,4)
35 . S TEST(IND)=1,DATE(IND)=TDATE
36 . S TEXT(IND)="height measured "_$$EDATE^PXRMDATE(HDATE)
37 . S BMI=WT/(HT*HT)
38 . N PBMI S PBMI=0 ; BMI Percentile
39 . N GENDER S GENDER=$P(^DPT(DFN,0),U,2)
40 . N DOB S DOB=$P(^DPT(DFN,0),U,3)
41 . N AGE S AGE=$$FMDIFF^XLFDT($$DT^XLFDT(),DOB,1)/365.24 ; Age in yrs
42 . I $T(BMIPCTL^TMGGRC1)]"" S PBMI=$$BMIPCTL^TMGGRC1(AGE,GENDER,BMI,"")
43 . S PBMI=+PBMI ; We get a textish result (e.g. 78th percentile)
44 . S (DATA(IND,"VALUE"),DATA(IND,"BMI%ILE"))=PBMI
45 Q
46 ; VEN/SMH <- End
47 ;
48 ;================================
49BSA(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;Multi-occurrence computed
50 ;finding for BSA. The coefficients have been adjusted for heights
51 ;in cm and weights in kg expect for Boyd where the weight is grams.
52 ;The default is to use the Mosteller formula.
53 N BSA,FORMULA,HT,IND,TDATE,TYPE,WHL,WT
54 S TYPE=$S(TEST="":"M",TEST="M":"M",TEST="D":"D",TEST="H":"H",TEST="G":"G",TEST="B":"B",1:"M")
55 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"
56 ;Get the list of weight and height measurements.
57 D WANDHL(DFN,NGET,BDT,EDT,.NFOUND,.WHL)
58 F IND=1:1:NFOUND D
59 . S TDATE=$P(WHL(IND),U,1),WT=$P(WHL(IND),U,2)
60 . S HT=$P(WHL(IND),U,3),HDATE=$P(WHL(IND),U,4)
61 . S TEST(IND)=1,DATE(IND)=TDATE
62 . I TYPE="M" S BSA=$$SQRT^XLFMTH((WT*HT)/36)
63 . I TYPE="D" S BSA=.20247*$$PWR^XLFMTH(HT,.725)*$$PWR^XLFMTH(WT,.425)
64 . I TYPE="H" S BSA=.15058*$$PWR^XLFMTH(HT,.3964)*$$PWR^XLFMTH(WT,.5378)
65 . I TYPE="G" S BSA=.164*$$PWR^XLFMTH(HT,.42246)*$$PWR^XLFMTH(WT,.51456)
66 . I TYPE="B" D
67 .. N WEXP
68 .. S WT=1000*WT
69 .. S WEXP=.7285-(.0188*$$LOG^XLFMTH(WT))
70 .. S BSA=.001277*$$PWR^XLFMTH(HT,.3)*$$PWR^XLFMTH(WT,WEXP)
71 . S BSA=$FN(BSA,"",2)
72 . S (DATA(IND,"VALUE"),DATA(IND,"BSA"))=BSA
73 . S TEXT(IND)=FORMULA_", height measured "_$$EDATE^PXRMDATE(HDATE)
74 Q
75 ;
76 ;================================
77GHEIGHT(DFN,WDATE,HT,HDATE) ;Return the height measurement taken on the
78 ;date closest to WDATE (WDATE is the date of the weight measurement). If no height is
79 ;found return -1.
80 N BCKDATE,DAS,DIFFL,DIFFS,DONE,FWDDATE,TEMP
81 S (DONE,HDATE)=0,HT=-1
82 ;Check for height measured on same date and time.
83 S DAS=$O(^PXRMINDX(120.5,"PI",DFN,8,WDATE,""))
84 I DAS'="" D
85 . D GETDATA^PXRMVITL(DAS,.TEMP)
86 . I TEMP("RATE")'=+TEMP("RATE") Q
87 . S HT=+(TEMP("RATE")*0.0254),HDATE=WDATE,DONE=1
88 I 'DONE S (BCKDATE,FWDDATE)=WDATE
89 F Q:DONE D
90 . S BCKDATE=+$O(^PXRMINDX(120.5,"PI",DFN,8,BCKDATE),-1)
91 . S FWDDATE=+$O(^PXRMINDX(120.5,"PI",DFN,8,FWDDATE))
92 . I (BCKDATE=0),(FWDDATE=0) S DONE=1 Q
93 . S DIFFS=$$FMDIFF^XLFDT(WDATE,BCKDATE,2),DIFFL(DIFFS,BCKDATE)=""
94 . S DIFFS=$$FMDIFF^XLFDT(FWDDATE,WDATE,2)
95 . S DIFFS=$S(DIFFS<0:-DIFFS,1:DIFFS),DIFFL(DIFFS,FWDDATE)=""
96 . S DIFFS=$O(DIFFL("")),HDATE=$O(DIFFL(DIFFS,""))
97 . I HDATE=0 Q
98 . S DAS=$O(^PXRMINDX(120.5,"PI",DFN,8,HDATE,""))
99 . D GETDATA^PXRMVITL(DAS,.TEMP)
100 . I TEMP("RATE")'=+TEMP("RATE") K DIFFL(DIFFS,HDATE) Q
101 . S HT=+(TEMP("RATE")*0.0254)
102 . S DONE=1
103 Q
104 ;
105 ;================================
106WANDHL(DFN,NGET,BDT,EDT,NFOUND,WHL) ;Return an ordered and
107 ;paired list of weight and height measurements. Weight is in kilograms
108 ;and height is in meters.
109 N DAS,DIFFL,DIFFS,DONE,HT,HDATE,NOCC
110 N SDIR,TDATE,TEMP,WLIST,WT
111 S SDIR=$S(NGET>0:-1,1:1)
112 S NOCC=$S(NGET>0:NGET,1:-NGET)
113 ;Get a list of weight measurements in the date range.
114 S TDATE=BDT-.000001
115 F S TDATE=+$O(^PXRMINDX(120.5,"PI",DFN,9,TDATE)) Q:(TDATE=0)!(TDATE>EDT) D
116 . S DAS=$O(^PXRMINDX(120.5,"PI",DFN,9,TDATE,""))
117 . S WLIST(TDATE)=DAS
118 ;Get up to NOCC BMI values.
119 S TDATE="",(DONE,NFOUND)=0
120 F S TDATE=$O(WLIST(TDATE),SDIR) Q:(DONE)!(TDATE="") D
121 . S DAS=WLIST(TDATE)
122 . K TEMP
123 . D GETDATA^PXRMVITL(DAS,.TEMP)
124 . I TEMP("RATE")'=+TEMP("RATE") Q
125 . S WT=+TEMP("RATE")*0.4535924
126 .;Find the closest height measurement.
127 . D GHEIGHT(DFN,TDATE,.HT,.HDATE)
128 . I HT=-1 Q
129 . S NFOUND=NFOUND+1
130 . S WHL(NFOUND)=TDATE_U_WT_U_HT_U_HDATE
131 . I NFOUND=NOCC S DONE=1
132 Q
133 ;
Note: See TracBrowser for help on using the repository browser.