LRBLDW ;AVAMC/REG/CYM - BLOOD DONOR WORKLIST ;6/28/96 09:06 ;
;;5.2;LAB SERVICE;**72,247**;Sep 27, 1994
;Per VHA Directive 97-033 this routine should not be modified. Medical Device # BK970021
D V^LRU W !!?20,"BLOOD DONOR WORKLIST" K A,T
I '$D(^LRE("AT")) W $C(7),!,"No tests pending",! Q
F A=10:1:20 D FIELD^DID(65.54,A,"","LABEL","LRA") S LRA(A)=LRA("LABEL") W !,$J(A,3),") ",LRA(A)
SEL W !!,"Select test(s) by number: " R X:DTIME G:X=""!(X[U) END I X["?" W !,"Enter one or more of the above numbers",!,"For 2 or more selections separate each with a ',' (ex. 12,13,15)",!,"Enter 'ALL' for all tests." G SEL
I X="ALL" D ALL G SHOW
I X?.E1CA.E!($L(X)>200) W $C(7),!,"No CONTROL CHARACTERS, LETTERS or more than 200 characters allowed." G SEL
I '+X W $C(7),!,"START with a NUMBER !!",! G SEL
S LRN=X F LRB=0:0 S LRV=+LRN,LRN=$E(LRN,$L(LRV)+2,$L(LRN)) S:$D(LRA(LRV)) LRT(LRV)=LRA(LRV) Q:'$L(LRN)
SHOW I '$D(LRT) W $C(7),!,"None of the listed tests selected, try again " S %=1 D YN^LRU G LRBLDW:%=1,END
W !!,"You have selected the following tests:" F A=0:0 S A=$O(LRT(A)) Q:'A W !,$J(A,3),") ",LRT(A)
W !,"OK " S %=1 D YN^LRU G:%'=1 LRBLDW
S ZTRTN="QUE^LRBLDW" D BEG^LRUTL G:POP!($D(ZTSK)) END
QUE U IO D L^LRU,S^LRU,H S LR("F")=1
S C="" F A=1:1 S C=$O(^LRE("AT",C)) Q:C=""!(LR("Q")) K C(1) D T
W:IOST'?1"C".E @IOF D END^LRUTL,END Q
T S T=0 F B=1:1 S T=$O(^LRE("AT",C,T)) Q:'T!(LR("Q")) D:$D(LRT(T)) W
Q:LR("Q") I $D(C(1)) W !,LR("%")
Q
W I '$D(C(1)) S P=$O(^LRE("AT",C,T,0)),C(4)=$O(^(P,0)),P=^LRE(P,0),C(4)=^(5,C(4),0),Y=+C(4) D D^LRU S C(2)=Y D:$Y>(IOSL-6) H Q:LR("Q") W !,C,?42,$P(P,"^",5),?46,$P(P,"^",6),?55,C(2),! S C(1)=1
D:$Y>(IOSL-6) H Q:LR("Q") W !,LRT(T) Q
;
H I $D(LR("F")),IOST?1"C".E D M^LRU Q:LR("Q")
D F^LRU W !,"LABORATORY SERVICE",?23,"BLOOD DONOR WORKLIST"
W !,"DONOR ID",?42,"ABO",?46,"RH",?55,"Collection date",!,LR("%") Q
ALL F A=0:0 S A=$O(LRA(A)) Q:'A S LRT(A)=LRA(A)
Q
END D V^LRU Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRBLDW 1966 printed Apr 09, 2024@21:16:50 Page 2
LRBLDW ;AVAMC/REG/CYM - BLOOD DONOR WORKLIST ;6/28/96 09:06 ;
+1 ;;5.2;LAB SERVICE;**72,247**;Sep 27, 1994
+2 ;Per VHA Directive 97-033 this routine should not be modified. Medical Device # BK970021
+3 DO V^LRU
WRITE !!?20,"BLOOD DONOR WORKLIST"
KILL A,T
+4 IF '$DATA(^LRE("AT"))
WRITE $CHAR(7),!,"No tests pending",!
QUIT
+5 FOR A=10:1:20
DO FIELD^DID(65.54,A,"","LABEL","LRA")
SET LRA(A)=LRA("LABEL")
WRITE !,$JUSTIFY(A,3),") ",LRA(A)
SEL WRITE !!,"Select test(s) by number: "
READ X:DTIME
if X=""!(X[U)
GOTO END
IF X["?"
WRITE !,"Enter one or more of the above numbers",!,"For 2 or more selections separate each with a ',' (ex. 12,13,15)",!,"Enter 'ALL' for all tests."
GOTO SEL
+1 IF X="ALL"
DO ALL
GOTO SHOW
+2 IF X?.E1CA.E!($LENGTH(X)>200)
WRITE $CHAR(7),!,"No CONTROL CHARACTERS, LETTERS or more than 200 characters allowed."
GOTO SEL
+3 IF '+X
WRITE $CHAR(7),!,"START with a NUMBER !!",!
GOTO SEL
+4 SET LRN=X
FOR LRB=0:0
SET LRV=+LRN
SET LRN=$EXTRACT(LRN,$LENGTH(LRV)+2,$LENGTH(LRN))
if $DATA(LRA(LRV))
SET LRT(LRV)=LRA(LRV)
if '$LENGTH(LRN)
QUIT
SHOW IF '$DATA(LRT)
WRITE $CHAR(7),!,"None of the listed tests selected, try again "
SET %=1
DO YN^LRU
if %=1
GOTO LRBLDW
GOTO END
+1 WRITE !!,"You have selected the following tests:"
FOR A=0:0
SET A=$ORDER(LRT(A))
if 'A
QUIT
WRITE !,$JUSTIFY(A,3),") ",LRT(A)
+2 WRITE !,"OK "
SET %=1
DO YN^LRU
if %'=1
GOTO LRBLDW
+3 SET ZTRTN="QUE^LRBLDW"
DO BEG^LRUTL
if POP!($DATA(ZTSK))
GOTO END
QUE USE IO
DO L^LRU
DO S^LRU
DO H
SET LR("F")=1
+1 SET C=""
FOR A=1:1
SET C=$ORDER(^LRE("AT",C))
if C=""!(LR("Q"))
QUIT
KILL C(1)
DO T
+2 if IOST'?1"C".E
WRITE @IOF
DO END^LRUTL
DO END
QUIT
T SET T=0
FOR B=1:1
SET T=$ORDER(^LRE("AT",C,T))
if 'T!(LR("Q"))
QUIT
if $DATA(LRT(T))
DO W
+1 if LR("Q")
QUIT
IF $DATA(C(1))
WRITE !,LR("%")
+2 QUIT
W IF '$DATA(C(1))
SET P=$ORDER(^LRE("AT",C,T,0))
SET C(4)=$ORDER(^(P,0))
SET P=^LRE(P,0)
SET C(4)=^(5,C(4),0)
SET Y=+C(4)
DO D^LRU
SET C(2)=Y
if $Y>(IOSL-6)
DO H
if LR("Q")
QUIT
WRITE !,C,?42,$PIECE(P,"^",5),?46,$PIECE(P,"^",6),?55,C(2),!
SET C(1)=1
+1 if $Y>(IOSL-6)
DO H
if LR("Q")
QUIT
WRITE !,LRT(T)
QUIT
+2 ;
H IF $DATA(LR("F"))
IF IOST?1"C".E
DO M^LRU
if LR("Q")
QUIT
+1 DO F^LRU
WRITE !,"LABORATORY SERVICE",?23,"BLOOD DONOR WORKLIST"
+2 WRITE !,"DONOR ID",?42,"ABO",?46,"RH",?55,"Collection date",!,LR("%")
QUIT
ALL FOR A=0:0
SET A=$ORDER(LRA(A))
if 'A
QUIT
SET LRT(A)=LRA(A)
+1 QUIT
END DO V^LRU
QUIT
