- 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
