- LRBLJTS2 ; IHS/DIR/FJE - TRANSFUSION STATISTICS 9/14/89 08:54 ;
- ;;5.2;LR;;NOV 01, 1997
- ;
- ;;5.2;LAB SERVICE;;Sep 27, 1994
- 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
- Q:LR("Q") W !,"Total cost of all components: ",$J(LRT,9,2) D H2 Q:LR("Q")
- S A=0 F S A=$O(^TMP($J,"Z",A)) Q:A="" D A
- F A=1:1:6 S S(A)=0
- 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")
- 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
- B 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")
- Q
- C S S(2)=S(2)+$P(T(1),"^",2),S(5)=S(5)+$P(T(1),"^"),P=0
- 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)
- Q
- A S (A(1),A(2),T)=0 F S T=$O(^TMP($J,"Z",A,T)) Q:T="" D T
- S ^TMP($J,"Z",A)=A(1)_"^"_A(2) Q
- T 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)
- S ^TMP($J,"Z",A,T)=T(1)_"^"_T(2),A(1)=A(1)+T(1),A(2)=A(2)+T(2) Q
- L S X=^TMP($J,"D",C,0),K=+X,Z=$P(X,"^",2),T=0
- 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)
- Q:LR("Q") W !?31,"------",?55,"---------",!?31,$J(Z,6),?55,$J(K,9,2),!,LR("%") S LRT=LRT+K Q
- H D H^LRBLJTS1 Q:LR("Q") W !,"Treating specialty",?31,"# units",?40,"% total units",?58,"Cost",!,LR("%") Q
- H1 D:$Y>(IOSL-6) H Q:LR("Q") W !!,C(1),":",! F X=1:1:$L(C(1)) W "-"
- Q
- H2 D H^LRBLJTS1 Q:LR("Q")
- 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
- H3 D H2 Q:LR("Q") W !,A(2)," (continued from ",LRQ-1,")" Q
- H4 D H3 Q:LR("Q") W !?6,T Q
- LRBLJTS2 ; IHS/DIR/FJE - TRANSFUSION STATISTICS 9/14/89 08:54 ;
- +1 ;;5.2;LR;;NOV 01, 1997
- +2 ;
- +3 ;;5.2;LAB SERVICE;;Sep 27, 1994
- +4 SET LRT=0
- DO H
- SET C(1)=0
- FOR A=0:0
- SET C(1)=$ORDER(^TMP($JOB,"C",C(1)))
- IF C(1)=""!(LR("Q"))
- QUIT
- SET C=+$ORDER(^(C(1),0))
- IF $DATA(^TMP($JOB,"D",C))
- DO H1
- IF LR("Q")
- QUIT
- DO L
- +5 IF LR("Q")
- QUIT
- WRITE !,"Total cost of all components: ",$JUSTIFY(LRT,9,2)
- DO H2
- IF LR("Q")
- QUIT
- +6 SET A=0
- FOR
- SET A=$ORDER(^TMP($JOB,"Z",A))
- IF A=""
- QUIT
- DO A
- +7 FOR A=1:1:6
- SET S(A)=0
- +8 SET A=0
- FOR A(3)=0:1
- SET A=$ORDER(^TMP($JOB,"Z",A))
- IF A=""
- QUIT
- SET A(1)=^(A)
- SET A(2)=LRF(A)
- IF $Y>(IOSL-6)
- DO H2
- IF LR("Q")
- QUIT
- WRITE !
- IF A(3)
- WRITE LR("%")
- WRITE !,A(2),?20,$JUSTIFY($PIECE(A(1),"^",2),5),?50,$JUSTIFY($PIECE(A(1),"^"),8,2)
- DO B
- IF LR("Q")
- QUIT
- +9 WRITE !,LR("%"),!,"Totals",?20,$JUSTIFY(S(1),5),?30,$JUSTIFY(S(2),5),?40,$JUSTIFY(S(3),5),?50,$JUSTIFY(S(4),8,2),?60,$JUSTIFY(S(5),8,2),?70,$JUSTIFY(S(6),8,2)
- QUIT
- B SET S(1)=S(1)+$PIECE(A(1),"^",2)
- SET S(4)=S(4)+$PIECE(A(1),"^")
- SET T=0
- FOR
- SET T=$ORDER(^TMP($JOB,"Z",A,T))
- IF T=""!(LR("Q"))
- QUIT
- SET T(1)=^(T)
- IF $Y>(IOSL-6)
- DO H3
- IF LR("Q")
- QUIT
- WRITE !!?3,T,?30,$JUSTIFY($PIECE(T(1),"^",2),5),?60,$JUSTIFY($PIECE(T(1),"^"),8,2)
- DO C
- IF LR("Q")
- QUIT
- +1 QUIT
- C SET S(2)=S(2)+$PIECE(T(1),"^",2)
- SET S(5)=S(5)+$PIECE(T(1),"^")
- SET P=0
- +1 FOR
- SET P=$ORDER(^TMP($JOB,"Z",A,T,P))
- IF P=""!(LR("Q"))
- QUIT
- SET P(1)=^(P)
- SET S(3)=S(3)+$PIECE(P(1),"^",2)
- SET S(6)=S(6)+$PIECE(P(1),"^")
- IF $Y>(IOSL-6)
- DO H4
- IF LR("Q")
- QUIT
- WRITE !?6,P,?40,$JUSTIFY($PIECE(P(1),"^",2),5),?70,$JUSTIFY($PIECE(P(1),"^"),8,2)
- +2 QUIT
- A SET (A(1),A(2),T)=0
- FOR
- SET T=$ORDER(^TMP($JOB,"Z",A,T))
- IF T=""
- QUIT
- DO T
- +1 SET ^TMP($JOB,"Z",A)=A(1)_"^"_A(2)
- QUIT
- T SET (T(1),T(2),P)=0
- FOR
- SET P=$ORDER(^TMP($JOB,"Z",A,T,P))
- IF P=""
- QUIT
- SET X=^(P)
- SET X(1)=$PIECE(X,"^")
- SET X(2)=$PIECE(X,"^",2)
- SET T(1)=T(1)+X(1)
- SET T(2)=T(2)+X(2)
- +1 SET ^TMP($JOB,"Z",A,T)=T(1)_"^"_T(2)
- SET A(1)=A(1)+T(1)
- SET A(2)=A(2)+T(2)
- QUIT
- L SET X=^TMP($JOB,"D",C,0)
- SET K=+X
- SET Z=$PIECE(X,"^",2)
- SET T=0
- +1 FOR B=0:0
- SET T=$ORDER(^TMP($JOB,"D",C,T))
- IF T=""!(LR("Q"))
- QUIT
- SET X=^(T)
- SET Z(1)=$PIECE(X,"^",2)
- SET K(1)=$PIECE(X,"^")
- IF $Y>(IOSL-6)
- DO H1
- IF LR("Q")
- QUIT
- WRITE !,T,?31,$JUSTIFY(Z(1),6),?43,$JUSTIFY(Z(1)/Z*100,4,1),?55,$JUSTIFY(K(1),9,2)
- +2 IF LR("Q")
- QUIT
- WRITE !?31,"------",?55,"---------",!?31,$JUSTIFY(Z,6),?55,$JUSTIFY(K,9,2),!,LR("%")
- SET LRT=LRT+K
- QUIT
- H DO H^LRBLJTS1
- IF LR("Q")
- QUIT
- WRITE !,"Treating specialty",?31,"# units",?40,"% total units",?58,"Cost",!,LR("%")
- QUIT
- H1 IF $Y>(IOSL-6)
- DO H
- IF LR("Q")
- QUIT
- WRITE !!,C(1),":",!
- FOR X=1:1:$LENGTH(C(1))
- WRITE "-"
- +1 QUIT
- H2 DO H^LRBLJTS1
- IF LR("Q")
- QUIT
- +1 WRITE !,"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("%")
- SET A(3)=0
- QUIT
- H3 DO H2
- IF LR("Q")
- QUIT
- WRITE !,A(2)," (continued from ",LRQ-1,")"
- QUIT
- H4 DO H3
- IF LR("Q")
- QUIT
- WRITE !?6,T
- QUIT
