source: WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RASERV.m@ 1432

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

initial load of WorldVistAEHR

File size: 804 bytes
RevLine 
[613]1RASERV ;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),"^")
10Q K RADMI,RAWD,RADM,RANOW,RATRN,RATS,RATSD,RATSI,VA200,VAERR,VAIP
11 Q
12SER ; 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
Note: See TracBrowser for help on using the repository browser.