source: FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LRBLJTS2.m

Last change on this file was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.3 KB
Line 
1LRBLJTS2 ;AVAMC/REG - TRANSFUSION STATISTICS ;9/14/89 08:54 ;
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 S LRT=0 D H S C(1)=0 F A=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,"D",C)) D H1 Q:LR("Q") D L
5 Q:LR("Q") W !,"Total cost of all components: ",$J(LRT,9,2) D H2 Q:LR("Q")
6 S A=0 F S A=$O(^TMP($J,"Z",A)) Q:A="" D A
7 F A=1:1:6 S S(A)=0
8 S A=0 F A(3)=0:1 S A=$O(^TMP($J,"Z",A)) Q:A="" S A(1)=^(A),A(2)=LRF(A) D:$Y>(IOSL-6) H2 Q:LR("Q") W ! W:A(3) LR("%") W !,A(2),?20,$J($P(A(1),"^",2),5),?50,$J($P(A(1),"^"),8,2) D B Q:LR("Q")
9 W !,LR("%"),!,"Totals",?20,$J(S(1),5),?30,$J(S(2),5),?40,$J(S(3),5),?50,$J(S(4),8,2),?60,$J(S(5),8,2),?70,$J(S(6),8,2) Q
10B S S(1)=S(1)+$P(A(1),"^",2),S(4)=S(4)+$P(A(1),"^"),T=0 F S T=$O(^TMP($J,"Z",A,T)) Q:T=""!(LR("Q")) S T(1)=^(T) D:$Y>(IOSL-6) H3 Q:LR("Q") W !!?3,T,?30,$J($P(T(1),"^",2),5),?60,$J($P(T(1),"^"),8,2) D C Q:LR("Q")
11 Q
12C S S(2)=S(2)+$P(T(1),"^",2),S(5)=S(5)+$P(T(1),"^"),P=0
13 F S P=$O(^TMP($J,"Z",A,T,P)) Q:P=""!(LR("Q")) S P(1)=^(P),S(3)=S(3)+$P(P(1),"^",2),S(6)=S(6)+$P(P(1),"^") D:$Y>(IOSL-6) H4 Q:LR("Q") W !?6,P,?40,$J($P(P(1),"^",2),5),?70,$J($P(P(1),"^"),8,2)
14 Q
15A S (A(1),A(2),T)=0 F S T=$O(^TMP($J,"Z",A,T)) Q:T="" D T
16 S ^TMP($J,"Z",A)=A(1)_"^"_A(2) Q
17T S (T(1),T(2),P)=0 F S P=$O(^TMP($J,"Z",A,T,P)) Q:P="" S X=^(P),X(1)=$P(X,"^"),X(2)=$P(X,"^",2),T(1)=T(1)+X(1),T(2)=T(2)+X(2)
18 S ^TMP($J,"Z",A,T)=T(1)_"^"_T(2),A(1)=A(1)+T(1),A(2)=A(2)+T(2) Q
19L S X=^TMP($J,"D",C,0),K=+X,Z=$P(X,"^",2),T=0
20 F B=0:0 S T=$O(^TMP($J,"D",C,T)) Q:T=""!(LR("Q")) S X=^(T),Z(1)=$P(X,"^",2),K(1)=$P(X,"^") D:$Y>(IOSL-6) H1 Q:LR("Q") W !,T,?31,$J(Z(1),6),?43,$J(Z(1)/Z*100,4,1),?55,$J(K(1),9,2)
21 Q:LR("Q") W !?31,"------",?55,"---------",!?31,$J(Z,6),?55,$J(K,9,2),!,LR("%") S LRT=LRT+K Q
22H D H^LRBLJTS1 Q:LR("Q") W !,"Treating specialty",?31,"# units",?40,"% total units",?58,"Cost",!,LR("%") Q
23H1 D:$Y>(IOSL-6) H Q:LR("Q") W !!,C(1),":",! F X=1:1:$L(C(1)) W "-"
24 Q
25H2 D H^LRBLJTS1 Q:LR("Q")
26 W !,"Administrative",?20,"Component",?30,"Specialty",?40,"Physician",?50,"Component",?60,"Specialty",?70,"Physician",!,"Category",?23,"Units",?33,"Units",?43,"Units",?53,"Cost",?63,"Cost",?73,"Cost",!,LR("%") S A(3)=0 Q
27H3 D H2 Q:LR("Q") W !,A(2)," (continued from ",LRQ-1,")" Q
28H4 D H3 Q:LR("Q") W !?6,T Q
Note: See TracBrowser for help on using the repository browser.