LRBLAA1 ;AVAMC/REG - XM:TX BY TREATING SPECIALTY REPORT ;4/12/92 08:41 ;
;;5.2;LAB SERVICE;**247**;Sep 27, 1994
;Per VHA Directive 97-033 this routine should not be modified. Medical Device # BK970021
S A=0
F LRA=0:0 S A=$O(^TMP($J,A)) Q:A=""!(LR("Q")) S X=^(A),LRJ=$P(X,U),LRT=$P(X,U,2) D:$Y>(IOSL-6) H^LRBLAA Q:LR("Q") W !!,A,?34,"Units Xm'd:",?45,$J(LRJ,4),?54,"Tx'd:",?57,$J(LRT,4),?67,"C/T: " W $S(LRT:$J(LRJ/LRT,5,3),1:"NA") D M
W !!,"ALL TREATING SPECIALTIES",?34,"Total Xm'd:",?45,$J(LRL,4),?54,"Tx'd:",?57,$J(LRM,4),?67,"C/T: " W $S(LRM:$J(LRL/LRM,5,3),1:"NA") Q
M S B=0 F B(1)=0:0 S B=$O(^TMP($J,A,B)) Q:B=""!(LR("Q")) S X=^(B),LRK=$P(X,U),LRD=$P(X,U,2) D:$Y>(IOSL-6) H1 Q:LR("Q") W !?2,B,?34,"Units Xm'd:",?45,$J(LRK,4),?54,"Tx'd:",?57,$J(LRD,4),?67,"C/T: " W $S(LRD:$J(LRK/LRD,5,3),1:"NA")
Q
;
H1 D H^LRBLAA Q:LR("Q") W !,A," (cont'd from ",LRQ-1,")" Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRBLAA1 889 printed Dec 13, 2024@02:10:11 Page 2
LRBLAA1 ;AVAMC/REG - XM:TX BY TREATING SPECIALTY REPORT ;4/12/92 08:41 ;
+1 ;;5.2;LAB SERVICE;**247**;Sep 27, 1994
+2 ;Per VHA Directive 97-033 this routine should not be modified. Medical Device # BK970021
+3 SET A=0
+4 FOR LRA=0:0
SET A=$ORDER(^TMP($JOB,A))
if A=""!(LR("Q"))
QUIT
SET X=^(A)
SET LRJ=$PIECE(X,U)
SET LRT=$PIECE(X,U,2)
if $Y>(IOSL-6)
DO H^LRBLAA
if LR("Q")
QUIT
WRITE !!,A,?34,"Units Xm'd:",?45,$JUSTIFY(LRJ,4),?54,"Tx'd:",?57,$JUSTIFY(LRT,4),?67,"C/T: "
WRITE $SELECT(LRT:$JUSTIFY(LRJ/LRT,5,3),1:"NA")
DO M
+5 WRITE !!,"ALL TREATING SPECIALTIES",?34,"Total Xm'd:",?45,$JUSTIFY(LRL,4),?54,"Tx'd:",?57,$JUSTIFY(LRM,4),?67,"C/T: "
WRITE $SELECT(LRM:$JUSTIFY(LRL/LRM,5,3),1:"NA")
QUIT
M SET B=0
FOR B(1)=0:0
SET B=$ORDER(^TMP($JOB,A,B))
if B=""!(LR("Q"))
QUIT
SET X=^(B)
SET LRK=$PIECE(X,U)
SET LRD=$PIECE(X,U,2)
if $Y>(IOSL-6)
DO H1
if LR("Q")
QUIT
WRITE !?2,B,?34,"Units Xm'd:",?45,$JUSTIFY(LRK,4),?54,"Tx'd:",?57,$JUSTIFY(LRD,4),?67,"C/T: "
WRITE $SELECT(LRD:$JUSTIFY(LRK/LRD,5,3),1:"NA")
+1 QUIT
+2 ;
H1 DO H^LRBLAA
if LR("Q")
QUIT
WRITE !,A," (cont'd from ",LRQ-1,")"
QUIT
