- 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 Jan 18, 2025@02:57:14 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