source: WorldVistAEHR/trunk/r/GEN_MED_REC_VITALS-GMRV/GMRVBMI.m@ 1604

Last change on this file since 1604 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 1.8 KB
Line 
1GMRVBMI ;HIRMFO/YH-EXTRACT HEIGHT TO CALCULATE BMI FOR WEIGHT; 3/24/97
2 ;;4.0;Vitals/Measurements;**1**;Apr 25, 1997
3HT ;OBTAIN THE LATEST HEIGHT FOR THE CURRENT WEIGHT
4 K GHEIGHT S GI=$O(^GMRD(120.51,"B","HEIGHT",0)) Q:GI'>0
5 S GH=0 F S GH=$O(^GMR(120.5,"AA",DFN,GI,GH)) Q:GH'>0 S GH(1)=0 F S GH(1)=$O(^GMR(120.5,"AA",DFN,GI,GH,GH(1))) Q:GH(1)'>0 I $D(^GMR(120.5,GH(1),0)),'$D(^GMR(120.5,GH(1),2)),$P(^GMR(120.5,GH(1),0),"^",8)'="" D
6 . I $P(^GMR(120.5,GH(1),0),"^",8)>0 S GHEIGHT($P(^(0),"^"))=$P(^(0),"^",8)
7 Q
8CALBMI(GBMI) ;OBTAIN HEIGHT TO CALCULATE BMI
9 N GDATE,GMRVHT S GMRVHT="" D HT I '$D(GHEIGHT) K GHEIGHT,GI,GH Q
10 ;HEIGHT AND WEIGHT WERE OBTAINED AT THE SAME TIME
11 I $D(GHEIGHT(GBMI(1))) D K GHEIGHT,GH,GI Q
12 . S GBMI(2)=GBMI(2)/2.2,GMRVHT=+GHEIGHT(GBMI(1))*2.54/100
13 . I +GMRVHT'>0 S GBMI=$J(0,0,0) Q
14 . S GBMI=$J(GBMI(2)/(GMRVHT*GMRVHT),0,0) S GBMI=GBMI_$S(GBMI>27:"*",1:"")
15 ;EXTRACT THE HEIGHT TAKEN BEFORE THE WEIGHT WAS TAKEN
16 S GDATE=9999999-GBMI(1),GDATE(1)=0 F S GDATE=$O(^GMR(120.5,"AA",DFN,GI,GDATE)) Q:GDATE'>0!(GDATE(1)>0) D
17 . S G=$O(^GMR(120.5,"AA",DFN,GI,GDATE,0)) Q:G'>0 I $P($G(^GMR(120.5,G,0)),"^",8)'>0 Q
18 . S GDATE(1)=GDATE
19 ;EXTRACT THE HEIGHT TAKEN AFTER THE WEIGHT WAS TAKEN
20 I GDATE(1)>0,$D(GHEIGHT(9999999-GDATE(1))) D K GHEIGHT,GH,GI Q
21 . S GDATE(1)=9999999-GDATE(1),GMRVHT=+GHEIGHT(GDATE(1))
22 . S GBMI(2)=GBMI(2)/2.2,GMRVHT=GMRVHT*2.54/100
23 . I +GMRVHT'>0 S GBMI=$J(0,0,0) Q
24 . S GBMI=$J(GBMI(2)/(GMRVHT*GMRVHT),0,0),GBMI=GBMI_$S(GBMI>27:"*",1:"")
25 S GDATE=GBMI(1),GDATE(1)=0 F S GDATE=$O(GHEIGHT(GDATE)) Q:GDATE'>0!(GDATE(1)>0) S GDATE(1)=GDATE
26 I GDATE(1)>0 D K GHEIGHT,GH,GI,G Q
27 . S GMRVHT=+GHEIGHT(GDATE(1))
28 . S GBMI(2)=GBMI(2)/2.2,GMRVHT=GMRVHT*2.54/100
29 . I +GMRVHT'>0 S GBMI=$J(0,0,0) Q
30 . S GBMI=$J(GBMI(2)/(GMRVHT*GMRVHT),0,0),GBMI=GBMI_$S(GBMI>27:"*",1:"")
31 K GHEIGHT,GI,GH,G Q
Note: See TracBrowser for help on using the repository browser.