- LRBLDW ; IHS/DIR/AAB - BLOOD DONOR WORKLIST 6/28/96 09:06 ;
- ;;5.2;LR;**1002**;JUN 01, 1998
- ;;5.2;LAB SERVICE;**72**;Sep 27, 1994
- 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
- LRBLDW ; IHS/DIR/AAB - BLOOD DONOR WORKLIST 6/28/96 09:06 ;
- +1 ;;5.2;LR;**1002**;JUN 01, 1998
- +2 ;;5.2;LAB SERVICE;**72**;Sep 27, 1994
- +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
