LRBLAA1.m

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 ---LRBLAA1   889     printed  Apr 09, 2024@21:18:01                                                                                                                                                                                                      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