LRBLJX ; IHS/DIR/FJE - UNITS ON XMATCH 2/18/93 09:36 ;
;;5.2;LR;;NOV 01, 1997
;
;;5.2;LAB SERVICE;;Sep 27, 1994
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),?36,$J($P(W,"^",4),2),$P(W,"^",5),?40,$P(W,"^"),?45 S T=$P(W,"^",2) D T W T,?57,$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 ?63 W:IOM>80 $P(Y,"^"),?94,SSN W:IOM<81 $E($P(Y,"^"),1,12),SSN(1) Q
S X=^LR(E,0),(DFN,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 ?62 W:IOM>80 $P(Y,"^"),?94,HRCN W:IOM<81 $E($P(Y,"^"),1,10),$J(HRCN,8) Q ;IHS/ANMC/CLS 11/1/95
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",?35,"Type",?40,"Loc",?45,"Mo/Da TIME",?57,"Prod",?63,"Patient/SSN",!,LR("%") Q
W !,"XMATCHED",?13,"SPECIMEN",?46,"EXPIRES",!,"Mo/Da TIME",?12,"Mo/Da TIME",?24,"Unit ID",?35,"Type",?40,"Loc",?45,"Mo/Da TIME",?57,"Prod",?63,"Patient/HRCN",!,LR("%") Q ;IHS/ANMC/CLS 11/1/95
;
END D V^LRU Q
LRBLJX ; IHS/DIR/FJE - UNITS ON XMATCH 2/18/93 09:36 ;
+1 ;;5.2;LR;;NOV 01, 1997
+2 ;
+3 ;;5.2;LAB SERVICE;;Sep 27, 1994
+4 WRITE !!?10,"Units on crossmatch by date/time crossmatched",!!
+5 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),?36,$JUSTIFY($PIECE(W,"^",4),2),$PIECE(W,"^",5),?40,$PIECE(W,"^"),?45
SET T=$PIECE(W,"^",2)
DO T
WRITE T,?57,$PIECE(^LAB(66,$PIECE(W,"^",3),0),"^",2)
+1 ;S X=^LR(E,0),Y=$P">P">P">P">P">P">P">P">P">P">P">P">P">P">P">P(X,"^",3),(LRDP">P">P">P">P">P">P">P">P">P">P">P">P">P">P">PF,X)=$P">P">P">P">P">P">P">P">P">P">P">P">P">P">P">P(X,"^",2),X=^DIC(X,0,"GL"),Y=@(X_Y_",0)") S SSN=$P">P">P">P">P">P">P">P">P">P">P">P">P">P">P">P(Y,"^",9) D SSN^LRU W ?63 W:IOM>80 $P">P">P">P">P">P">P">P">P">P">P">P">P">P">P">P(Y,"^"),?94,SSN W:IOM<81 $E($P">P">P">P">P">P">P">P">P">P">P">P">P">P">P">P(Y,"^"),1,12),SSN(1) Q
+2 ;IHS/ANMC/CLS 11/1/95
SET X=^LR(E,0)
SET (DFN,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 ?62
IF IOM>80
WRITE $PIECE(Y,"^"),?94,HRCN
IF IOM<81
WRITE $EXTRACT($PIECE(Y,"^"),1,10),$JUSTIFY(HRCN,8)
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 ;W !,"XMATCHED",?13,"SPECIMEN",?46,"EXPIRES",!,"Mo/Da TIME",?12,"Mo/Da TIME",?24,"Unit ID",?35,"Type",?40,"Loc",?45,"Mo/Da TIME",?57,"Prod",?63,"Patient/SSN",!,LR("%") Q
+3 ;IHS/ANMC/CLS 11/1/95
WRITE !,"XMATCHED",?13,"SPECIMEN",?46,"EXPIRES",!,"Mo/Da TIME",?12,"Mo/Da TIME",?24,"Unit ID",?35,"Type",?40,"Loc",?45,"Mo/Da TIME",?57,"Prod",?63,"Patient/HRCN",!,LR("%")
QUIT
+4 ;
END DO V^LRU
QUIT
