source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRBLRCT.m@ 1766

Last change on this file since 1766 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.9 KB
Line 
1LRBLRCT ;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
7QUE 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
10C 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
13SET 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 ;
16W 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
18V 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
20U 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
22X 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
25A 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 ;
31H 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
35H1 D H Q:LR("Q") W !,?6,LRP,?38,SSN Q
36H2 S LRQ(2)=0 D H Q
37 ;
38STATS 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 ;
46Z S Z=$P(X,".",2),Y=$P(X,"."),X=Y+$S(Z>5:1,1:0) Q
47END D V^LRU Q
Note: See TracBrowser for help on using the repository browser.