34 lines
1.9 KiB
Mathematica
34 lines
1.9 KiB
Mathematica
LRAPAULC ;AVAMC/REG - ACCESSION COUNTS BY PATHOLOGIST ;8/14/95 08:12
|
|
;;5.2;LAB SERVICE;**72**;Sep 27, 1994
|
|
D END,B^LRU G:Y<0 END S LRLDT=LRLDT+.99,LRSDT=LRSDT-.0001
|
|
S ZTRTN="QUE^LRAPAULC" D BEG^LRUTL G:POP!($D(ZTSK)) END
|
|
QUE U IO D L^LRU,S^LRU,H S LR("F")=1 F LRO="ASP","ACY","AAU","AEM" Q:LR("Q") S LRSS=$E(LRO,2,3) D L
|
|
D C,END,END^LRUTL Q
|
|
L F LRC=LRSDT:0 S LRC=$O(^LR(LRO,LRC)) Q:'LRC!(LRC>LRLDT)!(LR("Q")) F LRP=0:0 S LRP=$O(^LR(LRO,LRC,LRP)) Q:'LRP!(LR("Q")) D @$S(LRSS="AU":"W",1:"SP")
|
|
Q
|
|
W I '$D(^LR(LRP,"AU")) K ^LR("AAU",LRC,LRP) Q
|
|
S X=$P(^LR(LRP,"AU"),"^",10) I 'X S X=^("AU") D U Q
|
|
S:'$D(LR(LRSS,X)) LR(LRSS,X)=0 S LR(LRSS,X)=LR(LRSS,X)+1 Q
|
|
;
|
|
SP F LRI=0:0 S LRI=$O(^LR(LRO,LRC,LRP,LRI)) Q:'LRI!(LR("Q")) D WR
|
|
Q
|
|
WR I '$D(^LR(LRP,LRSS,LRI,0)) K ^LR(LRO,LRC,LRP,LRI) Q
|
|
S X=$P(^LR(LRP,LRSS,LRI,0),"^",2) I 'X S X=^(0) D U Q
|
|
S:'$D(LR(LRSS,X)) LR(LRSS,X)=0 S LR(LRSS,X)=LR(LRSS,X)+1 Q
|
|
C F LRSS="SP","CY","EM","AU" Q:LR("Q") S LRI=0 D D
|
|
Q
|
|
D D:$Y>(IOSL-6) H Q:LR("Q") W !!?30 D T
|
|
F LRP=0:0 S LRP=$O(LR(LRSS,LRP)) Q:'LRP D:$Y>(IOSL-6) H1 Q:(LR("Q")) W !,$S($D(^VA(200,LRP,0)):$P(^(0),U),1:LRP)," :",?32,$J(LR(LRSS,LRP),5) S LRI=LRI+LR(LRSS,LRP)
|
|
Q:LR("Q") I $D(LR(LRSS,0)) D:$Y>(IOSL-6) H Q:LR("Q") W !,"Unassigned accessions :",?32,$J(LR(LRSS,0),5)
|
|
W !?32,"-----",!?26,"Total",?32,$J(LRI,5) Q:'$D(LR(LRSS,0))
|
|
F LRP=0:0 S LRP=$O(LR(LRSS,0,LRP)) Q:'LRP!(LR("Q")) S Y=LRP D D^LRU S LRD=Y F LRC=0:0 S LRC=$O(LR(LRSS,0,LRP,LRC)) Q:'LRC!(LR("Q")) D:$Y>(IOSL-6) H Q:LR("Q") W !?3,LRD,?30,"Accession #: ",LRC
|
|
Q
|
|
U S:'$D(LR(LRSS,0)) LR(LRSS,0)=0 S LR(LRSS,0)=LR(LRSS,0)+1,LR(LRSS,0,+X,$P(X,"^",6))="" Q
|
|
;
|
|
H I $D(LR("F")),IOST?1"C".E D M^LRU Q:LR("Q")
|
|
D F^LRU W !,"Accession counts by Senior Pathologist",!,"From: ",LRSTR," to:",LRLST,!,LR("%") Q
|
|
H1 D H Q:LR("Q") W !?30 D T Q
|
|
T W $S(LRSS="SP":"SURGICAL PATHOLOGY",LRSS="CY":"CYTOPATHOLOGY",LRSS="EM":"ELECTRON MICROSCOPY",1:"AUTOPSY PATHOLOGY")," ACCESSION AREAS" Q
|
|
;
|
|
END D V^LRU Q
|