- 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 Jan 18, 2025@02:59:32 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