GMRVBP0 ;HIRMFO/YH-KYOCERA B/P GRAPH - STORE DATA IN ^TMP($J) ;5/24/99 12:40
;;4.0;Vitals/Measurements;**1,11**;Apr 25, 1997
EN1 ;
N GAPICAL,GRADIAL,GBRACHI 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))
K ^TMP($J,"GMR"),^TMP($J,"GMRK"),^TMP($J,"GDT"),^TMP($J,"GMRVG"),^TMP($J,"GTNM") F GI=1:1:200 S ^TMP($J,"GMRK","G"_GI)=""
S GMROUT=0,(^TMP($J,"GMRK","G82M"),^TMP($J,"GMRK","G210M"),^TMP($J,"GMRK","G226M"))=0.6
S GSTART1=(9999999-GMRFIN)-.0001,GEND1=9999999-GMRSTRT
F GTYPE="B","P" D SETT
U IO D ^GMRVBP1
Q1 D Q1^GMRVGR0
Q
SETT ;
S GTYPE(1)=$S(GTYPE="B":"BLOOD PRESSURE",GTYPE="P":"PULSE",1:"") Q:GTYPE(1)
S GTYP=$O(^GMRD(120.51,"B",GTYPE(1),0)) Q:GTYP'>0
F GX=GSTART1:0 S GX=$O(^GMR(120.5,"AA",DFN,GTYP,GX)) Q:GX>GEND1!(GX'>0) F GEN=0:0 S GEN=$O(^GMR(120.5,"AA",DFN,GTYP,GX,GEN)) Q:GEN'>0 I '$D(^GMR(120.5,GEN,2)) D BLDARR
Q
BLDARR S GDATA=$G(^GMR(120.5,GEN,0)) Q:GDATA=""
S GMRVX=GTYPE,GMRVX(0)=$P(GDATA,"^",8),GMRVX(1)=0 D:GMRVX(0)>0!(GMRVX(0)="0") EN1^GMRVSAS0
K GMRVARY S GMRVARY="" I $P($G(^GMR(120.5,GEN,5,0)),"^",4)>0 D CHAR^GMRVCHAR(GEN,.GMRVARY,GTYP)
K GG S GG="" I $O(GMRVARY(0)) D
. S GG(1)=0 F S GG(1)=$O(GMRVARY(GG(1))) Q:GG(1)'>0 S GG(2)=0 F S GG(2)=$O(GMRVARY(GG(1),GG(2))) Q:GG(2)'>0 S GG(3)="" F S GG(3)=$O(GMRVARY(GG(1),GG(2),GG(3))) Q:GG(3)="" S GG=GG_$S(GG="":"",1:";")_GG(3)
S GDATA(1)=GG_"^"_$S($G(GMRVX(1))>0:1,1:"")_"^"
I GTYPE="P" D Q
. I '$D(^GMR(120.5,GEN,5,"B")) S ^TMP($J,"GMRVG",GTYPE,9999999-GX,GMRVX(0))=GDATA(1) Q
. I $D(^GMR(120.5,GEN,5,"B",GBRACHI)) S ^TMP($J,"GMRVG",GTYPE,9999999-GX,GMRVX(0))=GDATA(1) Q
. I $D(^GMR(120.5,GEN,5,"B",GAPICAL)) S ^TMP($J,"GMRVG",GTYPE,9999999-GX,GMRVX(0))=GDATA(1) Q
. I $D(^GMR(120.5,GEN,5,"B",GRADIAL)) S ^TMP($J,"GMRVG",GTYPE,9999999-GX,GMRVX(0))=GDATA(1) Q
I GMRVX(0)>0 S ^TMP($J,"GMRVG","S",9999999-GX,$P(GMRVX(0),"/"))=$S($P(GMRVX(0),"/")<$P(^GMRD(120.57,1,1),"^",7)&($P(GMRVX(0),"/")>$P(^(1),"^",9)):"",1:"^1^")
I $P($G(GMRVX(0)),"/",3)'="" D
. S ^TMP($J,"GMRVG","B",9999999-GX,$P(GMRVX(0),"/",1,2))=GDATA(1) S ^TMP($J,"GMRVG","C",9999999-GX,"/"_$P(GMRVX(0),"/",3))=GDATA(1)
. S ^TMP($J,"GMRVG","D",9999999-GX,$P(GMRVX(0),"/",3))=$S($P(GMRVX(0),"/",3)<$P(^GMRD(120.57,1,1),"^",8)&($P(GMRVX(0),"/",3)>$P(^(1),"^",10)):"",1:"^1^")
I $P($G(GMRVX(0)),"/",3)="" D
. S ^TMP($J,"GMRVG",GTYPE,9999999-GX,GMRVX(0))=GDATA(1)
. S:$P(GMRVX(0),"/",2)>0 ^TMP($J,"GMRVG","D",9999999-GX,$P(GMRVX(0),"/",2))=$S($P(GMRVX(0),"/",2)<$P(^GMRD(120.57,1,1),"^",8)&($P(GMRVX(0),"/",2)>$P(^(1),"^",10)):"",1:"^1^")
S GDIAS=$S($D(^TMP($J,"GMRVG","D",9999999-GX)):$O(^TMP($J,"GMRVG","D",9999999-GX,0)),1:0)
S GSYS=$S($D(^TMP($J,"GMRVG","S",9999999-GX)):$O(^TMP($J,"GMRVG","S",9999999-GX,0)),1:0)
I GDIAS,GSYS S GMAP=$J(GDIAS+((GSYS-GDIAS)/3),0,0),^TMP($J,"GMRVG","M",9999999-GX,GMAP)=""
K GSYS,GDIAS Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRVBP0 2916 printed Dec 13, 2024@01:56:01 Page 2
GMRVBP0 ;HIRMFO/YH-KYOCERA B/P GRAPH - STORE DATA IN ^TMP($J) ;5/24/99 12:40
+1 ;;4.0;Vitals/Measurements;**1,11**;Apr 25, 1997
EN1 ;
+1 NEW GAPICAL,GRADIAL,GBRACHI
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))
+2 KILL ^TMP($JOB,"GMR"),^TMP($JOB,"GMRK"),^TMP($JOB,"GDT"),^TMP($JOB,"GMRVG"),^TMP($JOB,"GTNM")
FOR GI=1:1:200
SET ^TMP($JOB,"GMRK","G"_GI)=""
+3 SET GMROUT=0
SET (^TMP($JOB,"GMRK","G82M"),^TMP($JOB,"GMRK","G210M"),^TMP($JOB,"GMRK","G226M"))=0.6
+4 SET GSTART1=(9999999-GMRFIN)-.0001
SET GEND1=9999999-GMRSTRT
+5 FOR GTYPE="B","P"
DO SETT
+6 USE IO
DO ^GMRVBP1
Q1 DO Q1^GMRVGR0
+1 QUIT
SETT ;
+1 SET GTYPE(1)=$SELECT(GTYPE="B":"BLOOD PRESSURE",GTYPE="P":"PULSE",1:"")
if GTYPE(1)
QUIT
+2 SET GTYP=$ORDER(^GMRD(120.51,"B",GTYPE(1),0))
if GTYP'>0
QUIT
+3 FOR GX=GSTART1:0
SET GX=$ORDER(^GMR(120.5,"AA",DFN,GTYP,GX))
if GX>GEND1!(GX'>0)
QUIT
FOR GEN=0:0
SET GEN=$ORDER(^GMR(120.5,"AA",DFN,GTYP,GX,GEN))
if GEN'>0
QUIT
IF '$DATA(^GMR(120.5,GEN,2))
DO BLDARR
+4 QUIT
BLDARR SET GDATA=$GET(^GMR(120.5,GEN,0))
if GDATA=""
QUIT
+1 SET GMRVX=GTYPE
SET GMRVX(0)=$PIECE(GDATA,"^",8)
SET GMRVX(1)=0
if GMRVX(0)>0!(GMRVX(0)="0")
DO EN1^GMRVSAS0
+2 KILL GMRVARY
SET GMRVARY=""
IF $PIECE($GET(^GMR(120.5,GEN,5,0)),"^",4)>0
DO CHAR^GMRVCHAR(GEN,.GMRVARY,GTYP)
+3 KILL GG
SET GG=""
IF $ORDER(GMRVARY(0))
Begin DoDot:1
+4 SET GG(1)=0
FOR
SET GG(1)=$ORDER(GMRVARY(GG(1)))
if GG(1)'>0
QUIT
SET GG(2)=0
FOR
SET GG(2)=$ORDER(GMRVARY(GG(1),GG(2)))
if GG(2)'>0
QUIT
SET GG(3)=""
FOR
SET GG(3)=$ORDER(GMRVARY(GG(1),GG(2),GG(3)))
if GG(3)=""
QUIT
SET GG=GG_$SELECT(GG="":"",1:";")_GG(3)
End DoDot:1
+5 SET GDATA(1)=GG_"^"_$SELECT($GET(GMRVX(1))>0:1,1:"")_"^"
+6 IF GTYPE="P"
Begin DoDot:1
+7 IF '$DATA(^GMR(120.5,GEN,5,"B"))
SET ^TMP($JOB,"GMRVG",GTYPE,9999999-GX,GMRVX(0))=GDATA(1)
QUIT
+8 IF $DATA(^GMR(120.5,GEN,5,"B",GBRACHI))
SET ^TMP($JOB,"GMRVG",GTYPE,9999999-GX,GMRVX(0))=GDATA(1)
QUIT
+9 IF $DATA(^GMR(120.5,GEN,5,"B",GAPICAL))
SET ^TMP($JOB,"GMRVG",GTYPE,9999999-GX,GMRVX(0))=GDATA(1)
QUIT
+10 IF $DATA(^GMR(120.5,GEN,5,"B",GRADIAL))
SET ^TMP($JOB,"GMRVG",GTYPE,9999999-GX,GMRVX(0))=GDATA(1)
QUIT
End DoDot:1
QUIT
+11 IF GMRVX(0)>0
SET ^TMP($JOB,"GMRVG","S",9999999-GX,$PIECE(GMRVX(0),"/"))=$SELECT($PIECE(GMRVX(0),"/")<$PIECE(^GMRD(120.57,1,1),"^",7)&($PIECE(GMRVX(0),"/")>$PIECE(^(1),"^",9)):"",1:"^1^")
+12 IF $PIECE($GET(GMRVX(0)),"/",3)'=""
Begin DoDot:1
+13 SET ^TMP($JOB,"GMRVG","B",9999999-GX,$PIECE(GMRVX(0),"/",1,2))=GDATA(1)
SET ^TMP($JOB,"GMRVG","C",9999999-GX,"/"_$PIECE(GMRVX(0),"/",3))=GDATA(1)
+14 SET ^TMP($JOB,"GMRVG","D",9999999-GX,$PIECE(GMRVX(0),"/",3))=$SELECT($PIECE(GMRVX(0),"/",3)<$PIECE(^GMRD(120.57,1,1),"^",8)&($PIECE(GMRVX(0),"/",3)>$PIECE(^(1),"^",10)):"",1:"^1^")
End DoDot:1
+15 IF $PIECE($GET(GMRVX(0)),"/",3)=""
Begin DoDot:1
+16 SET ^TMP($JOB,"GMRVG",GTYPE,9999999-GX,GMRVX(0))=GDATA(1)
+17 if $PIECE(GMRVX(0),"/",2)>0
SET ^TMP($JOB,"GMRVG","D",9999999-GX,$PIECE(GMRVX(0),"/",2))=$SELECT($PIECE(GMRVX(0),"/",2)<$PIECE(^GMRD(120.57,1,1),"^",8)&($PIECE(GMRVX(0),"/",2)>$PIECE(^(1),"^",10)):"",1:"^1^")
End DoDot:1
+18 SET GDIAS=$SELECT($DATA(^TMP($JOB,"GMRVG","D",9999999-GX)):$ORDER(^TMP($JOB,"GMRVG","D",9999999-GX,0)),1:0)
+19 SET GSYS=$SELECT($DATA(^TMP($JOB,"GMRVG","S",9999999-GX)):$ORDER(^TMP($JOB,"GMRVG","S",9999999-GX,0)),1:0)
+20 IF GDIAS
IF GSYS
SET GMAP=$JUSTIFY(GDIAS+((GSYS-GDIAS)/3),0,0)
SET ^TMP($JOB,"GMRVG","M",9999999-GX,GMAP)=""
+21 KILL GSYS,GDIAS
QUIT
