source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRUG.m@ 1604

Last change on this file since 1604 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 861 bytes
Line 
1LRUG ;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
10CK 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
13AUTO ;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
Note: See TracBrowser for help on using the repository browser.