| [613] | 1 | LRBLPD ;AVAMC/REG - BB PT INFO ;2/18/93 09:42 ;
|
|---|
| 2 | ;;5.2;LAB SERVICE;**247**;Sep 27, 1994
|
|---|
| 3 | ;Per VHA Directive 97-033 this routine should not be modified. Medical Device # BK970021
|
|---|
| 4 | D END S X="BLOOD BANK" D ^LRUTL G:Y=-1 END I LRSS'="BB" W $C(7),!!,"MUST BE BLOOD BANK" G END
|
|---|
| 5 | S LRQ=1 D ^LRUL I '$O(^LRO(69.2,LRAA,7,DUZ,1,0)) D R^LRUL G END
|
|---|
| 6 | S X=$P(^DD(66,.26,0),U,3),LRF(1)="RBC",LRG(1)="1^RBC",C=1 F A=7:1 S B=$P(X,";",A) Q:B="" S C=C+1,LRG(C)=A_"^"_$P(B,":",2),LRF(A)=$P(B,":",2)
|
|---|
| 7 | W !,"List all blood components " S %=1 D YN^LRU G:%<1 END S LRE=$S(%=1:1,1:0) I 'LRE D ASK G:'LRF END
|
|---|
| 8 | W !,"List only total number of units for each component " S %=2 D YN^LRU G:%<1 END S LRJ=$S(%=1:1,1:0)
|
|---|
| 9 | D B^LRU G:Y<0 END S LRLDT=9999998-LRLDT,LRSDT=9999999-LRSDT
|
|---|
| 10 | K DIC,DIE,DR S ZTRTN="QUE^LRBLPD" D BEG^LRUTL D:POP R^LRUL G:POP!($D(ZTSK)) END
|
|---|
| 11 | QUE U IO D L^LRU,S^LRU
|
|---|
| 12 | S DIWL=5,DIWR=IOM-5,DIWF="W",LRC(1.7)="RBC Antibody present:",LRC(1)="RBC Antigen present :",LRC(1.5)="RBC Antigen absent :"
|
|---|
| 13 | S LRP=0 F LRP(1)=0:0 S LRP=$O(^LRO(69.2,LRAA,7,DUZ,1,"C",LRP)) Q:LRP=""!(LR("Q")) F LRDFN=0:0 S LRDFN=$O(^LRO(69.2,LRAA,7,DUZ,1,"C",LRP,LRDFN)) Q:'LRDFN!(LR("Q")) D LOOP
|
|---|
| 14 | D EN^LRUL,END^LRUTL,END Q
|
|---|
| 15 | LOOP K ^TMP($J) S LRQ=0,SSN=$P(^LRO(69.2,LRAA,7,DUZ,1,LRDFN,0),"^",10),X=^LR(LRDFN,0),LRPABO=$P(X,"^",5),LRPRH=$P(X,"^",6),LRDPF=$P(X,U,2) D H S LR("F")=1
|
|---|
| 16 | S LRI=LRLDT F B=1:1 S LRI=$O(^LR(LRDFN,1.6,LRI)) Q:'LRI!(LRI>LRSDT) D SET
|
|---|
| 17 | S A=0 F B=1:1 S A=$O(^TMP($J,A)) Q:A=""!(LR("Q")) D:$Y>(IOSL-6) H Q:LR("Q") W ! S LRT=0 D N Q:LR("Q") W:LRT !,"Total ",$S($D(LRF(A)):LRF(A),1:"?"),": ",LRT
|
|---|
| 18 | Q:LR("Q") I B=1 W !,"No transfused units" W:'LRE " for ",LRF(LRF) W " on record for specified period.",!
|
|---|
| 19 | W !! K ^TMP($J) S A=0 F B=0:1 S A=$O(^LR(LRDFN,3,A)) Q:'A!(LR("Q")) S LRX=^(A,0) D:$Y>(IOSL-6) H Q:LR("Q") S X=LRX D ^DIWP
|
|---|
| 20 | D:B ^DIWW W ! F C=1.7,1,1.5 Q:LR("Q") W ! S A=0 F B=0:1 S A=$O(^LR(LRDFN,C,A)) Q:'A!(LR("Q")) W:'B LRC(C) W:B ! W ?21,$P(^LAB(61.3,A,0),"^") D:$Y>(IOSL-6) H Q:LR("Q")
|
|---|
| 21 | Q
|
|---|
| 22 | ;
|
|---|
| 23 | SET S X=^LR(LRDFN,1.6,LRI,0),Z=+$P(X,"^",2),Z=$S($D(^LAB(66,Z,0)):^(0),1:""),Y=+$P(Z,"^",19),Z=+$P(Z,"^",26),Z=$S(Y:1,'Z:"?",1:Z) I 'LRE,LRF'=Z Q
|
|---|
| 24 | S ^TMP($J,Z,B)=LRI_"^"_X Q
|
|---|
| 25 | ;
|
|---|
| 26 | ASK S (A,LRF)=0 F B=0:0 S B=$O(LRG(B)) Q:'B W !?13,$J(B,2),?18,$P(LRG(B),"^",2) S A=A+1
|
|---|
| 27 | W !!,"Select (1-",A,"): " R X:DTIME Q:X=""!(X[U) I +X'=X!(X<1)!(X>A) W $C(7),!!,"Select a NUMBER from 1 to ",A G ASK
|
|---|
| 28 | S LRF=+LRG(X) W ?18,$P(LRG(X),"^",2) Q
|
|---|
| 29 | ;
|
|---|
| 30 | N F C=0:0 S C=$O(^TMP($J,A,C)) Q:'C!(LR("Q")) S X=^(C),LRI=+X,Y=$P(X,U,2) D D^LRU,O Q:LR("Q") D:$Y>(IOSL-6) H Q:LR("Q")
|
|---|
| 31 | Q
|
|---|
| 32 | O S X(1)=+$P(X,U,3),X(7)=$P(X,U,8),X(10)=$P(X,U,11),M=$S($D(^LAB(66,X(1),0)):$E($P(^(0),U),1,30),1:"component not known"),LRT=LRT+$S(X(7):X(7),1:1)
|
|---|
| 33 | Q:LRJ W !,$P(X,"^",4),?18,$E($P(M,"^"),1,30) I X(7)!(X(10)) W ?45,"(",X(7),"/",X(10),")"
|
|---|
| 34 | W ?54,$P(X,"^",6)_" "_$P(X,"^",7),?60,Y
|
|---|
| 35 | F F=1,2 F E=0:0 S E=$O(^LR(LRDFN,1.6,LRI,F,E)) Q:'E!(LR("Q")) W !?6,^(E,0) D:$Y>(IOSL-6) H Q:LR("Q")
|
|---|
| 36 | Q
|
|---|
| 37 | ;
|
|---|
| 38 | END D V^LRU Q
|
|---|
| 39 | ;
|
|---|
| 40 | H I $D(LR("F")),IOST?1"C".E D M^LRU Q:LR("Q")
|
|---|
| 41 | D F^LRU W !,"TRANSFUSION SERVICE/BLOOD BANK REPORT from ",LRSTR," to ",LRLST,!,"PATIENT: ",LRP," ",SSN," ",$J(LRPABO,2)," ",LRPRH
|
|---|
| 42 | W:'LRJ !,"Unit Transfused",?18,"Component",?36,"(# of Units/ml )",?60,"Date/Time Completed" W:LRJ !,"Components Transfused" W !,LR("%")
|
|---|
| 43 | Q
|
|---|
