source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRAPC.m@ 1489

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

initial load of WorldVistAEHR

File size: 1.7 KB
Line 
1LRAPC ;AVAMC/REG - ANAT TOPOGRAPHY COUNTS ;8/14/95 08:36 ;
2 ;;5.2;LAB SERVICE;**72**;Sep 27, 1994
3 S LRDICS="SPCYEM" D ^LRAP G:'$D(Y) END W !!,LRO(68)," (",LRABV,") TOPOGRAPHY COUNTS",!!
4 D XR^LRU S S(1)=LRO(68)
5 K T S T="" W !!,"TOPOGRAPHY (Organ/Tissue)" F B=1:1 D ASK Q:X[U!(X="")
6 G:B<2&(T="") END S:T=""&(B=2) T=$O(T(-1)) W ! D B^LRU G:Y<0 END S LRSDT=LRSDT-.01,LRLDT=LRLDT+.99
7 S ZTRTN="QUE^LRAPC" D BEG^LRUTL G:POP!($D(ZTSK)) END
8QUE U IO S (O,C,C(1),C(2))=0 K ^TMP($J) D L^LRU,S^LRU
9 F A=0:0 S LRSDT=$O(^LR(LRXR,LRSDT)) Q:'LRSDT!(LRSDT>LRLDT) D L
10 D H,TOT K ^TMP($J) D END^LRUTL,END Q
11TOT S LR("F")=1,T=-1 F X=1:1 S T=$O(O(T)) Q:T=""!(LR("Q")) D:$Y>(IOSL-8) H Q:LR("Q") W !?2,"T-",T,$E(".....",1,5-$L(T)),?14,$J(O(T),5),?22 W:C(2) $J(O(T)/C(2)*100,5,2),"%"
12 S X=0 F A=0:1 S X=$O(^TMP($J,X)) Q:'X!(LR("Q"))
13 Q:LR("Q") W !!,"# Patients: ",A,!,"# accessions: ",C(1),!,"# organ/tissues: ",C(2),!,"% = % of organ/tissues" Q
14L F LRDFN=0:0 S LRDFN=$O(^LR(LRXR,LRSDT,LRDFN)) Q:'LRDFN D I
15 Q
16I F I=0:0 S I=$O(^LR(LRXR,LRSDT,LRDFN,I)) Q:'I D T
17 Q
18T S X=$G(^LR(LRDFN,LRSS,I,0)) Q:$P($P(X,U,6)," ")'=LRABV S ^TMP($J,LRDFN)="",C(1)=C(1)+1 ;set pt in utility global C(1)= acc # count
19 S T=0 F B=0:1 S T=$O(^LR(LRDFN,LRSS,I,2,T)) Q:'T S W=+^(T,0) D TG
20 S C(2)=C(2)+B Q ;Number of organ/tissues
21TG Q:'$D(^LAB(61,W,0)) S W(1)=^(0),X=$P(W(1),"^",2),Y=-1 F C=0:1 S Y=$O(T(Y)) Q:Y="" I $E(X,1,L(Y))=T(Y) S:'$D(O(Y)) O(Y)=0 S O(Y)=O(Y)+1
22 Q
23ASK K A("B") W !,"Choice #",$J(B,2),": Select 1 or more characters of the code: " R X:DTIME Q:X=""!(X[U)
24 D CK^LRAUSM G:$D(A("B")) ASK S T(X)=X,L(X)=$L(X) Q
25H I $D(LR("F")),IOST?1"C".E D M^LRU Q:LR("Q")
26 D F^LRU W !,LRO(68)," (",LRABV,") TOPOGRAPHY COUNTS"
27 W !,"Topography",?14,"Count",?22,"From:",LRSTR," To:",LRLST,!,LR("%") Q
28 ;
29END D V^LRU Q
Note: See TracBrowser for help on using the repository browser.