LRAPA ;AVAMC/REG/WTY - ANAT PATH ACCESSIONS PER DAY ;9/25/00
;;5.2;LAB SERVICE;**72,248,338**;Sep 27, 1994
;
D ^LRAP G:'$D(Y) END W !!,LRO(68)," ACCESSION/SPECIMEN LIST COUNT BY DAY" D XR^LRU
D B^LRU G:Y<0 END
S ZTRTN="QUE^LRAPA" D BEG^LRUTL G:POP!($D(ZTSK)) END
QUE U IO K ^TMP($J) S (C,S)=0,LRSDT=LRSDT-.01,LRLDT=LRLDT+.99 D L^LRU,S^LRU
F X=0:0 S LRSDT=$O(^LR(LRXR,LRSDT)) Q:'LRSDT!(LRSDT>LRLDT) S W=LRSDT\1 D Y
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)
S X=0 F A=0:1 S X=$O(^TMP($J,"P",X)) Q:'X
W !?25,"---------",?45,"---------"
W !,"Total number",?25,$J(C,9),?45,$J(S,9)
W !,"Total Patients: ",A
K ^TMP($J)
W:IOST'?1"C".E&($E(IOST,1,2)'="P-"!($D(LR("FORM")))) @IOF
D END^LRUTL,END
Q
Y F Y=0:0 S Y=$O(^LR(LRXR,LRSDT,Y)) Q:'Y D @($S("CYEMSP"[LRSS:"I",1:"A"))
Q
I 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
Q
A 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
Q
H I $D(LR("F")),IOST?1"C".E D M^LRU Q:LR("Q")
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
;
END D V^LRU Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRAPA 1525 printed Nov 22, 2024@17:16:54 Page 2
LRAPA ;AVAMC/REG/WTY - ANAT PATH ACCESSIONS PER DAY ;9/25/00
+1 ;;5.2;LAB SERVICE;**72,248,338**;Sep 27, 1994
+2 ;
+3 DO ^LRAP
if '$DATA(Y)
GOTO END
WRITE !!,LRO(68)," ACCESSION/SPECIMEN LIST COUNT BY DAY"
DO XR^LRU
+4 DO B^LRU
if Y<0
GOTO END
+5 SET ZTRTN="QUE^LRAPA"
DO BEG^LRUTL
if POP!($DATA(ZTSK))
GOTO END
QUE USE IO
KILL ^TMP($JOB)
SET (C,S)=0
SET LRSDT=LRSDT-.01
SET LRLDT=LRLDT+.99
DO L^LRU
DO S^LRU
+1 FOR X=0:0
SET LRSDT=$ORDER(^LR(LRXR,LRSDT))
if 'LRSDT!(LRSDT>LRLDT)
QUIT
SET W=LRSDT\1
DO Y
+2 DO H
SET LR("F")=1
FOR LRX=0:0
SET LRX=$ORDER(^TMP($JOB,LRX))
if 'LRX
QUIT
SET Y=LRX
SET A=^(LRX)
SET C=C+A
DO D^LRU
SET LRY=Y
if $Y>(IOSL-6)
DO H
if LR("Q")
QUIT
WRITE !,LRY,?25,$JUSTIFY(A,9)
IF $DATA(^TMP($JOB,LRX,1))
SET S(1)=^(1)
SET S=S+S(1)
WRITE ?45,$JUSTIFY(S(1),9)
+3 SET X=0
FOR A=0:1
SET X=$ORDER(^TMP($JOB,"P",X))
if 'X
QUIT
+4 WRITE !?25,"---------",?45,"---------"
+5 WRITE !,"Total number",?25,$JUSTIFY(C,9),?45,$JUSTIFY(S,9)
+6 WRITE !,"Total Patients: ",A
+7 KILL ^TMP($JOB)
+8 if IOST'?1"C".E&($EXTRACT(IOST,1,2)'="P-"!($DATA(LR("FORM"))))
WRITE @IOF
+9 DO END^LRUTL
DO END
+10 QUIT
Y FOR Y=0:0
SET Y=$ORDER(^LR(LRXR,LRSDT,Y))
if 'Y
QUIT
DO @($SELECT("CYEMSP"[LRSS:"I",1:"A"))
+1 QUIT
I SET I=0
FOR
SET I=$ORDER(^LR(LRXR,LRSDT,Y,I))
if 'I
QUIT
IF $PIECE($PIECE($GET(^LR(Y,LRSS,I,0)),U,6)," ")=LRABV
SET ^TMP($JOB,"P",Y)=""
if '$DATA(^TMP($JOB,W))
SET ^(W)=0
SET ^(W)=^(W)+1
IF $DATA(^LR(Y,LRSS,I,.1,0))
SET V=$PIECE(^(0),"^",4)
if '$DATA(^TMP($JOB,W,1))
SET ^(1)=0
SET ^(1)=^(1)+V
+1 QUIT
A IF $PIECE($PIECE($GET(^LR(Y,"AU")),U,6)," ")=LRABV
SET ^TMP($JOB,"P",Y)=""
if '$DATA(^TMP($JOB,W))
SET ^(W)=0
SET ^(W)=^(W)+1
+1 QUIT
H IF $DATA(LR("F"))
IF IOST?1"C".E
DO M^LRU
if LR("Q")
QUIT
+1 DO F^LRU
WRITE !,LRO(68)," ACCESSION/SPECIMEN COUNT BY DATE",!?23,"FROM ",LRSTR," TO ",LRLST,!,"DATE",?25,"Accession Count",?45,"Specimen count",!,LR("%")
QUIT
+2 ;
END DO V^LRU
QUIT
