RASERV.m

RASERV ;HISC/CAH,FPT,GJC AISC/MJK,DMK-Finds Service, Ward, Bedsection of Inpatient ;9/12/94  11:48

 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998

 Q:'$D(RADFN)  S DFN=RADFN,VA200=1 I $D(RADTE),RADTE S VAIP("D")=RADTE

 D IN5^VADPT G Q:VAIP(1)=""

 S RASER=$P(VAIP(8),"^",2),RAWD=""

 S RATS=+$P(VAIP(8),"^"),RAWARD=$P(VAIP(5),"^",2)

 I VAIP(5)]"" S RAWD=^DIC(42,+VAIP(5),0)

 I '$D(^DIC(45.7,RATS,0)) D SER G Q

 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),"^")

Q K RADMI,RAWD,RADM,RANOW,RATRN,RATS,RATSD,RATSI,VA200,VAERR,VAIP

 Q

SER ; Define Service/Section

 S X=$$EXTERNAL^DILFD(42,.03,"",$P(RAWD,"^",3)) S:X']"" X="UNKNOWN"

 S X=$O(^DIC(49,"B",X,0)),RASER=$S($D(^DIC(49,+X,0)):$P(^(0),"^"),1:"Unknown")

 Q

RASERV    ;HISC/CAH,FPT,GJC AISC/MJK,DMK-Finds Service, Ward, Bedsection of Inpatient ;9/12/94  11:48

 +1       ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998

 +2        IF '$DATA(RADFN)

               QUIT 

           SET DFN=RADFN

           SET VA200=1

           IF $DATA(RADTE)

               IF RADTE

                   SET VAIP("D")=RADTE

 +3        DO IN5^VADPT

           IF VAIP(1)=""

               GOTO Q

 +4        SET RASER=$PIECE(VAIP(8),"^",2)

           SET RAWD=""

 +5        SET RATS=+$PIECE(VAIP(8),"^")

           SET RAWARD=$PIECE(VAIP(5),"^",2)

 +6        IF VAIP(5)]""

               SET RAWD=^DIC(42,+VAIP(5),0)

 +7        IF '$DATA(^DIC(45.7,RATS,0))

               DO SER

               GOTO Q

 +8        SET RATS=^DIC(45.7,RATS,0)

           SET RASER=$SELECT($DATA(^DIC(49,+$PIECE(RATS,"^",4),0)):$PIECE(^(0),"^"),1:"Unknown")

           IF $DATA(^DIC(42.4,+$PIECE(RATS,"^",2),0))

               SET RABED=$PIECE(^(0),"^")

Q          KILL RADMI,RAWD,RADM,RANOW,RATRN,RATS,RATSD,RATSI,VA200,VAERR,VAIP

 +1        QUIT 

SER       ; Define Service/Section

 +1        SET X=$$EXTERNAL^DILFD(42,.03,"",$PIECE(RAWD,"^",3))

           IF X']""

               SET X="UNKNOWN"

 +2        SET X=$ORDER(^DIC(49,"B",X,0))

           SET RASER=$SELECT($DATA(^DIC(49,+X,0)):$PIECE(^(0),"^"),1:"Unknown")

 +3        QUIT