- LRAPA ;AVAMC/REG/WTY - ANAT PATH ACCESSIONS PER DAY ;JUL 06, 2010 3:14 PM
- ;;5.2;LAB SERVICE;**72,248,338,1027**;NOV 01, 1997
- ;
- 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
- LRAPA ;AVAMC/REG/WTY - ANAT PATH ACCESSIONS PER DAY ;JUL 06, 2010 3:14 PM
- +1 ;;5.2;LAB SERVICE;**72,248,338,1027**;NOV 01, 1997
- +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
