| 1 | LRBLJTS1 ;AVAMC/REG - TRANSFUSION STATS ;3/3/93 22:49 ;
|
|---|
| 2 | ;;5.2;LAB SERVICE;**247,267**;Sep 27, 1994
|
|---|
| 3 | ;Per VHA Directive 97-033 this routine should not be modified. Medical Device # BK970021
|
|---|
| 4 | S L=0,B=LRSDT F B(1)=0:0 S B=$O(^LRD(65,"AB",B)) Q:'B!(B>LRLDT) S A=0 F A(1)=0:0 S A=$O(^LRD(65,"AB",B,A)) Q:'A I $D(^LRD(65,A,4)),$P(^(4),"^")="T" S Y=$P(^(4),"^",2) D T
|
|---|
| 5 | D K^LRU,P,^LRBLJTS2 Q
|
|---|
| 6 | T Q:'$D(^LRD(65,A,6)) S X=$P(^(6),"^",3) Q:X']LRA!(X]LRB) S J=$P(^(0),"^",4),Z=^LAB(66,J,0),Z(1)=$P(Z,"^"),Z(26)=$P(Z,"^",26) Q:Z(1)']LRC!(Z(1)]LRE)
|
|---|
| 7 | S W=^LRD(65,A,0),W(1)=$P(W,"^"),V=^(6),V(2)=$P(V,"^",2),V=+V,Z(9)=$P(Z,"^",19) I V'=L S L=V,G=^LR(L,0),H=$P(G,"^",3),G=$P(G,"^",2),G=^DIC(G,0,"GL"),G=@(G_H_",0)"),^TMP($J,"P",$P(G,"^"),L)=""
|
|---|
| 8 | S ^TMP($J,"A",X,J,V,$P(Y,"."),A)=W(1)_"^"_V(2)_"^"_$P(W,"^",10)_"^"_Z(26),^TMP($J,"C",Z(1),J)=""
|
|---|
| 9 | S W(4)=+$P($G(^LAB(66,+$P(W,"^",4),0)),"^",26)
|
|---|
| 10 | I Z(9) S ^TMP($J,"B",X,1,V)=""
|
|---|
| 11 | E S ^TMP($J,"B",X,2,V)=""
|
|---|
| 12 | Q
|
|---|
| 13 | P D HDR S LR("F")=1,T=0 F A=0:0 S T=$O(^TMP($J,"A",T)) Q:T=""!(LR("Q")) D H1,Q
|
|---|
| 14 | Q
|
|---|
| 15 | Q S C(1)=0 F B=0:0 S C(1)=$O(^TMP($J,"C",C(1))) Q:C(1)=""!(LR("Q")) S C=+$O(^(C(1),0)) I $D(^TMP($J,"A",T,C)) D H2 Q:LR("Q") D L
|
|---|
| 16 | Q:LR("Q") S R=0 F R(1)=0:1 S R=$O(^TMP($J,"B",T,1,R)) Q:'R
|
|---|
| 17 | I R(1) D:$Y>(IOSL-5) H1 Q:LR("Q") W !!,T," patients given RBC components: ",R(1) S ^TMP($J,"B",T,1,0)=R(1)
|
|---|
| 18 | S R=0 F R(1)=0:1 S R=$O(^TMP($J,"B",T,2,R)) Q:'R
|
|---|
| 19 | I R(1) D:$Y>(IOSL-5) H1 Q:LR("Q") W !,T," patients given non-RBC components: ",R(1) S ^TMP($J,"B",T,2,0)=R(1)
|
|---|
| 20 | W !,T," cost of all components: ",$J(^TMP($J,"A",T,0),9,2)
|
|---|
| 21 | Q
|
|---|
| 22 | L S (K,Z,Z(1),L(1))=0 F F=0:0 S L(1)=$O(^TMP($J,"P",L(1))) Q:L(1)=""!(LR("Q")) F L=0:0 S L=$O(^TMP($J,"P",L(1),L)) Q:'L!(LR("Q")) I $D(^TMP($J,"A",T,C,L)) D R
|
|---|
| 23 | Q:LR("Q") W:K !?50,"---------",!?50,$J(K,9,2) S ^TMP($J,"D",C,T)=K_"^"_Z
|
|---|
| 24 | S:'$D(^TMP($J,"D",C,0)) ^(0)="0^0" S X=^(0),^(0)=($P(X,"^")+K)_"^"_($P(X,"^",2)+Z) S:'$D(^TMP($J,"A",T,0)) ^(0)=0 S X=^(0),^(0)=X+K Q
|
|---|
| 25 | R F W=0:0 S W=$O(^TMP($J,"A",T,C,L,W)) Q:'W!(LR("Q")) S T(2)=$E(W,4,5)_"/"_$E(W,6,7)_"/"_$E(W,2,3) F I=0:0 S I=$O(^TMP($J,"A",T,C,L,W,I)) Q:'I!(LR("Q")) S V=^(I) D W
|
|---|
| 26 | Q
|
|---|
| 27 | W D:$Y>(IOSL-5) H3 Q:LR("Q") S V(1)=$P(V,"^",3),Y=$P(V,"^",2),K=K+V(1),Z=Z+1 W ! I L'=Z(1) S Z(1)=L W $E(L(1),1,20)
|
|---|
| 28 | W ?21,T(2),?30,$E($P(V,"^",2),1,18),?49,$J(V(1),9,2),?60,$P(V,"^"),?75,$J(Z,4)
|
|---|
| 29 | S X=$P(V,"^",4) S:X="" X="?" S:'$D(^TMP($J,"Z",X,T,Y)) ^(Y)="0^0" S X=^(Y),X(1)=$P(X,"^")+V(1),X(2)=$P(X,"^",2)+1,^(Y)=X(1)_"^"_X(2) Q
|
|---|
| 30 | H ;from LRBLJTS2
|
|---|
| 31 | I $D(LR("F")),IOST?1"C".E D M^LRU Q:LR("Q")
|
|---|
| 32 | D F^LRU W !,"Transfusions by Treating Specialty/Physician (",LRSTR," - ",LRLST,")" Q
|
|---|
| 33 | ;
|
|---|
| 34 | HDR D H Q:LR("Q") W !,"Patient transfused",?21,"Date",?30,"Physician",?53,"Cost",?60,"Unit ID",?74,"Count",!,LR("%") Q
|
|---|
| 35 | H1 D:$Y>(IOSL-5) HDR Q:LR("Q") W !!?20,"TREATING SPECIALTY: ",T Q
|
|---|
| 36 | H2 D:$Y>(IOSL-5) H1 Q:LR("Q") W !,"Component: ",C(1),":",!?11 F X=1:1:$L(C(1)) W "-"
|
|---|
| 37 | Q
|
|---|
| 38 | H3 D H2 S Z(1)=0 Q
|
|---|
