GMVHS1 ;HIOFO/FT-RETURN PATIENT DATA UTILITY (cont.) ;10/3/07
;;5.0;GEN. MED. REC. - VITALS;**3,23**;Oct 31, 2002;Build 25
;
; This routine uses the following IAs:
; #4290 - ^PXRMINDX global (controlled)
;
CALCBMI(GMVNODE) ; Calculate BMI for a record
; GMVNODE = FILE 120.5 zero node of patient's weight
N GMVADATE,GMVAHGT,GMVBDATE,GMVBHGT,GMVBMI,GMVDFN,GMVH,GMVHTI,GMVIEN,GMVHGT,GMVWDATE,GMVWTI
S GMVHTI=$$GETTYPEI^GMVHS("HT") ;height ien
S GMVWTI=$$GETTYPEI^GMVHS("WT") ;weight ien
S GMVBMI="^",GMVNODE=$G(GMVNODE)
I $P(GMVNODE,U,3)'=GMVWTI Q GMVBMI ;not a weight reading
I $P(GMVNODE,U,8)'>0 Q GMVBMI ;weight'>0
S GMVDFN=$P(GMVNODE,U,2)
I 'GMVDFN Q GMVBMI
S GMVWDATE=$P(GMVNODE,U,1) ;date/time of weight
S GMVHGT=0
; Look for exact date/time match for height entry
S GMVIEN=$O(^PXRMINDX(120.5,"PI",GMVDFN,GMVHTI,GMVWDATE,0))
I GMVIEN'="" S GMVHGT=$$HEIGHT(GMVIEN)
I $P(GMVHGT,U,1) S GMVBMI=$$CALC($P(GMVNODE,U,8),$P(GMVHGT,U,1)) Q GMVBMI
; get height and date/time taken before weight
S GMVBDATE=GMVWDATE,GMVBHGT=0
F S GMVBDATE=$O(^PXRMINDX(120.5,"PI",GMVDFN,GMVHTI,GMVBDATE),-1) Q:GMVBDATE'>0!(+GMVBHGT) D
.S GMVIEN=0
.F S GMVIEN=$O(^PXRMINDX(120.5,"PI",GMVDFN,GMVHTI,GMVBDATE,GMVIEN)) Q:$L(GMVIEN)'>0!(+GMVBHGT) D
..S GMVBHGT=$$HEIGHT(GMVIEN)
..Q
.Q
; get height and date/time taken after weight
S GMVADATE=GMVWDATE,GMVAHGT=0
F S GMVADATE=$O(^PXRMINDX(120.5,"PI",GMVDFN,GMVHTI,GMVADATE)) Q:GMVADATE'>0!(+GMVAHGT) D
.S GMVIEN=0
.F S GMVIEN=$O(^PXRMINDX(120.5,"PI",GMVDFN,GMVHTI,GMVADATE,GMVIEN)) Q:$L(GMVIEN)'>0!(+GMVAHGT) D
..S GMVAHGT=$$HEIGHT(GMVIEN)
..Q
.Q
S GMVBDATE=$P(GMVBHGT,U,2),GMVBHGT=$P(GMVBHGT,U,1)
S GMVADATE=$P(GMVAHGT,U,2),GMVAHGT=$P(GMVAHGT,U,1)
I $P(GMVBDATE,".",1)=$P(GMVWDATE,".",1) S GMVBMI=$$CALC($P(GMVNODE,U,8),GMVBHGT) Q GMVBMI
I $P(GMVADATE,".",1)=$P(GMVWDATE,".",1) S GMVBMI=$$CALC($P(GMVNODE,U,8),GMVAHGT) Q GMVBMI
S GMVH=$S(GMVBHGT>0:GMVBHGT,GMVAHGT>0:GMVAHGT,1:"")
I GMVH="" Q GMVBMI
S GMVBMI=$$CALC($P(GMVNODE,U,8),GMVH) Q GMVBMI
Q GMVBMI
;
HEIGHT(GMVIEN) ; Does record have a useable height value? Is yes, return that value.
; GMVIEN = File 120.5 entry number
N GMVCLIO,GMVX
S GMVIEN=$G(GMVIEN),GMVX=0
I GMVIEN=+GMVIEN D
.D F1205^GMVUTL(.GMVCLIO,GMVIEN)
I GMVIEN'=+GMVIEN D
.D CLIO^GMVUTL(.GMVCLIO,GMVIEN)
S GMVCLIO(0)=$G(GMVCLIO(0))
S GMVX=$P(GMVCLIO(0),U,8)
I GMVX'>0 Q GMVX
S GMVX=GMVX_U_$P(GMVCLIO(0),U,1)
Q GMVX
;
CALC(GMVWT,GMVHT) ; Crunch the numbers, return bmi score
; GMVWT (lb)
; GMVHT (in)
N GMVX
S GMVWT=$G(GMVWT),GMVHT=$G(GMVHT)
I 'GMVWT!(GMVHT'>0) Q ""
S GMVWT=GMVWT/2.2,GMVHT=GMVHT*2.54/100
S GMVX=$J(GMVWT/(GMVHT*GMVHT),0,0) S GMVX=GMVX_$S(GMVX>27:"*",1:"")
Q GMVX
;
ABNORMAL ; Is reading outside of normal range?
N GMVASTRK,GMVDIA,GMVSYS
S GMVASTRK=""
I GMVTYPE="T" D
.S:GMVRATE>$P(GMVABNML("T"),U,1) GMVASTRK="*"
.S:GMVRATE<$P(GMVABNML("T"),U,2) GMVASTRK="*"
.Q
I GMVTYPE="P" D
.S:GMVRATE>$P(GMVABNML("P"),U,1) GMVASTRK="*"
.S:GMVRATE<$P(GMVABNML("P"),U,2) GMVASTRK="*"
.Q
I GMVTYPE="R" D
.S:GMVRATE>$P(GMVABNML("R"),U,1) GMVASTRK="*"
.S:GMVRATE<$P(GMVABNML("R"),U,2) GMVASTRK="*"
.Q
I GMVTYPE="BP" D
.S GMVSYS=$P(GMVRATE,"/",1)
.S GMVDIA=$S($P(GMVRATE,"/",3)="":$P(GMVRATE,"/",2),1:$P(GMVRATE,"/",3))
.S:GMVSYS>$P(GMVABNML("BP"),U,1) GMVASTRK="*"
.S:GMVSYS<$P(GMVABNML("BP"),U,2) GMVASTRK="*"
.S:GMVDIA>$P(GMVABNML("BP"),U,3) GMVASTRK="*"
.S:GMVDIA<$P(GMVABNML("BP"),U,4) GMVASTRK="*"
.Q
I GMVTYPE="CVP" D
.S:GMVRATE>$P(GMVABNML("CVP"),U,1) GMVASTRK="*"
.S:GMVRATE<$P(GMVABNML("CVP"),U,2) GMVASTRK="*"
.Q
I GMVTYPE="PO2" D
.S:GMVRATE<$P(GMVABNML("PO2"),U,2) GMVASTRK="*"
.Q
S $P(GMVDATA,U,12)=GMVASTRK
Q
TEXT(RATE) ; Is rate a text code?
; Returns 0 if RATE has a text code and 1 if a numeric reading
N GMVYES
S RATE=$G(RATE),GMVYES=1
I "REFUSEDPASSUNAVAILABLE"[$$UP^XLFSTR(RATE) S GMVYES=0
Q GMVYES
;
RANGE ; Find normal ranges and store in array
N GMVPIEN,GMVPNODE
S GMVABNML("T")="0^0" ;high^low
S GMVABNML("P")="0^0" ;high^low
S GMVABNML("R")="0^0" ;high^low
S GMVABNML("CVP")="0^0" ;high^low
S GMVABNML("PO2")="0^0" ;low
S GMVABNML("BP")="0^0^0^0" ;sys high^sys low^dia high^dia low
S GMVPIEN=$O(^GMRD(120.57,0))
Q:'GMVPIEN
S GMVPNODE=$G(^GMRD(120.57,GMVPIEN,1))
S GMVABNML("T")=$P(GMVPNODE,U,1)_U_$P(GMVPNODE,U,2)
S GMVABNML("P")=$P(GMVPNODE,U,3)_U_$P(GMVPNODE,U,4)
S GMVABNML("R")=$P(GMVPNODE,U,5)_U_$P(GMVPNODE,U,6)
S GMVABNML("BP")=$P(GMVPNODE,U,7)_U_$P(GMVPNODE,U,9)_U_$P(GMVPNODE,U,8)_U_$P(GMVPNODE,U,10)
S GMVABNML("CVP")=$P(GMVPNODE,U,11)_U_$P(GMVPNODE,U,12)
S GMVABNML("PO2")=""_U_$P(GMVPNODE,U,13)
Q
GMVHS1 ;HIOFO/FT-RETURN PATIENT DATA UTILITY (cont.) ;10/3/07
+1 ;;5.0;GEN. MED. REC. - VITALS;**3,23**;Oct 31, 2002;Build 25
+2 ;
+3 ; This routine uses the following IAs:
+4 ; #4290 - ^PXRMINDX global (controlled)
+5 ;
CALCBMI(GMVNODE) ; Calculate BMI for a record
+1 ; GMVNODE = FILE 120.5 zero node of patient's weight
+2 NEW GMVADATE,GMVAHGT,GMVBDATE,GMVBHGT,GMVBMI,GMVDFN,GMVH,GMVHTI,GMVIEN,GMVHGT,GMVWDATE,GMVWTI
+3 ;height ien
SET GMVHTI=$$GETTYPEI^GMVHS("HT")
+4 ;weight ien
SET GMVWTI=$$GETTYPEI^GMVHS("WT")
+5 SET GMVBMI="^"
SET GMVNODE=$GET(GMVNODE)
+6 ;not a weight reading
IF $PIECE(GMVNODE,U,3)'=GMVWTI
QUIT GMVBMI
+7 ;weight'>0
IF $PIECE(GMVNODE,U,8)'>0
QUIT GMVBMI
+8 SET GMVDFN=$PIECE(GMVNODE,U,2)
+9 IF 'GMVDFN
QUIT GMVBMI
+10 ;date/time of weight
SET GMVWDATE=$PIECE(GMVNODE,U,1)
+11 SET GMVHGT=0
+12 ; Look for exact date/time match for height entry
+13 SET GMVIEN=$ORDER(^PXRMINDX(120.5,"PI",GMVDFN,GMVHTI,GMVWDATE,0))
+14 IF GMVIEN'=""
SET GMVHGT=$$HEIGHT(GMVIEN)
+15 IF $PIECE(GMVHGT,U,1)
SET GMVBMI=$$CALC($PIECE(GMVNODE,U,8),$PIECE(GMVHGT,U,1))
QUIT GMVBMI
+16 ; get height and date/time taken before weight
+17 SET GMVBDATE=GMVWDATE
SET GMVBHGT=0
+18 FOR
SET GMVBDATE=$ORDER(^PXRMINDX(120.5,"PI",GMVDFN,GMVHTI,GMVBDATE),-1)
IF GMVBDATE'>0!(+GMVBHGT)
QUIT
Begin DoDot:1
+19 SET GMVIEN=0
+20 FOR
SET GMVIEN=$ORDER(^PXRMINDX(120.5,"PI",GMVDFN,GMVHTI,GMVBDATE,GMVIEN))
IF $LENGTH(GMVIEN)'>0!(+GMVBHGT)
QUIT
Begin DoDot:2
+21 SET GMVBHGT=$$HEIGHT(GMVIEN)
+22 QUIT
End DoDot:2
+23 QUIT
End DoDot:1
+24 ; get height and date/time taken after weight
+25 SET GMVADATE=GMVWDATE
SET GMVAHGT=0
+26 FOR
SET GMVADATE=$ORDER(^PXRMINDX(120.5,"PI",GMVDFN,GMVHTI,GMVADATE))
IF GMVADATE'>0!(+GMVAHGT)
QUIT
Begin DoDot:1
+27 SET GMVIEN=0
+28 FOR
SET GMVIEN=$ORDER(^PXRMINDX(120.5,"PI",GMVDFN,GMVHTI,GMVADATE,GMVIEN))
IF $LENGTH(GMVIEN)'>0!(+GMVAHGT)
QUIT
Begin DoDot:2
+29 SET GMVAHGT=$$HEIGHT(GMVIEN)
+30 QUIT
End DoDot:2
+31 QUIT
End DoDot:1
+32 SET GMVBDATE=$PIECE(GMVBHGT,U,2)
SET GMVBHGT=$PIECE(GMVBHGT,U,1)
+33 SET GMVADATE=$PIECE(GMVAHGT,U,2)
SET GMVAHGT=$PIECE(GMVAHGT,U,1)
+34 IF $PIECE(GMVBDATE,".",1)=$PIECE(GMVWDATE,".",1)
SET GMVBMI=$$CALC($PIECE(GMVNODE,U,8),GMVBHGT)
QUIT GMVBMI
+35 IF $PIECE(GMVADATE,".",1)=$PIECE(GMVWDATE,".",1)
SET GMVBMI=$$CALC($PIECE(GMVNODE,U,8),GMVAHGT)
QUIT GMVBMI
+36 SET GMVH=$SELECT(GMVBHGT>0:GMVBHGT,GMVAHGT>0:GMVAHGT,1:"")
+37 IF GMVH=""
QUIT GMVBMI
+38 SET GMVBMI=$$CALC($PIECE(GMVNODE,U,8),GMVH)
QUIT GMVBMI
+39 QUIT GMVBMI
+40 ;
HEIGHT(GMVIEN) ; Does record have a useable height value? Is yes, return that value.
+1 ; GMVIEN = File 120.5 entry number
+2 NEW GMVCLIO,GMVX
+3 SET GMVIEN=$GET(GMVIEN)
SET GMVX=0
+4 IF GMVIEN=+GMVIEN
Begin DoDot:1
+5 DO F1205^GMVUTL(.GMVCLIO,GMVIEN)
End DoDot:1
+6 IF GMVIEN'=+GMVIEN
Begin DoDot:1
+7 DO CLIO^GMVUTL(.GMVCLIO,GMVIEN)
End DoDot:1
+8 SET GMVCLIO(0)=$GET(GMVCLIO(0))
+9 SET GMVX=$PIECE(GMVCLIO(0),U,8)
+10 IF GMVX'>0
QUIT GMVX
+11 SET GMVX=GMVX_U_$PIECE(GMVCLIO(0),U,1)
+12 QUIT GMVX
+13 ;
CALC(GMVWT,GMVHT) ; Crunch the numbers, return bmi score
+1 ; GMVWT (lb)
+2 ; GMVHT (in)
+3 NEW GMVX
+4 SET GMVWT=$GET(GMVWT)
SET GMVHT=$GET(GMVHT)
+5 IF 'GMVWT!(GMVHT'>0)
QUIT ""
+6 SET GMVWT=GMVWT/2.2
SET GMVHT=GMVHT*2.54/100
+7 SET GMVX=$JUSTIFY(GMVWT/(GMVHT*GMVHT),0,0)
SET GMVX=GMVX_$SELECT(GMVX>27:"*",1:"")
+8 QUIT GMVX
+9 ;
ABNORMAL ; Is reading outside of normal range?
+1 NEW GMVASTRK,GMVDIA,GMVSYS
+2 SET GMVASTRK=""
+3 IF GMVTYPE="T"
Begin DoDot:1
+4 IF GMVRATE>$PIECE(GMVABNML("T"),U,1)
SET GMVASTRK="*"
+5 IF GMVRATE<$PIECE(GMVABNML("T"),U,2)
SET GMVASTRK="*"
+6 QUIT
End DoDot:1
+7 IF GMVTYPE="P"
Begin DoDot:1
+8 IF GMVRATE>$PIECE(GMVABNML("P"),U,1)
SET GMVASTRK="*"
+9 IF GMVRATE<$PIECE(GMVABNML("P"),U,2)
SET GMVASTRK="*"
+10 QUIT
End DoDot:1
+11 IF GMVTYPE="R"
Begin DoDot:1
+12 IF GMVRATE>$PIECE(GMVABNML("R"),U,1)
SET GMVASTRK="*"
+13 IF GMVRATE<$PIECE(GMVABNML("R"),U,2)
SET GMVASTRK="*"
+14 QUIT
End DoDot:1
+15 IF GMVTYPE="BP"
Begin DoDot:1
+16 SET GMVSYS=$PIECE(GMVRATE,"/",1)
+17 SET GMVDIA=$SELECT($PIECE(GMVRATE,"/",3)="":$PIECE(GMVRATE,"/",2),1:$PIECE(GMVRATE,"/",3))
+18 IF GMVSYS>$PIECE(GMVABNML("BP"),U,1)
SET GMVASTRK="*"
+19 IF GMVSYS<$PIECE(GMVABNML("BP"),U,2)
SET GMVASTRK="*"
+20 IF GMVDIA>$PIECE(GMVABNML("BP"),U,3)
SET GMVASTRK="*"
+21 IF GMVDIA<$PIECE(GMVABNML("BP"),U,4)
SET GMVASTRK="*"
+22 QUIT
End DoDot:1
+23 IF GMVTYPE="CVP"
Begin DoDot:1
+24 IF GMVRATE>$PIECE(GMVABNML("CVP"),U,1)
SET GMVASTRK="*"
+25 IF GMVRATE<$PIECE(GMVABNML("CVP"),U,2)
SET GMVASTRK="*"
+26 QUIT
End DoDot:1
+27 IF GMVTYPE="PO2"
Begin DoDot:1
+28 IF GMVRATE<$PIECE(GMVABNML("PO2"),U,2)
SET GMVASTRK="*"
+29 QUIT
End DoDot:1
+30 SET $PIECE(GMVDATA,U,12)=GMVASTRK
+31 QUIT
TEXT(RATE) ; Is rate a text code?
+1 ; Returns 0 if RATE has a text code and 1 if a numeric reading
+2 NEW GMVYES
+3 SET RATE=$GET(RATE)
SET GMVYES=1
+4 IF "REFUSEDPASSUNAVAILABLE"[$$UP^XLFSTR(RATE)
SET GMVYES=0
+5 QUIT GMVYES
+6 ;
RANGE ; Find normal ranges and store in array
+1 NEW GMVPIEN,GMVPNODE
+2 ;high^low
SET GMVABNML("T")="0^0"
+3 ;high^low
SET GMVABNML("P")="0^0"
+4 ;high^low
SET GMVABNML("R")="0^0"
+5 ;high^low
SET GMVABNML("CVP")="0^0"
+6 ;low
SET GMVABNML("PO2")="0^0"
+7 ;sys high^sys low^dia high^dia low
SET GMVABNML("BP")="0^0^0^0"
+8 SET GMVPIEN=$ORDER(^GMRD(120.57,0))
+9 IF 'GMVPIEN
QUIT
+10 SET GMVPNODE=$GET(^GMRD(120.57,GMVPIEN,1))
+11 SET GMVABNML("T")=$PIECE(GMVPNODE,U,1)_U_$PIECE(GMVPNODE,U,2)
+12 SET GMVABNML("P")=$PIECE(GMVPNODE,U,3)_U_$PIECE(GMVPNODE,U,4)
+13 SET GMVABNML("R")=$PIECE(GMVPNODE,U,5)_U_$PIECE(GMVPNODE,U,6)
+14 SET GMVABNML("BP")=$PIECE(GMVPNODE,U,7)_U_$PIECE(GMVPNODE,U,9)_U_$PIECE(GMVPNODE,U,8)_U_$PIECE(GMVPNODE,U,10)
+15 SET GMVABNML("CVP")=$PIECE(GMVPNODE,U,11)_U_$PIECE(GMVPNODE,U,12)
+16 SET GMVABNML("PO2")=""_U_$PIECE(GMVPNODE,U,13)
+17 QUIT
