RAO7UTL1 ;HISC/GJC,FPT-Utilities for HL7 messages. ;9/14/98 08:00
;;5.0;Radiology/Nuclear Medicine;**2,76**;Mar 16, 1998;Build 4
BRKOUT ; Breakout the 'MSH', 'ORC' & 'PID' segments.
; Called from: RAO7RON & RAO7RCH
N RADATA,RAHEAD,RASEG,X S X=0
F S X=$O(RAMSG(X)) Q:X'>0 D
. S RASEG=$G(RAMSG(X)),RAHEAD=$P(RASEG,RAHLFS)
. Q:RAHEAD'="PID"&(RAHEAD'="ORC")&(RAHEAD'="MSH")
. S RADATA=$P(RASEG,RAHLFS,2,999)
. S:RAHEAD="MSH" RAMSH3=$P(RADATA,RAHLFS,3)
. S:RAHEAD="ORC" RAORC2=$P(RADATA,RAHLFS,2),RAORC3=$P(RADATA,RAHLFS,3)
. S:RAHEAD="PID" RAPID3=$P(RADATA,RAHLFS,3),RAPID5=$P(RADATA,RAHLFS,5)
. Q
S RADIV(.119)=$P($G(^RA(79,RAMSH3,.1)),U,19)
S:RADIV(.119)="" RADIV(.119)="n"
Q
ABNOR(RAOIFN,RADFN,RADTI) ; test code to find 'Diagnostic Code' for
; descendents and adopted procedures. Called from RAO7CMP.
; 'RAOIFN'-> ien of file 75.1
; 'RADFN' -> ien of the Rad/Nuc Med Patient
; 'RADTI' -> inverse date of the registered exam
Q:'($D(^RADPT("AO",RAOIFN,RADFN,RADTI))\10) ""
N RABN,RACNI,RAXAM S RABN="",RACNI=0
F S RACNI=$O(^RADPT("AO",RAOIFN,RADFN,RADTI,RACNI)) Q:RACNI'>0 D Q:RABN]""
. S RAXAM(0)=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
. Q:'$P(RAXAM(0),"^",25) ; Quit if not part of the set.
. S RABN=$$DIAG^RAO7UTL(RADFN,RADTI,RACNI)
. Q
Q RABN
;
XAMDT(RADFN) ;Return exam date/time for interpreted non-cancelled case. The
;'Cancelled' EXAMINATION STATUS record has an order number of zero.
;IA#: 4875 Private w/MPI
; input: RADFN=The DFN of the patient
;return: RAXAMDT=The exam date/time (FM internal) of the most recent
; non-cancelled interpreted case, else "0^an active exam
; with interpretation was not found for this patient"
N RAXAMDT S RAXAMDT="0^an active exam with interpretation was not found for this patient"
S RADTI=0 F S RADTI=$O(^RADPT(RADFN,"DT",RADTI)) Q:'RADTI D Q:RAXAMDT
.S RACNI=0
.F S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI)) Q:'RACNI D Q:RAXAMDT
..S RAX=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)) Q:$P(RAX,U,17)="" ;no rpt
..Q:$P($G(^RA(72,+$P(RAX,U,3),0)),U,3)=0 ;cancelled case
..S RAXAMDT=(9999999.9999-RADTI)
..Q
.Q
K RACNI,RADTI,RAX
Q RAXAMDT
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAO7UTL1 2220 printed Apr 09, 2024@21:35:10 Page 2
RAO7UTL1 ;HISC/GJC,FPT-Utilities for HL7 messages. ;9/14/98 08:00
+1 ;;5.0;Radiology/Nuclear Medicine;**2,76**;Mar 16, 1998;Build 4
BRKOUT ; Breakout the 'MSH', 'ORC' & 'PID' segments.
+1 ; Called from: RAO7RON & RAO7RCH
+2 NEW RADATA,RAHEAD,RASEG,X
SET X=0
+3 FOR
SET X=$ORDER(RAMSG(X))
if X'>0
QUIT
Begin DoDot:1
+4 SET RASEG=$GET(RAMSG(X))
SET RAHEAD=$PIECE(RASEG,RAHLFS)
+5 if RAHEAD'="PID"&(RAHEAD'="ORC")&(RAHEAD'="MSH")
QUIT
+6 SET RADATA=$PIECE(RASEG,RAHLFS,2,999)
+7 if RAHEAD="MSH"
SET RAMSH3=$PIECE(RADATA,RAHLFS,3)
+8 if RAHEAD="ORC"
SET RAORC2=$PIECE(RADATA,RAHLFS,2)
SET RAORC3=$PIECE(RADATA,RAHLFS,3)
+9 if RAHEAD="PID"
SET RAPID3=$PIECE(RADATA,RAHLFS,3)
SET RAPID5=$PIECE(RADATA,RAHLFS,5)
+10 QUIT
End DoDot:1
+11 SET RADIV(.119)=$PIECE($GET(^RA(79,RAMSH3,.1)),U,19)
+12 if RADIV(.119)=""
SET RADIV(.119)="n"
+13 QUIT
ABNOR(RAOIFN,RADFN,RADTI) ; test code to find 'Diagnostic Code' for
+1 ; descendents and adopted procedures. Called from RAO7CMP.
+2 ; 'RAOIFN'-> ien of file 75.1
+3 ; 'RADFN' -> ien of the Rad/Nuc Med Patient
+4 ; 'RADTI' -> inverse date of the registered exam
+5 if '($DATA(^RADPT("AO",RAOIFN,RADFN,RADTI))\10)
QUIT ""
+6 NEW RABN,RACNI,RAXAM
SET RABN=""
SET RACNI=0
+7 FOR
SET RACNI=$ORDER(^RADPT("AO",RAOIFN,RADFN,RADTI,RACNI))
if RACNI'>0
QUIT
Begin DoDot:1
+8 SET RAXAM(0)=$GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
+9 ; Quit if not part of the set.
if '$PIECE(RAXAM(0),"^",25)
QUIT
+10 SET RABN=$$DIAG^RAO7UTL(RADFN,RADTI,RACNI)
+11 QUIT
End DoDot:1
if RABN]""
QUIT
+12 QUIT RABN
+13 ;
XAMDT(RADFN) ;Return exam date/time for interpreted non-cancelled case. The
+1 ;'Cancelled' EXAMINATION STATUS record has an order number of zero.
+2 ;IA#: 4875 Private w/MPI
+3 ; input: RADFN=The DFN of the patient
+4 ;return: RAXAMDT=The exam date/time (FM internal) of the most recent
+5 ; non-cancelled interpreted case, else "0^an active exam
+6 ; with interpretation was not found for this patient"
+7 NEW RAXAMDT
SET RAXAMDT="0^an active exam with interpretation was not found for this patient"
+8 SET RADTI=0
FOR
SET RADTI=$ORDER(^RADPT(RADFN,"DT",RADTI))
if 'RADTI
QUIT
Begin DoDot:1
+9 SET RACNI=0
+10 FOR
SET RACNI=$ORDER(^RADPT(RADFN,"DT",RADTI,"P",RACNI))
if 'RACNI
QUIT
Begin DoDot:2
+11 ;no rpt
SET RAX=$GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
if $PIECE(RAX,U,17)=""
QUIT
+12 ;cancelled case
if $PIECE($GET(^RA(72,+$PIECE(RAX,U,3),0)),U,3)=0
QUIT
+13 SET RAXAMDT=(9999999.9999-RADTI)
+14 QUIT
End DoDot:2
if RAXAMDT
QUIT
+15 QUIT
End DoDot:1
if RAXAMDT
QUIT
+16 KILL RACNI,RADTI,RAX
+17 QUIT RAXAMDT
+18 ;
