GMVLPO0 ;HIOFO/YH,FT-DOT MATRIX OXIMETRY/RESP. GRAPH - DATA ARRAY ;11/6/01 15:43
;;5.0;GEN. MED. REC. - VITALS;;Oct 31, 2002
;
; This routine uses the following IAs:
; #10061 - ^VADPT calls (supported)
; #10104 - ^XLFSTR calls (supported)
;
EN1 ;ENTRY POINT FROM GMVSR0 TO PRINT PO2/RESP. GRAPH FOR LINE PRINTER
S GMROUT=0 K ^TMP($J,"GMRVG"),^TMP($J,"GMRK"),^TMP($J,"GDT"),^TMP($J,"GTNM")
D DEM^VADPT,INP^VADPT S GMRBTH=$P(VADM(3),"^",2),GMRNAM=VADM(1)
S GSTART1=(9999999-GMRFIN)-.0001,GEND1=9999999-GMRSTRT
F GTYPE="PO2","R","P" D SETT^GMVHPO0
F GMRK="PO2","R","P" D GMRDT
K GMRVD F GMRDT=0:0 S GMRDT=$O(^TMP($J,"GMRDT",GMRDT)) Q:GMRDT'>0 D PULSE
F GMRDT=0:0 S GMRDT=$O(GMRVD(GMRDT)) Q:GMRDT'>0 K ^TMP($J,"GMRDT",GMRDT)
S (GMRTNM,GMRI)=0 I $D(^TMP($J,"GMRDT")) F S GMRI=$O(^TMP($J,"GMRDT",GMRI)) Q:GMRI'>0 S GMRTNM=GMRTNM+1
U IO D GRAPH
Q1 K Z,GSOL,GIVDT,GMRHLOC,GMRVJ,GDATA,GDT,GEN,GEND1,GI,GJ,GK,GMRVX,GSTART1,GTNM,GTYP,GTYPE,GX,I,GMRVD D KVAR^VADPT K VA,VAROOT
K GMRRMBD,GAGE,GCNT,GDOB,GCNTB,GCNTD,GCNTP,GCNTR,GCNTT,GCNTT1,GCNTI,GCNTO,GDT1,GCNTPD,GCNTTD,GCNTW,GPG,GPGS,GTYPE1,GCNTB3,GDTA,XDT,XIO,XX,^TMP($J,"GMRK"),^TMP($J,"GMR"),^TMP($J,"GDT"),^TMP($J,"GMRVG")
K GLPRNTR,GMRESP,GMRPO2,GMRR,GMRRHI,GMRRLO,GMRROFF,GMRY,GP,GR,GMRQUAL,GLINE,^TMP($J,"GTNM") Q
GRAPH ;
S:'$D(GFLAG) GFLAG=0 S GMRPGC=0,GMRX1="" F X=1:1:10 S GMRX1=GMRX1_" "_"|"
S (GMRX,GMRX2)=GMRX1 F X=1:1:10 S $P(GMRX,"|",X)="__________",$P(GMRX2,"|",X)="----------"
S GMRPG=$S(GMRTNM=0:1,1:GMRTNM\10+$S(GMRTNM#10>0:1,1:0)) F GMRPGS=1:1:GMRPG S GMRPO2=105.666,GMRPO2(1)=100,GMRESP=45.666,GMRESP(1)=40,GMRY=9 D PAGE Q:GMROUT ;PO2 AND RESPIRATION VALUES WHEN $Y=1
Q
PAGE ;
K GMRQUAL W:'($E(IOST)'="C"&'GFLAG) @IOF S GFLAG=1,GMRPGC=GMRPGC+1 W !
I '$D(^TMP($J,"GMRVG")) W !!!!!!!!,?5,"THERE IS NO DATA FOR THIS REPORT" X "F Y=$Y:1:(IOSL-6) W !" D FOOTER^GMVLPO2 Q
W ! D DATES^GMVVS2 W !," Pulse Ox. Resp.",?17,"|",?18,GMRX
F GMRI=0:0 Q:$Y>61 W ! D SETHD^GMVLPO1 W ?8,GMRHDR10,?16,$S(GMR3:"-",1:" "),?17,"|" D DATAPRT^GMVLPO1
W !,?17,"|",GMRX2 F GMRI="R","PO2","OX1","OX2","OX3","P","P1" S GMRLINE(GMRI)=GMRX1
S GMRNM=0 F GMRDT=0:0 S GMRDT=$O(^TMP($J,"GMRDT",GMRDT)) Q:GMRDT'>0 S GMRNM=GMRNM+1 Q:GMRNM>10 F GMRI="PO2","R","P" D:$D(^TMP($J,"GMRVG",GMRI,GMRDT)) STLNP^GMVLPO2
F GMRI="R","PO2","OX1","OX2","OX3","P","P1" D
.S G=$S(GMRI="R":"Respiration",GMRI="PO2":"Pulse Ox.",GMRI="OX1":" L/Min",GMRI="OX2":" %",GMRI="OX3":" Method",GMRI="P":"Pulse",1:"")
. W !,G,?17,"|",GMRLINE(GMRI)
I 'GMROUT W !,?17,$$REPEAT^XLFSTR("-",111)
W !,"R: Respiration POx: Pulse Oximetry * - Abnormal value ** - Abnormal value off of graph"
W ! I $D(GMRQUAL) S GLPRNTR=1 D LEGEND^GMVLGQU F I=1:1:5 W !,GLINE(I)
I IOSL'<($Y+10) F X=1:1 W ! Q:IOSL<($Y+10)
D FOOTER^GMVLPO2 S GMRDT="" F GMRNM=1:1:10 S GMRDT=$O(^TMP($J,"GMRDT",GMRDT)) Q:GMRDT'>0 K ^TMP($J,"GMRDT",GMRDT)
K GG,GI,GMRVJ,GSYNO Q
GMRDT S GMRTNM(GMRK)=0 F GMRI=0:0 S GMRI=$O(^TMP($J,"GMRVG",GMRK,GMRI)) Q:GMRI'>0 S GMRJ="" F X=0:0 S GMRJ=$O(^TMP($J,"GMRVG",GMRK,GMRI,GMRJ)) Q:GMRJ="" S GMRTNM(GMRK)=GMRTNM(GMRK)+1 S:GMRK'="XI1" ^TMP($J,"GMRDT",GMRI)=""
Q
PULSE ; Process Apical, Brachial, and Radial Pulses
N GMRP,GMRVPS,GMRVPO,GMRVR
S GMRP=$O(^TMP($J,"GMRVG","P",GMRDT,"")) Q:GMRP=""
S GMRVPS=$P($G(^TMP($J,"GMRVG","P",GMRDT,GMRP)),"^",1)
I GMRVPS'["APICAL",(GMRVPS'["RADIAL"),(GMRVPS'["BRACHIAL") S GMRVD(GMRDT)=""
S GMRVPO=$O(^TMP($J,"GMRVG","PO2",GMRDT,""))
S GMRVR=$O(^TMP($J,"GMRVG","R",GMRDT,""))
I GMRVPO="",(GMRVR="") Q
K GMRVD(GMRDT)
Q
GMVLPO0 ;HIOFO/YH,FT-DOT MATRIX OXIMETRY/RESP. GRAPH - DATA ARRAY ;11/6/01 15:43
+1 ;;5.0;GEN. MED. REC. - VITALS;;Oct 31, 2002
+2 ;
+3 ; This routine uses the following IAs:
+4 ; #10061 - ^VADPT calls (supported)
+5 ; #10104 - ^XLFSTR calls (supported)
+6 ;
EN1 ;ENTRY POINT FROM GMVSR0 TO PRINT PO2/RESP. GRAPH FOR LINE PRINTER
+1 SET GMROUT=0
KILL ^TMP($JOB,"GMRVG"),^TMP($JOB,"GMRK"),^TMP($JOB,"GDT"),^TMP($JOB,"GTNM")
+2 DO DEM^VADPT
DO INP^VADPT
SET GMRBTH=$PIECE(VADM(3),"^",2)
SET GMRNAM=VADM(1)
+3 SET GSTART1=(9999999-GMRFIN)-.0001
SET GEND1=9999999-GMRSTRT
+4 FOR GTYPE="PO2","R","P"
DO SETT^GMVHPO0
+5 FOR GMRK="PO2","R","P"
DO GMRDT
+6 KILL GMRVD
FOR GMRDT=0:0
SET GMRDT=$ORDER(^TMP($JOB,"GMRDT",GMRDT))
IF GMRDT'>0
QUIT
DO PULSE
+7 FOR GMRDT=0:0
SET GMRDT=$ORDER(GMRVD(GMRDT))
IF GMRDT'>0
QUIT
KILL ^TMP($JOB,"GMRDT",GMRDT)
+8 SET (GMRTNM,GMRI)=0
IF $DATA(^TMP($JOB,"GMRDT"))
FOR
SET GMRI=$ORDER(^TMP($JOB,"GMRDT",GMRI))
IF GMRI'>0
QUIT
SET GMRTNM=GMRTNM+1
+9 USE IO
DO GRAPH
Q1 KILL Z,GSOL,GIVDT,GMRHLOC,GMRVJ,GDATA,GDT,GEN,GEND1,GI,GJ,GK,GMRVX,GSTART1,GTNM,GTYP,GTYPE,GX,I,GMRVD
DO KVAR^VADPT
KILL VA,VAROOT
+1 KILL GMRRMBD,GAGE,GCNT,GDOB,GCNTB,GCNTD,GCNTP,GCNTR,GCNTT,GCNTT1,GCNTI,GCNTO,GDT1,GCNTPD,GCNTTD,GCNTW,GPG,GPGS,GTYPE1,GCNTB3,GDTA,XDT,XIO,XX,^TMP($JOB,"GMRK"),^TMP($JOB,"GMR"),^TMP($JOB,"GDT"),^TMP($JOB,"GMRVG")
+2 KILL GLPRNTR,GMRESP,GMRPO2,GMRR,GMRRHI,GMRRLO,GMRROFF,GMRY,GP,GR,GMRQUAL,GLINE,^TMP($JOB,"GTNM")
QUIT
GRAPH ;
+1 IF '$DATA(GFLAG)
SET GFLAG=0
SET GMRPGC=0
SET GMRX1=""
FOR X=1:1:10
SET GMRX1=GMRX1_" "_"|"
+2 SET (GMRX,GMRX2)=GMRX1
FOR X=1:1:10
SET $PIECE(GMRX,"|",X)="__________"
SET $PIECE(GMRX2,"|",X)="----------"
+3 ;PO2 AND RESPIRATION VALUES WHEN $Y=1
SET GMRPG=$SELECT(GMRTNM=0:1,1:GMRTNM\10+$SELECT(GMRTNM#10>0:1,1:0))
FOR GMRPGS=1:1:GMRPG
SET GMRPO2=105.666
SET GMRPO2(1)=100
SET GMRESP=45.666
SET GMRESP(1)=40
SET GMRY=9
DO PAGE
IF GMROUT
QUIT
+4 QUIT
PAGE ;
+1 KILL GMRQUAL
IF '($EXTRACT(IOST)'="C"&'GFLAG)
WRITE @IOF
SET GFLAG=1
SET GMRPGC=GMRPGC+1
WRITE !
+2 IF '$DATA(^TMP($JOB,"GMRVG"))
WRITE !!!!!!!!,?5,"THERE IS NO DATA FOR THIS REPORT"
XECUTE "F Y=$Y:1:(IOSL-6) W !"
DO FOOTER^GMVLPO2
QUIT
+3 WRITE !
DO DATES^GMVVS2
WRITE !," Pulse Ox. Resp.",?17,"|",?18,GMRX
+4 FOR GMRI=0:0
IF $Y>61
QUIT
WRITE !
DO SETHD^GMVLPO1
WRITE ?8,GMRHDR10,?16,$SELECT(GMR3:"-",1:" "),?17,"|"
DO DATAPRT^GMVLPO1
+5 WRITE !,?17,"|",GMRX2
FOR GMRI="R","PO2","OX1","OX2","OX3","P","P1"
SET GMRLINE(GMRI)=GMRX1
+6 SET GMRNM=0
FOR GMRDT=0:0
SET GMRDT=$ORDER(^TMP($JOB,"GMRDT",GMRDT))
IF GMRDT'>0
QUIT
SET GMRNM=GMRNM+1
IF GMRNM>10
QUIT
FOR GMRI="PO2","R","P"
IF $DATA(^TMP($JOB,"GMRVG",GMRI,GMRDT))
DO STLNP^GMVLPO2
+7 FOR GMRI="R","PO2","OX1","OX2","OX3","P","P1"
Begin DoDot:1
+8 SET G=$SELECT(GMRI="R":"Respiration",GMRI="PO2":"Pulse Ox.",GMRI="OX1":" L/Min",GMRI="OX2":" %",GMRI="OX3":" Method",GMRI="P":"Pulse",1:"")
+9 WRITE !,G,?17,"|",GMRLINE(GMRI)
End DoDot:1
+10 IF 'GMROUT
WRITE !,?17,$$REPEAT^XLFSTR("-",111)
+11 WRITE !,"R: Respiration POx: Pulse Oximetry * - Abnormal value ** - Abnormal value off of graph"
+12 WRITE !
IF $DATA(GMRQUAL)
SET GLPRNTR=1
DO LEGEND^GMVLGQU
FOR I=1:1:5
WRITE !,GLINE(I)
+13 IF IOSL'<($Y+10)
FOR X=1:1
WRITE !
IF IOSL<($Y+10)
QUIT
+14 DO FOOTER^GMVLPO2
SET GMRDT=""
FOR GMRNM=1:1:10
SET GMRDT=$ORDER(^TMP($JOB,"GMRDT",GMRDT))
IF GMRDT'>0
QUIT
KILL ^TMP($JOB,"GMRDT",GMRDT)
+15 KILL GG,GI,GMRVJ,GSYNO
QUIT
GMRDT SET GMRTNM(GMRK)=0
FOR GMRI=0:0
SET GMRI=$ORDER(^TMP($JOB,"GMRVG",GMRK,GMRI))
IF GMRI'>0
QUIT
SET GMRJ=""
FOR X=0:0
SET GMRJ=$ORDER(^TMP($JOB,"GMRVG",GMRK,GMRI,GMRJ))
IF GMRJ=""
QUIT
SET GMRTNM(GMRK)=GMRTNM(GMRK)+1
IF GMRK'="XI1"
SET ^TMP($JOB,"GMRDT",GMRI)=""
+1 QUIT
PULSE ; Process Apical, Brachial, and Radial Pulses
+1 NEW GMRP,GMRVPS,GMRVPO,GMRVR
+2 SET GMRP=$ORDER(^TMP($JOB,"GMRVG","P",GMRDT,""))
IF GMRP=""
QUIT
+3 SET GMRVPS=$PIECE($GET(^TMP($JOB,"GMRVG","P",GMRDT,GMRP)),"^",1)
+4 IF GMRVPS'["APICAL"
IF (GMRVPS'["RADIAL")
IF (GMRVPS'["BRACHIAL")
SET GMRVD(GMRDT)=""
+5 SET GMRVPO=$ORDER(^TMP($JOB,"GMRVG","PO2",GMRDT,""))
+6 SET GMRVR=$ORDER(^TMP($JOB,"GMRVG","R",GMRDT,""))
+7 IF GMRVPO=""
IF (GMRVR="")
QUIT
+8 KILL GMRVD(GMRDT)
+9 QUIT
