- GMRVGR0 ;HIRMFO/MH,YH-VITALS GRAPH (PART 1) ;3/10/99
- ;;4.0;Vitals/Measurements;**1,7,11**;Apr 25, 1997
- EN1 ;ENTRY POINT FROM GMRVSR0 TO PRINT SF-511 GRAPH FOR KYOCERA
- S GMRHT=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,GHT)="",^TMP($J,"GMRK","G50M")=0.2,^TMP($J,"GMRK","G82M")=0.6
- S GSTART1=(9999999-GMRFIN)-.0001,GEND1=9999999-GMRSTRT
- F GTYPE="B","H","P","R","T","W","PO2","CVP","CG","PN" D SETT
- S GRPT=5 D SETIO U IO D ^GMRVGR1
- Q1 K GSOL,GIVDT,GMRHLOC,GMRVJ,GDATA,GDT,GEN,GEND1,GI,GJ,GK,GMRVX,GSTART1,GTNM,GTYP,GTYPE,GX,I D KVAR^VADPT K VA,VAROOT
- W:$E(IOST)="P"!$D(IO("S")) !
- D QIO^GMRVGR5 K GRPT,GMROUT,GMRRMBD,GAGE,GCNT,GDOB,GCNTB,GCNTD,GCNTP,GCNTR,GCNTT,GCNTT1,GCNTI,GCNTO,GDT1,GCNTPD,GCNTTD,GCNTW,GPG,GPGS,GHT,GTYPE1,GCNTB3,GDTA,XDT,XIO,XX,^TMP($J,"GMRK"),^TMP($J,"GMR"),^TMP($J,"GDT"),^TMP($J,"GMRVG")
- K GLINE,GMRQUAL,^TMP($J,"GTNM") Q
- SETT ;SET GMRT
- S GTYP(1)=$S(GTYPE="B":"BLOOD PRESSURE",GTYPE="P":"PULSE",GTYPE="R":"RESPIRATION",GTYPE="T":"TEMPERATURE",GTYPE="H":"HEIGHT",GTYPE="W":"WEIGHT",GTYPE="CG":"CIRCUMFERENCE/GIRTH",GTYPE="PO2":"PULSE OXIMETRY",1:"")
- I GTYP(1)="" S GTYP(1)=$S(GTYPE="CVP":"CENTRAL VENOUS PRESSURE",GTYPE="PN":"PAIN",1:"")
- Q:GTYP(1)=""
- S GTYP=$O(^GMRD(120.51,"B",GTYP(1),""))
- I 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=$S($D(^GMR(120.5,GEN,0)):^(0),1:"")
- S GMRVX=GTYPE,GMRVX(0)=$P(GDATA,"^",8),GMRVX(1)=0 D:GMRVX(0)>0!(GMRVX(0)<0)!($E(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 ^TMP($J,"GMRVG",GTYPE,9999999-GX,$P(GDATA,"^",8))=GG_"^"_$S($G(GMRVX(1))>0:1,1:"")_"^^"_$P(GDATA,"^",10)
- I GTYPE="P",GG["DORSALIS PEDIS",$P(GDATA,"^",8)=1 S $P(^TMP($J,"GMRVG",GTYPE,9999999-GX,$P(GDATA,"^",8)),"^",2)=0
- S:$D(^TMP($J,"GMRVG","H",9999999-GX,$P(GDATA,"^",8))) GHT=$P(GDATA,"^",8)
- I GTYPE="B",$P(GDATA,"^",8)'>0 S ^TMP($J,"GMRVG","B",9999999-GX,$P(GDATA,"^",8))="^^"
- I GTYPE="B",$L($P(GDATA,"^",8))>7,+$P(GDATA,"^",8)>0 D
- . S ^TMP($J,"GMRVG","B",9999999-GX,$P($P(GDATA,"^",8),"/",1,2))=^TMP($J,"GMRVG","B",9999999-GX,$P(GDATA,"^",8)) K ^($P(GDATA,"^",8)) S ^TMP($J,"GMRVG","C",9999999-GX,"/"_$P($P(GDATA,"^",8),"/",3))=GG
- K GG Q
- SETIO ;
- S X="GMRYRP0" X ^%ZOSF("TEST") Q:'$T
- D IO^GMRVGR5
- D SETIOAR
- Q
- SETIOAR F GTYPE1="XI"_($P(^GMRD(126.56,0),"^",4)+4),"XO"_($P(^GMRD(126.58,0),"^",4)+1) F GDT=0:0 S GDT=$O(^TMP($J,"GMR",GTYPE1,GDT)) Q:GDT'>0 F GDTA=0:0 S GDTA=$O(^TMP($J,"GMR",GTYPE1,GDT,GDTA)) Q:GDTA="" D SETIOAR1
- Q
- SETIOAR1 S:GTYPE1["XI" ^TMP($J,"GMRVG","I",GDT,GDTA)="^" S:GTYPE1["XO" ^TMP($J,"GMRVG","O",GDT,GDTA)="^"
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRVGR0 3093 printed Jan 18, 2025@02:57:42 Page 2
- GMRVGR0 ;HIRMFO/MH,YH-VITALS GRAPH (PART 1) ;3/10/99
- +1 ;;4.0;Vitals/Measurements;**1,7,11**;Apr 25, 1997
- EN1 ;ENTRY POINT FROM GMRVSR0 TO PRINT SF-511 GRAPH FOR KYOCERA
- +1 SET GMRHT=0
- 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)=""
- +2 SET (GMROUT,GHT)=""
- SET ^TMP($JOB,"GMRK","G50M")=0.2
- SET ^TMP($JOB,"GMRK","G82M")=0.6
- +3 SET GSTART1=(9999999-GMRFIN)-.0001
- SET GEND1=9999999-GMRSTRT
- +4 FOR GTYPE="B","H","P","R","T","W","PO2","CVP","CG","PN"
- DO SETT
- +5 SET GRPT=5
- DO SETIO
- USE IO
- DO ^GMRVGR1
- Q1 KILL GSOL,GIVDT,GMRHLOC,GMRVJ,GDATA,GDT,GEN,GEND1,GI,GJ,GK,GMRVX,GSTART1,GTNM,GTYP,GTYPE,GX,I
- DO KVAR^VADPT
- KILL VA,VAROOT
- +1 if $EXTRACT(IOST)="P"!$DATA(IO("S"))
- WRITE !
- +2 DO QIO^GMRVGR5
- KILL GRPT,GMROUT,GMRRMBD,GAGE,GCNT,GDOB,GCNTB,GCNTD,GCNTP,GCNTR,GCNTT,GCNTT1,GCNTI,GCNTO,GDT1,GCNTPD,GCNTTD,GCNTW,GPG,GPGS,GHT,GTYPE1,GCNTB3,GDTA,XDT,XIO,XX,^TMP($JOB,"GMRK"),^TMP($JOB,"GMR"),^TMP($JOB,"GDT"),^TMP($JOB,"GMRVG")
- +3 KILL GLINE,GMRQUAL,^TMP($JOB,"GTNM")
- QUIT
- SETT ;SET GMRT
- +1 SET GTYP(1)=$SELECT(GTYPE="B":"BLOOD PRESSURE",GTYPE="P":"PULSE",GTYPE="R":"RESPIRATION",GTYPE="T":"TEMPERATURE",GTYPE="H":"HEIGHT",GTYPE="W":"WEIGHT",GTYPE="CG":"CIRCUMFERENCE/GIRTH",GTYPE="PO2":"PULSE OXIMETRY",1:"")
- +2 IF GTYP(1)=""
- SET GTYP(1)=$SELECT(GTYPE="CVP":"CENTRAL VENOUS PRESSURE",GTYPE="PN":"PAIN",1:"")
- +3 if GTYP(1)=""
- QUIT
- +4 SET GTYP=$ORDER(^GMRD(120.51,"B",GTYP(1),""))
- +5 IF GTYP>0
- 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
- +6 QUIT
- BLDARR SET GDATA=$SELECT($DATA(^GMR(120.5,GEN,0)):^(0),1:"")
- +1 SET GMRVX=GTYPE
- SET GMRVX(0)=$PIECE(GDATA,"^",8)
- SET GMRVX(1)=0
- if GMRVX(0)>0!(GMRVX(0)<0)!($EXTRACT(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 ^TMP($JOB,"GMRVG",GTYPE,9999999-GX,$PIECE(GDATA,"^",8))=GG_"^"_$SELECT($GET(GMRVX(1))>0:1,1:"")_"^^"_$PIECE(GDATA,"^",10)
- +6 IF GTYPE="P"
- IF GG["DORSALIS PEDIS"
- IF $PIECE(GDATA,"^",8)=1
- SET $PIECE(^TMP($JOB,"GMRVG",GTYPE,9999999-GX,$PIECE(GDATA,"^",8)),"^",2)=0
- +7 if $DATA(^TMP($JOB,"GMRVG","H",9999999-GX,$PIECE(GDATA,"^",8)))
- SET GHT=$PIECE(GDATA,"^",8)
- +8 IF GTYPE="B"
- IF $PIECE(GDATA,"^",8)'>0
- SET ^TMP($JOB,"GMRVG","B",9999999-GX,$PIECE(GDATA,"^",8))="^^"
- +9 IF GTYPE="B"
- IF $LENGTH($PIECE(GDATA,"^",8))>7
- IF +$PIECE(GDATA,"^",8)>0
- Begin DoDot:1
- +10 SET ^TMP($JOB,"GMRVG","B",9999999-GX,$PIECE($PIECE(GDATA,"^",8),"/",1,2))=^TMP($JOB,"GMRVG","B",9999999-GX,$PIECE(GDATA,"^",8))
- KILL ^($PIECE(GDATA,"^",8))
- SET ^TMP($JOB,"GMRVG","C",9999999-GX,"/"_$PIECE($PIECE(GDATA,"^",8),"/",3))=GG
- End DoDot:1
- +11 KILL GG
- QUIT
- SETIO ;
- +1 SET X="GMRYRP0"
- XECUTE ^%ZOSF("TEST")
- if '$TEST
- QUIT
- +2 DO IO^GMRVGR5
- +3 DO SETIOAR
- +4 QUIT
- SETIOAR FOR GTYPE1="XI"_($PIECE(^GMRD(126.56,0),"^",4)+4),"XO"_($PIECE(^GMRD(126.58,0),"^",4)+1)
- FOR GDT=0:0
- SET GDT=$ORDER(^TMP($JOB,"GMR",GTYPE1,GDT))
- if GDT'>0
- QUIT
- FOR GDTA=0:0
- SET GDTA=$ORDER(^TMP($JOB,"GMR",GTYPE1,GDT,GDTA))
- if GDTA=""
- QUIT
- DO SETIOAR1
- +1 QUIT
- SETIOAR1 if GTYPE1["XI"
- SET ^TMP($JOB,"GMRVG","I",GDT,GDTA)="^"
- if GTYPE1["XO"
- SET ^TMP($JOB,"GMRVG","O",GDT,GDTA)="^"
- +1 QUIT