LRABG1 ;SLC/RWF - PULMONARY LAB DATA DISPLAY ;2/22/87 2:08 PM ;
;;5.2;LAB SERVICE;**187,201,213**;Sep 27, 1994
PRL K LRXCH S:IOST["P-" LRXCH=1 D:$Y+4>IOSL WAIT,HEAD:'LREND S LRIDT=$O(^LR(LRDFN,"CH",LRIDT)) G LREND:LRIDT="",LREND:LREND I $G(LREDT),LRIDT>LREDT G LREND
G PRL:$O(^LR(LRDFN,"CH",LRIDT,443))=""!($O(^(443))>459) S Z=^(0) G PRL:'$P(Z,U,3) I LRTOP>0 G:LRTOP'=$P(Z,U,5) PRL
S Z6="" F I=444,446:1:449,451:1:459 S Z6=Z6_$S($D(^LR(LRDFN,"CH",LRIDT,I)):$P(^(I),"^",1),1:"")_"^"
S Z2=$S($D(^LR(LRDFN,"CH",LRIDT,445)):^(445),1:"")
S Z8=$S($D(^LR(LRDFN,"CH",LRIDT,450)):^(450),1:"")
S Z=^LR(LRDFN,"CH",LRIDT,0),X=$P(Z,U,1) D DAT
W ! W:Y'=LRLDT Y
W !?2,"@"_T S LRSPEC=$P(Z,U,5),LRLDT=Y W $E("AVC W",LRSPEC-79),?11
S LRZZ=$P(Z2,U,1),I=1 X LRXW
S I=2,LRZZ=$P(Z6,U,I) X LRXW S I=3,LRZZ=$P(Z6,U,I) X LRXW S I=4,LRZZ=$P(Z6,U,5) X LRXW
S LRZZ=$P(Z8,U,1),I=5 X LRXW
F I=6:1:9 S LRZZ=$P(Z6,U,I) X LRXW
FI W ?75 S LRFIO2=$P(Z6,U,1) W LRFIO2 IF LRFIO2["L" S LRFIO2=LRFIO2*4+20 W "=",LRFIO2,"%"
W ! I $L($P(Z,U,5)),$D(^LAB(61,$P(Z,U,5),0)) W $E($P(^(0),U,1),1,14)
IF $P(Z6,U,4)>1 W ?15,"%MetHb IS ",$P(Z6,U,4)
S LRPT=$P(Z6,U,11) IF LRPT,LRPT'=37 W ?26,"TEMP ",LRPT,": " F K=12:1:14 S LRZZ=$P(Z6,U,K),I=K-7 X LRXW
IF $D(^LR(LRDFN,"CH",LRIDT,1)) W !,?6,"NOTE:" S I=0 F S I=$O(^LR(LRDFN,"CH",LRIDT,1,I)) Q:I<1 W ^(I,0),!
D AA G PRL
AA S LRPCO2=$P(Z6,U,6),LRPO2=$P(Z6,U,7) ;DIF=AGE*.28-3.06
IF $P(Z6,U,11)-37 S X=$P(Z6,U,13),Y=$P(Z,U,14) S:X>1 LRPCO2=X S:Y>1 LRPO2=Y
IF LRSPEC-80!(LRFIO2["CA") W ! Q ;SPEC'=ART. BLOOD
S LRFIO2=LRFIO2/100,LRALV=600*LRFIO2-(LRPCO2*(LRFIO2+(1-LRFIO2/.79)))
W !?6,"computed LRALV-art=",$J(LRALV-LRPO2,1,0) W:LRALV<LRPO2 " ERROR,",$C(7)
IF LRALV S X=$J(LRPO2/LRALV,1,2) W " art/LRALV=",X W:X'>.75 " (ratio should be above .75)" W:X>1 " ERROR",$C(7)
W ! Q
HEAD ;from LRABG
W @IOF S LRLDT=0,X=DT D DAT
W !,$P($G(^DIC(4,+$P($G(^XMB(1,1,"XUS")),U,17),0)),U)," BLOOD GAS REPORT",?60,Y
W !?5,SSN,?30,PNM,?60,"AGE ",AGE
W !,"DATE A/V"
H4 F I=1:1:3 W ! F J=0:1:10 W:J=0 $S(I=1:" TIME",I=2:"Ref High",1:"Ref Low ") I J>0 W $S($D(LRLN(J)):$J($P(LRLN(J),U,I),7),I=1:$J($P(^LAB(60,$P(LRTST,U,J),.1),U,1),7),1:" ")
W ! F J=1:4:76 W "----"
W "---" Q
DAT S Y=$$FMTE^XLFDT(X,"5ZM")
S T=$P(Y,"@",2),Y=$P(Y,"@") Q
;
WAIT Q:$D(LRXCH) S LREND=0 R !,"PRESS '^' TO STOP ",J:DTIME U IO
S:J="" J=1 S LREND=".^"[J Q
LREND W:'LREND !," last blood gas" D:LRIDT<1 WAIT D ^%ZISC
K LRIDT,LRXW,LRPQ,LRPJ,LRFIO2,LRPO2,LRALV,LRDFN,LRDPF,LRLDT,LRLI
K LRLL,LRLLT,LRLN,LRLNM,LRLO,LRLOC,LRPCO2,LRPT,LRSPEC,LRTOP,LRTST
K LRUTLITY,LRXCH,LRZZ,PNM,SEX,SSN,T,Z,Z2,Z6,Z8,I,J
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRABG1 2648 printed Nov 22, 2024@17:16:07 Page 2
LRABG1 ;SLC/RWF - PULMONARY LAB DATA DISPLAY ;2/22/87 2:08 PM ;
+1 ;;5.2;LAB SERVICE;**187,201,213**;Sep 27, 1994
PRL KILL LRXCH
if IOST["P-"
SET LRXCH=1
if $Y+4>IOSL
DO WAIT
if 'LREND
DO HEAD
SET LRIDT=$ORDER(^LR(LRDFN,"CH",LRIDT))
if LRIDT=""
GOTO LREND
if LREND
GOTO LREND
IF $GET(LREDT)
IF LRIDT>LREDT
GOTO LREND
+1 if $ORDER(^LR(LRDFN,"CH",LRIDT,443))=""!($ORDER(^(443))>459)
GOTO PRL
SET Z=^(0)
if '$PIECE(Z,U,3)
GOTO PRL
IF LRTOP>0
if LRTOP'=$PIECE(Z,U,5)
GOTO PRL
+2 SET Z6=""
FOR I=444,446:1:449,451:1:459
SET Z6=Z6_$SELECT($DATA(^LR(LRDFN,"CH",LRIDT,I)):$PIECE(^(I),"^",1),1:"")_"^"
+3 SET Z2=$SELECT($DATA(^LR(LRDFN,"CH",LRIDT,445)):^(445),1:"")
+4 SET Z8=$SELECT($DATA(^LR(LRDFN,"CH",LRIDT,450)):^(450),1:"")
+5 SET Z=^LR(LRDFN,"CH",LRIDT,0)
SET X=$PIECE(Z,U,1)
DO DAT
+6 WRITE !
if Y'=LRLDT
WRITE Y
+7 WRITE !?2,"@"_T
SET LRSPEC=$PIECE(Z,U,5)
SET LRLDT=Y
WRITE $EXTRACT("AVC W",LRSPEC-79),?11
+8 SET LRZZ=$PIECE(Z2,U,1)
SET I=1
XECUTE LRXW
+9 SET I=2
SET LRZZ=$PIECE(Z6,U,I)
XECUTE LRXW
SET I=3
SET LRZZ=$PIECE(Z6,U,I)
XECUTE LRXW
SET I=4
SET LRZZ=$PIECE(Z6,U,5)
XECUTE LRXW
+10 SET LRZZ=$PIECE(Z8,U,1)
SET I=5
XECUTE LRXW
+11 FOR I=6:1:9
SET LRZZ=$PIECE(Z6,U,I)
XECUTE LRXW
FI WRITE ?75
SET LRFIO2=$PIECE(Z6,U,1)
WRITE LRFIO2
IF LRFIO2["L"
SET LRFIO2=LRFIO2*4+20
WRITE "=",LRFIO2,"%"
+1 WRITE !
IF $LENGTH($PIECE(Z,U,5))
IF $DATA(^LAB(61,$PIECE(Z,U,5),0))
WRITE $EXTRACT($PIECE(^(0),U,1),1,14)
+2 IF $PIECE(Z6,U,4)>1
WRITE ?15,"%MetHb IS ",$PIECE(Z6,U,4)
+3 SET LRPT=$PIECE(Z6,U,11)
IF LRPT
IF LRPT'=37
WRITE ?26,"TEMP ",LRPT,": "
FOR K=12:1:14
SET LRZZ=$PIECE(Z6,U,K)
SET I=K-7
XECUTE LRXW
+4 IF $DATA(^LR(LRDFN,"CH",LRIDT,1))
WRITE !,?6,"NOTE:"
SET I=0
FOR
SET I=$ORDER(^LR(LRDFN,"CH",LRIDT,1,I))
if I<1
QUIT
WRITE ^(I,0),!
+5 DO AA
GOTO PRL
AA ;DIF=AGE*.28-3.06
SET LRPCO2=$PIECE(Z6,U,6)
SET LRPO2=$PIECE(Z6,U,7)
+1 IF $PIECE(Z6,U,11)-37
SET X=$PIECE(Z6,U,13)
SET Y=$PIECE(Z,U,14)
if X>1
SET LRPCO2=X
if Y>1
SET LRPO2=Y
+2 ;SPEC'=ART. BLOOD
IF LRSPEC-80!(LRFIO2["CA")
WRITE !
QUIT
+3 SET LRFIO2=LRFIO2/100
SET LRALV=600*LRFIO2-(LRPCO2*(LRFIO2+(1-LRFIO2/.79)))
+4 WRITE !?6,"computed LRALV-art=",$JUSTIFY(LRALV-LRPO2,1,0)
if LRALV<LRPO2
WRITE " ERROR,",$CHAR(7)
+5 IF LRALV
SET X=$JUSTIFY(LRPO2/LRALV,1,2)
WRITE " art/LRALV=",X
if X'>.75
WRITE " (ratio should be above .75)"
if X>1
WRITE " ERROR",$CHAR(7)
+6 WRITE !
QUIT
HEAD ;from LRABG
+1 WRITE @IOF
SET LRLDT=0
SET X=DT
DO DAT
+2 WRITE !,$PIECE($GET(^DIC(4,+$PIECE($GET(^XMB(1,1,"XUS")),U,17),0)),U)," BLOOD GAS REPORT",?60,Y
+3 WRITE !?5,SSN,?30,PNM,?60,"AGE ",AGE
+4 WRITE !,"DATE A/V"
H4 FOR I=1:1:3
WRITE !
FOR J=0:1:10
if J=0
WRITE $SELECT(I=1:" TIME",I=2:"Ref High",1:"Ref Low ")
IF J>0
WRITE $SELECT($DATA(LRLN(J)):$JUSTIFY($PIECE(LRLN(J),U,I),7),I=1:$JUSTIFY($PIECE(^LAB(60,$PIECE(LRTST,U,J),.1),U,1),7),1:" ")
+1 WRITE !
FOR J=1:4:76
WRITE "----"
+2 WRITE "---"
QUIT
DAT SET Y=$$FMTE^XLFDT(X,"5ZM")
+1 SET T=$PIECE(Y,"@",2)
SET Y=$PIECE(Y,"@")
QUIT
+2 ;
WAIT if $DATA(LRXCH)
QUIT
SET LREND=0
READ !,"PRESS '^' TO STOP ",J:DTIME
USE IO
+1 if J=""
SET J=1
SET LREND=".^"[J
QUIT
LREND if 'LREND
WRITE !," last blood gas"
if LRIDT<1
DO WAIT
DO ^%ZISC
+1 KILL LRIDT,LRXW,LRPQ,LRPJ,LRFIO2,LRPO2,LRALV,LRDFN,LRDPF,LRLDT,LRLI
+2 KILL LRLL,LRLLT,LRLN,LRLNM,LRLO,LRLOC,LRPCO2,LRPT,LRSPEC,LRTOP,LRTST
+3 KILL LRUTLITY,LRXCH,LRZZ,PNM,SEX,SSN,T,Z,Z2,Z6,Z8,I,J
+4 QUIT
