source: FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LRRS.m

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