GMVBMI ;HIOFO/YH,FT-EXTRACT HEIGHT TO CALCULATE BMI FOR WEIGHT; 5/9/07
;;5.0;GEN. MED. REC. - VITALS;**3,23**;Oct 31, 2002;Build 25
;
; This routine uses the following IAs:
; <None>
;
HT ;OBTAIN ALL HEIGHTS FOR THE PATIENT
; DFN MUST BE DEFINED
K GHEIGHT
S GH=0,GI=$O(^GMRD(120.51,"B","HEIGHT",0))
Q:GI'>0
F S GH=$O(^PXRMINDX(120.5,"PI",DFN,GI,GH)) Q:GH'>0 S GH(1)=0 F S GH(1)=$O(^PXRMINDX(120.5,"PI",DFN,GI,GH,GH(1))) Q:$L(GH(1))'>0 D
.I GH(1)=+GH(1) D ;VITALS RECORD
..I $D(^GMR(120.5,GH(1),0)),'$D(^GMR(120.5,GH(1),2)),$P(^GMR(120.5,GH(1),0),U,8)'="" D
...I $P(^GMR(120.5,GH(1),0),U,8)>0 S GHEIGHT($P(^GMR(120.5,GH(1),0),U,1))=$P(^GMR(120.5,GH(1),0),U,8)
...Q
..Q
.I GH(1)'=+GH(1) D
..N GMVCLIO
..D CLIO^GMVUTL(.GMVCLIO,GH(1))
..Q:$P(GMVCLIO(0),U,1)=""
..Q:$P(GMVCLIO(0),U,8)'>0
..I $P(GMVCLIO(0),U,8)>0 S GHEIGHT($P(GMVCLIO(0),U,1))=$P(GMVCLIO(0),U,8)
..Q
.Q
Q
CALBMI(GBMI,GMVDEC) ;OBTAIN HEIGHT TO CALCULATE BMI
; GBMI(1)=DATE/TIME WEIGHT WAS TAKEN
; GBMI(2)=WEIGHT
; GMVDEC = # of decimal places to return (optional)
; Can have 0, 1, 2, or 3.
; Default is 2.
N GDATE,GMRVHT
S GMRVHT="",GMVDEC=$G(GMVDEC,2)
S GMVDEC=$S(GMVDEC=3:3,GMVDEC=1:1,GMVDEC=0:0,1:2)
D HT
I '$D(GHEIGHT) K GHEIGHT,GI,GH Q
;HEIGHT AND WEIGHT WERE OBTAINED AT THE SAME TIME
I $D(GHEIGHT(GBMI(1))) D K GHEIGHT,GH,GI Q
.S GBMI(2)=GBMI(2)/2.2,GMRVHT=+GHEIGHT(GBMI(1))*2.54/100
.I +GMRVHT'>0 S GBMI=$J(0,0,0) Q
.S GBMI=$J(GBMI(2)/(GMRVHT*GMRVHT),0,GMVDEC) S GBMI=GBMI_$S(GBMI>27:"*",1:"")
;EXTRACT THE HEIGHT TAKEN BEFORE THE WEIGHT WAS TAKEN
S GDATE=GBMI(1),GDATE(1)=0
F S GDATE=$O(GHEIGHT(GDATE),-1) Q:GDATE'>0!(GDATE(1)>0) D
.S GDATE(1)=GDATE
I GDATE(1)>0,$D(GHEIGHT(GDATE(1))) D K GHEIGHT,GH,GI Q
.S GMRVHT=+GHEIGHT(GDATE(1))
.S GBMI(2)=GBMI(2)/2.2,GMRVHT=GMRVHT*2.54/100
.I +GMRVHT'>0 S GBMI=$J(0,0,0) Q
.S GBMI=$J(GBMI(2)/(GMRVHT*GMRVHT),0,GMVDEC),GBMI=GBMI_$S(GBMI>27:"*",1:"")
;EXTRACT THE HEIGHT TAKEN AFTER THE WEIGHT WAS TAKEN
S GDATE=GBMI(1),GDATE(1)=0
F S GDATE=$O(GHEIGHT(GDATE)) Q:GDATE'>0!(GDATE(1)>0) S GDATE(1)=GDATE
I GDATE(1)>0 D K GHEIGHT,GH,GI,G Q
.S GMRVHT=+GHEIGHT(GDATE(1))
.S GBMI(2)=GBMI(2)/2.2,GMRVHT=GMRVHT*2.54/100
.I +GMRVHT'>0 S GBMI=$J(0,0,0) Q
.S GBMI=$J(GBMI(2)/(GMRVHT*GMRVHT),0,GMVDEC),GBMI=GBMI_$S(GBMI>27:"*",1:"")
K GHEIGHT,GI,GH,G
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMVBMI 2395 printed Oct 16, 2024@17:59:01 Page 2
GMVBMI ;HIOFO/YH,FT-EXTRACT HEIGHT TO CALCULATE BMI FOR WEIGHT; 5/9/07
+1 ;;5.0;GEN. MED. REC. - VITALS;**3,23**;Oct 31, 2002;Build 25
+2 ;
+3 ; This routine uses the following IAs:
+4 ; <None>
+5 ;
HT ;OBTAIN ALL HEIGHTS FOR THE PATIENT
+1 ; DFN MUST BE DEFINED
+2 KILL GHEIGHT
+3 SET GH=0
SET GI=$ORDER(^GMRD(120.51,"B","HEIGHT",0))
+4 if GI'>0
QUIT
+5 FOR
SET GH=$ORDER(^PXRMINDX(120.5,"PI",DFN,GI,GH))
if GH'>0
QUIT
SET GH(1)=0
FOR
SET GH(1)=$ORDER(^PXRMINDX(120.5,"PI",DFN,GI,GH,GH(1)))
if $LENGTH(GH(1))'>0
QUIT
Begin DoDot:1
+6 ;VITALS RECORD
IF GH(1)=+GH(1)
Begin DoDot:2
+7 IF $DATA(^GMR(120.5,GH(1),0))
IF '$DATA(^GMR(120.5,GH(1),2))
IF $PIECE(^GMR(120.5,GH(1),0),U,8)'=""
Begin DoDot:3
+8 IF $PIECE(^GMR(120.5,GH(1),0),U,8)>0
SET GHEIGHT($PIECE(^GMR(120.5,GH(1),0),U,1))=$PIECE(^GMR(120.5,GH(1),0),U,8)
+9 QUIT
End DoDot:3
+10 QUIT
End DoDot:2
+11 IF GH(1)'=+GH(1)
Begin DoDot:2
+12 NEW GMVCLIO
+13 DO CLIO^GMVUTL(.GMVCLIO,GH(1))
+14 if $PIECE(GMVCLIO(0),U,1)=""
QUIT
+15 if $PIECE(GMVCLIO(0),U,8)'>0
QUIT
+16 IF $PIECE(GMVCLIO(0),U,8)>0
SET GHEIGHT($PIECE(GMVCLIO(0),U,1))=$PIECE(GMVCLIO(0),U,8)
+17 QUIT
End DoDot:2
+18 QUIT
End DoDot:1
+19 QUIT
CALBMI(GBMI,GMVDEC) ;OBTAIN HEIGHT TO CALCULATE BMI
+1 ; GBMI(1)=DATE/TIME WEIGHT WAS TAKEN
+2 ; GBMI(2)=WEIGHT
+3 ; GMVDEC = # of decimal places to return (optional)
+4 ; Can have 0, 1, 2, or 3.
+5 ; Default is 2.
+6 NEW GDATE,GMRVHT
+7 SET GMRVHT=""
SET GMVDEC=$GET(GMVDEC,2)
+8 SET GMVDEC=$SELECT(GMVDEC=3:3,GMVDEC=1:1,GMVDEC=0:0,1:2)
+9 DO HT
+10 IF '$DATA(GHEIGHT)
KILL GHEIGHT,GI,GH
QUIT
+11 ;HEIGHT AND WEIGHT WERE OBTAINED AT THE SAME TIME
+12 IF $DATA(GHEIGHT(GBMI(1)))
Begin DoDot:1
+13 SET GBMI(2)=GBMI(2)/2.2
SET GMRVHT=+GHEIGHT(GBMI(1))*2.54/100
+14 IF +GMRVHT'>0
SET GBMI=$JUSTIFY(0,0,0)
QUIT
+15 SET GBMI=$JUSTIFY(GBMI(2)/(GMRVHT*GMRVHT),0,GMVDEC)
SET GBMI=GBMI_$SELECT(GBMI>27:"*",1:"")
End DoDot:1
KILL GHEIGHT,GH,GI
QUIT
+16 ;EXTRACT THE HEIGHT TAKEN BEFORE THE WEIGHT WAS TAKEN
+17 SET GDATE=GBMI(1)
SET GDATE(1)=0
+18 FOR
SET GDATE=$ORDER(GHEIGHT(GDATE),-1)
if GDATE'>0!(GDATE(1)>0)
QUIT
Begin DoDot:1
+19 SET GDATE(1)=GDATE
End DoDot:1
+20 IF GDATE(1)>0
IF $DATA(GHEIGHT(GDATE(1)))
Begin DoDot:1
+21 SET GMRVHT=+GHEIGHT(GDATE(1))
+22 SET GBMI(2)=GBMI(2)/2.2
SET GMRVHT=GMRVHT*2.54/100
+23 IF +GMRVHT'>0
SET GBMI=$JUSTIFY(0,0,0)
QUIT
+24 SET GBMI=$JUSTIFY(GBMI(2)/(GMRVHT*GMRVHT),0,GMVDEC)
SET GBMI=GBMI_$SELECT(GBMI>27:"*",1:"")
End DoDot:1
KILL GHEIGHT,GH,GI
QUIT
+25 ;EXTRACT THE HEIGHT TAKEN AFTER THE WEIGHT WAS TAKEN
+26 SET GDATE=GBMI(1)
SET GDATE(1)=0
+27 FOR
SET GDATE=$ORDER(GHEIGHT(GDATE))
if GDATE'>0!(GDATE(1)>0)
QUIT
SET GDATE(1)=GDATE
+28 IF GDATE(1)>0
Begin DoDot:1
+29 SET GMRVHT=+GHEIGHT(GDATE(1))
+30 SET GBMI(2)=GBMI(2)/2.2
SET GMRVHT=GMRVHT*2.54/100
+31 IF +GMRVHT'>0
SET GBMI=$JUSTIFY(0,0,0)
QUIT
+32 SET GBMI=$JUSTIFY(GBMI(2)/(GMRVHT*GMRVHT),0,GMVDEC)
SET GBMI=GBMI_$SELECT(GBMI>27:"*",1:"")
End DoDot:1
KILL GHEIGHT,GH,GI,G
QUIT
+33 KILL GHEIGHT,GI,GH,G
+34 QUIT
