| 1 | LR7OSBB1 ;slc/dcm - BB PT INFO for OE/RR pt lists ;8/11/97
|
|---|
| 2 | ;;5.2;LAB SERVICE;**121,230**;Sep 27, 1994
|
|---|
| 3 | ;Formerly known as LRBLPD1 which came from LRBLPD
|
|---|
| 4 | OERR ;
|
|---|
| 5 | N LRDFN
|
|---|
| 6 | S LRDFN=$$LRDFN^LR7OR1(DFN)
|
|---|
| 7 | I 'LRDFN W !,"No Lab Data for: "_$P(^DPT(DFN,0),"^") Q
|
|---|
| 8 | S LRDPF="2^DPT(",LRQ=1
|
|---|
| 9 | D INI
|
|---|
| 10 | S DIWL=5,DIWR=IOM-5,DIWF="W",C(1.7)="RBC Antibody present:",C(1)="RBC Antigen present :",C(1.5)="RBC Antigen absent :"
|
|---|
| 11 | D S^LRU I $A(IOST)=80 S A(1)=0 D L^LRU,H
|
|---|
| 12 | I $A(IOST)'=80 W @IOF,!,LRP," ",SSN,?46,$J(LRPABO,2),?49,LRPRH S A(1)=$Y+(IOSL-3)
|
|---|
| 13 | D S F B=0:1 S A=$O(^LR(LRDFN,3,A)) Q:'A S X=^(A,0) D:$Y>A(1)!'$Y MORE Q:A(2)?1P D ^DIWP
|
|---|
| 14 | D:B ^DIWW D S F C=1.7,1,1.5 Q:A(2)?1P W ! S A=0 F B=0:1 S A=$O(^LR(LRDFN,C,A)) Q:'A!(A(2)?1P) W:'B C(C) W:B ! W ?21,$P(^LAB(61.3,A,0),"^") D:$Y>A(1)!'$Y MORE Q:A(2)?1P
|
|---|
| 15 | D S F B=1:1 S A=$O(^LR(LRDFN,1.6,A)) Q:'A!(A(2)?1P) S X=^LR(LRDFN,1.6,A,0),Y=+X D D^LRU,N Q:A(2)?1P D:$Y>A(1)!'$Y MORE Q:A(2)?1P
|
|---|
| 16 | I B=1,A(2)'?1P W !,"No transfused units on record",!
|
|---|
| 17 | Q
|
|---|
| 18 | ;
|
|---|
| 19 | N W:B=1 !!?34,"TRANSFUSIONS",?64,"Transfusion",!?6,"Unit",?18,"Component",?36,"(# of units/ml )",?60,"Date/time completed"
|
|---|
| 20 | S X(1)=$P(X,"^",2),X(7)=$P(X,"^",7),X(10)=$P(X,"^",10),M=$S(X(1):$E($P(^LAB(66,X(1),0),"^"),1,30),1:"component not entered")
|
|---|
| 21 | W !,$J(B,3),")",?6,$P(X,"^",3),?18,$E($P(M,"^"),1,30) I X(7)!(X(10)) W ?45,"(",X(7),"/",X(10),")"
|
|---|
| 22 | W ?54,$P(X,"^",5)_" "_$P(X,"^",6),?60,Y
|
|---|
| 23 | F F=1,2 F E=0:0 S E=$O(^LR(LRDFN,1.6,A,F,E)) Q:'E!(A(2)?1P) W !?6,^(E,0) D:$Y>A(1)!'$Y MORE Q:A(2)?1P
|
|---|
| 24 | Q
|
|---|
| 25 | ;
|
|---|
| 26 | MORE G:$A(IOST)=80 H R !,"^ TO STOP: ",A(2):DTIME I A(2)?1P S A=0 Q
|
|---|
| 27 | S A(1)=A(1)+21 W $C(13),$J("",15),$C(13) Q
|
|---|
| 28 | S S (A,A(2))=0 Q
|
|---|
| 29 | ;
|
|---|
| 30 | H S LRQ=LRQ+1,X="N",%DT="T" D ^%DT,D^LRU W @IOF,!,Y,?22,LRQ(1),?(IOM-10),"Pg: ",LRQ
|
|---|
| 31 | W !,"LABORATORY SERVICE"
|
|---|
| 32 | W !,LRP," ",SSN,?46,$J(LRPABO,2),?49,LRPRH S A(1)=A(1)+(IOSL-4) Q
|
|---|
| 33 | SET ;
|
|---|
| 34 | D V^LRU S X="BLOOD BANK" D ^LRUTL
|
|---|
| 35 | I Y=-1 S OREND=1 Q
|
|---|
| 36 | I LRSS'="BB" W $C(7),!!,"MUST BE BLOOD BANK" S OREND=1 Q
|
|---|
| 37 | Q
|
|---|
| 38 | CLEAN ;
|
|---|
| 39 | K A,AGE,B,C,DFN,DOB,I,LR,LRAA,LRABV,LRAD,LRADM,LRADX,LRAWRD,LRAX,LRCAPLOC,LRDFN,LRDPAF,LRDPF,LRFNAM,LRH,LRMD,LROLLOC,LRP,LRPABO,LRPARAM,LRPF,LRPFN,LRPRH,LRQ,LRS,LRSF,LRSS,LRSVC,LRU,LRWHO,N,P,R,SEX,SSN,X,Y
|
|---|
| 40 | Q
|
|---|
| 41 | INI ;
|
|---|
| 42 | K LREXP S (LRS,LRS(1),LRSVC,DOB,LRAWRD,LRMD,LRMD(1),LRADX,LRADM)="",LRPF="^"_$P(LRDPF,"^",2),LRPFN=+LRDPF,LRFNAM=$P(^DIC(LRPFN,0),"^")
|
|---|
| 43 | S Y=@(LRPF_DFN_",0)"),LRP=$P(Y,"^"),SEX=$P(Y,"^",2),DOB=$P(Y,"^",3),SSN=$P(Y,"^",9),LRLLOC=$S($D(^(.1)):^(.1),1:""),X=$S($D(^(.104)):+^(.104),1:"") D SSN^LRU I 'X S X=$S($D(^LR(LRDFN,.2)):+^(.2),1:"")
|
|---|
| 44 | S:LRLLOC="" LRLLOC="OUTPATIENT"
|
|---|
| 45 | I X,$D(^VA(200,X,0)) S LRMD=$P(^(0),"^"),LRMD(1)=X
|
|---|
| 46 | S X=^LR(LRDFN,0),LRPABO=$P(X,"^",5),LRPRH=$P(X,"^",6)
|
|---|
| 47 | S LRSVC=$S($D(@(LRPF_DFN_",.103)")):^(.103),1:"") I LRSVC S LRS=$S($D(^DIC(45.7,LRSVC,0)):$P(^(0),"^"),1:"") S:LRS]"" LRS(1)=LRSVC
|
|---|
| 48 | S (X2,Y)=DOB,AGE="" I Y>1630000 D D^LRU S DOB=Y,X1=DT D ^%DTC S AGE=X\365.25
|
|---|
| 49 | I $D(@(LRPF_DFN_",.35)")),$P(@(LRPF_DFN_",.35)"),"^") S (LREXP,Y)=+^(.35) D D^LRU S (LRLLOC,^LR(LRDFN,.1))="DIED "_Y W $C(7),!!,?34,"",LRLLOC,"",! Q
|
|---|
| 50 | Q
|
|---|
