LRRS13 ;SLC/DCM,BA/DALISC/FHS/DRH - INTERIM REPORT BY LOCATION (MANUAL QUEUE) ;2/19/91 11:39 ;
;;5.2;LAB SERVICE;;Sep 27, 1994
;EXTENSION OF LRRS12
DQ ;dequeued
S LRHOLD=LRODT
S:$D(ZTQUEUED) ZTREQ="@" U IO D @$S(LRLOC="S":"IT",LRLOC="R":"IT",1:"ALL")
END ;
D ^LRRK
K LRLOCXY,LRX1,LRY1,OK
Q
CHKDAT ;
S LRHOLD=LRODT
S LRCHK=""
F S LRODT=$O(^LRO(69,LRODT)) Q:LRODT=""!(LRODT>LRLAST) D
. I $O(^LRO(69,LRODT,1,"AL",LRCHK))="" D NORPT
S LRODT=LRHOLD K LRHOLD
Q
IT ;
S LRHOLD=LRODT
S LRLLOC=""
F S LRLLOC=$O(LRLLOC(LRLLOC)) Q:LRLLOC=""!($G(LREND)) D
. S LRODT=LRDTXX-.5
. D BIG
. S LRANY=0
. F S LRODT=$O(^LRO(69,LRODT)) Q:LRODT=""!(LRODT>LRLAST)!($G(LREND)) D
.. I $D(^LRO(69,LRODT,1,"AL",LRLLOC)) D PROCESS S LRANY=1
. I '$G(LRANY) D NORPT QUIT
Q
NORPT ;
W !!!
W !?10,"No Reports from: ",LRLLOC," for this date range."
W @IOF
Q
ALL ;
S LREND=0
S LRODT=LRDTXX-.5
F S LRODT=$O(^LRO(69,LRODT)) Q:+LRODT'>0!(LRODT>LRLAST)!($G(LREND)) D
. S LRLLOC="",LRANY=0
. F S LRLLOC=$O(^LRO(69,LRODT,1,"AL",LRLLOC)) Q:LRLLOC=""!($G(LREND)) D
.. D BIG,PROCESS S LRANY=1
Q:LRLLOC="" I '$G(LRANY) D NORPT QUIT
Q
BIG ;
;Q:$G(LRANY)
S LRXY98Z=1
S LRLTR=$S(LRLLOC="":"UNK",1:LRLLOC)
W !!
I $E(IOST,1,2)'="C-" D ^LRLTR
;D ^LRLTR W @IOF
K LRXY98Z
Q
PROCESS ;
S LREDT=9999999-LRODT,LRSDT=LRODT+.5
S LRJ0=1
D LNAME
Q:LREND
K LRHOLD
Q
LNAME ;
Q:$G(LREND)
S LRNAME=""
F S LRNAME=$O(^LRO(69,LRODT,1,"AL",LRLLOC,LRNAME)) Q:LRNAME=""!($G(LREND)) D
. D PAT Q:LREND
Q
PAT ;
Q:$G(LREND)
S LRDFN=0
F S LRDFN=+$O(^LRO(69,LRODT,1,"AL",LRLLOC,LRNAME,LRDFN)) Q:LRDFN<1!($G(LREND)) D
. S LRIDT=9999999-LRSDT D DS^LRRP2 S:LRSTOP LREND=1 Q:$G(LREND)
Q
SINGLE ;from option LRRS BY LOC
S LRSINGLE=1,LRLOC="S" D BEGIN^LRRS12
Q
SHOW ;Display possible choices of locations
W !?10,"Select from: " S I="",LREND=0 F A=0:0 S I=$O(^LRO(69,LRODT,1,"AL",I)) Q:I="" D:$Y>(IOSL-4) WAIT Q:LREND W ?25,I,!
K A S (LROK,LREND)=0 W ! Q
WAIT R !!?10,"Press RETURN to continue or '^' to exit: ",X:DTIME S:'$T!($E(X)="^") LREND=1 Q:LREND
W @IOF,!!?10,"Select from: " Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRRS13 2168 printed Oct 16, 2024@18:20:58 Page 2
LRRS13 ;SLC/DCM,BA/DALISC/FHS/DRH - INTERIM REPORT BY LOCATION (MANUAL QUEUE) ;2/19/91 11:39 ;
+1 ;;5.2;LAB SERVICE;;Sep 27, 1994
+2 ;EXTENSION OF LRRS12
DQ ;dequeued
+1 SET LRHOLD=LRODT
+2 if $DATA(ZTQUEUED)
SET ZTREQ="@"
USE IO
DO @$SELECT(LRLOC="S":"IT",LRLOC="R":"IT",1:"ALL")
END ;
+1 DO ^LRRK
+2 KILL LRLOCXY,LRX1,LRY1,OK
+3 QUIT
CHKDAT ;
+1 SET LRHOLD=LRODT
+2 SET LRCHK=""
+3 FOR
SET LRODT=$ORDER(^LRO(69,LRODT))
if LRODT=""!(LRODT>LRLAST)
QUIT
Begin DoDot:1
+4 IF $ORDER(^LRO(69,LRODT,1,"AL",LRCHK))=""
DO NORPT
End DoDot:1
+5 SET LRODT=LRHOLD
KILL LRHOLD
+6 QUIT
IT ;
+1 SET LRHOLD=LRODT
+2 SET LRLLOC=""
+3 FOR
SET LRLLOC=$ORDER(LRLLOC(LRLLOC))
if LRLLOC=""!($GET(LREND))
QUIT
Begin DoDot:1
+4 SET LRODT=LRDTXX-.5
+5 DO BIG
+6 SET LRANY=0
+7 FOR
SET LRODT=$ORDER(^LRO(69,LRODT))
if LRODT=""!(LRODT>LRLAST)!($GET(LREND))
QUIT
Begin DoDot:2
+8 IF $DATA(^LRO(69,LRODT,1,"AL",LRLLOC))
DO PROCESS
SET LRANY=1
End DoDot:2
+9 IF '$GET(LRANY)
DO NORPT
QUIT
End DoDot:1
+10 QUIT
NORPT ;
+1 WRITE !!!
+2 WRITE !?10,"No Reports from: ",LRLLOC," for this date range."
+3 WRITE @IOF
+4 QUIT
ALL ;
+1 SET LREND=0
+2 SET LRODT=LRDTXX-.5
+3 FOR
SET LRODT=$ORDER(^LRO(69,LRODT))
if +LRODT'>0!(LRODT>LRLAST)!($GET(LREND))
QUIT
Begin DoDot:1
+4 SET LRLLOC=""
SET LRANY=0
+5 FOR
SET LRLLOC=$ORDER(^LRO(69,LRODT,1,"AL",LRLLOC))
if LRLLOC=""!($GET(LREND))
QUIT
Begin DoDot:2
+6 DO BIG
DO PROCESS
SET LRANY=1
End DoDot:2
End DoDot:1
+7 if LRLLOC=""
QUIT
IF '$GET(LRANY)
DO NORPT
QUIT
+8 QUIT
BIG ;
+1 ;Q:$G(LRANY)
+2 SET LRXY98Z=1
+3 SET LRLTR=$SELECT(LRLLOC="":"UNK",1:LRLLOC)
+4 WRITE !!
+5 IF $EXTRACT(IOST,1,2)'="C-"
DO ^LRLTR
+6 ;D ^LRLTR W @IOF
+7 KILL LRXY98Z
+8 QUIT
PROCESS ;
+1 SET LREDT=9999999-LRODT
SET LRSDT=LRODT+.5
+2 SET LRJ0=1
+3 DO LNAME
+4 if LREND
QUIT
+5 KILL LRHOLD
+6 QUIT
LNAME ;
+1 if $GET(LREND)
QUIT
+2 SET LRNAME=""
+3 FOR
SET LRNAME=$ORDER(^LRO(69,LRODT,1,"AL",LRLLOC,LRNAME))
if LRNAME=""!($GET(LREND))
QUIT
Begin DoDot:1
+4 DO PAT
if LREND
QUIT
End DoDot:1
+5 QUIT
PAT ;
+1 if $GET(LREND)
QUIT
+2 SET LRDFN=0
+3 FOR
SET LRDFN=+$ORDER(^LRO(69,LRODT,1,"AL",LRLLOC,LRNAME,LRDFN))
if LRDFN<1!($GET(LREND))
QUIT
Begin DoDot:1
+4 SET LRIDT=9999999-LRSDT
DO DS^LRRP2
if LRSTOP
SET LREND=1
if $GET(LREND)
QUIT
End DoDot:1
+5 QUIT
SINGLE ;from option LRRS BY LOC
+1 SET LRSINGLE=1
SET LRLOC="S"
DO BEGIN^LRRS12
+2 QUIT
SHOW ;Display possible choices of locations
+1 WRITE !?10,"Select from: "
SET I=""
SET LREND=0
FOR A=0:0
SET I=$ORDER(^LRO(69,LRODT,1,"AL",I))
if I=""
QUIT
if $Y>(IOSL-4)
DO WAIT
if LREND
QUIT
WRITE ?25,I,!
+2 KILL A
SET (LROK,LREND)=0
WRITE !
QUIT
WAIT READ !!?10,"Press RETURN to continue or '^' to exit: ",X:DTIME
if '$TEST!($EXTRACT(X)="^")
SET LREND=1
if LREND
QUIT
+1 WRITE @IOF,!!?10,"Select from: "
QUIT
