source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRAPA.m@ 1800

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

initial load of WorldVistAEHR

File size: 1.5 KB
Line 
1LRAPA ;AVAMC/REG/WTY - ANAT PATH ACCESSIONS PER DAY ;9/25/00
2 ;;5.2;LAB SERVICE;**72,248,338**;Sep 27, 1994
3 ;
4 D ^LRAP G:'$D(Y) END W !!,LRO(68)," ACCESSION/SPECIMEN LIST COUNT BY DAY" D XR^LRU
5 D B^LRU G:Y<0 END
6 S ZTRTN="QUE^LRAPA" D BEG^LRUTL G:POP!($D(ZTSK)) END
7QUE U IO K ^TMP($J) S (C,S)=0,LRSDT=LRSDT-.01,LRLDT=LRLDT+.99 D L^LRU,S^LRU
8 F X=0:0 S LRSDT=$O(^LR(LRXR,LRSDT)) Q:'LRSDT!(LRSDT>LRLDT) S W=LRSDT\1 D Y
9 D H S LR("F")=1 F LRX=0:0 S LRX=$O(^TMP($J,LRX)) Q:'LRX S Y=LRX,A=^(LRX),C=C+A D D^LRU S LRY=Y D:$Y>(IOSL-6) H Q:LR("Q") W !,LRY,?25,$J(A,9) I $D(^TMP($J,LRX,1)) S S(1)=^(1),S=S+S(1) W ?45,$J(S(1),9)
10 S X=0 F A=0:1 S X=$O(^TMP($J,"P",X)) Q:'X
11 W !?25,"---------",?45,"---------"
12 W !,"Total number",?25,$J(C,9),?45,$J(S,9)
13 W !,"Total Patients: ",A
14 K ^TMP($J)
15 W:IOST'?1"C".E&($E(IOST,1,2)'="P-"!($D(LR("FORM")))) @IOF
16 D END^LRUTL,END
17 Q
18Y F Y=0:0 S Y=$O(^LR(LRXR,LRSDT,Y)) Q:'Y D @($S("CYEMSP"[LRSS:"I",1:"A"))
19 Q
20I S I=0 F S I=$O(^LR(LRXR,LRSDT,Y,I)) Q:'I I $P($P($G(^LR(Y,LRSS,I,0)),U,6)," ")=LRABV S ^TMP($J,"P",Y)="" S:'$D(^TMP($J,W)) ^(W)=0 S ^(W)=^(W)+1 I $D(^LR(Y,LRSS,I,.1,0)) S V=$P(^(0),"^",4) S:'$D(^TMP($J,W,1)) ^(1)=0 S ^(1)=^(1)+V
21 Q
22A I $P($P($G(^LR(Y,"AU")),U,6)," ")=LRABV S ^TMP($J,"P",Y)="" S:'$D(^TMP($J,W)) ^(W)=0 S ^(W)=^(W)+1
23 Q
24H I $D(LR("F")),IOST?1"C".E D M^LRU Q:LR("Q")
25 D F^LRU W !,LRO(68)," ACCESSION/SPECIMEN COUNT BY DATE",!?23,"FROM ",LRSTR," TO ",LRLST,!,"DATE",?25,"Accession Count",?45,"Specimen count",!,LR("%") Q
26 ;
27END D V^LRU Q
Note: See TracBrowser for help on using the repository browser.