LRBLAA1.m

LRBLAA1 ; IHS/DIR/FJE - XM:TX BY TREATING SPECIALTY REPORT 4/12/92 08:41 ;

 ;;5.2;LR;;NOV 01, 1997

 ;

 ;;5.2;LAB SERVICE;;Sep 27, 1994

 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

LRBLAA1   ; IHS/DIR/FJE - XM:TX BY TREATING SPECIALTY REPORT 4/12/92 08:41 ;

 +1       ;;5.2;LR;;NOV 01, 1997

 +2       ;

 +3       ;;5.2;LAB SERVICE;;Sep 27, 1994

 +4        SET A=0

 +5        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

 +6        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