- 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 Feb 19, 2025@00:04:14 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 ;