Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RASERV

RASERV.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ;VAIP(1): The Internal Entry Number (IEN) of the PATIENT MOVEMENT (#405) record
  1. ; found for the specified date/time VAIP("D") VALUE). (e.g., IEN=231009).
  1. ;VAIP(5): The WARD LOCATION to which patient was assigned with that movement in
  1. ; internal^external format (e.g., 32^1B-SURG).
  1. ;VAIP(8): The TREATING SPECIALTY assigned with that movement in internal^external
  1. ; format (e.g., 98^OPTOMETRY).
  1. ;
  1. ;Note: both RESER & RASERIEN are required variables referenced in the [RA REGISTER] input template
  1. ;output variables:
  1. ;RASER=external value of a SERVICE/SECTION record or "Unknown"
  1. ;RASERIEN = an IEN of a SERVICE/SECTION record or null
  1. ;
  1. Q:'$D(RADFN) S DFN=RADFN,VA200=1 I $D(RADTE),RADTE S VAIP("D")=RADTE
  1. D IN5^VADPT G Q:VAIP(1)=""
  1. ;defualt RASERIEN to null
  1. S RASERIEN=""
  1. ;RASER = external value of TREATING SPECIALTY
  1. S RASER=$P(VAIP(8),"^",2),RAWD=""
  1. ;RATS = internal value of TREATING SPECIALTY
  1. ;RAWARD = external value of WARD LOCATION
  1. S RATS=+$P(VAIP(8),"^"),RAWARD=$P(VAIP(5),"^",2)
  1. ;if the patient is assigned to a ward on the date in question: VAIP("D")
  1. ;set RAWD equal to the zero node of WARD LOCATION record.
  1. I VAIP(5)]"" S RAWD=$G(^DIC(42,+VAIP(5),0))
  1. ;if no TREATING SPECIALTY
  1. I '$D(^DIC(45.7,RATS,0)) D SER G Q
  1. ;if TREATING SPECIALTY:
  1. ;+$P(RATS,"^",2) = IEN of SPECIALTY (#42.4) record
  1. ;+$P(RATS,"^",4) = IEN of SERVICE/SECTION (#49) record
  1. S RATS=$G(^DIC(45.7,RATS,0))
  1. S RASER=$S($D(^DIC(49,+$P(RATS,"^",4),0)):$P(^(0),"^"),1:"Unknown")
  1. ;the SERVICE/SECTION was found reset RASERIEN to its IEN
  1. S:RASER'="Unknown" RASERIEN=+$P(RATS,"^",4)
  1. ;set RABED value based off SPECIALTY record
  1. S:$D(^DIC(42.4,+$P(RATS,"^",2),0)) RABED=$P(^(0),"^")
  1. ;
  1. Q ;quit/clean-up/exit
  1. K RADMI,RAWD,RADM,RANOW,RATRN,RATS,RATSD,RATSI,VA200,VAERR,VAIP
  1. Q
  1. ;
  1. 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.
  1. ;Note: RASERIEN used in RA REGISTER input template
  1. N RAX S RAX=$$EXTERNAL^DILFD(42,.03,"",$P(RAWD,"^",3)) S:RAX']"" RAX="UNKNOWN"
  1. S RASERIEN=$O(^DIC(49,"B",$E(RAX,1,30),0))
  1. S RASER=$S($D(^DIC(49,+RASERIEN,0)):$P(^(0),"^"),1:"Unknown")
  1. Q
  1. ;