LRBLPB.m

LRBLPB ; IHS/DIR/FJE - PATIENT ANTIBODIES 2/18/93 09:40 ;

 ;;5.2;LR;;NOV 01, 1997

 ;

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

 D END S X="BLOOD BANK" D ^LRUTL G:Y=-1 END

 W !!?20,"Patient antibody list"

 S ZTRTN="QUE^LRBLPB" D BEG^LRUTL G:POP!($D(ZTSK)) END

QUE U IO K ^TMP($J) D L^LRU,S^LRU

 S A=0 F LRDFN=0:0 S LRDFN=$O(^LR(LRDFN)) Q:'LRDFN  I $D(^LR(LRDFN,"BB")) S X=^LR(LRDFN,0) D A

 S ^TMP($J,0)=A

 D END^LRUTL,END Q

A S A=A+1 Q:'$D(^LR(LRDFN,1.7))  S Y=$P(X,"^",3),Z=^DIC($P(X,"^",2),0,"GL"),Z=@(Z_Y_",0)"),Z(1)=$P(Z,"^")_" "_$P(Z,"^",9)

 F B=0:0 S B=$O(^LR(LRDFN,1.7,B)) Q:'B  S ^TMP($J,B,Z(1))="",^TMP($J,Z(1),B)=""

 Q

END D V^LRU Q

LRBLPB    ; IHS/DIR/FJE - PATIENT ANTIBODIES 2/18/93 09:40 ;

 +1       ;;5.2;LR;;NOV 01, 1997

 +2       ;

 +3       ;;5.2;LAB SERVICE;;Sep 27, 1994

 +4        DO END

           SET X="BLOOD BANK"

           DO ^LRUTL

           IF Y=-1

               GOTO END

 +5        WRITE !!?20,"Patient antibody list"

 +6        SET ZTRTN="QUE^LRBLPB"

           DO BEG^LRUTL

           IF POP!($DATA(ZTSK))

               GOTO END

QUE        USE IO

           KILL ^TMP($JOB)

           DO L^LRU

           DO S^LRU

 +1        SET A=0

           FOR LRDFN=0:0

               SET LRDFN=$ORDER(^LR(LRDFN))

               IF 'LRDFN

                   QUIT 

               IF $DATA(^LR(LRDFN,"BB"))

                   SET X=^LR(LRDFN,0)

                   DO A

 +2        SET ^TMP($JOB,0)=A

 +3        DO END^LRUTL

           DO END

           QUIT 

A          SET A=A+1

           IF '$DATA(^LR(LRDFN,1.7))

               QUIT 

           SET Y=$PIECE(X,"^",3)

           SET Z=^DIC($PIECE(X,"^",2),0,"GL")

           SET Z=@(Z_Y_",0)")

           SET Z(1)=$PIECE(Z,"^")_" "_$PIECE(Z,"^",9)

 +1        FOR B=0:0

               SET B=$ORDER(^LR(LRDFN,1.7,B))

               IF 'B

                   QUIT 

               SET ^TMP($JOB,B,Z(1))=""

               SET ^TMP($JOB,Z(1),B)=""

 +2        QUIT 

END        DO V^LRU

           QUIT