1 | RASERV ;HISC/CAH,FPT,GJC AISC/MJK,DMK-Finds Service, Ward, Bedsection of Inpatient ;9/12/94 11:48
|
---|
2 | ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
|
---|
3 | Q:'$D(RADFN) S DFN=RADFN,VA200=1 I $D(RADTE),RADTE S VAIP("D")=RADTE
|
---|
4 | D IN5^VADPT G Q:VAIP(1)=""
|
---|
5 | S RASER=$P(VAIP(8),"^",2),RAWD=""
|
---|
6 | S RATS=+$P(VAIP(8),"^"),RAWARD=$P(VAIP(5),"^",2)
|
---|
7 | I VAIP(5)]"" S RAWD=^DIC(42,+VAIP(5),0)
|
---|
8 | I '$D(^DIC(45.7,RATS,0)) D SER G Q
|
---|
9 | S RATS=^DIC(45.7,RATS,0) S RASER=$S($D(^DIC(49,+$P(RATS,"^",4),0)):$P(^(0),"^"),1:"Unknown") S:$D(^DIC(42.4,+$P(RATS,"^",2),0)) RABED=$P(^(0),"^")
|
---|
10 | Q K RADMI,RAWD,RADM,RANOW,RATRN,RATS,RATSD,RATSI,VA200,VAERR,VAIP
|
---|
11 | Q
|
---|
12 | SER ; Define Service/Section
|
---|
13 | S X=$$EXTERNAL^DILFD(42,.03,"",$P(RAWD,"^",3)) S:X']"" X="UNKNOWN"
|
---|
14 | S X=$O(^DIC(49,"B",X,0)),RASER=$S($D(^DIC(49,+X,0)):$P(^(0),"^"),1:"Unknown")
|
---|
15 | Q
|
---|