| [613] | 1 | LRDPA1 ;AVAMC/REG/DALISC/FHS - PT LOOKUP IN FILES FOR LAB ;9/6/94 09:03 ;
|
|---|
| 2 | ;;5.2;LAB SERVICE;**1,153,201,310**;Sep 27, 1994
|
|---|
| 3 | N X
|
|---|
| 4 | EN K LREXP S (LRS,LRS(1),LRSVC,LRAWRD,LRMD,LRMD(1),LRADX,LRADM)="",LRPF="^"_$P(LRDPF,"^",2),LRPFN=+LRDPF,LRFNAM=$P(^DIC(LRPFN,0),"^")
|
|---|
| 5 | S LRP=PNM
|
|---|
| 6 | S:$D(VAIN(2)) LRMD(2)=+VAIN(2),LRMD=$P(VAIN(2),U,2)
|
|---|
| 7 | I '$G(LRMD(2)) S X=$S($D(^LR(LRDFN,.2)):+^(.2),1:"") I X,$D(^VA(200,X,0)) S LRMD=$P(^(0),U),LRMD(1)=X
|
|---|
| 8 | S LRCAPLOC=$S($G(^LR(LRDFN,.092)):^(.092),1:"") S:LRCAPLOC="" LRCAPLOC="Z"
|
|---|
| 9 | I $G(VAIN(4)) S LRLLOC=$P($G(^SC(+$G(^DIC(42,+VAIN(4),44)),0)),U,2),LRCAPLOC="W"
|
|---|
| 10 | E S LRLLOC=$G(^LR(LRDFN,.1)) I $L(LRLLOC) S X=+$O(^SC("B",LRLLOC,0)) I $D(^SC(X,0)) S LRSVC=$P(^(0),"^",20)
|
|---|
| 11 | S:LRLLOC="" LRLLOC="???"
|
|---|
| 12 | W !,LRP," ID: ",SSN," " W:LRMD]"" "Physician: ",LRMD,!
|
|---|
| 13 | I $D(LRSS),LRSS="BB" S X=^LR(LRDFN,0),LRPABO=$P(X,"^",5),LRPRH=$P(X,"^",6) W !,"ABO group: ",LRPABO," Rh type: ",LRPRH
|
|---|
| 14 | I $D(^LR(LRDFN,.091)),^(.091)]"" W !!,"Infection control warning:",$C(7),!?5,^(.091),!
|
|---|
| 15 | S:$G(VAIN(3)) (LRS(1),LRSVC)=+VAIN(3),LRS=$P(VAIN(3),U,2)
|
|---|
| 16 | I $G(VADM(3)) S DOB=$P(VADM(3),U,2)
|
|---|
| 17 | E S DOB=$$FMTE^XLFDT(DOB)
|
|---|
| 18 | 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
|
|---|
| 19 | W:AGE !,"AGE: ",AGE W " DATE OF BIRTH: ",DOB
|
|---|
| 20 | D:+LRDPF=2 A
|
|---|
| 21 | L I '$D(LRQ),$D(LRLABKY) S LRSVC="" D ASK^LRWU S:X["^"!(X="") (LRDFN,DFN)=-1 Q:DFN=-1 S LRLLOC=$G(^LR(LRDFN,.1)) I $L(LRLLOC) S X=+$O(^SC("B",LRLLOC,0)) I $D(^SC(X,0)) S LRSVC=$P(^(0),"^",20)
|
|---|
| 22 | I $D(LRSS),LRSS="BB" D ^LRDPA2
|
|---|
| 23 | Q
|
|---|
| 24 | A I $A(LRLLOC)<33 W $C(7),!!,"Patient in hospital but Ward Location begins with a space !!!",!,"Location =>",LRLLOC,"<=",!,"Ask MAS to fix it",! S LRLLOC="???"
|
|---|
| 25 | Q:+$G(LRDPF)'=2!('$G(VAIN(1))) S:$D(VAIN(9)) LRADX=VAIN(9)
|
|---|
| 26 | S:$G(VAIN(7)) LRADM=$P(VAIN(7),U,2)
|
|---|
| 27 | I $G(VAIN(7)) S VAIP("D")=$P(VAIN(7),U) D
|
|---|
| 28 | . N X,I,N,Y
|
|---|
| 29 | . D IN5^VADPT I $G(VAIP(5)) S LRAWRD=$P($G(^SC(+$G(^DIC(42,+VAIP(5),44)),0)),U,2)
|
|---|
| 30 | W !,"Ward on Adm: ",LRAWRD," Service: ",LRS,!,"Adm Date: ",LRADM," Adm DX: ",LRADX,!,"Present Ward: ",LRLLOC,?30,"Primary MD: ",LRMD
|
|---|
| 31 | W:$G(VAIN(11)) !?28,"Attending MD: ",$P(VAIN(11),U,2)
|
|---|
| 32 | K VAIP
|
|---|
| 33 | Q
|
|---|
