LRUR.m

LRUR ; IHS/DIR/FJE - LAB TEST COUNTS BY SPECIMEN 2/18/93 13:14 ;

 ;;5.2;LR;**1013**;JUL 15, 2002

 ;

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

 D END W !?20,"Lab test counts by specimen type"

 D B^LRU G:Y<0 END S LRLDT=9999999-LRLDT-.01,LRSDT=9999999-LRSDT+.99

 S ZTRTN="QUE^LRUR" D BEG^LRUTL G:POP!($D(ZTSK)) END

QUE U IO K ^TMP($J) D L^LRU,S^LRU,EN^LRUTL,H S LR("F")=1

 F LRDFN=0:0 S LRDFN=$O(^LR(LRDFN)) Q:'LRDFN  F A=LRLDT:0 S A=$O(^LR(LRDFN,"CH",A)) Q:'A!(A>LRSDT)  S S=$P(^(A,0),"^",5) S:'S S=LRU D C

 F A=0:0 S A=$O(^TMP($J,A)) Q:'A!(LR("Q"))  S X=$P(^LAB(61,A,0),"^"),^TMP($J,"B",X,A)="" F B=0:0 S B=$O(^TMP($J,A,B)) Q:'B!(LR("Q"))  S X=$S($D(^DD(63.04,B,0)):$P(^(0),"^"),1:B),^TMP($J,"C",X,B)=""

 S LRS=0 F LRA=0:0 S LRS=$O(^TMP($J,"B",LRS)) Q:LRS=""!(LR("Q"))  F LRI=0:0 S LRI=$O(^TMP($J,"B",LRS,LRI)) Q:'LRI!(LR("Q"))  D:$Y>(IOSL-6) H Q:LR("Q")  W !,"Specimen: ",LRS," (",^TMP($J,LRI),")" D T

 D END^LRUTL,END Q

T S LRT=0 F LRB=0:0 S LRT=$O(^TMP($J,"C",LRT)) Q:LRT=""!(LR("Q"))  F LRJ=0:0 S LRJ=$O(^TMP($J,"C",LRT,LRJ)) Q:'LRJ!(LR("Q"))  D:$Y>(IOSL-6) H1 Q:LR("Q")  I $D(^TMP($J,LRI,LRJ)) W !?3,LRT,?40,$J(^(LRJ),6)

 Q

C S:'$D(^TMP($J,S)) ^(S)=0 S X=^(S),^(S)=X+1 F B=1:0 S B=$O(^LR(LRDFN,"CH",A,B)) Q:'B  S:'$D(^TMP($J,S,B)) ^(B)=0 S X=^(B),^(B)=X+1

 Q

 ;

H I $D(LR("F")),IOST?1"C".E D M^LRU Q:LR("Q")

 D F^LRU W !,"LABORATORY SERVICE ",!?9,"TEST COUNTS FROM ",LRSTR," TO ",LRLST,!,LR("%") Q

H1 D H Q:LR("Q")  W !,"Specimen: ",LRS Q

END D V^LRU Q

LRUR      ; IHS/DIR/FJE - LAB TEST COUNTS BY SPECIMEN 2/18/93 13:14 ;

 +1       ;;5.2;LR;**1013**;JUL 15, 2002

 +2       ;

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

 +4        DO END

           WRITE !?20,"Lab test counts by specimen type"

 +5        DO B^LRU

           IF Y<0

               GOTO END

           SET LRLDT=9999999-LRLDT-.01

           SET LRSDT=9999999-LRSDT+.99

 +6        SET ZTRTN="QUE^LRUR"

           DO BEG^LRUTL

           IF POP!($DATA(ZTSK))

               GOTO END

QUE        USE IO

           KILL ^TMP($JOB)

           DO L^LRU

           DO S^LRU

           DO EN^LRUTL

           DO H

           SET LR("F")=1

 +1        FOR LRDFN=0:0

               SET LRDFN=$ORDER(^LR(LRDFN))

               IF 'LRDFN

                   QUIT 

               FOR A=LRLDT:0

                   SET A=$ORDER(^LR(LRDFN,"CH",A))

                   IF 'A!(A>LRSDT)

                       QUIT 

                   SET S=$PIECE(^(A,0),"^",5)

                   IF 'S

                       SET S=LRU

                   DO C

 +2        FOR A=0:0

               SET A=$ORDER(^TMP($JOB,A))

               IF 'A!(LR("Q"))

                   QUIT 

               SET X=$PIECE(^LAB(61,A,0),"^")

               SET ^TMP($JOB,"B",X,A)=""

               FOR B=0:0

                   SET B=$ORDER(^TMP($JOB,A,B))

                   IF 'B!(LR("Q"))

                       QUIT 

                   SET X=$SELECT($DATA(^DD(63.04,B,0)):$PIECE(^(0),"^"),1:B)

                   SET ^TMP($JOB,"C",X,B)=""

 +3        SET LRS=0

           FOR LRA=0:0

               SET LRS=$ORDER(^TMP($JOB,"B",LRS))

               IF LRS=""!(LR("Q"))

                   QUIT 

               FOR LRI=0:0

                   SET LRI=$ORDER(^TMP($JOB,"B",LRS,LRI))

                   IF 'LRI!(LR("Q"))

                       QUIT 

                   IF $Y>(IOSL-6)

                       DO H

                   IF LR("Q")

                       QUIT 

                   WRITE !,"Specimen: ",LRS," (",^TMP($JOB,LRI),")"

                   DO T

 +4        DO END^LRUTL

           DO END

           QUIT 

T          SET LRT=0

           FOR LRB=0:0

               SET LRT=$ORDER(^TMP($JOB,"C",LRT))

               IF LRT=""!(LR("Q"))

                   QUIT 

               FOR LRJ=0:0

                   SET LRJ=$ORDER(^TMP($JOB,"C",LRT,LRJ))

                   IF 'LRJ!(LR("Q"))

                       QUIT 

                   IF $Y>(IOSL-6)

                       DO H1

                   IF LR("Q")

                       QUIT 

                   IF $DATA(^TMP($JOB,LRI,LRJ))

                       WRITE !?3,LRT,?40,$JUSTIFY(^(LRJ),6)

 +1        QUIT 

C          IF '$DATA(^TMP($JOB,S))

               SET ^(S)=0

           SET X=^(S)

           SET ^(S)=X+1

           FOR B=1:0

               SET B=$ORDER(^LR(LRDFN,"CH",A,B))

               IF 'B

                   QUIT 

               IF '$DATA(^TMP($JOB,S,B))

                   SET ^(B)=0

               SET X=^(B)

               SET ^(B)=X+1

 +1        QUIT 

 +2       ;

H          IF $DATA(LR("F"))

               IF IOST?1"C".E

                   DO M^LRU

                   IF LR("Q")

                       QUIT 

 +1        DO F^LRU

           WRITE !,"LABORATORY SERVICE ",!?9,"TEST COUNTS FROM ",LRSTR," TO ",LRLST,!,LR("%")

           QUIT 

H1         DO H

           IF LR("Q")

               QUIT 

           WRITE !,"Specimen: ",LRS

           QUIT 

END        DO V^LRU

           QUIT