RASERV ;HISC/CAH,FPT,GJC AISC/MJK,DMK-Finds Service, Ward, Bedsection of Inpatient ; May 04, 2021@13:50:39
;;5.0;Radiology/Nuclear Medicine;**181**;Mar 16, 1998;Build 1
;
;VAIP(1): The Internal Entry Number (IEN) of the PATIENT MOVEMENT (#405) record
; found for the specified date/time VAIP("D") VALUE). (e.g., IEN=231009).
;VAIP(5): The WARD LOCATION to which patient was assigned with that movement in
; internal^external format (e.g., 32^1B-SURG).
;VAIP(8): The TREATING SPECIALTY assigned with that movement in internal^external
; format (e.g., 98^OPTOMETRY).
;
;Note: both RESER & RASERIEN are required variables referenced in the [RA REGISTER] input template
;output variables:
;RASER=external value of a SERVICE/SECTION record or "Unknown"
;RASERIEN = an IEN of a SERVICE/SECTION record or null
;
Q:'$D(RADFN) S DFN=RADFN,VA200=1 I $D(RADTE),RADTE S VAIP("D")=RADTE
D IN5^VADPT G Q:VAIP(1)=""
;defualt RASERIEN to null
S RASERIEN=""
;RASER = external value of TREATING SPECIALTY
S RASER=$P(VAIP(8),"^",2),RAWD=""
;RATS = internal value of TREATING SPECIALTY
;RAWARD = external value of WARD LOCATION
S RATS=+$P(VAIP(8),"^"),RAWARD=$P(VAIP(5),"^",2)
;if the patient is assigned to a ward on the date in question: VAIP("D")
;set RAWD equal to the zero node of WARD LOCATION record.
I VAIP(5)]"" S RAWD=$G(^DIC(42,+VAIP(5),0))
;if no TREATING SPECIALTY
I '$D(^DIC(45.7,RATS,0)) D SER G Q
;if TREATING SPECIALTY:
;+$P(RATS,"^",2) = IEN of SPECIALTY (#42.4) record
;+$P(RATS,"^",4) = IEN of SERVICE/SECTION (#49) record
S RATS=$G(^DIC(45.7,RATS,0))
S RASER=$S($D(^DIC(49,+$P(RATS,"^",4),0)):$P(^(0),"^"),1:"Unknown")
;the SERVICE/SECTION was found reset RASERIEN to its IEN
S:RASER'="Unknown" RASERIEN=+$P(RATS,"^",4)
;set RABED value based off SPECIALTY record
S:$D(^DIC(42.4,+$P(RATS,"^",2),0)) RABED=$P(^(0),"^")
;
Q ;quit/clean-up/exit
K RADMI,RAWD,RADM,RANOW,RATRN,RATS,RATSD,RATSI,VA200,VAERR,VAIP
Q
;
SER ;From the SERVICE field value (set of codes) defined for our ward try
;to find a matching record in the SERVICE/SECTION (#49) file.
;Note: RASERIEN used in RA REGISTER input template
N RAX S RAX=$$EXTERNAL^DILFD(42,.03,"",$P(RAWD,"^",3)) S:RAX']"" RAX="UNKNOWN"
S RASERIEN=$O(^DIC(49,"B",$E(RAX,1,30),0))
S RASER=$S($D(^DIC(49,+RASERIEN,0)):$P(^(0),"^"),1:"Unknown")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRASERV 2386 printed Dec 13, 2024@02:39:47 Page 2
RASERV ;HISC/CAH,FPT,GJC AISC/MJK,DMK-Finds Service, Ward, Bedsection of Inpatient ; May 04, 2021@13:50:39
+1 ;;5.0;Radiology/Nuclear Medicine;**181**;Mar 16, 1998;Build 1
+2 ;
+3 ;VAIP(1): The Internal Entry Number (IEN) of the PATIENT MOVEMENT (#405) record
+4 ; found for the specified date/time VAIP("D") VALUE). (e.g., IEN=231009).
+5 ;VAIP(5): The WARD LOCATION to which patient was assigned with that movement in
+6 ; internal^external format (e.g., 32^1B-SURG).
+7 ;VAIP(8): The TREATING SPECIALTY assigned with that movement in internal^external
+8 ; format (e.g., 98^OPTOMETRY).
+9 ;
+10 ;Note: both RESER & RASERIEN are required variables referenced in the [RA REGISTER] input template
+11 ;output variables:
+12 ;RASER=external value of a SERVICE/SECTION record or "Unknown"
+13 ;RASERIEN = an IEN of a SERVICE/SECTION record or null
+14 ;
+15 if '$DATA(RADFN)
QUIT
SET DFN=RADFN
SET VA200=1
IF $DATA(RADTE)
IF RADTE
SET VAIP("D")=RADTE
+16 DO IN5^VADPT
if VAIP(1)=""
GOTO Q
+17 ;defualt RASERIEN to null
+18 SET RASERIEN=""
+19 ;RASER = external value of TREATING SPECIALTY
+20 SET RASER=$PIECE(VAIP(8),"^",2)
SET RAWD=""
+21 ;RATS = internal value of TREATING SPECIALTY
+22 ;RAWARD = external value of WARD LOCATION
+23 SET RATS=+$PIECE(VAIP(8),"^")
SET RAWARD=$PIECE(VAIP(5),"^",2)
+24 ;if the patient is assigned to a ward on the date in question: VAIP("D")
+25 ;set RAWD equal to the zero node of WARD LOCATION record.
+26 IF VAIP(5)]""
SET RAWD=$GET(^DIC(42,+VAIP(5),0))
+27 ;if no TREATING SPECIALTY
+28 IF '$DATA(^DIC(45.7,RATS,0))
DO SER
GOTO Q
+29 ;if TREATING SPECIALTY:
+30 ;+$P(RATS,"^",2) = IEN of SPECIALTY (#42.4) record
+31 ;+$P(RATS,"^",4) = IEN of SERVICE/SECTION (#49) record
+32 SET RATS=$GET(^DIC(45.7,RATS,0))
+33 SET RASER=$SELECT($DATA(^DIC(49,+$PIECE(RATS,"^",4),0)):$PIECE(^(0),"^"),1:"Unknown")
+34 ;the SERVICE/SECTION was found reset RASERIEN to its IEN
+35 if RASER'="Unknown"
SET RASERIEN=+$PIECE(RATS,"^",4)
+36 ;set RABED value based off SPECIALTY record
+37 if $DATA(^DIC(42.4,+$PIECE(RATS,"^",2),0))
SET RABED=$PIECE(^(0),"^")
+38 ;
Q ;quit/clean-up/exit
+1 KILL RADMI,RAWD,RADM,RANOW,RATRN,RATS,RATSD,RATSI,VA200,VAERR,VAIP
+2 QUIT
+3 ;
SER ;From the SERVICE field value (set of codes) defined for our ward try
+1 ;to find a matching record in the SERVICE/SECTION (#49) file.
+2 ;Note: RASERIEN used in RA REGISTER input template
+3 NEW RAX
SET RAX=$$EXTERNAL^DILFD(42,.03,"",$PIECE(RAWD,"^",3))
if RAX']""
SET RAX="UNKNOWN"
+4 SET RASERIEN=$ORDER(^DIC(49,"B",$EXTRACT(RAX,1,30),0))
+5 SET RASER=$SELECT($DATA(^DIC(49,+RASERIEN,0)):$PIECE(^(0),"^"),1:"Unknown")
+6 QUIT
+7 ;
