LRRS ;SLC/DCM/BA/DALOI/FHS - INTERIM REPORT BY LOCATION (MANUAL QUEUE) ;2/19/91 11:39
;;5.2;LAB SERVICE;**283,337**;Sep 27, 1994;Build 2
;from option LRRS
BEGIN D:'$D(LRPARAM) ^LRPARAM G:$G(LREND) ^LRRK Q:$G(LREND) S:'$D(LRSINGLE) LRSINGLE=0 S:'$D(LRPRTPG) LRPRTPG=0 D LOC
END D ^LRRK
Q
CUM ;ENTRY POINT FOR CUMULATIVE OPTION LRAC LOC-LOC
S LRPRTPG=1
D BEGIN
Q
LOC K LRLLOC
S (LREND,LRSTOP)=0,(LRONETST,LRONESPC,LRLLOC,LRFLOC)="",LRELOC="ZZZZZZZZ",LRLAB=$S($D(LRLABKY):1,1:0) K DIC
K %DT S %DT("A")="DAILY REPORT FOR DAY: ",%DT="EQ" D DATE^LRWU Q:Y<1 K %DT S LRODT=Y,LRSDT=LRODT+.5,LREDT=9999999-LRODT
I $O(^LRO(69,LRODT,1,"AL",0))="" W !!?10,"No Reports for [ ",$$DTF^LRAFUNC1(LRODT),"] ",!! Q
I 'LRSINGLE F R !,"Do you want (A)ll locations, a (R)ange of locations,",!,"or (S)elected locations? S// ",X:DTIME S:X="" X="S" Q:$L(X)=1&("ARS^"[X) W !,"Enter 'A', 'R', 'S' or '^' to exit"
I 'LRSINGLE Q:X[U S LRLOC=X
ASKPG I 'LRPRTPG D
.S DIR(0)="Y",DIR("A")="Print address page",DIR("B")="NO"
.D ^DIR K DIR
.I Y S LRPRTPG=1
D @$S(LRLOC="S":"SELECT",LRLOC="R":"RANGE",1:"QUE")
Q
SELECT N LRLOCX,DIC,LRCNT
W !! D AL
Q:$G(LREND)
I $O(LRLLOC(0))="" W !!?7,"NOTHING SELECTED ",! Q
D QUE
Q
AL ;
S (LRCNT,LRLOCX,LREND)=""
F S LRLOCX=$O(^LRO(69,LRODT,1,"AL",LRLOCX)) Q:LRLOCX="" S LRCNT=LRCNT+1,LRLOCX(LRLOCX)=""
I 'LRCNT W !,"No Reports for ",$$DTF^LRAFUNC1(LRODT),! Q
S DIC=44,DIC("S")="I $L($P(^(0),U,2)),$D(LRLOCX($P(^(0),U,2)))",DIC(0)="QEZNM"
AL0 R !,"Select Report Location: ",X:DTIME S:'$T!($E(X)="^") LREND=1 Q:X=""
Q:$G(LREND)
I $D(LRLOCX(X)) S LRLLOC(X)="" G AL0
SELLOC D ^DIC G:Y<1 AL0
S Y1=$P(Y(0),U,2)
S:$D(LRLOCX(Y1)) LRLLOC(Y1)=""
Q:$D(DUOUT)
K DIC
G AL0
Q
DIS ;
N I
F I=1:1:LRCNT W !,I,?4,LRLOCX(I) S I=I+1 Q:I>LRCNT W:$D(LRLOCX(I)) ?39," ",I,?44,LRLOCX(I)
W ! Q
Q
RANGE W !,"Select STARTING PATIENT LOCATION: " R X:DTIME S:X="" X="^"
I X["?" W !,"Enter the first patient location (abbreviation) that you want." G RANGE
S:X="ALL"!(X="all") X="" S LRLLOC=X S LRFLOC=$S(LRLLOC="^":"",1:$E(LRLLOC,1,$L(LRLLOC)-1)_$C($A($E(LRLLOC,$L(LRLLOC)))-1))
RANGE2 W !,"Select ENDING LOCATION: " R X:DTIME S:X="" X="^"
I X["?" W !,"Enter the last patient location (abbreviation) that you want." G RANGE2
S:X="ALL"!(X="all") X="" S LRLLOC=X Q:LRLLOC="^" S LRELOC=$E(LRLLOC,1,15)
QUE S %ZIS="MQ",ZTRTN="DQ^LRRS" D IO^LRWU
Q
DQ ;dequeued
S:$D(ZTQUEUED) ZTREQ="@" U IO D @$S(LRLOC="S":"SEL",1:"RNG")
Q
SEL ;
S LRLLOC="",LRJ0=1
F S LRLLOC=$O(LRLLOC(LRLLOC)) Q:LRLLOC="" W:'LRJ0 @IOF S LRLTR=LRLLOC D:$E(IOST,1,2)'="C-" ^LRLTR D LNAME S LRJ0=0 Q:LREND
W @IOF
Q
RNG ;
S LRJ0=1
F S LRLLOC=$O(^LRO(69,LRODT,1,"AL",LRFLOC)) Q:LREND!(LRLLOC="")!(LRLLOC]LRELOC) D
.S LRFLOC=LRLLOC
.W:'LRJ0 @IOF
.S LRLTR=$S(LRLLOC="":"UNK",1:LRLLOC)
.D:$E(IOST,1,2)'="C-" ^LRLTR
.D LNAME
.Q:LREND
W @IOF
Q
LNAME S LRNAME="" F S LRNAME=$O(^LRO(69,LRODT,1,"AL",LRLLOC,LRNAME)) Q:LRNAME="" D PAT Q:LREND
Q
PAT S LRDFN=0 F S LRDFN=+$O(^LRO(69,LRODT,1,"AL",LRLLOC,LRNAME,LRDFN)) Q:LRDFN<1 S LRIDT=9999999-LRSDT D DS^LRRP2 S:LRSTOP LREND=1 Q:LREND
S LRJ0=0
Q
CUMSGLE ;ENTRY POINT FOR OPTION LRAC LOC
S LRPRTPG=1
SINGLE ;from option LRRS BY LOC
S LRSINGLE=1,LRLOC="S" D BEGIN
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[HLRRS 3634 printed Dec 13, 2024@02:20:12 Page 2
LRRS ;SLC/DCM/BA/DALOI/FHS - INTERIM REPORT BY LOCATION (MANUAL QUEUE) ;2/19/91 11:39
+1 ;;5.2;LAB SERVICE;**283,337**;Sep 27, 1994;Build 2
+2 ;from option LRRS
BEGIN if '$DATA(LRPARAM)
DO ^LRPARAM
if $GET(LREND)
GOTO ^LRRK
if $GET(LREND)
QUIT
if '$DATA(LRSINGLE)
SET LRSINGLE=0
if '$DATA(LRPRTPG)
SET LRPRTPG=0
DO LOC
END DO ^LRRK
+1 QUIT
CUM ;ENTRY POINT FOR CUMULATIVE OPTION LRAC LOC-LOC
+1 SET LRPRTPG=1
+2 DO BEGIN
+3 QUIT
LOC KILL LRLLOC
+1 SET (LREND,LRSTOP)=0
SET (LRONETST,LRONESPC,LRLLOC,LRFLOC)=""
SET LRELOC="ZZZZZZZZ"
SET LRLAB=$SELECT($DATA(LRLABKY):1,1:0)
KILL DIC
+2 KILL %DT
SET %DT("A")="DAILY REPORT FOR DAY: "
SET %DT="EQ"
DO DATE^LRWU
if Y<1
QUIT
KILL %DT
SET LRODT=Y
SET LRSDT=LRODT+.5
SET LREDT=9999999-LRODT
+3 IF $ORDER(^LRO(69,LRODT,1,"AL",0))=""
WRITE !!?10,"No Reports for [ ",$$DTF^LRAFUNC1(LRODT),"] ",!!
QUIT
+4 IF 'LRSINGLE
FOR
READ !,"Do you want (A)ll locations, a (R)ange of locations,",!,"or (S)elected locations? S// ",X:DTIME
if X=""
SET X="S"
if $LENGTH(X)=1&("ARS^"[X)
QUIT
WRITE !,"Enter 'A', 'R', 'S' or '^' to exit"
+5 IF 'LRSINGLE
if X[U
QUIT
SET LRLOC=X
ASKPG IF 'LRPRTPG
Begin DoDot:1
+1 SET DIR(0)="Y"
SET DIR("A")="Print address page"
SET DIR("B")="NO"
+2 DO ^DIR
KILL DIR
+3 IF Y
SET LRPRTPG=1
End DoDot:1
+4 DO @$SELECT(LRLOC="S":"SELECT",LRLOC="R":"RANGE",1:"QUE")
+5 QUIT
SELECT NEW LRLOCX,DIC,LRCNT
+1 WRITE !!
DO AL
+2 if $GET(LREND)
QUIT
+3 IF $ORDER(LRLLOC(0))=""
WRITE !!?7,"NOTHING SELECTED ",!
QUIT
+4 DO QUE
+5 QUIT
AL ;
+1 SET (LRCNT,LRLOCX,LREND)=""
+2 FOR
SET LRLOCX=$ORDER(^LRO(69,LRODT,1,"AL",LRLOCX))
if LRLOCX=""
QUIT
SET LRCNT=LRCNT+1
SET LRLOCX(LRLOCX)=""
+3 IF 'LRCNT
WRITE !,"No Reports for ",$$DTF^LRAFUNC1(LRODT),!
QUIT
+4 SET DIC=44
SET DIC("S")="I $L($P(^(0),U,2)),$D(LRLOCX($P(^(0),U,2)))"
SET DIC(0)="QEZNM"
AL0 READ !,"Select Report Location: ",X:DTIME
if '$TEST!($EXTRACT(X)="^")
SET LREND=1
if X=""
QUIT
+1 if $GET(LREND)
QUIT
+2 IF $DATA(LRLOCX(X))
SET LRLLOC(X)=""
GOTO AL0
SELLOC DO ^DIC
if Y<1
GOTO AL0
+1 SET Y1=$PIECE(Y(0),U,2)
+2 if $DATA(LRLOCX(Y1))
SET LRLLOC(Y1)=""
+3 if $DATA(DUOUT)
QUIT
+4 KILL DIC
+5 GOTO AL0
+6 QUIT
DIS ;
+1 NEW I
+2 FOR I=1:1:LRCNT
WRITE !,I,?4,LRLOCX(I)
SET I=I+1
if I>LRCNT
QUIT
if $DATA(LRLOCX(I))
WRITE ?39," ",I,?44,LRLOCX(I)
+3 WRITE !
QUIT
+4 QUIT
RANGE WRITE !,"Select STARTING PATIENT LOCATION: "
READ X:DTIME
if X=""
SET X="^"
+1 IF X["?"
WRITE !,"Enter the first patient location (abbreviation) that you want."
GOTO RANGE
+2 if X="ALL"!(X="all")
SET X=""
SET LRLLOC=X
SET LRFLOC=$SELECT(LRLLOC="^":"",1:$EXTRACT(LRLLOC,1,$LENGTH(LRLLOC)-1)_$CHAR($ASCII($EXTRACT(LRLLOC,$LENGTH(LRLLOC)))-1))
RANGE2 WRITE !,"Select ENDING LOCATION: "
READ X:DTIME
if X=""
SET X="^"
+1 IF X["?"
WRITE !,"Enter the last patient location (abbreviation) that you want."
GOTO RANGE2
+2 if X="ALL"!(X="all")
SET X=""
SET LRLLOC=X
if LRLLOC="^"
QUIT
SET LRELOC=$EXTRACT(LRLLOC,1,15)
QUE SET %ZIS="MQ"
SET ZTRTN="DQ^LRRS"
DO IO^LRWU
+1 QUIT
DQ ;dequeued
+1 if $DATA(ZTQUEUED)
SET ZTREQ="@"
USE IO
DO @$SELECT(LRLOC="S":"SEL",1:"RNG")
+2 QUIT
SEL ;
+1 SET LRLLOC=""
SET LRJ0=1
+2 FOR
SET LRLLOC=$ORDER(LRLLOC(LRLLOC))
if LRLLOC=""
QUIT
if 'LRJ0
WRITE @IOF
SET LRLTR=LRLLOC
if $EXTRACT(IOST,1,2)'="C-"
DO ^LRLTR
DO LNAME
SET LRJ0=0
if LREND
QUIT
+3 WRITE @IOF
+4 QUIT
RNG ;
+1 SET LRJ0=1
+2 FOR
SET LRLLOC=$ORDER(^LRO(69,LRODT,1,"AL",LRFLOC))
if LREND!(LRLLOC="")!(LRLLOC]LRELOC)
QUIT
Begin DoDot:1
+3 SET LRFLOC=LRLLOC
+4 if 'LRJ0
WRITE @IOF
+5 SET LRLTR=$SELECT(LRLLOC="":"UNK",1:LRLLOC)
+6 if $EXTRACT(IOST,1,2)'="C-"
DO ^LRLTR
+7 DO LNAME
+8 if LREND
QUIT
End DoDot:1
+9 WRITE @IOF
+10 QUIT
LNAME SET LRNAME=""
FOR
SET LRNAME=$ORDER(^LRO(69,LRODT,1,"AL",LRLLOC,LRNAME))
if LRNAME=""
QUIT
DO PAT
if LREND
QUIT
+1 QUIT
PAT SET LRDFN=0
FOR
SET LRDFN=+$ORDER(^LRO(69,LRODT,1,"AL",LRLLOC,LRNAME,LRDFN))
if LRDFN<1
QUIT
SET LRIDT=9999999-LRSDT
DO DS^LRRP2
if LRSTOP
SET LREND=1
if LREND
QUIT
+1 SET LRJ0=0
+2 QUIT
CUMSGLE ;ENTRY POINT FOR OPTION LRAC LOC
+1 SET LRPRTPG=1
SINGLE ;from option LRRS BY LOC
+1 SET LRSINGLE=1
SET LRLOC="S"
DO BEGIN
+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
