LRUG.m

LRUG ; IHS/DIR/AAB - GET LRDFN 9/3/97 09:18 ;  [ 07/22/2002  1:55 PM ]

 ;;5.2;LR;**1003,1013**;JUL 15, 2002

 ;;5.2;LAB SERVICE;**90**;Sep 27, 1994

 S LRA=X I $D(LRT),LRT="A" D AUTO Q:'$D(X)

 N LRSAVE S LRSAVE=$G(DIC),LRSAVE(0)=$G(DIC(0)),LRSAVE("W")=$G(DIC("W"))

 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)

 S DIC=LRSAVE,DIC(0)=LRSAVE(0),DIC("W")=LRSAVE("W")

 S LRA="" I LRDFN<1 K X Q

 I $D(LRT),LRT="A" D CK Q:'$D(X)

 S X=LRDFN Q

CK I LRP(0)'=LRP(1) W $C(7),!!,LRP(0)," does not equal ",LRP(1)," " K X Q

 I LRD'=LRD(1) W $C(7),!!,"Dates of birth are different" K X Q

 Q

AUTO ;Check for autologous donor in patient file

 Q:X["?"  W !!,"Donor:",LRP," DOB:",LRB W:LRS(2)]"" " SSN:",LRS(2)

 I '$D(^DPT("B",LRP(0))) W $C(7),!,LRP(0)," not entered in PATIENT FILE" K X

 Q

LRUG      ; IHS/DIR/AAB - GET LRDFN 9/3/97 09:18 ;  [ 07/22/2002  1:55 PM ]

 +1       ;;5.2;LR;**1003,1013**;JUL 15, 2002

 +2       ;;5.2;LAB SERVICE;**90**;Sep 27, 1994

 +3        SET LRA=X

           IF $DATA(LRT)

               IF LRT="A"

                   DO AUTO

                   IF '$DATA(X)

                       QUIT 

 +4        NEW LRSAVE

           SET LRSAVE=$GET(DIC)

           SET LRSAVE(0)=$GET(DIC(0))

           SET LRSAVE("W")=$GET(DIC("W"))

 +5        KILL DIC

           SET DIC(0)="EMZ"

           SET X=LRA

           WRITE !!,"PATIENT: "

           DO EN1^LRDPA

           KILL DIC,LRA

           IF LRDFN>0

               SET A=^LR(LRDFN,0)

               SET B=^DIC($PIECE(A,"^",2),0,"GL")

               SET A=$PIECE(A,"^",3)

               SET A=@(B_A_",0)")

               SET LRD(1)=$PIECE(A,"^",3)

               SET LRP(1)=$PIECE(A,"^")

               WRITE !,LRP(1)

 +6        SET DIC=LRSAVE

           SET DIC(0)=LRSAVE(0)

           SET DIC("W")=LRSAVE("W")

 +7        SET LRA=""

           IF LRDFN<1

               KILL X

               QUIT 

 +8        IF $DATA(LRT)

               IF LRT="A"

                   DO CK

                   IF '$DATA(X)

                       QUIT 

 +9        SET X=LRDFN

           QUIT 

CK         IF LRP(0)'=LRP(1)

               WRITE $CHAR(7),!!,LRP(0)," does not equal ",LRP(1)," "

               KILL X

               QUIT 

 +1        IF LRD'=LRD(1)

               WRITE $CHAR(7),!!,"Dates of birth are different"

               KILL X

               QUIT 

 +2        QUIT 

AUTO      ;Check for autologous donor in patient file

 +1        IF X["?"

               QUIT 

           WRITE !!,"Donor:",LRP," DOB:",LRB

           IF LRS(2)]""

               WRITE " SSN:",LRS(2)

 +2        IF '$DATA(^DPT("B",LRP(0)))

               WRITE $CHAR(7),!,LRP(0)," not entered in PATIENT FILE"

               KILL X

 +3        QUIT