LRAPQ.m

LRAPQ ; IHS/DIR/AAB - ANAT PATH QUEUE LIST 2/12/98 10:35 ; [ 07/08/1998 10:16 AM ]

 ;;5.2;LR;**1002,1006**;SEP 01, 1998

 ;

 ;;5.2;LAB SERVICE;**72,201**;Sep 27, 1994

 D ^LRAP G:'$D(Y) END

 W !!,LRO(68)," (",LRABV,")",!!?20,"List of pathology reports in print queue",!!?16,"1. ",$S(LRSS'="AU":"Preliminary",1:"Supplementary")," reports",!?16,"2. ",$S(LRSS'="AU":"Final",1:"Protocols"),?31,$S(LRSS'="AU":"reports",1:"")

ASK W !,"Select 1 or 2 : " R X:DTIME Q:X=""!(X[U)  I X<1!(X>2) W $C(7),!!,"Enter '1' for preliminary reports '2' for final reports" G ASK

 S LRS=X I LRSS="AU",X=1 S LRS=3

 S ZTRTN="QUE^LRAPQ" D BEG^LRUTL G:POP!($D(ZTSK)) END

QUE U IO D L^LRU,S^LRU,H S LR("F")=1,LRC=0

 F LRAN=0:0 S LRAN=$O(^LRO(69.2,LRAA,LRS,LRAN)) Q:'LRAN!(LR("Q"))  S LR=^(LRAN,0),LRDFN=+LR,LRI=$P(LR,U,2) D:$Y>(IOSL-5) H Q:LR("Q")  D L

 I 'LRC W !!,"There are no reports in the print queue."

 D END^LRUTL,END Q

L I LRSS'="AU" Q:$P($P($G(^LR(LRDFN,LRSS,LRI,0)),U,6)," ")'=LRABV  S X=+^(0) G W

 E  Q:$P($P($G(^LR(LRDFN,"AU")),U,6)," ")'=LRABV  S X=+^("AU")

W W !,$J(LRAN,4),?10,$$FMTE^XLFDT(X,"D") S LRC=LRC+1

 ;S X=^LR(LRDFN,0),Y=$P(X,"^",3),(LRDPF,X)=^DIC($P(X,"^",2),0,"GL"),X=@(X_Y_",0)") S SSN=$P(X,"^",9) D SSN^LRU

 S X=^LR(LRDFN,0),(DFN,Y)=$P(X,"^",3),(LRDPF,X)=^DIC($P(X,"^",2),0,"GL"),X=@(X_Y_",0)") S SSN=$P(X,"^",9) D SSN^LRU  ;IHS/ANMC/CLS 11/1/95

 ;W ?24,$P(X,"^"),?55,SSN Q

 W ?24,$P(X,"^"),?55,HRCN Q  ;IHS/ANMC/CLS 11/1/95

H I $D(LR("F")),IOST?1"C".E D M^LRU Q:LR("Q")

 D F^LRU W !,LRO(68)," (",LRABV,") ",$S(LRS=2&(LRSS'="AU"):"FINAL",LRS=1:"PRELIMINARY",LRS=2&(LRSS="AU"):"PROTOCOL(S)",1:"SUPPLEMENTARY"),$S(LRS=2&(LRSS="AU"):"",1:" REPORTS")," IN PRINT QUEUE"

 ;W !,"Acc #",?12,"Date",?24,"Patient",?55,"SSN",!,LR("%") Q

 W !,"Acc #",?12,"Date",?24,"Patient",?55,"HRCN",!,LR("%") Q  ;IHS/ANMC/CLS 11/1/95

 ;

END D V^LRU Q

LRAPQ     ; IHS/DIR/AAB - ANAT PATH QUEUE LIST 2/12/98 10:35 ; [ 07/08/1998 10:16 AM ]

 +1       ;;5.2;LR;**1002,1006**;SEP 01, 1998

 +2       ;

 +3       ;;5.2;LAB SERVICE;**72,201**;Sep 27, 1994

 +4        DO ^LRAP

           IF '$DATA(Y)

               GOTO END

 +5        WRITE !!,LRO(68)," (",LRABV,")",!!?20,"List of pathology reports in print queue",!!?16,"1. ",$SELECT(LRSS'="AU":"Preliminary",1:"Supplementary")," reports",!?16,"2. ",$SELECT(LRSS'="AU":"Final",1:"Protocols"),?31,$SELECT(LRSS'="AU":"reports",1:

"")

ASK        WRITE !,"Select 1 or 2 : "

           READ X:DTIME

           IF X=""!(X[U)

               QUIT 

           IF X<1!(X>2)

               WRITE $CHAR(7),!!,"Enter '1' for preliminary reports '2' for final reports"

               GOTO ASK

 +1        SET LRS=X

           IF LRSS="AU"

               IF X=1

                   SET LRS=3

 +2        SET ZTRTN="QUE^LRAPQ"

           DO BEG^LRUTL

           IF POP!($DATA(ZTSK))

               GOTO END

QUE        USE IO

           DO L^LRU

           DO S^LRU

           DO H

           SET LR("F")=1

           SET LRC=0

 +1        FOR LRAN=0:0

               SET LRAN=$ORDER(^LRO(69.2,LRAA,LRS,LRAN))

               IF 'LRAN!(LR("Q"))

                   QUIT 

               SET LR=^(LRAN,0)

               SET LRDFN=+LR

               SET LRI=$PIECE(LR,U,2)

               IF $Y>(IOSL-5)

                   DO H

               IF LR("Q")

                   QUIT 

               DO L

 +2        IF 'LRC

               WRITE !!,"There are no reports in the print queue."

 +3        DO END^LRUTL

           DO END

           QUIT 

L          IF LRSS'="AU"

               IF $PIECE($PIECE($GET(^LR(LRDFN,LRSS,LRI,0)),U,6)," ")'=LRABV

                   QUIT 

               SET X=+^(0)

               GOTO W

 +1       IF '$TEST

               IF $PIECE($PIECE($GET(^LR(LRDFN,"AU")),U,6)," ")'=LRABV

                   QUIT 

               SET X=+^("AU")

W          WRITE !,$JUSTIFY(LRAN,4),?10,$$FMTE^XLFDT(X,"D")

           SET LRC=LRC+1

 +1       ;S X=^LR(LRDFN,0),Y=$P(X,"^",3),(LRDPF,X)=^DIC($P(X,"^",2),0,"GL"),X=@(X_Y_",0)") S SSN=$P(X,"^",9) D SSN^LRU

 +2       ;IHS/ANMC/CLS 11/1/95

           SET X=^LR(LRDFN,0)

           SET (DFN,Y)=$PIECE(X,"^",3)

           SET (LRDPF,X)=^DIC($PIECE(X,"^",2),0,"GL")

           SET X=@(X_Y_",0)")

           SET SSN=$PIECE(X,"^",9)

           DO SSN^LRU

 +3       ;W ?24,$P(X,"^"),?55,SSN Q

 +4       ;IHS/ANMC/CLS 11/1/95

           WRITE ?24,$PIECE(X,"^"),?55,HRCN

           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)," (",LRABV,") ",$SELECT(LRS=2&(LRSS'="AU"):"FINAL",LRS=1:"PRELIMINARY",LRS=2&(LRSS="AU"):"PROTOCOL(S)",1:"SUPPLEMENTARY"),$SELECT(LRS=2&(LRSS="AU"):"",1:" REPORTS")," IN PRINT QUEUE"

 +2       ;W !,"Acc #",?12,"Date",?24,"Patient",?55,"SSN",!,LR("%") Q

 +3       ;IHS/ANMC/CLS 11/1/95

           WRITE !,"Acc #",?12,"Date",?24,"Patient",?55,"HRCN",!,LR("%")

           QUIT 

 +4       ;

END        DO V^LRU

           QUIT