- LRBLDPA ; IHS/DIR/AAB - BLOOD DONOR PRINT 6/26/96 08:57 ;
- ;;5.2;LR;**1002**;JUN 01, 1998
- ;;5.2;LAB SERVICE;**72**;Sep 27, 1994
- D END S (LRN,LR("Q"))=0,DIC="^LRE(",DIC(0)="AEQMZ",DIC("A")="Select DONOR: " D ^DIC K DIC G:X=""!(X[U) END S LR=+Y
- I $O(^LRE(LR,5,0)) W !!,"Select a single donation date " S %=2 D YN^LRU G:%<1 END I %=1 K ^TMP($J) S (A,C)=0 D L G:'$D(LRI) END W !!,"Include workload information " S %=2 D YN^LRU Q:%<1 S:%=1 LRN=1
- K DIC,DIE,DR S ZTRTN="QUE^LRBLDPA" W ! D BEG^LRUTL G:POP!($D(ZTSK)) END
- QUE N NAME U IO D L^LRU,S^LRU F X=6.1,6.2,6.3,6.4 D FIELD^DID(65.5,X,"","LABEL","NAME") S Y=NAME("LABEL")
- S DIWL=5,DIWR=IOM-5,DIWF="W"
- D ^LRBLDPA1,END^LRUTL,END Q
- L F B=1:1 S A=$O(^LRE(LR,5,A)) Q:'A!(LR("Q")) S W=^(A,0) D:B#21=0 M^LRU Q:LR("Q") S Y=+W,W(2)=$P(W,"^",2),C=C+1,^TMP($J,C)=A D D^LRU D W
- ASK Q:'$D(^TMP($J)) W !!,"CHOOSE FROM 1-",C," : " R X:DTIME Q:X=""!(X[U) I X'=+X!(X<1)!(X>C) W $C(7)," Numbers only from 1 to ",C G ASK
- S LRI=^TMP($J,X),Y=+^LRE(LR,5,LRI,0) D D^LRU W " ",Y K ^TMP($J) Q
- W W:B=1 !!?5,"Donation Date",?30,"Unit ID" W !,$J(C,2),?5,Y,?30,$P(W,"^",4) W:W(2)="N" "NO DONATION"
- Q
- END D V^LRU Q
- LRBLDPA ; IHS/DIR/AAB - BLOOD DONOR PRINT 6/26/96 08:57 ;
- +1 ;;5.2;LR;**1002**;JUN 01, 1998
- +2 ;;5.2;LAB SERVICE;**72**;Sep 27, 1994
- +3 DO END
- SET (LRN,LR("Q"))=0
- SET DIC="^LRE("
- SET DIC(0)="AEQMZ"
- SET DIC("A")="Select DONOR: "
- DO ^DIC
- KILL DIC
- IF X=""!(X[U)
- GOTO END
- SET LR=+Y
- +4 IF $ORDER(^LRE(LR,5,0))
- WRITE !!,"Select a single donation date "
- SET %=2
- DO YN^LRU
- IF %<1
- GOTO END
- IF %=1
- KILL ^TMP($JOB)
- SET (A,C)=0
- DO L
- IF '$DATA(LRI)
- GOTO END
- WRITE !!,"Include workload information "
- SET %=2
- DO YN^LRU
- IF %<1
- QUIT
- IF %=1
- SET LRN=1
- +5 KILL DIC,DIE,DR
- SET ZTRTN="QUE^LRBLDPA"
- WRITE !
- DO BEG^LRUTL
- IF POP!($DATA(ZTSK))
- GOTO END
- QUE NEW NAME
- USE IO
- DO L^LRU
- DO S^LRU
- FOR X=6.1,6.2,6.3,6.4
- DO FIELD^DID(65.5,X,"","LABEL","NAME")
- SET Y=NAME("LABEL")
- +1 SET DIWL=5
- SET DIWR=IOM-5
- SET DIWF="W"
- +2 DO ^LRBLDPA1
- DO END^LRUTL
- DO END
- QUIT
- L FOR B=1:1
- SET A=$ORDER(^LRE(LR,5,A))
- IF 'A!(LR("Q"))
- QUIT
- SET W=^(A,0)
- IF B#21=0
- DO M^LRU
- IF LR("Q")
- QUIT
- SET Y=+W
- SET W(2)=$PIECE(W,"^",2)
- SET C=C+1
- SET ^TMP($JOB,C)=A
- DO D^LRU
- DO W
- ASK IF '$DATA(^TMP($JOB))
- QUIT
- WRITE !!,"CHOOSE FROM 1-",C," : "
- READ X:DTIME
- IF X=""!(X[U)
- QUIT
- IF X'=+X!(X<1)!(X>C)
- WRITE $CHAR(7)," Numbers only from 1 to ",C
- GOTO ASK
- +1 SET LRI=^TMP($JOB,X)
- SET Y=+^LRE(LR,5,LRI,0)
- DO D^LRU
- WRITE " ",Y
- KILL ^TMP($JOB)
- QUIT
- W IF B=1
- WRITE !!?5,"Donation Date",?30,"Unit ID"
- WRITE !,$JUSTIFY(C,2),?5,Y,?30,$PIECE(W,"^",4)
- IF W(2)="N"
- WRITE "NO DONATION"
- +1 QUIT
- END DO V^LRU
- QUIT
