GMVGETD2 ;HOIFO/YH-EXTRACT VITALS/MEASUREMENT RECORDS FOR A GIVEN DATE (CONT.) ;12/9/02 14:03
;;5.0;GEN. MED. REC. - VITALS;**1,23**;Oct 31, 2002;Build 25
;
; This routine uses the following IAs:
; <None>
;
SETLN ;CALLED BY GMVGETD1
N GMRDAT,GMVLOOP,GMVQNAME,GMVUSER,X,Y
S GJ=GJ+1,GMRDAT=$P(^TMP($J,"GMRV",GMRDATE,GMRVTY,GMRVDA),"|",1),^TMP($J,"GRPC",GJ)=GMRVDA_"^"_$E(GMRDATE,4,5)_"/"_$E(GMRDATE,6,7)_"/"_$E(GMRDATE,2,3)
S GMVUSER=$$PERSON^GMVUTL1(+$P(GMRDAT,U,6)) ;user name
S ^TMP($J,"GRPC",GJ)=^TMP($J,"GRPC",GJ)_"@"_$E($P(GMRDATE,".",2)_"000000",1,2)_":"_$E($P(GMRDATE,".",2)_"000000",3,4)_" "
S GMRVTY(1)=$S(GMRVTY="T":"T: ",GMRVTY="P":"P: ",GMRVTY="R":"R: ",GMRVTY="BP":"B/P: ",GMRVTY="WT":"Wt: ",GMRVTY="HT":"Ht: ",GMRVTY="CG":"Circumference/Girth: ",GMRVTY="CVP":"Central Venous Pressure: ",GMRVTY="PO2":"Pulse Oximetry: ",1:"")
I GMRVTY(1)="" S GMRVTY(1)=$S(GMRVTY="PN":"Pain: ",1:"")
S GMRVTY(1)=GMRVTY(1)_" "
S ^TMP($J,"GRPC",GJ)=^TMP($J,"GRPC",GJ)_GMRVTY(1)
I GMRVTY="PN" D Q
. S ^TMP($J,"GRPC",GJ)=^(GJ)_$P(GMRDAT,"^",8)_" "_$S(+$P(GMRDAT,"^",8)=99:"Unable to respond",+$P(GMRDAT,"^",8)=10:"Worst imaginable pain",$P(GMRDAT,"^",8)="0":"No pain",1:"")_" _"_GMVUSER
I "PRBPCVPCGPO2"[GMRVTY S GMRVX=GMRVTY,GMRVX(0)=$P(GMRDAT,"^",8) D
. I '(GMRVX(0)<0!(GMRVX(0)>0)!($E(GMRVX(0))="0")) S ^TMP($J,"GRPC",GJ)=^TMP($J,"GRPC",GJ)_GMRVX(0)_" " Q
. D EN1^GMVSAS0
. S Z=$S(GMRVTY="CG":$J($P(GMRDAT,"^",8),0,2),GMRVTY="CVP":$J($P(GMRDAT,"^",8),0,1),GMRVTY'="BP":$J($P(GMRDAT,"^",8),3,0),1:$P(GMRDAT,"^",8)) D:GMRVTY'="BP" BLNK
. S ^TMP($J,"GRPC",GJ)=^TMP($J,"GRPC",GJ)_Z_$S('$D(GMRVX(1)):" ",'GMRVX(1):"",1:"*")
. I GMRVTY="CG" S ^TMP($J,"GRPC",GJ)=^TMP($J,"GRPC",GJ)_" in ("_$J(Z/.3937,0,2)_" cm)"
. I GMRVTY="CVP" S ^TMP($J,"GRPC",GJ)=^TMP($J,"GRPC",GJ)_" cmH2O ("_$J(Z/1.36,0,1)_" mmHg)"
. I GMRVTY="PO2" D
. . S ^TMP($J,"GRPC",GJ)=^TMP($J,"GRPC",GJ)_"%"
. . I $P(GMRDAT,"^",10)["%"!($P(GMRDAT,"^",10)[" l/min") D
. . . S ^TMP($J,"GRPC",GJ)=^TMP($J,"GRPC",GJ)_" with supplemental O2"
. . . N GMV S GMV=$P(GMRDAT,"^",10) I GMV[" l/min" S GMV=$P(GMV," l/min")_"L/min"_$P(GMV," l/min",2)
. . . S ^TMP($J,"GRPC",GJ)=^TMP($J,"GRPC",GJ)_" "_GMV
I GMRVTY="T" S X=$P(GMRDAT,"^",8) D
. I X'>0 S ^TMP($J,"GRPC",GJ)=^TMP($J,"GRPC",GJ)_X Q
. S GMRVX=GMRVTY,GMRVX(0)=X D EN1^GMVSAS0
. D EN1^GMVUTL S:'Y Y="" S Z=$J(X,5,1) D BLNK S ^TMP($J,"GRPC",GJ)=^TMP($J,"GRPC",GJ)_Z_" F " S Z=$J(Y,4,1) D BLNK S ^TMP($J,"GRPC",GJ)=^TMP($J,"GRPC",GJ)_"("_Z_" C)"_$S('$D(GMRVX(1)):" ",'GMRVX(1):"",1:"*")
I GMRVTY="HT" S X=$P(GMRDAT,"^",8) D
. I X'>0 S ^TMP($J,"GRPC",GJ)=^TMP($J,"GRPC",GJ)_X Q
. D EN2^GMVUTL S:'Y Y="" S Z=$J(X,5,2) D BLNK S ^TMP($J,"GRPC",GJ)=^TMP($J,"GRPC",GJ)_Z_" in " S Z=$J(Y,5,2) D BLNK S ^TMP($J,"GRPC",GJ)=^TMP($J,"GRPC",GJ)_"("_Z_" cm)"
I GMRVTY="WT" S X=$P(GMRDAT,"^",8) D
. I X'>0 S ^TMP($J,"GRPC",GJ)=^TMP($J,"GRPC",GJ)_X Q
. D EN3^GMVUTL S:'Y Y="" S Z=$J(X,7,2) D BLNK S ^TMP($J,"GRPC",GJ)=^TMP($J,"GRPC",GJ)_Z_" lb " S Z=$J(Y,6,2) D BLNK S ^TMP($J,"GRPC",GJ)=^TMP($J,"GRPC",GJ)_"("_Z_" kg)"
I (+$P(GMRDAT,"^",8)'>0)&($P(GMRDAT,"^",8)'="0") D Q
.S ^TMP($J,"GRPC",GJ)=^TMP($J,"GRPC",GJ)_" _"_GMVUSER
.Q
S GMRVITY=+$P(GMRDAT,"^",3)
K GMRVARY
S GMRZZ=""
S GMRVARY=$P(^TMP($J,"GMRV",GMRDATE,GMRVTY,GMRVDA),"|",2)
F GMVLOOP=1:1 Q:$P(GMRVARY,U,GMVLOOP)="" D
.S GMVQNAME=$$FIELD^GMVGETQL($P(GMRVARY,U,GMVLOOP),1,"E")
.I GMVQNAME=""!(GMVQNAME=-1) Q
.S GMRZZ=GMRZZ_$S(GMRZZ'="":", ",1:"")_GMVQNAME
.Q
S:GMRZZ'=""&(GMRVTY'="PO2") GMRZZ=" ("_GMRZZ_")"
S:GMRVTY="PO2" ^TMP($J,"GRPC",GJ)=^TMP($J,"GRPC",GJ)_" "_GMRZZ
I GMRVTY="P",GMRZZ["DORSALIS PEDIS",$P(GMRDAT,"^",8)=1 S ^TMP($J,"GRPC",GJ)=$P(^(GJ),"*",1)_$P(^(GJ),"*",2)
S:GMRVTY'="PO2" ^TMP($J,"GRPC",GJ)=^TMP($J,"GRPC",GJ)_" "_GMRZZ
S ^TMP($J,"GRPC",GJ)=^TMP($J,"GRPC",GJ)_" _"_GMVUSER
I GMRVTY="WT" S GMRBMI="",GMRBMI(1)=$P(GMRDAT,"^"),GMRBMI(2)=+$P(GMRDAT,"^",8) D CALBMI^GMVBMI(.GMRBMI) D:GMRBMI'=""
. S GJ=GJ+1,^TMP($J,"GRPC",GJ)=$E(GMRDATE,4,5)_"/"_$E(GMRDATE,6,7)_"/"_$E(GMRDATE,2,3)
. S ^TMP($J,"GRPC",GJ)=" @"_$E($P(GMRDATE,".",2)_"000000",1,2)_":"_$E($P(GMRDATE,".",2)_"000000",3,4)_" Body Mass Index: "_GMRBMI
K Z,GMRBMI
Q
BLNK ;
N I
F I=1:1:$L(Z) Q:$E(Z,I)'=" "
S Z=$E(Z,I,$L(Z))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMVGETD2 4295 printed Dec 13, 2024@01:58:50 Page 2
GMVGETD2 ;HOIFO/YH-EXTRACT VITALS/MEASUREMENT RECORDS FOR A GIVEN DATE (CONT.) ;12/9/02 14:03
+1 ;;5.0;GEN. MED. REC. - VITALS;**1,23**;Oct 31, 2002;Build 25
+2 ;
+3 ; This routine uses the following IAs:
+4 ; <None>
+5 ;
SETLN ;CALLED BY GMVGETD1
+1 NEW GMRDAT,GMVLOOP,GMVQNAME,GMVUSER,X,Y
+2 SET GJ=GJ+1
SET GMRDAT=$PIECE(^TMP($JOB,"GMRV",GMRDATE,GMRVTY,GMRVDA),"|",1)
SET ^TMP($JOB,"GRPC",GJ)=GMRVDA_"^"_$EXTRACT(GMRDATE,4,5)_"/"_$EXTRACT(GMRDATE,6,7)_"/"_$EXTRACT(GMRDATE,2,3)
+3 ;user name
SET GMVUSER=$$PERSON^GMVUTL1(+$PIECE(GMRDAT,U,6))
+4 SET ^TMP($JOB,"GRPC",GJ)=^TMP($JOB,"GRPC",GJ)_"@"_$EXTRACT($PIECE(GMRDATE,".",2)_"000000",1,2)_":"_$EXTRACT($PIECE(GMRDATE,".",2)_"000000",3,4)_" "
+5 SET GMRVTY(1)=$SELECT(GMRVTY="T":"T: ",GMRVTY="P":"P: ",GMRVTY="R":"R: ",GMRVTY="BP":"B/P: ",GMRVTY="WT":"Wt: ",GMRVTY="HT":"Ht: ",GMRVTY="CG":"Circumference/Girth: ",GMRVTY="CVP":"Central Venous Pressure: ",GMRVTY="PO2":"Pulse Oximetry: ",1:""
)
+6 IF GMRVTY(1)=""
SET GMRVTY(1)=$SELECT(GMRVTY="PN":"Pain: ",1:"")
+7 SET GMRVTY(1)=GMRVTY(1)_" "
+8 SET ^TMP($JOB,"GRPC",GJ)=^TMP($JOB,"GRPC",GJ)_GMRVTY(1)
+9 IF GMRVTY="PN"
Begin DoDot:1
+10 SET ^TMP($JOB,"GRPC",GJ)=^(GJ)_$PIECE(GMRDAT,"^",8)_" "_$SELECT(+$PIECE(GMRDAT,"^",8)=99:"Unable to respond",+$PIECE(GMRDAT,"^",8)=10:"Worst imaginable pain",$PIECE(GMRDAT,"^",8)="0":"No pain",1:"")_" _"_GMVUSER
End DoDot:1
QUIT
+11 IF "PRBPCVPCGPO2"[GMRVTY
SET GMRVX=GMRVTY
SET GMRVX(0)=$PIECE(GMRDAT,"^",8)
Begin DoDot:1
+12 IF '(GMRVX(0)<0!(GMRVX(0)>0)!($EXTRACT(GMRVX(0))="0"))
SET ^TMP($JOB,"GRPC",GJ)=^TMP($JOB,"GRPC",GJ)_GMRVX(0)_" "
QUIT
+13 DO EN1^GMVSAS0
+14 SET Z=$SELECT(GMRVTY="CG":$JUSTIFY($PIECE(GMRDAT,"^",8),0,2),GMRVTY="CVP":$JUSTIFY($PIECE(GMRDAT,"^",8),0,1),GMRVTY'="BP":$JUSTIFY($PIECE(GMRDAT,"^",8),3,0),1:$PIECE(GMRDAT,"^",8))
if GMRVTY'="BP"
DO BLNK
+15 SET ^TMP($JOB,"GRPC",GJ)=^TMP($JOB,"GRPC",GJ)_Z_$SELECT('$DATA(GMRVX(1)):" ",'GMRVX(1):"",1:"*")
+16 IF GMRVTY="CG"
SET ^TMP($JOB,"GRPC",GJ)=^TMP($JOB,"GRPC",GJ)_" in ("_$JUSTIFY(Z/.3937,0,2)_" cm)"
+17 IF GMRVTY="CVP"
SET ^TMP($JOB,"GRPC",GJ)=^TMP($JOB,"GRPC",GJ)_" cmH2O ("_$JUSTIFY(Z/1.36,0,1)_" mmHg)"
+18 IF GMRVTY="PO2"
Begin DoDot:2
+19 SET ^TMP($JOB,"GRPC",GJ)=^TMP($JOB,"GRPC",GJ)_"%"
+20 IF $PIECE(GMRDAT,"^",10)["%"!($PIECE(GMRDAT,"^",10)[" l/min")
Begin DoDot:3
+21 SET ^TMP($JOB,"GRPC",GJ)=^TMP($JOB,"GRPC",GJ)_" with supplemental O2"
+22 NEW GMV
SET GMV=$PIECE(GMRDAT,"^",10)
IF GMV[" l/min"
SET GMV=$PIECE(GMV," l/min")_"L/min"_$PIECE(GMV," l/min",2)
+23 SET ^TMP($JOB,"GRPC",GJ)=^TMP($JOB,"GRPC",GJ)_" "_GMV
End DoDot:3
End DoDot:2
End DoDot:1
+24 IF GMRVTY="T"
SET X=$PIECE(GMRDAT,"^",8)
Begin DoDot:1
+25 IF X'>0
SET ^TMP($JOB,"GRPC",GJ)=^TMP($JOB,"GRPC",GJ)_X
QUIT
+26 SET GMRVX=GMRVTY
SET GMRVX(0)=X
DO EN1^GMVSAS0
+27 DO EN1^GMVUTL
if 'Y
SET Y=""
SET Z=$JUSTIFY(X,5,1)
DO BLNK
SET ^TMP($JOB,"GRPC",GJ)=^TMP($JOB,"GRPC",GJ)_Z_" F "
SET Z=$JUSTIFY(Y,4,1)
DO BLNK
SET ^TMP($JOB,"GRPC",GJ)=^TMP($JOB,"GRPC",GJ)_"("_Z_" C)"_$SELECT('$DATA(GMRVX(1)):" ",'GMRVX(1):"",1:"*")
End DoDot:1
+28 IF GMRVTY="HT"
SET X=$PIECE(GMRDAT,"^",8)
Begin DoDot:1
+29 IF X'>0
SET ^TMP($JOB,"GRPC",GJ)=^TMP($JOB,"GRPC",GJ)_X
QUIT
+30 DO EN2^GMVUTL
if 'Y
SET Y=""
SET Z=$JUSTIFY(X,5,2)
DO BLNK
SET ^TMP($JOB,"GRPC",GJ)=^TMP($JOB,"GRPC",GJ)_Z_" in "
SET Z=$JUSTIFY(Y,5,2)
DO BLNK
SET ^TMP($JOB,"GRPC",GJ)=^TMP($JOB,"GRPC",GJ)_"("_Z_" cm)"
End DoDot:1
+31 IF GMRVTY="WT"
SET X=$PIECE(GMRDAT,"^",8)
Begin DoDot:1
+32 IF X'>0
SET ^TMP($JOB,"GRPC",GJ)=^TMP($JOB,"GRPC",GJ)_X
QUIT
+33 DO EN3^GMVUTL
if 'Y
SET Y=""
SET Z=$JUSTIFY(X,7,2)
DO BLNK
SET ^TMP($JOB,"GRPC",GJ)=^TMP($JOB,"GRPC",GJ)_Z_" lb "
SET Z=$JUSTIFY(Y,6,2)
DO BLNK
SET ^TMP($JOB,"GRPC",GJ)=^TMP($JOB,"GRPC",GJ)_"("_Z_" kg)"
End DoDot:1
+34 IF (+$PIECE(GMRDAT,"^",8)'>0)&($PIECE(GMRDAT,"^",8)'="0")
Begin DoDot:1
+35 SET ^TMP($JOB,"GRPC",GJ)=^TMP($JOB,"GRPC",GJ)_" _"_GMVUSER
+36 QUIT
End DoDot:1
QUIT
+37 SET GMRVITY=+$PIECE(GMRDAT,"^",3)
+38 KILL GMRVARY
+39 SET GMRZZ=""
+40 SET GMRVARY=$PIECE(^TMP($JOB,"GMRV",GMRDATE,GMRVTY,GMRVDA),"|",2)
+41 FOR GMVLOOP=1:1
if $PIECE(GMRVARY,U,GMVLOOP)=""
QUIT
Begin DoDot:1
+42 SET GMVQNAME=$$FIELD^GMVGETQL($PIECE(GMRVARY,U,GMVLOOP),1,"E")
+43 IF GMVQNAME=""!(GMVQNAME=-1)
QUIT
+44 SET GMRZZ=GMRZZ_$SELECT(GMRZZ'="":", ",1:"")_GMVQNAME
+45 QUIT
End DoDot:1
+46 if GMRZZ'=""&(GMRVTY'="PO2")
SET GMRZZ=" ("_GMRZZ_")"
+47 if GMRVTY="PO2"
SET ^TMP($JOB,"GRPC",GJ)=^TMP($JOB,"GRPC",GJ)_" "_GMRZZ
+48 IF GMRVTY="P"
IF GMRZZ["DORSALIS PEDIS"
IF $PIECE(GMRDAT,"^",8)=1
SET ^TMP($JOB,"GRPC",GJ)=$PIECE(^(GJ),"*",1)_$PIECE(^(GJ),"*",2)
+49 if GMRVTY'="PO2"
SET ^TMP($JOB,"GRPC",GJ)=^TMP($JOB,"GRPC",GJ)_" "_GMRZZ
+50 SET ^TMP($JOB,"GRPC",GJ)=^TMP($JOB,"GRPC",GJ)_" _"_GMVUSER
+51 IF GMRVTY="WT"
SET GMRBMI=""
SET GMRBMI(1)=$PIECE(GMRDAT,"^")
SET GMRBMI(2)=+$PIECE(GMRDAT,"^",8)
DO CALBMI^GMVBMI(.GMRBMI)
if GMRBMI'=""
Begin DoDot:1
+52 SET GJ=GJ+1
SET ^TMP($JOB,"GRPC",GJ)=$EXTRACT(GMRDATE,4,5)_"/"_$EXTRACT(GMRDATE,6,7)_"/"_$EXTRACT(GMRDATE,2,3)
+53 SET ^TMP($JOB,"GRPC",GJ)=" @"_$EXTRACT($PIECE(GMRDATE,".",2)_"000000",1,2)_":"_$EXTRACT($PIECE(GMRDATE,".",2)_"000000",3,4)_" Body Mass Index: "_GMRBMI
End DoDot:1
+54 KILL Z,GMRBMI
+55 QUIT
BLNK ;
+1 NEW I
+2 FOR I=1:1:$LENGTH(Z)
if $EXTRACT(Z,I)'=" "
QUIT
+3 SET Z=$EXTRACT(Z,I,$LENGTH(Z))
+4 QUIT