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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---LRRS   3634     printed  Feb 18, 2025@23:46:04                                                                                                                                                                                                        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