- 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 Mar 13, 2025@21:10:23 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
