source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRUR.m@ 776

Last change on this file since 776 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.4 KB
RevLine 
[613]1LRUR ;AVAMC/REG - LAB TEST COUNTS BY SPECIMEN ;2/18/93 13:14 ;
2 ;;5.2;LAB SERVICE;;Sep 27, 1994
3 D END W !?20,"Lab test counts by specimen type"
4 D B^LRU G:Y<0 END S LRLDT=9999999-LRLDT-.01,LRSDT=9999999-LRSDT+.99
5 S ZTRTN="QUE^LRUR" D BEG^LRUTL G:POP!($D(ZTSK)) END
6QUE U IO K ^TMP($J) D L^LRU,S^LRU,EN^LRUTL,H S LR("F")=1
7 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
8 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)=""
9 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
10 D END^LRUTL,END Q
11T 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)
12 Q
13C 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
14 Q
15 ;
16H I $D(LR("F")),IOST?1"C".E D M^LRU Q:LR("Q")
17 D F^LRU W !,"LABORATORY SERVICE ",!?9,"TEST COUNTS FROM ",LRSTR," TO ",LRLST,!,LR("%") Q
18H1 D H Q:LR("Q") W !,"Specimen: ",LRS Q
19END D V^LRU Q
Note: See TracBrowser for help on using the repository browser.