LRUET ;AVAMC/REG - RESULTS FOR A TEST RANGE ;2/18/93 12:43 ;
;;5.2;LAB SERVICE;;Sep 27, 1994
D V^LRU W ! S DIC("A")="Select lab test to check a range of values: "
S DIC=60,DIC(0)="AEQMOZ",DIC("S")="I $P(^(0),U,5)[""CH""" D ^DIC K DIC G:Y<1 END
S LRC=+Y,N(1)=$P(^LAB(60,LRC,.1),"^"),LRN=$P($P(Y(0),U,5),";",2)
ASK S DIC(0)="AEQMO",DIC="^LAB(61,",DIC("A")="Select Specimen Type to check: " D ^DIC K DIC G:Y<1 END S LRA=+Y,LRA(1)=$P(Y,U,2) I '$D(^LAB(60,LRC,1,LRA,0)) W $C(7),!,"Not a valid specimen for the test selected." G ASK
A W !!,?15,"1. Greater than a value",!?15,"2. Less than a value",! R "Select 1 or 2: ",X:DTIME G:X=""!(X[U) END I X<1!(X>2) W $C(7)," Enter 1 or 2" G A
S LRG=$S(X=1:">",1:"<")
B R !,"Select value: ",X:DTIME G:X=""!(X[U) END S X=+X I 'X W $C(7),!,"Must be a numeric value." G B
S LRB=LRG_X,LRQ(2)=N(1)_LRB_" ("_LRA(1)_")"
D B^LRU Q:Y<0 S LRLDT(1)=LRLDT+.99,LRSDT(1)=LRSDT-.01,LRLDT=9999998-LRLDT,LRSDT=9999999-LRSDT
S ZTRTN="QUE^LRUET" D BEG^LRUTL Q:POP!($D(ZTSK))
QUE U IO K ^TMP($J) D L^LRU,S^LRU,H S LR("F")=1
F LRDFN=0:0 S LRDFN=$O(^LR(LRDFN)) Q:'LRDFN I $D(^LR(LRDFN,0)),$P(^(0),"^",2)=2 S LRI=LRLDT F A=0:0 S LRI=$O(^LR(LRDFN,"CH",LRI)) Q:LRI<1!(LRI>LRSDT) D C
D D K ^TMP($J) D END,END^LRUTL Q
C Q:'$D(^LR(LRDFN,"CH",LRI,LRN))!($P(^(0),"^",5)'=LRA) S X=$P(^(LRN),"^") G:$E(X)=LRG S I @(+^(LRN)_LRB),^(LRN)'="canc" G S
Q
S S DFN=$P(^LR(LRDFN,0),"^",3) Q:'DFN S X=^DPT(DFN,0),LRP=$P(X,"^"),SSN=$P(X,"^",9),^TMP($J,LRP,LRDFN,LRN,LRI)=$P(^LR(LRDFN,"CH",LRI,LRN),"^"),^TMP($J,LRP)=SSN,^TMP($J,"B",LRP,LRI)=$P(^LR(LRDFN,"CH",LRI,0),"^",11) Q
;
D S LRP=0 F LRA=0:0 S LRP=$O(^TMP($J,LRP)) Q:LRP=""!(LR("Q")) F LRDFN=0:0 S LRDFN=$O(^TMP($J,LRP,LRDFN)) Q:'LRDFN!(LR("Q")) D LRT
Q
LRT D:$Y>(IOSL-6) H Q:LR("Q") S X=^TMP($J,LRP) W !!,LRP,?31,X
F LRT=0:0 S LRT=$O(^TMP($J,LRP,LRDFN,LRT)) Q:'LRT!(LR("Q")) D:$Y>(IOSL-6) H1 Q:LR("Q") S LRE=0 F LRI=0:0 S LRI=$O(^TMP($J,LRP,LRDFN,LRT,LRI)) Q:'LRI!(LR("Q")) S LRX=^(LRI),LRE=LRE+1 D W
Q
W D:$Y>(IOSL-6) H1 Q:LR("Q") S Y=9999999-LRI D DT^LRU W !,^TMP($J,"B",LRP,LRI) W:LRE=1 ?31,N(1) W ?41,Y,?65,$J(LRX,5) Q
;
H Q:LR("Q") I $D(LR("F")),IOST?1"C".E D M^LRU Q:LR("Q")
D F^LRU W !,LRQ(2)," From: ",LRSTR," to ",LRLST,!,"Report for: ",$P(^VA(200,DUZ,0),U),!,"Patient",?34,"SSN",!,"Location",?31,"Test",?45,"Date",?65,"Result",!,LR("%") Q
H1 D H Q:LR("Q") W !,LRP,?31,^TMP($J,LRP) Q
;
END D V^LRU Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRUET 2423 printed Apr 09, 2024@21:10:29 Page 2
LRUET ;AVAMC/REG - RESULTS FOR A TEST RANGE ;2/18/93 12:43 ;
+1 ;;5.2;LAB SERVICE;;Sep 27, 1994
+2 DO V^LRU
WRITE !
SET DIC("A")="Select lab test to check a range of values: "
+3 SET DIC=60
SET DIC(0)="AEQMOZ"
SET DIC("S")="I $P(^(0),U,5)[""CH"""
DO ^DIC
KILL DIC
if Y<1
GOTO END
+4 SET LRC=+Y
SET N(1)=$PIECE(^LAB(60,LRC,.1),"^")
SET LRN=$PIECE($PIECE(Y(0),U,5),";",2)
ASK SET DIC(0)="AEQMO"
SET DIC="^LAB(61,"
SET DIC("A")="Select Specimen Type to check: "
DO ^DIC
KILL DIC
if Y<1
GOTO END
SET LRA=+Y
SET LRA(1)=$PIECE(Y,U,2)
IF '$DATA(^LAB(60,LRC,1,LRA,0))
WRITE $CHAR(7),!,"Not a valid specimen for the test selected."
GOTO ASK
A WRITE !!,?15,"1. Greater than a value",!?15,"2. Less than a value",!
READ "Select 1 or 2: ",X:DTIME
if X=""!(X[U)
GOTO END
IF X<1!(X>2)
WRITE $CHAR(7)," Enter 1 or 2"
GOTO A
+1 SET LRG=$SELECT(X=1:">",1:"<")
B READ !,"Select value: ",X:DTIME
if X=""!(X[U)
GOTO END
SET X=+X
IF 'X
WRITE $CHAR(7),!,"Must be a numeric value."
GOTO B
+1 SET LRB=LRG_X
SET LRQ(2)=N(1)_LRB_" ("_LRA(1)_")"
+2 DO B^LRU
if Y<0
QUIT
SET LRLDT(1)=LRLDT+.99
SET LRSDT(1)=LRSDT-.01
SET LRLDT=9999998-LRLDT
SET LRSDT=9999999-LRSDT
+3 SET ZTRTN="QUE^LRUET"
DO BEG^LRUTL
if POP!($DATA(ZTSK))
QUIT
QUE USE IO
KILL ^TMP($JOB)
DO L^LRU
DO S^LRU
DO H
SET LR("F")=1
+1 FOR LRDFN=0:0
SET LRDFN=$ORDER(^LR(LRDFN))
if 'LRDFN
QUIT
IF $DATA(^LR(LRDFN,0))
IF $PIECE(^(0),"^",2)=2
SET LRI=LRLDT
FOR A=0:0
SET LRI=$ORDER(^LR(LRDFN,"CH",LRI))
if LRI<1!(LRI>LRSDT)
QUIT
DO C
+2 DO D
KILL ^TMP($JOB)
DO END
DO END^LRUTL
QUIT
C if '$DATA(^LR(LRDFN,"CH",LRI,LRN))!($PIECE(^(0),"^",5)'=LRA)
QUIT
SET X=$PIECE(^(LRN),"^")
if $EXTRACT(X)=LRG
GOTO S
IF @(+^(LRN)_LRB)
IF ^(LRN)'="canc"
GOTO S
+1 QUIT
S SET DFN=$PIECE(^LR(LRDFN,0),"^",3)
if 'DFN
QUIT
SET X=^DPT(DFN,0)
SET LRP=$PIECE(X,"^")
SET SSN=$PIECE(X,"^",9)
SET ^TMP($JOB,LRP,LRDFN,LRN,LRI)=$PIECE(^LR(LRDFN,"CH",LRI,LRN),"^")
SET ^TMP($JOB,LRP)=SSN
SET ^TMP($JOB,"B",LRP,LRI)=$PIECE(^LR(LRDFN,"CH",LRI,0),"^",11)
QUIT
+1 ;
D SET LRP=0
FOR LRA=0:0
SET LRP=$ORDER(^TMP($JOB,LRP))
if LRP=""!(LR("Q"))
QUIT
FOR LRDFN=0:0
SET LRDFN=$ORDER(^TMP($JOB,LRP,LRDFN))
if 'LRDFN!(LR("Q"))
QUIT
DO LRT
+1 QUIT
LRT if $Y>(IOSL-6)
DO H
if LR("Q")
QUIT
SET X=^TMP($JOB,LRP)
WRITE !!,LRP,?31,X
+1 FOR LRT=0:0
SET LRT=$ORDER(^TMP($JOB,LRP,LRDFN,LRT))
if 'LRT!(LR("Q"))
QUIT
if $Y>(IOSL-6)
DO H1
if LR("Q")
QUIT
SET LRE=0
FOR LRI=0:0
SET LRI=$ORDER(^TMP($JOB,LRP,LRDFN,LRT,LRI))
if 'LRI!(LR("Q"))
QUIT
SET LRX=^(LRI)
SET LRE=LRE+1
DO W
+2 QUIT
W if $Y>(IOSL-6)
DO H1
if LR("Q")
QUIT
SET Y=9999999-LRI
DO DT^LRU
WRITE !,^TMP($JOB,"B",LRP,LRI)
if LRE=1
WRITE ?31,N(1)
WRITE ?41,Y,?65,$JUSTIFY(LRX,5)
QUIT
+1 ;
H if LR("Q")
QUIT
IF $DATA(LR("F"))
IF IOST?1"C".E
DO M^LRU
if LR("Q")
QUIT
+1 DO F^LRU
WRITE !,LRQ(2)," From: ",LRSTR," to ",LRLST,!,"Report for: ",$PIECE(^VA(200,DUZ,0),U),!,"Patient",?34,"SSN",!,"Location",?31,"Test",?45,"Date",?65,"Result",!,LR("%")
QUIT
H1 DO H
if LR("Q")
QUIT
WRITE !,LRP,?31,^TMP($JOB,LRP)
QUIT
+1 ;
END DO V^LRU
QUIT
