Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LRZABG1

LRZABG1.m

Go to the documentation of this file.
LRZABG1 ;SLC/RWF- PULMONARY LAB DATA DISPLAY ; 2/22/87  2:08 PM ; [ 10/14/90  5:42 PM ]
 ;;V~4.08~
PRL D:$Y+4>IOSL WAIT,HEAD:'LREND S LRIDT=$N(^LR(LRDFN,"CH",LRIDT)) G LREND:LRIDT<1,LREND:LREND
 G PRL:$N(^LR(LRDFN,"CH",LRIDT,443))<1!($N(^(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:""),Z8=$S($D(^(450)):^(450),1:"")
 S Z=^LR(LRDFN,"CH",LRIDT,0),X=$P(Z,U,1) D DAT
 W ! W:Y'=LRLDT Y," " W ?6,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,"%"  ;IHS/ANMC/CLS disabled calculation
 W ! I $L($P(Z,U,5)),$D(^LAB(61,$P(Z,U,5),0)) W $E($P(^(0),U,1),1,14)
 ;W ! I $L($P(Z6,U,15)) S LRSAM=$P(Z6,U,15) W $S(LRSAM="N":"Arterial",LRSAM="Y":"Capillary",1:"Arterial") K LRSAM  ;IHS/ANMC/CLS 08/31/90 prints Sample
 IF $P(Z6,U,4)>.24 W ?15,"%MetHb IS ",$P(Z6,U,4)  ;IHS/ANMC/CLS 09/28/90 changed >1 to >.24
 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:" F I=0:0 S I=$N(^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,",*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",*7
 W ! Q
 W @IOF S LRLDT=0,X=DT D DAT
 W !,^DD("SITE")," BLOOD GAS REPORT",?60,Y
 W !?5,HRCN,?30,PNM,?60,"AGE ",AGE  ;IHS/ANMC/CLS 09/03/90 HRCN
 W !,"DATE/TIME"  ;IHS/ANMC/CLS 09/03/90 replaced A/V with TIME
H4 F I=1:1:2 W ! F J=0:1:10 W:J=0 $S(I=1:"        ",1:"Sample ") 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:"       ")
 ;IHS/ANMC/CLS 09/03/90 removed TIME and Ref High, replaced Ref Low with Sample
 ;W !,"NORM HIGH   17   95     1.0     23.6  7.45  40   85    2.5  25   ranges for"
 ;W !,"NORM LOW    13   92      .4     16.6  7.35  34   68   -2.5  19   room air"
 W ! F J=1:4:76 W "----"
 W "---" Q
DAT S Y=$E(X,4,5)_"/"_$E(X,6,7) ;_"/"_$E(X,2,3)
 S T=$E(X_"00",9,10)_$E(X_"000",11,12) Q
 ;
WAIT Q:$D(LRZCH)  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 X ^%ZIS("C") K LRIDT,LRXW,Z,LRPQ,LRPJ,LRFIO2,LRPO2,LRALV,LRDFN,LRDPF,LRLDT,LRLI,LRLL,LRLLT,LRLN,LRLNM,LRLO,LRLOC,LRPCO2,LRPT,LRSPEC,LRTOP,LRTST,LRUTLITY,SLZCH,LRZZ,PNM,SEX,SSN,T,Z2,Z6,Z8
 K LRZCH,HRCN  ;IHS/ANMC/CLS 10/14/90 HRCN
 Q