BLRUER ;IHS/MSC/MKK - ERROR TRACKING TASKED REPORT ;2/18/98 07:03 ;
;;5.2;LAB SERVICE;**1038**;NOV 1, 1997;Build 6
;
EEP ; EP - Ersatz EP
D EEP^BLRGMENU
Q
;
; Cloned from the LR*5.2*1031 version of LRUER
;
; This version is designed to be tasked. It will REJECT interactive reporting.
;
BEGIN ; EP - Beginning
I $D(ZTQUEUED)<1 D Q
. W !!,?4,"This report can only be run from TASKMAN."
. D PRESSKEY^BLRGMENU(9)
S:$D(ZTQUEUED) ZTREQ="@"
;
GETPARAM ; EP - Get the parameters from the IHS LAB SUPERVISOR TASKED REPORTS PARAMETERS (#90475.7) file
NEW ACCDELC,D1,D1IEN,DEVICE,DEVDESC,GPD0,GPD1,TRANGE,DUZ2,DUZ2DESC,LISTTEST,NEWPAGE,PREVREPT,SPECREJ
;
; Parameters for LRUER report are in 90475.71
S (GPD0,GPD1)=1
;
S D1IEN=GPD1_","_GPD0
S DUZ2=$$GET1^DIQ(90475.71,D1IEN,.01,"I")
S DUZ2=$$GET1^DIQ(90475.71,D1IEN,.01,"I")
S DUZ2DESC=$$GET1^DIQ(90475.71,D1IEN,.01)
S PREVREPT=+$$GET1^DIQ(90475.71,D1IEN,1,"I")
S SPECREJ=+$$GET1^DIQ(90475.71,D1IEN,2,"I")
S ACCDELC=+$$GET1^DIQ(90475.71,D1IEN,3,"I")
S LISTTEST=+$$GET1^DIQ(90475.71,D1IEN,4,"I")
S NEWPAGE=+$$GET1^DIQ(90475.71,D1IEN,5,"I")
S DTRANGE=+$$GET1^DIQ(90475.71,D1IEN,6,"I")
S DEVICE=+$$GET1^DIQ(90475.71,D1IEN,7,"I")
;
; IF and ONLY IF the DEVICE variable is zero, then quit.
; Can Only happen if user up-hatted (^) out of the setup process.
Q:DEVICE<1
;
D DONTASK ; Do the report
;
G END
Q
;
DONTASK ; EP
S LRC(1)=$S(PREVREPT:"reported incorrectly as",SPECREJ:"specimen rejected",1:"")
S LRC(2)=$S(ACCDELC:1,1:"")
S LRC(3)="DUMMYZZZZ"
S LRSDT=$S(DTRANGE=1:$$HTFM^XLFDT(+$H-7),DTRANGE=2:$$HTFM^XLFDT(+$H-30),DTRANGE=3:$$HTFM^XLFDT(+$H-365),1:$$HTFM^XLFDT(+$H-1))
S LRLDT=$$DT^XLFDT
S LRSTR=$$FMTE^XLFDT(LRSDT,"5DZ")
S LRLST=$$FMTE^XLFDT(LRLDT,"5DZ")
S LRS=LRSDT-.01,LRE=LRLDT+.99,LRLDT=9999998-LRLDT,LRSDT=9999999-LRSDT
S LRF=LISTTEST
S LRL=NEWPAGE
K IOP,ZTSK,%ZIS
S ZTSAVE("*")=""
S %ZIS="Q"
; S IOP="`"_$$FIND1^DIC(3.5,,,"BLRUER TASKED")
S IOP="`"_DEVICE
D ENTRYAUD^BLRUTIL("DONTASK^BLRUER")
D EN^XUTMDEVQ("QUE^BLRUER","TASKED IHS LAB ERROR TRACKING REPORT",.ZTSAVE,.%ZIS)
G END
Q
;
QUE ; EP
S:$D(ZTQUEUED) ZTREQ="@"
U IO
N A,B,C,D,E,G,J,LRDFN,LRX,V,X,Y,Z
K ^TMP($J),^TMP("LRDFN",$J)
S LRQ(1)=^DD("SITE"),(LRQ,LR("Q"))=0
D L^LRU,H S LR("F")=1
F B=LRS:0 S B=$O(^LRO(69,B)) Q:'B!(B>LRE) D
. N X,I
. S I=0 F S I=$O(^LRO(69,B,1,I)) Q:'I S X=+$G(^(I,0)) I X D
.. S ^TMP("LRDFN",$J,X)=""
I $$GET1^DIQ(9009029,+$G(DUZ(2)),"TAKE SNAPSHOTS","I") D
. NEW SHOTMP
. M SHOTMP("LRDFN",$J)=^TMP("LRDFN",$J)
. D ENTRYAUD^BLRUTIL("QUE^BLRUER")
F LRDFN=0:0 S LRDFN=$O(^TMP("LRDFN",$J,LRDFN)) Q:'LRDFN S LRI=LRLDT F A=0:0 S LRI=$O(^LR(LRDFN,"CH",LRI)) Q:'LRI!(LRI>LRSDT) D A
K ^TMP("LRDFN",$J) D W,END^LRUTL,END
Q
;
A ; EP
I LRC(2),$O(^LR(LRDFN,"CH",LRI,1,"AC",0)) D SET Q
F B=0:0 S B=$O(^LR(LRDFN,"CH",LRI,1,B)) Q:'B I $G(^LR(LRDFN,"CH",LRI,1,B,0))[LRC(1)!($G(^LR(LRDFN,"CH",LRI,1,B,0))[LRC(3)) D SET Q ; IHS/OIT/MKK - LR*5.2*1030 - Get rid of Naked References
Q
;
SET ; EP
S X=^LR(LRDFN,"CH",LRI,0),Y=$P(X,"^",6) S:Y="" Y="?? ?? ??" S ^TMP($J,$P(Y," "),$P(Y," ",2,3),+X,LRDFN,LRI)=$P(X,"^",5) Q
Q
;
W ; EP
S (LRA,LRC)="" F A=0:0 S LRA=$O(^TMP($J,LRA)) Q:LRA=""!(LR("Q")) S LRC=LRC+1 D:LRL&(LRC>1) H Q:LR("Q") S LRB="" F B=0:0 S LRB=$O(^TMP($J,LRA,LRB)) Q:LRB=""!(LR("Q")) D W1
Q
;
W1 ; EP
F LRT=0:0 S LRT=$O(^TMP($J,LRA,LRB,LRT)) Q:'LRT!(LR("Q")) F LRDFN=0:0 S LRDFN=$O(^TMP($J,LRA,LRB,LRT,LRDFN)) Q:'LRDFN!(LR("Q")) D X
Q
;
X ; EP
F LRI=0:0 S LRI=$O(^TMP($J,LRA,LRB,LRT,LRDFN,LRI)) Q:'LRI!(LR("Q")) S X=+^(LRI),LRS=$P($G(^LAB(61,X,0)),"^") D P
Q
;
P ; EP
S LRDATE=$$FMTE^XLFDT(LRT,"M")
S X=^LR(LRDFN,0),(DFN,Y)=$P(X,"^",3),(LRDPF,X)=$P(X,"^",2),X=^DIC(X,0,"GL"),V=@(X_Y_",0)"),LRP=$P(V,"^"),SSN=$P(V,"^",9) D SSN^LRU ;IHS/ANMC/CLS 08/18/96
D:$Y>(IOSL-6) H W !!,LRA_" "_LRB,?14,LRDATE,?34,LRP," ",HRCN,?67,LRS D:LRF TST Q:LR("Q") ;IHS/ANMC/CLS 08/18/96
F B=0:0 S B=$O(^LR(LRDFN,"CH",LRI,1,B)) Q:'B!(LR("Q")) S B(1)=^(B,0) D:$Y>(IOSL-6) H1 Q:LR("Q") W !?5,B(1)
F B=0:0 S B=$O(^LR(LRDFN,"CH",LRI,1,"AC",B)) Q:'B!(LR("Q")) S C="" F E=0:0 S C=$O(^LR(LRDFN,"CH",LRI,1,"AC",B,C)) Q:C="" D:$Y>(IOSL-6) H1 Q:LR("Q") D P1
Q
;
P1 ; EP
S X=$G(^VA(200,B,0)) W !?5,$P(^LR(LRDFN,"CH",LRI,1,"AC",B,C),"^",3) W:$X>60 ! W " (deleted by ",$S($P(X,"^",2)]"":$P(X,"^",2),1:$P(X,",")),")"
Q
;
TST ; EP
S:'$D(LR(LRA)) LR(LRA)=+$O(^LRO(68,"B",LRA,0)) S X=$P(^LRO(68,LR(LRA),0),"^",3),Z=$P(LRB," ",2),G=$E(LRT,1,3) S:X="D" G=G_$P(LRB," ")
E S G=$S(X="Y":G_"0000",X="M":G_$E($P(LRB," "),1,2)_"00",1:G)
S (C,E,E(1))=0 F E(1)=0:0 S C=$O(^LRO(68,LR(LRA),1,G,1,Z,4,C)) Q:'C!(LR("Q")) S LRX=^(C,0) I $P(^LAB(60,C,0),U,4)'="WK" D B
Q
;
B ; EP
S E=E+1,J=$P(LRX,U,4),J=$S(J:$P($G(^VA(200,J,0)),"^",2),1:J) D:$Y>(IOSL-6) H2 Q:LR("Q") W ! W:E=1 "Test(s) ordered:" W ?18,$P($G(^LAB(60,C,0)),"^"),?49,"Tech: ",J
Q
;
H ; EP
I $D(LR("F")),IOST?1"C".E D M^LRU Q:LR("Q")
D F^LRU W !,LRC(1) W:$L(LRC(1))>44 ! W " From: ",LRSTR," To: ",LRLST,!,"Acc #",?14,"Date/Time",?34,"Name/HRCN",?67,"Specimen",!,LR("%")
Q
H1 ; EP
D H Q:LR("Q") W !,LRA," ",LRB,?14,LRDATE,?34,LRP," ",HRCN," ",LRS
Q
;
H2 ; EP
D H1 Q:LR("Q") W !,"Test(s) ordered:" S E=2
Q
END ; EP
D V^LRU
Q
;
DEBUGFOR ; EP - Check the FOR loop
NEW ACCDELC,D1,D1IEN,DEVICE,DEVDESC,TRANGE,DUZ2,DUZ2DESC,LISTTEST,NEWPAGE,PREVREPT,SPECREJ
;
; Parameters for LRUER report are in 90475.71
S GPD1=.9999999
F S GPD1=$O(^BLRLSRP(1,1,GPD1)) Q:GPD1<1 D
. S D1IEN=GPD1_","_1
. S DUZ2=$$GET1^DIQ(90475.71,D1IEN,.01,"I")
. S DUZ2=$$GET1^DIQ(90475.71,D1IEN,.01,"I")
. S DUZ2DESC=$$GET1^DIQ(90475.71,D1IEN,.01)
. S PREVREPT=+$$GET1^DIQ(90475.71,D1IEN,1,"I")
. S SPECREJ=+$$GET1^DIQ(90475.71,D1IEN,2,"I")
. S ACCDELC=+$$GET1^DIQ(90475.71,D1IEN,3,"I")
. S LISTTEST=+$$GET1^DIQ(90475.71,D1IEN,4,"I")
. S NEWPAGE=+$$GET1^DIQ(90475.71,D1IEN,5,"I")
. S DTRANGE=+$$GET1^DIQ(90475.71,D1IEN,6,"I")
. ;
. S LRSDT=$S(DTRANGE=1:$$HTFM^XLFDT(+$H-7),DTRANGE=2:$$HTFM^XLFDT(+$H-30),DTRANGE=3:$$HTFM^XLFDT(+$H-365),1:$$HTFM^XLFDT(+$H-1))
. S LRLDT=$$DT^XLFDT
. S LRSTR=$$FMTE^XLFDT(LRSDT,"5DZ")
. S LRLST=$$FMTE^XLFDT(LRLDT,"5DZ")
. S LRS=LRSDT-.01,LRE=LRLDT+.99,LRLDT=9999998-LRLDT,LRSDT=9999999-LRSDT
. ;
. S DEVICE=+$$GET1^DIQ(90475.71,D1IEN,7,"I")
. I DEVICE=0 D ; Default device is LABLABEL
.. S DEVICE=+$$FIND1^DIC(3.5,,,"LABLABEL")
.. S DEVDESC=$$GET1^DIQ(3.5,DEVICE,.01)
. ;
. W ?4,"GPD1:",GPD1," -- ",$$GET1^DIQ(4,GPD1,.01),!
. W ?9,"DUZ2:",DUZ2,"; DUZ2DESC:",DUZ2DESC,!
. W ?9,"PREVREPT:",PREVREPT,!
. W ?9,"SPECREJ:",SPECREJ,!
. W ?9,"ACCDELC:",ACCDELC,!
. W ?9,"LISTTEST:",LISTTEST,!
. W ?9,"NEWPAGE:",NEWPAGE,!
. W ?9,"DTRANGE:",DTRANGE,!
. ;
. S LRSDT=$S(DTRANGE=1:$$HTFM^XLFDT(+$H-7),DTRANGE=2:$$HTFM^XLFDT(+$H-30),DTRANGE=3:$$HTFM^XLFDT(+$H-365),1:$$HTFM^XLFDT(+$H-1))
. S LRLDT=$$DT^XLFDT
. W ?9,"LRSDT:",LRSDT,?29,"LRLDT:",LRLDT,!
. S LRSTR=$$FMTE^XLFDT(LRSDT,"5DZ")
. S LRLST=$$FMTE^XLFDT(LRLDT,"5DZ")
. W ?9,"LRSTR:",LRSTR,?29,"LRLST:",LRLST,!
. S LRS=LRSDT-.01,LRE=LRLDT+.99,LRLDT=9999998-LRLDT,LRSDT=9999999-LRSDT
. W ?9,"LRS:",LRS,?29,"LRE:",LRE,!
. W ?9,"LRSDT:",LRSDT,?29,"LRLDT:",LRLDT,!
Q
BLRUER ;IHS/MSC/MKK - ERROR TRACKING TASKED REPORT ;2/18/98 07:03 ;
+1 ;;5.2;LAB SERVICE;**1038**;NOV 1, 1997;Build 6
+2 ;
EEP ; EP - Ersatz EP
+1 DO EEP^BLRGMENU
+2 QUIT
+3 ;
+4 ; Cloned from the LR*5.2*1031 version of LRUER
+5 ;
+6 ; This version is designed to be tasked. It will REJECT interactive reporting.
+7 ;
BEGIN ; EP - Beginning
+1 IF $DATA(ZTQUEUED)<1
Begin DoDot:1
+2 WRITE !!,?4,"This report can only be run from TASKMAN."
+3 DO PRESSKEY^BLRGMENU(9)
End DoDot:1
QUIT
+4 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+5 ;
GETPARAM ; EP - Get the parameters from the IHS LAB SUPERVISOR TASKED REPORTS PARAMETERS (#90475.7) file
+1 NEW ACCDELC,D1,D1IEN,DEVICE,DEVDESC,GPD0,GPD1,TRANGE,DUZ2,DUZ2DESC,LISTTEST,NEWPAGE,PREVREPT,SPECREJ
+2 ;
+3 ; Parameters for LRUER report are in 90475.71
+4 SET (GPD0,GPD1)=1
+5 ;
+6 SET D1IEN=GPD1_","_GPD0
+7 SET DUZ2=$$GET1^DIQ(90475.71,D1IEN,.01,"I")
+8 SET DUZ2=$$GET1^DIQ(90475.71,D1IEN,.01,"I")
+9 SET DUZ2DESC=$$GET1^DIQ(90475.71,D1IEN,.01)
+10 SET PREVREPT=+$$GET1^DIQ(90475.71,D1IEN,1,"I")
+11 SET SPECREJ=+$$GET1^DIQ(90475.71,D1IEN,2,"I")
+12 SET ACCDELC=+$$GET1^DIQ(90475.71,D1IEN,3,"I")
+13 SET LISTTEST=+$$GET1^DIQ(90475.71,D1IEN,4,"I")
+14 SET NEWPAGE=+$$GET1^DIQ(90475.71,D1IEN,5,"I")
+15 SET DTRANGE=+$$GET1^DIQ(90475.71,D1IEN,6,"I")
+16 SET DEVICE=+$$GET1^DIQ(90475.71,D1IEN,7,"I")
+17 ;
+18 ; IF and ONLY IF the DEVICE variable is zero, then quit.
+19 ; Can Only happen if user up-hatted (^) out of the setup process.
+20 IF DEVICE<1
QUIT
+21 ;
+22 ; Do the report
DO DONTASK
+23 ;
+24 GOTO END
+25 QUIT
+26 ;
DONTASK ; EP
+1 SET LRC(1)=$SELECT(PREVREPT:"reported incorrectly as",SPECREJ:"specimen rejected",1:"")
+2 SET LRC(2)=$SELECT(ACCDELC:1,1:"")
+3 SET LRC(3)="DUMMYZZZZ"
+4 SET LRSDT=$SELECT(DTRANGE=1:$$HTFM^XLFDT(+$HOROLOG-7),DTRANGE=2:$$HTFM^XLFDT(+$HOROLOG-30),DTRANGE=3:$$HTFM^XLFDT(+$HOROLOG-365),1:$$HTFM^XLFDT(+$HOROLOG-1))
+5 SET LRLDT=$$DT^XLFDT
+6 SET LRSTR=$$FMTE^XLFDT(LRSDT,"5DZ")
+7 SET LRLST=$$FMTE^XLFDT(LRLDT,"5DZ")
+8 SET LRS=LRSDT-.01
SET LRE=LRLDT+.99
SET LRLDT=9999998-LRLDT
SET LRSDT=9999999-LRSDT
+9 SET LRF=LISTTEST
+10 SET LRL=NEWPAGE
+11 KILL IOP,ZTSK,%ZIS
+12 SET ZTSAVE("*")=""
+13 SET %ZIS="Q"
+14 ; S IOP="`"_$$FIND1^DIC(3.5,,,"BLRUER TASKED")
+15 SET IOP="`"_DEVICE
+16 DO ENTRYAUD^BLRUTIL("DONTASK^BLRUER")
+17 DO EN^XUTMDEVQ("QUE^BLRUER","TASKED IHS LAB ERROR TRACKING REPORT",.ZTSAVE,.%ZIS)
+18 GOTO END
+19 QUIT
+20 ;
QUE ; EP
+1 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 USE IO
+3 NEW A,B,C,D,E,G,J,LRDFN,LRX,V,X,Y,Z
+4 KILL ^TMP($JOB),^TMP("LRDFN",$JOB)
+5 SET LRQ(1)=^DD("SITE")
SET (LRQ,LR("Q"))=0
+6 DO L^LRU
DO H
SET LR("F")=1
+7 FOR B=LRS:0
SET B=$ORDER(^LRO(69,B))
IF 'B!(B>LRE)
QUIT
Begin DoDot:1
+8 NEW X,I
+9 SET I=0
FOR
SET I=$ORDER(^LRO(69,B,1,I))
IF 'I
QUIT
SET X=+$GET(^(I,0))
IF X
Begin DoDot:2
+10 SET ^TMP("LRDFN",$JOB,X)=""
End DoDot:2
End DoDot:1
+11 IF $$GET1^DIQ(9009029,+$GET(DUZ(2)),"TAKE SNAPSHOTS","I")
Begin DoDot:1
+12 NEW SHOTMP
+13 MERGE SHOTMP("LRDFN",$JOB)=^TMP("LRDFN",$JOB)
+14 DO ENTRYAUD^BLRUTIL("QUE^BLRUER")
End DoDot:1
+15 FOR LRDFN=0:0
SET LRDFN=$ORDER(^TMP("LRDFN",$JOB,LRDFN))
IF 'LRDFN
QUIT
SET LRI=LRLDT
FOR A=0:0
SET LRI=$ORDER(^LR(LRDFN,"CH",LRI))
IF 'LRI!(LRI>LRSDT)
QUIT
DO A
+16 KILL ^TMP("LRDFN",$JOB)
DO W
DO END^LRUTL
DO END
+17 QUIT
+18 ;
A ; EP
+1 IF LRC(2)
IF $ORDER(^LR(LRDFN,"CH",LRI,1,"AC",0))
DO SET
QUIT
+2 ; IHS/OIT/MKK - LR*5.2*1030 - Get rid of Naked References
FOR B=0:0
SET B=$ORDER(^LR(LRDFN,"CH",LRI,1,B))
IF 'B
QUIT
IF $GET(^LR(LRDFN,"CH",LRI,1,B,0))[LRC(1)!($GET(^LR(LRDFN,"CH",LRI,1,B,0))[LRC(3))
DO SET
QUIT
+3 QUIT
+4 ;
SET ; EP
+1 SET X=^LR(LRDFN,"CH",LRI,0)
SET Y=$PIECE(X,"^",6)
IF Y=""
SET Y="?? ?? ??"
SET ^TMP($JOB,$PIECE(Y," "),$PIECE(Y," ",2,3),+X,LRDFN,LRI)=$PIECE(X,"^",5)
QUIT
+2 QUIT
+3 ;
W ; EP
+1 SET (LRA,LRC)=""
FOR A=0:0
SET LRA=$ORDER(^TMP($JOB,LRA))
IF LRA=""!(LR("Q"))
QUIT
SET LRC=LRC+1
IF LRL&(LRC>1)
DO H
IF LR("Q")
QUIT
SET LRB=""
FOR B=0:0
SET LRB=$ORDER(^TMP($JOB,LRA,LRB))
IF LRB=""!(LR("Q"))
QUIT
DO W1
+2 QUIT
+3 ;
W1 ; EP
+1 FOR LRT=0:0
SET LRT=$ORDER(^TMP($JOB,LRA,LRB,LRT))
IF 'LRT!(LR("Q"))
QUIT
FOR LRDFN=0:0
SET LRDFN=$ORDER(^TMP($JOB,LRA,LRB,LRT,LRDFN))
IF 'LRDFN!(LR("Q"))
QUIT
DO X
+2 QUIT
+3 ;
X ; EP
+1 FOR LRI=0:0
SET LRI=$ORDER(^TMP($JOB,LRA,LRB,LRT,LRDFN,LRI))
IF 'LRI!(LR("Q"))
QUIT
SET X=+^(LRI)
SET LRS=$PIECE($GET(^LAB(61,X,0)),"^")
DO P
+2 QUIT
+3 ;
P ; EP
+1 SET LRDATE=$$FMTE^XLFDT(LRT,"M")
+2 ;IHS/ANMC/CLS 08/18/96
SET X=^LR(LRDFN,0)
SET (DFN,Y)=$PIECE(X,"^",3)
SET (LRDPF,X)=$PIECE(X,"^",2)
SET X=^DIC(X,0,"GL")
SET V=@(X_Y_",0)")
SET LRP=$PIECE(V,"^")
SET SSN=$PIECE(V,"^",9)
DO SSN^LRU
+3 ;IHS/ANMC/CLS 08/18/96
IF $Y>(IOSL-6)
DO H
WRITE !!,LRA_" "_LRB,?14,LRDATE,?34,LRP," ",HRCN,?67,LRS
IF LRF
DO TST
IF LR("Q")
QUIT
+4 FOR B=0:0
SET B=$ORDER(^LR(LRDFN,"CH",LRI,1,B))
IF 'B!(LR("Q"))
QUIT
SET B(1)=^(B,0)
IF $Y>(IOSL-6)
DO H1
IF LR("Q")
QUIT
WRITE !?5,B(1)
+5 FOR B=0:0
SET B=$ORDER(^LR(LRDFN,"CH",LRI,1,"AC",B))
IF 'B!(LR("Q"))
QUIT
SET C=""
FOR E=0:0
SET C=$ORDER(^LR(LRDFN,"CH",LRI,1,"AC",B,C))
IF C=""
QUIT
IF $Y>(IOSL-6)
DO H1
IF LR("Q")
QUIT
DO P1
+6 QUIT
+7 ;
P1 ; EP
+1 SET X=$GET(^VA(200,B,0))
WRITE !?5,$PIECE(^LR(LRDFN,"CH",LRI,1,"AC",B,C),"^",3)
IF $X>60
WRITE !
WRITE " (deleted by ",$SELECT($PIECE(X,"^",2)]"":$PIECE(X,"^",2),1:$PIECE(X,",")),")"
+2 QUIT
+3 ;
TST ; EP
+1 IF '$DATA(LR(LRA))
SET LR(LRA)=+$ORDER(^LRO(68,"B",LRA,0))
SET X=$PIECE(^LRO(68,LR(LRA),0),"^",3)
SET Z=$PIECE(LRB," ",2)
SET G=$EXTRACT(LRT,1,3)
IF X="D"
SET G=G_$PIECE(LRB," ")
+2 IF '$TEST
SET G=$SELECT(X="Y":G_"0000",X="M":G_$EXTRACT($PIECE(LRB," "),1,2)_"00",1:G)
+3 SET (C,E,E(1))=0
FOR E(1)=0:0
SET C=$ORDER(^LRO(68,LR(LRA),1,G,1,Z,4,C))
IF 'C!(LR("Q"))
QUIT
SET LRX=^(C,0)
IF $PIECE(^LAB(60,C,0),U,4)'="WK"
DO B
+4 QUIT
+5 ;
B ; EP
+1 SET E=E+1
SET J=$PIECE(LRX,U,4)
SET J=$SELECT(J:$PIECE($GET(^VA(200,J,0)),"^",2),1:J)
IF $Y>(IOSL-6)
DO H2
IF LR("Q")
QUIT
WRITE !
IF E=1
WRITE "Test(s) ordered:"
WRITE ?18,$PIECE($GET(^LAB(60,C,0)),"^"),?49,"Tech: ",J
+2 QUIT
+3 ;
H ; EP
+1 IF $DATA(LR("F"))
IF IOST?1"C".E
DO M^LRU
IF LR("Q")
QUIT
+2 DO F^LRU
WRITE !,LRC(1)
IF $LENGTH(LRC(1))>44
WRITE !
WRITE " From: ",LRSTR," To: ",LRLST,!,"Acc #",?14,"Date/Time",?34,"Name/HRCN",?67,"Specimen",!,LR("%")
+3 QUIT
H1 ; EP
+1 DO H
IF LR("Q")
QUIT
WRITE !,LRA," ",LRB,?14,LRDATE,?34,LRP," ",HRCN," ",LRS
+2 QUIT
+3 ;
H2 ; EP
+1 DO H1
IF LR("Q")
QUIT
WRITE !,"Test(s) ordered:"
SET E=2
+2 QUIT
END ; EP
+1 DO V^LRU
+2 QUIT
+3 ;
DEBUGFOR ; EP - Check the FOR loop
+1 NEW ACCDELC,D1,D1IEN,DEVICE,DEVDESC,TRANGE,DUZ2,DUZ2DESC,LISTTEST,NEWPAGE,PREVREPT,SPECREJ
+2 ;
+3 ; Parameters for LRUER report are in 90475.71
+4 SET GPD1=.9999999
+5 FOR
SET GPD1=$ORDER(^BLRLSRP(1,1,GPD1))
IF GPD1<1
QUIT
Begin DoDot:1
+6 SET D1IEN=GPD1_","_1
+7 SET DUZ2=$$GET1^DIQ(90475.71,D1IEN,.01,"I")
+8 SET DUZ2=$$GET1^DIQ(90475.71,D1IEN,.01,"I")
+9 SET DUZ2DESC=$$GET1^DIQ(90475.71,D1IEN,.01)
+10 SET PREVREPT=+$$GET1^DIQ(90475.71,D1IEN,1,"I")
+11 SET SPECREJ=+$$GET1^DIQ(90475.71,D1IEN,2,"I")
+12 SET ACCDELC=+$$GET1^DIQ(90475.71,D1IEN,3,"I")
+13 SET LISTTEST=+$$GET1^DIQ(90475.71,D1IEN,4,"I")
+14 SET NEWPAGE=+$$GET1^DIQ(90475.71,D1IEN,5,"I")
+15 SET DTRANGE=+$$GET1^DIQ(90475.71,D1IEN,6,"I")
+16 ;
+17 SET LRSDT=$SELECT(DTRANGE=1:$$HTFM^XLFDT(+$HOROLOG-7),DTRANGE=2:$$HTFM^XLFDT(+$HOROLOG-30),DTRANGE=3:$$HTFM^XLFDT(+$HOROLOG-365),1:$$HTFM^XLFDT(+$HOROLOG-1))
+18 SET LRLDT=$$DT^XLFDT
+19 SET LRSTR=$$FMTE^XLFDT(LRSDT,"5DZ")
+20 SET LRLST=$$FMTE^XLFDT(LRLDT,"5DZ")
+21 SET LRS=LRSDT-.01
SET LRE=LRLDT+.99
SET LRLDT=9999998-LRLDT
SET LRSDT=9999999-LRSDT
+22 ;
+23 SET DEVICE=+$$GET1^DIQ(90475.71,D1IEN,7,"I")
+24 ; Default device is LABLABEL
IF DEVICE=0
Begin DoDot:2
+25 SET DEVICE=+$$FIND1^DIC(3.5,,,"LABLABEL")
+26 SET DEVDESC=$$GET1^DIQ(3.5,DEVICE,.01)
End DoDot:2
+27 ;
+28 WRITE ?4,"GPD1:",GPD1," -- ",$$GET1^DIQ(4,GPD1,.01),!
+29 WRITE ?9,"DUZ2:",DUZ2,"; DUZ2DESC:",DUZ2DESC,!
+30 WRITE ?9,"PREVREPT:",PREVREPT,!
+31 WRITE ?9,"SPECREJ:",SPECREJ,!
+32 WRITE ?9,"ACCDELC:",ACCDELC,!
+33 WRITE ?9,"LISTTEST:",LISTTEST,!
+34 WRITE ?9,"NEWPAGE:",NEWPAGE,!
+35 WRITE ?9,"DTRANGE:",DTRANGE,!
+36 ;
+37 SET LRSDT=$SELECT(DTRANGE=1:$$HTFM^XLFDT(+$HOROLOG-7),DTRANGE=2:$$HTFM^XLFDT(+$HOROLOG-30),DTRANGE=3:$$HTFM^XLFDT(+$HOROLOG-365),1:$$HTFM^XLFDT(+$HOROLOG-1))
+38 SET LRLDT=$$DT^XLFDT
+39 WRITE ?9,"LRSDT:",LRSDT,?29,"LRLDT:",LRLDT,!
+40 SET LRSTR=$$FMTE^XLFDT(LRSDT,"5DZ")
+41 SET LRLST=$$FMTE^XLFDT(LRLDT,"5DZ")
+42 WRITE ?9,"LRSTR:",LRSTR,?29,"LRLST:",LRLST,!
+43 SET LRS=LRSDT-.01
SET LRE=LRLDT+.99
SET LRLDT=9999998-LRLDT
SET LRSDT=9999999-LRSDT
+44 WRITE ?9,"LRS:",LRS,?29,"LRE:",LRE,!
+45 WRITE ?9,"LRSDT:",LRSDT,?29,"LRLDT:",LRLDT,!
End DoDot:1
+46 QUIT
