LRBLPAB ;AVAMC/REG - ANTIBODIES IDENTIFIED ;2/18/93 09:37 ;
;;5.2;LAB SERVICE;**247**;Sep 27, 1994
;Per VHA Directive 97-033 this routine should not be modified. Medical Device # BK970021
W !!?20,"PATIENT ANTIBODIES IDENTIFIED"
I DUZ(0)'["@"&(DUZ(0)'["l") W $C(7),!,"You do not have the proper access to proceed." G END
S ZTRTN="QUE^LRBLPAB" D BEG^LRUTL G:POP!($D(ZTSK)) END
QUE U IO K ^TMP($J)
D L^LRU,S^LRU
S (LRW,LRC)=0 D H
S LRX=0 F LRD=0:0 S LRX=$O(^DPT("B",LRX)) Q:LRX="" D
. F LRY=0:0 S LRY=$O(^DPT("B",LRX,LRY)) Q:'LRY D
.. S LRDFN=$$LRDFN^LR7OR1(LRY)
.. I LRDFN S LRC=LRC+1 I $O(^LR(LRDFN,1.7,0)) D W
D:$Y>(IOSL-6) H W !,"Patients in lab data file: ",$J(LRC,6),!,"Patients with antibodies: ",$J(LRW,6)
F LRA=0:0 S LRA=$O(^TMP($J,LRA)) Q:'LRA D
. S LRA(1)=^TMP($J,LRA)
. D:$Y>(IOSL-6) H
. W !,$P(^LAB(61.3,LRA,0),"^")," = ",LRA(1)
D END^LRUTL,END
Q
W S LRW=LRW+1,X=^LR(LRDFN,0),Y=$P(X,"^",3),(LRDPF,X)=$P(X,"^",2),X=^DIC(X,0,"GL"),X=@(X_Y_",0)"),LRP=$P(X,"^"),SSN=$P(X,"^",9)
D:$Y>(IOSL-6) H
W !!,LRP,?35,"ID:",SSN
F LRA=0:0 S LRA=$O(^LR(LRDFN,1.7,LRA)) Q:'LRA D
. S:'$D(^TMP($J,LRA)) ^(LRA)=0
. S ^TMP($J,LRA)=^(LRA)+1
. D:$Y>(IOSL-6) H1
. W !?3,$P(^LAB(61.3,LRA,0),"^")
Q
H S LRQ=LRQ+1,%DT="T",X="N"
D ^%DT,D^LRU
W @IOF,Y," BLOOD BANK ",LRQ(1),?(IOM-10),"Pg: ",LRQ,!,LR("%")
Q
H1 D H
W !,LRP,?35,"ID:",SSN,?50,"(continued from pg:",LRQ-1,")"
Q
END D V^LRU Q
;LRW=count of pts with antibodies
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRBLPAB 1479 printed Dec 13, 2024@02:11:39 Page 2
LRBLPAB ;AVAMC/REG - ANTIBODIES IDENTIFIED ;2/18/93 09:37 ;
+1 ;;5.2;LAB SERVICE;**247**;Sep 27, 1994
+2 ;Per VHA Directive 97-033 this routine should not be modified. Medical Device # BK970021
+3 WRITE !!?20,"PATIENT ANTIBODIES IDENTIFIED"
+4 IF DUZ(0)'["@"&(DUZ(0)'["l")
WRITE $CHAR(7),!,"You do not have the proper access to proceed."
GOTO END
+5 SET ZTRTN="QUE^LRBLPAB"
DO BEG^LRUTL
if POP!($DATA(ZTSK))
GOTO END
QUE USE IO
KILL ^TMP($JOB)
+1 DO L^LRU
DO S^LRU
+2 SET (LRW,LRC)=0
DO H
+3 SET LRX=0
FOR LRD=0:0
SET LRX=$ORDER(^DPT("B",LRX))
if LRX=""
QUIT
Begin DoDot:1
+4 FOR LRY=0:0
SET LRY=$ORDER(^DPT("B",LRX,LRY))
if 'LRY
QUIT
Begin DoDot:2
+5 SET LRDFN=$$LRDFN^LR7OR1(LRY)
+6 IF LRDFN
SET LRC=LRC+1
IF $ORDER(^LR(LRDFN,1.7,0))
DO W
End DoDot:2
End DoDot:1
+7 if $Y>(IOSL-6)
DO H
WRITE !,"Patients in lab data file: ",$JUSTIFY(LRC,6),!,"Patients with antibodies: ",$JUSTIFY(LRW,6)
+8 FOR LRA=0:0
SET LRA=$ORDER(^TMP($JOB,LRA))
if 'LRA
QUIT
Begin DoDot:1
+9 SET LRA(1)=^TMP($JOB,LRA)
+10 if $Y>(IOSL-6)
DO H
+11 WRITE !,$PIECE(^LAB(61.3,LRA,0),"^")," = ",LRA(1)
End DoDot:1
+12 DO END^LRUTL
DO END
+13 QUIT
W SET LRW=LRW+1
SET X=^LR(LRDFN,0)
SET Y=$PIECE(X,"^",3)
SET (LRDPF,X)=$PIECE(X,"^",2)
SET X=^DIC(X,0,"GL")
SET X=@(X_Y_",0)")
SET LRP=$PIECE(X,"^")
SET SSN=$PIECE(X,"^",9)
+1 if $Y>(IOSL-6)
DO H
+2 WRITE !!,LRP,?35,"ID:",SSN
+3 FOR LRA=0:0
SET LRA=$ORDER(^LR(LRDFN,1.7,LRA))
if 'LRA
QUIT
Begin DoDot:1
+4 if '$DATA(^TMP($JOB,LRA))
SET ^(LRA)=0
+5 SET ^TMP($JOB,LRA)=^(LRA)+1
+6 if $Y>(IOSL-6)
DO H1
+7 WRITE !?3,$PIECE(^LAB(61.3,LRA,0),"^")
End DoDot:1
+8 QUIT
H SET LRQ=LRQ+1
SET %DT="T"
SET X="N"
+1 DO ^%DT
DO D^LRU
+2 WRITE @IOF,Y," BLOOD BANK ",LRQ(1),?(IOM-10),"Pg: ",LRQ,!,LR("%")
+3 QUIT
H1 DO H
+1 WRITE !,LRP,?35,"ID:",SSN,?50,"(continued from pg:",LRQ-1,")"
+2 QUIT
END DO V^LRU
QUIT
+1 ;LRW=count of pts with antibodies
