| 1 | LRUG ;AVAMC/REG/CYM - GET LRDFN ;9/3/97 09:18 ;
|
|---|
| 2 | ;;5.2;LAB SERVICE;**90**;Sep 27, 1994
|
|---|
| 3 | S LRA=X I $D(LRT),LRT="A" D AUTO Q:'$D(X)
|
|---|
| 4 | N LRSAVE S LRSAVE=$G(DIC),LRSAVE(0)=$G(DIC(0)),LRSAVE("W")=$G(DIC("W"))
|
|---|
| 5 | K DIC S DIC(0)="EMZ",X=LRA W !!,"PATIENT: " D EN1^LRDPA K DIC,LRA I LRDFN>0 S A=^LR(LRDFN,0),B=^DIC($P(A,"^",2),0,"GL"),A=$P(A,"^",3),A=@(B_A_",0)"),LRD(1)=$P(A,"^",3),LRP(1)=$P(A,"^") W !,LRP(1)
|
|---|
| 6 | S DIC=LRSAVE,DIC(0)=LRSAVE(0),DIC("W")=LRSAVE("W")
|
|---|
| 7 | S LRA="" I LRDFN<1 K X Q
|
|---|
| 8 | I $D(LRT),LRT="A" D CK Q:'$D(X)
|
|---|
| 9 | S X=LRDFN Q
|
|---|
| 10 | CK I LRP(0)'=LRP(1) W $C(7),!!,LRP(0)," does not equal ",LRP(1)," " K X Q
|
|---|
| 11 | I LRD'=LRD(1) W $C(7),!!,"Dates of birth are different" K X Q
|
|---|
| 12 | Q
|
|---|
| 13 | AUTO ;Check for autologous donor in patient file
|
|---|
| 14 | Q:X["?" W !!,"Donor:",LRP," DOB:",LRB W:LRS(2)]"" " SSN:",LRS(2)
|
|---|
| 15 | I '$D(^DPT("B",LRP(0))) W $C(7),!,LRP(0)," not entered in PATIENT FILE" K X
|
|---|
| 16 | Q
|
|---|
