LRBLJX ;AVAMC/REG - UNITS ON XMATCH ;2/18/93 09:36 ;
;;5.2;LAB SERVICE;**247,267**;Sep 27, 1994
;Per VHA Directive 97-033 this routine should not be modified. Medical Device # BK970021
W !!?10,"Units on crossmatch by date/time crossmatched",!!
S ZTRTN="QUE^LRBLJX" D BEG^LRUTL G:POP!($D(ZTSK)) END
QUE U IO K ^TMP($J) D L^LRU,S^LRU
F A=0:0 S A=$O(^LRD(65,"AP",A)) Q:'A F B=0:0 S B=$O(^LRD(65,"AP",A,B)) Q:'B D A
D W W:IOST'?1"C".E @IOF K ^TMP($J) D END^LRUTL,END Q
T ;from LRBLJR
Q:'T I $E(T,1,3)>$E(DT,1,3) S T=$E(T,4,5)_"/"_$E(T,6,7)_"/"_$E(T,2,3) Q
S T=T_"000",T=$E(T,4,5)_"/"_$E(T,6,7)_$S(T[".":" "_$E(T,9,10)_":"_$E(T,11,12),1:"") Q
W D H S LR("F")=1 F A=0:0 S A=$O(^TMP($J,A)) Q:'A!(LR("Q")) S T=A D T S T(1)=T D I
Q
I S B=0 F C=0:0 S B=$O(^TMP($J,A,B)) Q:B=""!(LR("Q")) F E=0:0 S E=$O(^TMP($J,A,B,E)) Q:E=""!(LR("Q")) S W=^(E) D:$Y>(IOSL-6) H Q:LR("Q") D P
Q
P W !,T(1),?12 S T=$P(W,"^",6) D T W T,?24,$P(B,"""",2),?38,$J($P(W,"^",4),2),$P(W,"^",5),?42,$P(W,"^"),?47 S T=$P(W,"^",2) D T W T,?60,$P(^LAB(66,$P(W,"^",3),0),"^",2)
S X=^LR(E,0),Y=$P(X,"^",3),(LRDPF,X)=$P(X,"^",2),X=^DIC(X,0,"GL"),Y=@(X_Y_",0)") S SSN=$P(Y,"^",9) D SSN^LRU W ?66 W:IOM>80 $P(Y,"^"),?94,SSN W:IOM<81 $E($P(Y,"^"),1,10),SSN(1) Q
A S X=^LRD(65,B,0),M=$P(^LRD(65,B,2,A,0),"^",2),L=$O(^LRD(65,B,3,0)),L=$S(L:$E($P(^(L,0),"^",4),1,4),1:"BB"),X(8)=$P(X,"^",8),X(8)=$S(X(8)="POS":"+",X(8)="NEG":"-",1:"") I 'M K ^LRD(65,"AP",A,B) Q
S K=$O(^LRD(65,B,2,A,1,0)),K=$S('K:"",1:+^(K,0)),X(1)=""""_$P(X,"^")_""""
S ^TMP($J,M,X(1),A)=L_"^"_$P(X,"^",6)_"^"_$P(X,"^",4)_"^"_$P(X,"^",7)_"^"_X(8)_"^"_K
Q
H I $D(LR("F")),IOST?1"C".E D M^LRU Q:LR("Q")
D F^LRU W !,"Blood Bank "
W !,"XMATCHED",?13,"SPECIMEN",?46,"EXPIRES",!,"Mo/Da TIME",?12,"Mo/Da TIME",?24,"Unit ID",?37,"Type",?42,"Loc",?47,"Mo/Da TIME",?60,"Prod",?66,"Patient/SSN",!,LR("%") Q
;
END D V^LRU Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRBLJX 1881 printed Dec 13, 2024@02:11:36 Page 2
LRBLJX ;AVAMC/REG - UNITS ON XMATCH ;2/18/93 09:36 ;
+1 ;;5.2;LAB SERVICE;**247,267**;Sep 27, 1994
+2 ;Per VHA Directive 97-033 this routine should not be modified. Medical Device # BK970021
+3 WRITE !!?10,"Units on crossmatch by date/time crossmatched",!!
+4 SET ZTRTN="QUE^LRBLJX"
DO BEG^LRUTL
if POP!($DATA(ZTSK))
GOTO END
QUE USE IO
KILL ^TMP($JOB)
DO L^LRU
DO S^LRU
+1 FOR A=0:0
SET A=$ORDER(^LRD(65,"AP",A))
if 'A
QUIT
FOR B=0:0
SET B=$ORDER(^LRD(65,"AP",A,B))
if 'B
QUIT
DO A
+2 DO W
if IOST'?1"C".E
WRITE @IOF
KILL ^TMP($JOB)
DO END^LRUTL
DO END
QUIT
T ;from LRBLJR
+1 if 'T
QUIT
IF $EXTRACT(T,1,3)>$EXTRACT(DT,1,3)
SET T=$EXTRACT(T,4,5)_"/"_$EXTRACT(T,6,7)_"/"_$EXTRACT(T,2,3)
QUIT
+2 SET T=T_"000"
SET T=$EXTRACT(T,4,5)_"/"_$EXTRACT(T,6,7)_$SELECT(T[".":" "_$EXTRACT(T,9,10)_":"_$EXTRACT(T,11,12),1:"")
QUIT
W DO H
SET LR("F")=1
FOR A=0:0
SET A=$ORDER(^TMP($JOB,A))
if 'A!(LR("Q"))
QUIT
SET T=A
DO T
SET T(1)=T
DO I
+1 QUIT
I SET B=0
FOR C=0:0
SET B=$ORDER(^TMP($JOB,A,B))
if B=""!(LR("Q"))
QUIT
FOR E=0:0
SET E=$ORDER(^TMP($JOB,A,B,E))
if E=""!(LR("Q"))
QUIT
SET W=^(E)
if $Y>(IOSL-6)
DO H
if LR("Q")
QUIT
DO P
+1 QUIT
P WRITE !,T(1),?12
SET T=$PIECE(W,"^",6)
DO T
WRITE T,?24,$PIECE(B,"""",2),?38,$JUSTIFY($PIECE(W,"^",4),2),$PIECE(W,"^",5),?42,$PIECE(W,"^"),?47
SET T=$PIECE(W,"^",2)
DO T
WRITE T,?60,$PIECE(^LAB(66,$PIECE(W,"^",3),0),"^",2)
+1 SET X=^LR(E,0)
SET Y=$PIECE(X,"^",3)
SET (LRDPF,X)=$PIECE(X,"^",2)
SET X=^DIC(X,0,"GL")
SET Y=@(X_Y_",0)")
SET SSN=$PIECE(Y,"^",9)
DO SSN^LRU
WRITE ?66
if IOM>80
WRITE $PIECE(Y,"^"),?94,SSN
if IOM<81
WRITE $EXTRACT($PIECE(Y,"^"),1,10),SSN(1)
QUIT
A SET X=^LRD(65,B,0)
SET M=$PIECE(^LRD(65,B,2,A,0),"^",2)
SET L=$ORDER(^LRD(65,B,3,0))
SET L=$SELECT(L:$EXTRACT($PIECE(^(L,0),"^",4),1,4),1:"BB")
SET X(8)=$PIECE(X,"^",8)
SET X(8)=$SELECT(X(8)="POS":"+",X(8)="NEG":"-",1:"")
IF 'M
KILL ^LRD(65,"AP",A,B)
QUIT
+1 SET K=$ORDER(^LRD(65,B,2,A,1,0))
SET K=$SELECT('K:"",1:+^(K,0))
SET X(1)=""""_$PIECE(X,"^")_""""
+2 SET ^TMP($JOB,M,X(1),A)=L_"^"_$PIECE(X,"^",6)_"^"_$PIECE(X,"^",4)_"^"_$PIECE(X,"^",7)_"^"_X(8)_"^"_K
+3 QUIT
H IF $DATA(LR("F"))
IF IOST?1"C".E
DO M^LRU
if LR("Q")
QUIT
+1 DO F^LRU
WRITE !,"Blood Bank "
+2 WRITE !,"XMATCHED",?13,"SPECIMEN",?46,"EXPIRES",!,"Mo/Da TIME",?12,"Mo/Da TIME",?24,"Unit ID",?37,"Type",?42,"Loc",?47,"Mo/Da TIME",?60,"Prod",?66,"Patient/SSN",!,LR("%")
QUIT
+3 ;
END DO V^LRU
QUIT
