- 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
