91 lines
3.5 KiB
Mathematica
91 lines
3.5 KiB
Mathematica
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
|