- LRBLJDP ; IHS/DIR/AAB - PRINT UNIT DISPOSITION 10/11/95 07:47 ;
- ;;5.2;LR;**1002**;JUN 01, 1998
- ;;5.2;LAB SERVICE;**72**;Sep 27, 1994
- D END S X="BLOOD BANK" D ^LRUTL G:Y=-1 END K LR S X=$P(^DD(65,4.1,0),U,3) F Y=1:1 S Z=$P(X,";",Y) Q:Z="" S LR($P(Z,":"))=$P(Z,":",2)
- K LR("T")
- ASK R !!,"Select DISPOSITION: ",X:DTIME G:X=""!(X[U) END I '$D(LR(X)) D SEL G ASK
- W " ",LR(X) S LRD=X,LRD(1)=LR(X) D B^LRBLU G:Y<0 END S LRSDT=LRSDT-.0001,LRLDT=$S(LRLDT'[".":LRLDT+.99,1:LRLDT)
- S ZTRTN="QUE^LRBLJDP" D BEG^LRUTL G:POP!($D(ZTSK)) END
- QUE U IO K ^TMP($J) D L^LRU,S^LRU,H S LR("F")=1
- S LRO=LRSDT F A=0:0 S LRO=$O(^LRD(65,"AB",LRO)) Q:'LRO!(LRO>LRLDT) F LRI=0:0 S LRI=$O(^LRD(65,"AB",LRO,LRI)) Q:'LRI D S
- F LRC=0:0 S LRC=$O(^TMP($J,LRC)) Q:'LRC!(LR("Q")) S LRC(1)=$P(^LAB(66,LRC,0),"^") D:$Y>(IOSL-6) H Q:LR("Q") W !!,LRC(1) D T
- I LRD="MO" D:$Y>(IOSL-6) HDR Q:LR("Q") W !!,"Units modified to:",?41,"Count:" F LRL=0:0 S LRL=$O(LRM(LRL)) Q:'LRL D:$Y>(IOSL-6) HDR Q:LR("Q") W !,$P(^LAB(66,LRL,0),"^"),?41,$J(LRM(LRL),5)
- D END^LRUTL,END Q
- T F LRO=0:0 S LRO=$O(^TMP($J,LRC,LRO)) Q:'LRO!(LR("Q")) S Y=LRO D DT^LRU S LRY=Y,LRA=0 F LRB=0:0 S LRA=$O(^TMP($J,LRC,LRO,LRA)) Q:LRA=""!(LR("Q")) S LRI=^(LRA),LRE=^LRD(65,LRI,0) D W
- Q
- W D:$Y>(IOSL-6) H1 Q:LR("Q") W !,LRA,?15,LRY W:LRD'="MO"&(LRD'="S")&(LRD'="R") ?30,$P(LRE,"^",2) W:LRD="S"!(LRD="R") ?30,$E($P(^LRD(65,LRI,4),"^",5),1,30)
- I LRD'="MO" S Y=$P(LRE,"^",5),R=$P(LRE,"^",8) D DT^LRU W ?61,$J($P(LRE,"^",7),2),$S(R="POS":"+",R="NEG":"-",1:"") W:LRD'="S"&(LRD'="R") ?65,Y W:LRD="S"!(LRD="R") ?69,$P(LRE,"^",13)
- I LRD="MO" S LRL=0 F LRG=0:1 S LRL=$O(^LRD(65,LRI,9,LRL)) Q:'LRL!(LR("Q")) S LRF=^(LRL,0),LRM=+LRF D:$Y>(IOSL-6) H2 Q:LR("Q") D A
- Q:LR("Q") F LRL=0:0 S LRL=$O(^LRD(65,LRI,5,LRL)) Q:'LRL!(LR("Q")) S LRF=^(LRL,0) D:$Y>(IOSL-6) H2 Q:LR("Q") W !?3,LRF
- Q
- A W:LRG ! W ?30,$E($P(^LAB(66,LRM,0),"^"),1,36),?67,$P(LRF,"^",2) S:'$D(LRM(LRM)) LRM(LRM)=0 S LRM(LRM)=LRM(LRM)+1 Q
- S I '$D(^LRD(65,LRI,4)) K ^LRD(65,"AB",LRO,LRI) Q
- Q:$P(^LRD(65,LRI,4),"^")'=LRD S Y=^LRD(65,LRI,0) S:$P(Y,"^",16)=DUZ(2) ^TMP($J,$P(Y,"^",4),LRO,$P(Y,"^"))=LRI Q
- HDR I $D(LR("F")),IOST?1"C".E D M^LRU Q:LR("Q")
- D F^LRU W !,"BLOOD BANK ",LRAA(4)
- W !,"UNIT DISPOSITION: ",LRD(1)," (from ",LRSTR," to ",LRLST,")" Q
- H D HDR Q:LR("Q") W !,"UNIT ID",?15,"DISP DATE",?30,$S(LRD="MO":"MODIFY TO",LRD="S"!(LRD="R"):"SHIPPED TO",1:"SOURCE")
- W:LRD'="MO" ?58,"ABO/Rh" W:LRD'="S"&(LRD'="R")&(LRD'="MO") ?65,"DATE RECEIVED" W:LRD="MO" ?67,"UNIT ID" W:LRD="S"!(LRD="R") ?69,"INVOICE" W !,LR("%") Q
- H1 D H Q:LR("Q") W !,"COMPONENT: ",LRC(1),! Q
- H2 D H1 Q:LR("Q") W !,LRA,?15,LRY," (Continued from pg ",LRQ-1,")",! Q
- ;
- SEL W !!,"Select from:" S X=0 F A=0:0 S X=$O(LR(X)) Q:X="" W !?3,X,?6,"for",?10,LR(X)
- Q
- ;
- END D V^LRU Q
- LRBLJDP ; IHS/DIR/AAB - PRINT UNIT DISPOSITION 10/11/95 07:47 ;
- +1 ;;5.2;LR;**1002**;JUN 01, 1998
- +2 ;;5.2;LAB SERVICE;**72**;Sep 27, 1994
- +3 DO END
- SET X="BLOOD BANK"
- DO ^LRUTL
- IF Y=-1
- GOTO END
- KILL LR
- SET X=$PIECE(^DD(65,4.1,0),U,3)
- FOR Y=1:1
- SET Z=$PIECE(X,";",Y)
- IF Z=""
- QUIT
- SET LR($PIECE(Z,":"))=$PIECE(Z,":",2)
- +4 KILL LR("T")
- ASK READ !!,"Select DISPOSITION: ",X:DTIME
- IF X=""!(X[U)
- GOTO END
- IF '$DATA(LR(X))
- DO SEL
- GOTO ASK
- +1 WRITE " ",LR(X)
- SET LRD=X
- SET LRD(1)=LR(X)
- DO B^LRBLU
- IF Y<0
- GOTO END
- SET LRSDT=LRSDT-.0001
- SET LRLDT=$SELECT(LRLDT'[".":LRLDT+.99,1:LRLDT)
- +2 SET ZTRTN="QUE^LRBLJDP"
- DO BEG^LRUTL
- IF POP!($DATA(ZTSK))
- GOTO END
- QUE USE IO
- KILL ^TMP($JOB)
- DO L^LRU
- DO S^LRU
- DO H
- SET LR("F")=1
- +1 SET LRO=LRSDT
- FOR A=0:0
- SET LRO=$ORDER(^LRD(65,"AB",LRO))
- IF 'LRO!(LRO>LRLDT)
- QUIT
- FOR LRI=0:0
- SET LRI=$ORDER(^LRD(65,"AB",LRO,LRI))
- IF 'LRI
- QUIT
- DO S
- +2 FOR LRC=0:0
- SET LRC=$ORDER(^TMP($JOB,LRC))
- IF 'LRC!(LR("Q"))
- QUIT
- SET LRC(1)=$PIECE(^LAB(66,LRC,0),"^")
- IF $Y>(IOSL-6)
- DO H
- IF LR("Q")
- QUIT
- WRITE !!,LRC(1)
- DO T
- +3 IF LRD="MO"
- IF $Y>(IOSL-6)
- DO HDR
- IF LR("Q")
- QUIT
- WRITE !!,"Units modified to:",?41,"Count:"
- FOR LRL=0:0
- SET LRL=$ORDER(LRM(LRL))
- IF 'LRL
- QUIT
- IF $Y>(IOSL-6)
- DO HDR
- IF LR("Q")
- QUIT
- WRITE !,$PIECE(^LAB(66,LRL,0),"^"),?41,$JUSTIFY(LRM(LRL),5)
- +4 DO END^LRUTL
- DO END
- QUIT
- T FOR LRO=0:0
- SET LRO=$ORDER(^TMP($JOB,LRC,LRO))
- IF 'LRO!(LR("Q"))
- QUIT
- SET Y=LRO
- DO DT^LRU
- SET LRY=Y
- SET LRA=0
- FOR LRB=0:0
- SET LRA=$ORDER(^TMP($JOB,LRC,LRO,LRA))
- IF LRA=""!(LR("Q"))
- QUIT
- SET LRI=^(LRA)
- SET LRE=^LRD(65,LRI,0)
- DO W
- +1 QUIT
- W IF $Y>(IOSL-6)
- DO H1
- IF LR("Q")
- QUIT
- WRITE !,LRA,?15,LRY
- IF LRD'="MO"&(LRD'="S")&(LRD'="R")
- WRITE ?30,$PIECE(LRE,"^",2)
- IF LRD="S"!(LRD="R")
- WRITE ?30,$EXTRACT($PIECE(^LRD(65,LRI,4),"^",5),1,30)
- +1 IF LRD'="MO"
- SET Y=$PIECE(LRE,"^",5)
- SET R=$PIECE(LRE,"^",8)
- DO DT^LRU
- WRITE ?61,$JUSTIFY($PIECE(LRE,"^",7),2),$SELECT(R="POS":"+",R="NEG":"-",1:"")
- IF LRD'="S"&(LRD'="R")
- WRITE ?65,Y
- IF LRD="S"!(LRD="R")
- WRITE ?69,$PIECE(LRE,"^",13)
- +2 IF LRD="MO"
- SET LRL=0
- FOR LRG=0:1
- SET LRL=$ORDER(^LRD(65,LRI,9,LRL))
- IF 'LRL!(LR("Q"))
- QUIT
- SET LRF=^(LRL,0)
- SET LRM=+LRF
- IF $Y>(IOSL-6)
- DO H2
- IF LR("Q")
- QUIT
- DO A
- +3 IF LR("Q")
- QUIT
- FOR LRL=0:0
- SET LRL=$ORDER(^LRD(65,LRI,5,LRL))
- IF 'LRL!(LR("Q"))
- QUIT
- SET LRF=^(LRL,0)
- IF $Y>(IOSL-6)
- DO H2
- IF LR("Q")
- QUIT
- WRITE !?3,LRF
- +4 QUIT
- A IF LRG
- WRITE !
- WRITE ?30,$EXTRACT($PIECE(^LAB(66,LRM,0),"^"),1,36),?67,$PIECE(LRF,"^",2)
- IF '$DATA(LRM(LRM))
- SET LRM(LRM)=0
- SET LRM(LRM)=LRM(LRM)+1
- QUIT
- S IF '$DATA(^LRD(65,LRI,4))
- KILL ^LRD(65,"AB",LRO,LRI)
- QUIT
- +1 IF $PIECE(^LRD(65,LRI,4),"^")'=LRD
- QUIT
- SET Y=^LRD(65,LRI,0)
- IF $PIECE(Y,"^",16)=DUZ(2)
- SET ^TMP($JOB,$PIECE(Y,"^",4),LRO,$PIECE(Y,"^"))=LRI
- QUIT
- HDR IF $DATA(LR("F"))
- IF IOST?1"C".E
- DO M^LRU
- IF LR("Q")
- QUIT
- +1 DO F^LRU
- WRITE !,"BLOOD BANK ",LRAA(4)
- +2 WRITE !,"UNIT DISPOSITION: ",LRD(1)," (from ",LRSTR," to ",LRLST,")"
- QUIT
- H DO HDR
- IF LR("Q")
- QUIT
- WRITE !,"UNIT ID",?15,"DISP DATE",?30,$SELECT(LRD="MO":"MODIFY TO",LRD="S"!(LRD="R"):"SHIPPED TO",1:"SOURCE")
- +1 IF LRD'="MO"
- WRITE ?58,"ABO/Rh"
- IF LRD'="S"&(LRD'="R")&(LRD'="MO")
- WRITE ?65,"DATE RECEIVED"
- IF LRD="MO"
- WRITE ?67,"UNIT ID"
- IF LRD="S"!(LRD="R")
- WRITE ?69,"INVOICE"
- WRITE !,LR("%")
- QUIT
- H1 DO H
- IF LR("Q")
- QUIT
- WRITE !,"COMPONENT: ",LRC(1),!
- QUIT
- H2 DO H1
- IF LR("Q")
- QUIT
- WRITE !,LRA,?15,LRY," (Continued from pg ",LRQ-1,")",!
- QUIT
- +1 ;
- SEL WRITE !!,"Select from:"
- SET X=0
- FOR A=0:0
- SET X=$ORDER(LR(X))
- IF X=""
- QUIT
- WRITE !?3,X,?6,"for",?10,LR(X)
- +1 QUIT
- +2 ;
- END DO V^LRU
- QUIT
