source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LRBLJDP.m

Last change on this file was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.8 KB
Line 
1LRBLJDP ;AVAMC/REG - PRINT UNIT DISPOSITION ;10/11/95 07:47 ;
2 ;;5.2;LAB SERVICE;**72,247**;Sep 27, 1994
3 ;Per VHA Directive 97-033 this routine should not be modified. Medical Device # BK970021
4 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)
5 K LR("T")
6ASK R !!,"Select DISPOSITION: ",X:DTIME G:X=""!(X[U) END I '$D(LR(X)) D SEL G ASK
7 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)
8 S ZTRTN="QUE^LRBLJDP" D BEG^LRUTL G:POP!($D(ZTSK)) END
9QUE U IO K ^TMP($J) D L^LRU,S^LRU,H S LR("F")=1
10 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
11 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
12 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)
13 D END^LRUTL,END Q
14T 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
15 Q
16W 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)
17 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)
18 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
19 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
20 Q
21A 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
22S I '$D(^LRD(65,LRI,4)) K ^LRD(65,"AB",LRO,LRI) Q
23 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
24HDR I $D(LR("F")),IOST?1"C".E D M^LRU Q:LR("Q")
25 D F^LRU W !,"BLOOD BANK ",LRAA(4)
26 W !,"UNIT DISPOSITION: ",LRD(1)," (from ",LRSTR," to ",LRLST,")" Q
27H 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")
28 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
29H1 D H Q:LR("Q") W !,"COMPONENT: ",LRC(1),! Q
30H2 D H1 Q:LR("Q") W !,LRA,?15,LRY," (Continued from pg ",LRQ-1,")",! Q
31 ;
32SEL 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)
33 Q
34 ;
35END D V^LRU Q
Note: See TracBrowser for help on using the repository browser.