source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRDPA1.m@ 1006

Last change on this file since 1006 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.1 KB
Line 
1LRDPA1 ;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
4EN 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
21L 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
24A 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
Note: See TracBrowser for help on using the repository browser.