| [613] | 1 | LRBLDA1 ;AVAMC/REG - BLOOD DONOR LABELS ; 10/23/88 15:45 ;
|
|---|
| 2 | ;;5.2;LAB SERVICE;**247**;Sep 27, 1994
|
|---|
| 3 | ;Per VHA Directive 97-033 this routine should not be modified. Medical Device # BK970021
|
|---|
| 4 | U IO S LRP=LRP(1) F LRA=0:1 S LRP=$O(^LRE("B",LRP)) G:LRP=""!(LRP]LRP(2)) END F LRI=0:0 S LRI=$O(^LRE("B",LRP,LRI)) Q:'LRI S LRW=$O(^LRE(LRI,5,0)) I LRW>LRSDT S LRW=^(LRW,0) D W
|
|---|
| 5 | END D END^LRUTL,V^LRU Q
|
|---|
| 6 | ;
|
|---|
| 7 | W S X=^LRE(LRI,0) Q:$P(X,"^",10) Q:LRABO]""&($P(X,"^",5)'=LRABO) Q:LRRH]""&($P(X,"^",6)'=LRRH)
|
|---|
| 8 | S LRW(7)=$P(LRW,"^",7) I LR,LRW(7)'=LR,'$D(^LRE(LRI,2,LR)) Q
|
|---|
| 9 | S C=1 W $P(LRP,",",2)_" "_$P(LRP,",")
|
|---|
| 10 | I $D(^LRE(LRI,1)) S X=^(1) D A
|
|---|
| 11 | F B=C:1:LR(1) W !
|
|---|
| 12 | Q
|
|---|
| 13 | A F B=1:1:3 I $P(X,"^",B)]"" S C=C+1 W !,$P(X,"^",B)
|
|---|
| 14 | S C=C+1 W !,$P(X,"^",4) W:$P(X,"^",5) ", ",$P(^DIC(5,$P(X,"^",5),0),"^",2) W " ",$P(X,"^",6) Q
|
|---|
| 15 | EN ;
|
|---|
| 16 | AB R !,"ABO GROUP: ",X:DTIME I '$T!(X[U) K Y Q
|
|---|
| 17 | I X'=""&(X'="A")&(X'="B")&(X'="O")&(X'="AB") W $C(7),!!,"Enter A, O, B or AB" G AB
|
|---|
| 18 | S LRABO=X
|
|---|
| 19 | R R !,"Rh TYPE: ",X:DTIME I '$T!(X[U) K Y Q
|
|---|
| 20 | I X'=""&(X'="P")&(X'="N") W $C(7),!!,"Enter P for POS or N for NEG" G R
|
|---|
| 21 | S LRRH=$S(X="N":"NEG",X="P":"POS",1:"") Q
|
|---|
| 22 | EN1 ;RBC ANTIGENS ABSENT
|
|---|
| 23 | W !
|
|---|
| 24 | B S DIC="^LAB(61.3,",DIC(0)="AEQM",DIC("S")="I $P(^(0),U,5)=""AN""",DIC("A")="Select RBC ANTIGEN ABSENT: " D ^DIC K DIC I Y>0 S LRJ(+Y)=$P(Y,U,2) G B
|
|---|
| 25 | S (B,X)="" F A=0:0 S A=$O(LRJ(A)) Q:'A S B=B_LRJ(A)_", ",X=X+1
|
|---|
| 26 | S B=$E(B,1,$L(B)-2) I X>1 S B=$P(B,", ",1,X-1)_" and "_$P(B,", ",X)
|
|---|
| 27 | S LRF=B Q
|
|---|
