LRAPA.m

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