GMRVDS0 ;HIRMFO/YH,FT-DISPLAY LATEST VITALS/MEASUREMENTS ;6/13/01 15:03
;;4.0;Vitals/Measurements;**1,7,11,13**;Apr 25, 1997
;
; This routine uses the following IAs:
; #10061 ^VADPT calls (supported)
;
EN2 ;ENTRY TO DISPLAY THE LATEST VITALS/MEASUREMENTS IF DFN IS UNKNOWN
S DIC(0)="AEM",DIC="^DPT(" D ^DIC K DIC Q:+Y'>0 S DFN=+Y
EN3 ; ENTRY TO DISPLAY THE LATEST VITALS/MEASUREMENTS IF DFN IS KNOWN
Q:'$D(DFN)
S GMREDB="P" D PAT^GMRVDS1 D Q
Q
EN1 ; ENTRY TO DISPLAY VITALS
N GAPICAL,GRADIAL,GBRACHI,OK
S GAPICAL=$O(^GMRD(120.52,"B","APICAL",0)),GRADIAL=$O(^GMRD(120.52,"B","RADIAL",0)),GBRACHI=$O(^GMRD(120.52,"B","BRACHIAL",0))
F GMRX=1:1:$L(GMRSTR,";") S X=$P(GMRSTR,";",GMRX) Q:'$D(^GMRD(120.51,"C",X)) S GMR(X)=$O(^GMRD(120.51,"C",X,"")),Y=$P($G(^GMRD(120.51,GMR(X),0)),"^") Q:Y=""
K GMRDT,GMRVWT,GMRVHT S X="" F S X=$O(GMR(X)) Q:X="" S GMRDATS="" I GMR(X)'="" F GMRDAT=0:0 S GMRDAT=$O(^GMR(120.5,"AA",DFN,+GMR(X),GMRDAT)) Q:$S(GMRDAT'>0:1,GMRDATS>0:1,1:0) D SETDATAR
I '($D(GMRDATA)\10) W !,"There are no results to report " G Q
F X="T","P","R","PO2","BP","HT","WT","CVP","CG","PN" I $D(GMRDATA(X)) S GMRVDT="",(GMRVDT(1),GMVD)=0 F S GMVD=$O(GMRDATA(X,GMVD)) Q:GMVD'>0 D WRTDT S GMVD(1)=0 F S GMVD(1)=$O(GMRDATA(X,GMVD,GMVD(1))) Q:GMVD(1)'>0 D
. S GMRVX(0)=GMRDATA(X,GMVD,GMVD(1)) S GMRVX=X D EN1^GMRVSAS0
. W ! W:GMRVDT(1)=0 $S(X="BP":"B/P",X="P":"Pulse",X="R":"Resp.",X="T":"Temp.",X="HT":"Ht.",X="CG":"Circ/Girth",X="WT":"Wt.",X="PO2":"Pulse Ox",X="PN":"Pain",1:X)_": "
. I GMRVDT(1)=0 W ?12,"("_GMRVDT_") " S GMRVDT(1)=1
. I X="T" W ?29,GMRVX(0)_" F ("_$J(+GMRVX(0)-32*5/9,0,1)_" C)"
. I X="WT" W ?29,GMRVX(0)_" lb ("_$J(GMRVX(0)/2.2,0,2)_" kg)" S GMRVWT=GMRVX(0)/2.2
. I X="HT" W ?29,$S(GMRVX(0)\12:GMRVX(0)\12_" ft ",1:"")_$S(GMRVX(0)#12:GMRVX(0)#12_" in",1:"")_" ("_$J(GMRVX(0)*2.54,0,2)_" cm)" S GMRVHT=(GMRVX(0)*2.54)/100
. I X="CG" W ?29,GMRVX(0)_" in ("_$J(+GMRVX(0)/.3937,0,2)_" cm)"
. I X="CVP" W ?29,GMRVX(0)_" cmH2O ("_$J(GMRVX(0)/1.36,0,1)_" mmHg)"
. I X="PO2" W ?29,GMRVX(0)_"% "
. I X="P"!(X="R")!(X="BP") W ?29,GMRVX(0)
. I X="PN" D
. . I "UNAVAILABLEPASSREFUSED"[$$UP^XLFSTR(GMRVX(0)) W ?9,GMRVX(0) Q
. . I GMRVX(0)=0 W ?29,GMRVX(0)_" - No pain " Q
. . I GMRVX(0)=99 W ?29,GMRVX(0)_" - Unable to respond " Q
. . I GMRVX(0)=10 W ?29,GMRVX(0)_" - Worst imaginable pain " Q
. . W ?29,GMRVX(0) Q
. W $S('$D(GMRVX(1)):"",'GMRVX(1):"",1:"*") K GMRVX
. D CHAR
. I X="WT",$G(GMRVWT)>0,$G(GMRVHT)>0 W !,"BMI: " S GMRVHT(1)=$J(GMRVWT/(GMRVHT*GMRVHT),0,0) W ?29,GMRVHT(1)_$S(GMRVHT(1)>27:"*",1:"")
. Q
Q W ! K GMRVWT,GMRVHT,GMR,GMVD,GBP,GMRVARY,GMRVDA,GMRDATA,GMVDM,GLIN,GMRZZ Q:$D(GLOC)
K GMRVDT,GMROUT,DFN,%Y,GMRL,GMRDT,DIC,GMRDAT,GMRDATS,GMRSTR,GMRX,GMRVX,POP D KVAR^VADPT K VA
Q
SETDATAR ;
S Y=0 F S Y=$O(^GMR(120.5,"AA",DFN,GMR(X),GMRDAT,Y)) Q:Y'>0!GMRDATS I '$D(^GMR(120.5,Y,2)),$P(^GMR(120.5,Y,0),"^",8)'="" D SETNODE
D:X="BP"!(X="P") SETBP^GMRVDS2 Q
SETNODE ;
N G S GMRL=$S($D(^GMR(120.5,Y,0)):^(0),1:"")
;N G S G=$P(GMRL,"^",8) Q:'(G>0!(G<0)!($E(G)="0"))
I X'="P" S G=$P(GMRL,"^",8) Q:"REFUSEDPASSUNAVAILABLE"[$$UP^XLFSTR(G)
I X="P" S OK=0,G=$P(GMRL,"^",8) D Q:'OK
. I "REFUSEDPASSUNAVAILABLE"[$$UP^XLFSTR(G) Q
. I '$D(^GMR(120.5,Y,5,"B")) S OK=1 Q
. I $D(^GMR(120.5,Y,5,"B",GAPICAL)) S OK=1 Q
. I $D(^GMR(120.5,Y,5,"B",GBRACHI)) S OK=1 Q
. I $D(^GMR(120.5,Y,5,"B",GRADIAL)) S OK=1
S GMRL1=$P(GMRL,"^") ;adding trailing zeros to time if necessary
S $P(GMRL1,".",2)=$P(GMRL1,".",2)_"0000"
S $P(GMRL1,".",2)=$E($P(GMRL1,".",2),1,4)
S $P(GMRL,"^")=GMRL1
K GMRL1
I GMRL'="" S GMRDATA(X,$P(GMRL,"^"),Y)=$P(GMRL,"^",8),GMRDATS=1 I $P($G(^GMR(120.5,Y,5,0)),"^",4)>0 D CHAR^GMRVCHAR(Y,.GMRVARY,GMR(X))
Q
WRTDT ;
S GMRVDT=$E(GMVD,4,5)_"/"_$E(GMVD,6,7)_"/"_$E(GMVD,2,3)_"@"_$E($P(GMVD,".",2),1,2)_$S($E($P(GMVD,".",2),3,4)'="":":"_$E($P(GMVD,".",2),3,4),1:"")
Q
CHAR ;
S GMRZZ=$$WRITECH^GMRVCHAR(GMVD(1),.GMRVARY,5) S:GMRZZ'=""&(X'="PO2") GMRZZ="("_GMRZZ_")"
I X="PO2",$P(^GMR(120.5,GMVD(1),0),"^",10)'="" S GMRVPO=$P(^(0),"^",10) W "with supplemental O2 "_$S(GMRVPO["l/min":$P(GMRVPO," l/min")_"L/min",1:"")_$S(GMRVPO["l/min":$P(GMRVPO," l/min",2),1:GMRVPO)_" " W:GMRZZ'="" !,?29,"- ",GMRZZ K GMRZZ Q
W:GMRZZ'="" GMRZZ K GMRZZ
Q
GMRVDS0 ;HIRMFO/YH,FT-DISPLAY LATEST VITALS/MEASUREMENTS ;6/13/01 15:03
+1 ;;4.0;Vitals/Measurements;**1,7,11,13**;Apr 25, 1997
+2 ;
+3 ; This routine uses the following IAs:
+4 ; #10061 ^VADPT calls (supported)
+5 ;
EN2 ;ENTRY TO DISPLAY THE LATEST VITALS/MEASUREMENTS IF DFN IS UNKNOWN
+1 SET DIC(0)="AEM"
SET DIC="^DPT("
DO ^DIC
KILL DIC
IF +Y'>0
QUIT
SET DFN=+Y
EN3 ; ENTRY TO DISPLAY THE LATEST VITALS/MEASUREMENTS IF DFN IS KNOWN
+1 IF '$DATA(DFN)
QUIT
+2 SET GMREDB="P"
DO PAT^GMRVDS1
DO Q
+3 QUIT
EN1 ; ENTRY TO DISPLAY VITALS
+1 NEW GAPICAL,GRADIAL,GBRACHI,OK
+2 SET GAPICAL=$ORDER(^GMRD(120.52,"B","APICAL",0))
SET GRADIAL=$ORDER(^GMRD(120.52,"B","RADIAL",0))
SET GBRACHI=$ORDER(^GMRD(120.52,"B","BRACHIAL",0))
+3 FOR GMRX=1:1:$LENGTH(GMRSTR,";")
SET X=$PIECE(GMRSTR,";",GMRX)
IF '$DATA(^GMRD(120.51,"C",X))
QUIT
SET GMR(X)=$ORDER(^GMRD(120.51,"C",X,""))
SET Y=$PIECE($GET(^GMRD(120.51,GMR(X),0)),"^")
IF Y=""
QUIT
+4 KILL GMRDT,GMRVWT,GMRVHT
SET X=""
FOR
SET X=$ORDER(GMR(X))
IF X=""
QUIT
SET GMRDATS=""
IF GMR(X)'=""
FOR GMRDAT=0:0
SET GMRDAT=$ORDER(^GMR(120.5,"AA",DFN,+GMR(X),GMRDAT))
IF $SELECT(GMRDAT'>0
QUIT
DO SETDATAR
+5 IF '($DATA(GMRDATA)\10)
WRITE !,"There are no results to report "
GOTO Q
+6 FOR X="T","P","R","PO2","BP","HT","WT","CVP","CG","PN"
IF $DATA(GMRDATA(X))
SET GMRVDT=""
SET (GMRVDT(1),GMVD)=0
FOR
SET GMVD=$ORDER(GMRDATA(X,GMVD))
IF GMVD'>0
QUIT
DO WRTDT
SET GMVD(1)=0
FOR
SET GMVD(1)=$ORDER(GMRDATA(X,GMVD,GMVD(1)))
IF GMVD(1)'>0
QUIT
Begin DoDot:1
+7 SET GMRVX(0)=GMRDATA(X,GMVD,GMVD(1))
SET GMRVX=X
DO EN1^GMRVSAS0
+8 WRITE !
IF GMRVDT(1)=0
WRITE $SELECT(X="BP":"B/P",X="P":"Pulse",X="R":"Resp.",X="T":"Temp.",X="HT":"Ht.",X="CG":"Circ/Girth",X="WT":"Wt.",X="PO2":"Pulse Ox",X="PN":"Pain",1:X)_": "
+9 IF GMRVDT(1)=0
WRITE ?12,"("_GMRVDT_") "
SET GMRVDT(1)=1
+10 IF X="T"
WRITE ?29,GMRVX(0)_" F ("_$JUSTIFY(+GMRVX(0)-32*5/9,0,1)_" C)"
+11 IF X="WT"
WRITE ?29,GMRVX(0)_" lb ("_$JUSTIFY(GMRVX(0)/2.2,0,2)_" kg)"
SET GMRVWT=GMRVX(0)/2.2
+12 IF X="HT"
WRITE ?29,$SELECT(GMRVX(0)\12:GMRVX(0)\12_" ft ",1:"")_$SELECT(GMRVX(0)#12:GMRVX(0)#12_" in",1:"")_" ("_$JUSTIFY(GMRVX(0)*2.54,0,2)_" cm)"
SET GMRVHT=(GMRVX(0)*2.54)/100
+13 IF X="CG"
WRITE ?29,GMRVX(0)_" in ("_$JUSTIFY(+GMRVX(0)/.3937,0,2)_" cm)"
+14 IF X="CVP"
WRITE ?29,GMRVX(0)_" cmH2O ("_$JUSTIFY(GMRVX(0)/1.36,0,1)_" mmHg)"
+15 IF X="PO2"
WRITE ?29,GMRVX(0)_"% "
+16 IF X="P"!(X="R")!(X="BP")
WRITE ?29,GMRVX(0)
+17 IF X="PN"
Begin DoDot:2
+18 IF "UNAVAILABLEPASSREFUSED"[$$UP^XLFSTR(GMRVX(0))
WRITE ?9,GMRVX(0)
QUIT
+19 IF GMRVX(0)=0
WRITE ?29,GMRVX(0)_" - No pain "
QUIT
+20 IF GMRVX(0)=99
WRITE ?29,GMRVX(0)_" - Unable to respond "
QUIT
+21 IF GMRVX(0)=10
WRITE ?29,GMRVX(0)_" - Worst imaginable pain "
QUIT
+22 WRITE ?29,GMRVX(0)
QUIT
End DoDot:2
+23 WRITE $SELECT('$DATA(GMRVX(1)):"",'GMRVX(1):"",1:"*")
KILL GMRVX
+24 DO CHAR
+25 IF X="WT"
IF $GET(GMRVWT)>0
IF $GET(GMRVHT)>0
WRITE !,"BMI: "
SET GMRVHT(1)=$JUSTIFY(GMRVWT/(GMRVHT*GMRVHT),0,0)
WRITE ?29,GMRVHT(1)_$SELECT(GMRVHT(1)>27:"*",1:"")
+26 QUIT
End DoDot:1
Q WRITE !
KILL GMRVWT,GMRVHT,GMR,GMVD,GBP,GMRVARY,GMRVDA,GMRDATA,GMVDM,GLIN,GMRZZ
IF $DATA(GLOC)
QUIT
+1 KILL GMRVDT,GMROUT,DFN,%Y,GMRL,GMRDT,DIC,GMRDAT,GMRDATS,GMRSTR,GMRX,GMRVX,POP
DO KVAR^VADPT
KILL VA
+2 QUIT
SETDATAR ;
+1 SET Y=0
FOR
SET Y=$ORDER(^GMR(120.5,"AA",DFN,GMR(X),GMRDAT,Y))
IF Y'>0!GMRDATS
QUIT
IF '$DATA(^GMR(120.5,Y,2))
IF $PIECE(^GMR(120.5,Y,0),"^",8)'=""
DO SETNODE
+2 IF X="BP"!(X="P")
DO SETBP^GMRVDS2
QUIT
SETNODE ;
+1 NEW G
SET GMRL=$SELECT($DATA(^GMR(120.5,Y,0)):^(0),1:"")
+2 ;N G S G=$P(GMRL,"^",8) Q:'(G>0!(G<0)!($E(G)="0"))
+3 IF X'="P"
SET G=$PIECE(GMRL,"^",8)
IF "REFUSEDPASSUNAVAILABLE"[$$UP^XLFSTR(G)
QUIT
+4 IF X="P"
SET OK=0
SET G=$PIECE(GMRL,"^",8)
Begin DoDot:1
+5 IF "REFUSEDPASSUNAVAILABLE"[$$UP^XLFSTR(G)
QUIT
+6 IF '$DATA(^GMR(120.5,Y,5,"B"))
SET OK=1
QUIT
+7 IF $DATA(^GMR(120.5,Y,5,"B",GAPICAL))
SET OK=1
QUIT
+8 IF $DATA(^GMR(120.5,Y,5,"B",GBRACHI))
SET OK=1
QUIT
+9 IF $DATA(^GMR(120.5,Y,5,"B",GRADIAL))
SET OK=1
End DoDot:1
IF 'OK
QUIT
+10 ;adding trailing zeros to time if necessary
SET GMRL1=$PIECE(GMRL,"^")
+11 SET $PIECE(GMRL1,".",2)=$PIECE(GMRL1,".",2)_"0000"
+12 SET $PIECE(GMRL1,".",2)=$EXTRACT($PIECE(GMRL1,".",2),1,4)
+13 SET $PIECE(GMRL,"^")=GMRL1
+14 KILL GMRL1
+15 IF GMRL'=""
SET GMRDATA(X,$PIECE(GMRL,"^"),Y)=$PIECE(GMRL,"^",8)
SET GMRDATS=1
IF $PIECE($GET(^GMR(120.5,Y,5,0)),"^",4)>0
DO CHAR^GMRVCHAR(Y,.GMRVARY,GMR(X))
+16 QUIT
WRTDT ;
+1 SET GMRVDT=$EXTRACT(GMVD,4,5)_"/"_$EXTRACT(GMVD,6,7)_"/"_$EXTRACT(GMVD,2,3)_"@"_$EXTRACT($PIECE(GMVD,".",2),1,2)_$SELECT($EXTRACT($PIECE(GMVD,".",2),3,4)'="":":"_$EXTRACT($PIECE(GMVD,".",2),3,4),1:"")
+2 QUIT
CHAR ;
+1 SET GMRZZ=$$WRITECH^GMRVCHAR(GMVD(1),.GMRVARY,5)
IF GMRZZ'=""&(X'="PO2")
SET GMRZZ="("_GMRZZ_")"
+2 IF X="PO2"
IF $PIECE(^GMR(120.5,GMVD(1),0),"^",10)'=""
SET GMRVPO=$PIECE(^(0),"^",10)
WRITE "with supplemental O2 "_$SELECT(GMRVPO["l/min":$PIECE(GMRVPO," l/min")_"L/min",1:"")_$SELECT(GMRVPO["l/min":$PIECE(GMRVPO," l/min",2),1:GMRVPO)_" "
IF GMRZZ'=""
WRITE !,?29,"- ",GMRZZ
KILL GMRZZ
QUIT
+3 IF GMRZZ'=""
WRITE GMRZZ
KILL GMRZZ
+4 QUIT
