- 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
