| 1 | LRBLRCT ;AVAMC/REG/CYM - CROSSMATCH:TRANSFUSION REPORT ;6/19/96 09:50 ;
|
|---|
| 2 | ;;5.2;LAB SERVICE;**72,247,267**;Sep 27, 1994
|
|---|
| 3 | ;Per VHA Directive 97-033 this routine should not be modified. Medical Device # BK970021
|
|---|
| 4 | D END W !!?20,"Crossmatch:Transfusion Report",!
|
|---|
| 5 | D B^LRU G:Y<0 END S LRLDT=LRLDT+.99,LRSDT=LRSDT-.0001
|
|---|
| 6 | S ZTRTN="QUE^LRBLRCT" D BEG^LRUTL G:POP!($D(ZTSK)) END
|
|---|
| 7 | QUE U IO S LRG("?")="UNKNOWN",LRF("?")=0,LRQ(2)=1
|
|---|
| 8 | K ^TMP($J) D L^LRU,S^LRU,H S LR("F")=1 D C
|
|---|
| 9 | W ! W:IOST'?1"C".E @IOF D END^LRUTL,END Q
|
|---|
| 10 | C F A=LRSDT:0 S A=$O(^LRD(65,"AN",A)) Q:'A!(A>LRLDT) F I=0:0 S I=$O(^LRD(65,"AN",A,I)) Q:'I F P=0:0 S P=$O(^LRD(65,"AN",A,I,P)) Q:'P F B=0:0 S B=$O(^LRD(65,"AN",A,I,P,B)) Q:'B D SET
|
|---|
| 11 | F A=0:0 S A=$O(^TMP($J,A)) Q:'A S X=^LR(A,0),Y=$P(X,"^",3),X=$P(X,"^",2),X=^DIC(X,0,"GL"),X=@(X_Y_",0)"),^TMP($J,"B",$P(X,"^"),A)=$P(X,"^",9)
|
|---|
| 12 | D W Q:LR("Q") D STATS Q
|
|---|
| 13 | SET S Z=$O(^LRD(65,I,3,0)) I Z S X=^(Z,0),Z=$P(X,"^",4)
|
|---|
| 14 | S X=^LRD(65,I,2,P,1,B,0),Y=$P(X,"^",4),LRF(Y)=0,^TMP($J,P,+X,I)=$P(X,"^",10)_"^"_$S(Y]"":Y,1:"?")_"^"_Z Q
|
|---|
| 15 | ;
|
|---|
| 16 | W S (LRP,LRX,LRX(1),LRT,LRZ)=0 F A=0:0 S LRP=$O(^TMP($J,"B",LRP)) Q:LRP=""!(LR("Q")) F LRDFN=0:0 S LRDFN=$O(^TMP($J,"B",LRP,LRDFN)) Q:'LRDFN!(LR("Q")) S SSN=^(LRDFN),LRDPF=$P(^LR(LRDFN,0),U,2),LRZ=LRZ+1 W:LRZ>1 !,LR("%") D V
|
|---|
| 17 | Q
|
|---|
| 18 | V D:$Y>(IOSL-6) H Q:LR("Q") D SSN^LRU W !,$J(LRZ,3),")",?6,LRP,?38,SSN F LRS=0:0 S LRS=$O(^TMP($J,LRDFN,LRS)) Q:'LRS!(LR("Q")) S Y=LRS D DT^LRU S LRD=Y D U
|
|---|
| 19 | Q
|
|---|
| 20 | U S LRI=0 F LRE=0:1 S LRI=$O(^TMP($J,LRDFN,LRS,LRI)) Q:'LRI S:'LRE LRX(1)=LRX(1)+1 S LRC=^(LRI),LRX=LRX+1,LRH=1 D:$P(LRC,"^")="TRANSFUSED" A D:$Y>(IOSL-6) H1 Q:LR("Q") D X
|
|---|
| 21 | Q
|
|---|
| 22 | X S Y=$P(LRC,"^",2),X=^LRD(65,LRI,0),C=$P(^LAB(66,$P(X,"^",4),0),"^",2) W !,LRD,?17,$P(X,"^"),?32,C,?37,Y,?40,$E($P(LRC,"^"),1,23)
|
|---|
| 23 | I $D(^LRD(65,"AP",LRDFN,LRI)) W " On x-match, not counted" W ?65,$E($P(LRC,U,3),1,14) S LRX=LRX-1 Q
|
|---|
| 24 | S LRF(Y)=LRF(Y)+LRH Q
|
|---|
| 25 | A S Y=$O(^LRD(65,LRI,9,0)) I 'Y S LRT=LRT+1 Q
|
|---|
| 26 | S Y=^LRD(65,LRI,9,Y,0),Y(2)=$P(Y,"^",2),Y=+Y,Z=0
|
|---|
| 27 | F X=0:0 S X=$O(^LRD(65,"B",Y(2),X)) Q:'X I $D(^LRD(65,X,0)),$P(^(0),"^",4)=Y S Z=$S($D(^LRD(65,X,9,0)):$P(^(0),"^",4),1:0) Q
|
|---|
| 28 | I Z S LRH=$S(Z=1:0,1:+(1/Z)),LRT=LRT+$S(Z=1:1,1:LRH),LRX=LRX-1
|
|---|
| 29 | Q
|
|---|
| 30 | ;
|
|---|
| 31 | H I $D(LR("F")),IOST?1"C".E D M^LRU Q:LR("Q")
|
|---|
| 32 | D F^LRU W !,"BLOOD BANK",!,"CROSSMATCH:TRANSFUSIONS (from: ",LRSTR," to ",LRLST,")"
|
|---|
| 33 | W:LRQ(2) !,"Specimen date",?17,"Unit ID",?32,"Comp",?37,"XM",?40,"Release Reason",?65,"Location"
|
|---|
| 34 | W !,LR("%") Q
|
|---|
| 35 | H1 D H Q:LR("Q") W !,?6,LRP,?38,SSN Q
|
|---|
| 36 | H2 S LRQ(2)=0 D H Q
|
|---|
| 37 | ;
|
|---|
| 38 | STATS D:$Y>(IOSL-11) H2 Q:LR("Q") I LRT["." S X=LRT D Z S LRT=X
|
|---|
| 39 | W !,LR("%"),!,"Number of specimens crossmatched:",$J(LRX(1),6)
|
|---|
| 40 | W !,"Total units crossmatched:",$J(LRX,6)
|
|---|
| 41 | W !,"Total units transfused:",$J(LRT,6)
|
|---|
| 42 | I LRT W !,"Crossmatch/transfusion ratio:",$J(LRX/LRT,9,2)
|
|---|
| 43 | D:$Y>(IOSL-11) H2 Q:LR("Q") S A=0 F B=0:0 S A=$O(LRF(A)) Q:A=""!(LR("Q")) W:LRF(A) !,"Number of units ",$$EXTERNAL^DILFD(65.02,.04,"",A),"(",A,"):",$P(LRF(A),".")+$S($P(LRF(A),".",2)>5:1,1:0)
|
|---|
| 44 | Q
|
|---|
| 45 | ;
|
|---|
| 46 | Z S Z=$P(X,".",2),Y=$P(X,"."),X=Y+$S(Z>5:1,1:0) Q
|
|---|
| 47 | END D V^LRU Q
|
|---|
