RAMAGHL ;HCIOFO/SG - ORDERS/EXAMS API (HL7 UTILITIES) ; 2/25/09 3:30pm
;;5.0;Radiology/Nuclear Medicine;**90**;Mar 16, 1998;Build 20
;
; This routine uses the following IAs:
;
; #872 Access to the file #101 (controlled)
;
Q
;
;***** RETURNS THE LIST OF ACTIVE HL7 APPLICATIONS
;
; .APPLST Reference to a local variable where the list
; of active HL7 applications associated with the
; RA REG*, RA EXAMINED*, RA CANCEL*, and RA RPT*
; HL7 protocols (as receiving applications) will
; be returned to.
; APPLST(
; HL7AppIEN) HL7 application name
;
; Return values:
; <0 Error descriptor (see $$ERROR^RAERR)
; 0 Ok
;
APPLST(APPLST) ;
N IEN,NAME,PART,PIEN,PL,RAMSG,ROOT,SUBSLST
K APPLST
;--- Build the list of subscriber IENs
S ROOT=$$ROOT^DILFD(101,,1)
F PART="RA REG","RA EXAMINED","RA CANCEL","RA RPT" D
. S NAME=$O(@ROOT@("B",PART),-1),PL=$L(PART)
. F S NAME=$O(@ROOT@("B",NAME)) Q:$E(NAME,1,PL)'=PART D
. . S PIEN=0
. . F S PIEN=$O(@ROOT@("B",NAME,PIEN)) Q:PIEN'>0 D
. . . S IEN=0
. . . F S IEN=$O(@ROOT@(PIEN,775,IEN)) Q:IEN'>0 D
. . . . S SUBSLST(+@ROOT@(PIEN,775,IEN,0))=""
;--- Build the list of receiving application IENs
S PIEN=0
F S PIEN=$O(SUBSLST(PIEN)) Q:PIEN'>0 D
. S IEN=+$$GET1^DIQ(101,PIEN_",",770.2,"I",,"RAMSG")
. S:IEN>0 APPLST(IEN)=""
;--- Check if the applications are active and get their names
S IEN=0
F S IEN=$O(APPLST(IEN)) Q:IEN'>0 D
. I $P($$GETAPP^HLCS2(IEN),U,2)="i" K APPLST(IEN) Q
. S APPLST(IEN)=$$GET1^DIQ(771,IEN_",",.01,,,"RAMSG")
;---
Q 0
;
;***** SENDS "EXAMINED" HL7 MESSAGES (ORM)
;
; RACASE Exam/case identifiers
; ^01: IEN of the patient in the file #70 (RADFN)
; ^02: IEN in the REGISTERED EXAMS multiple (RADTI)
; ^03: IEN in the EXAMINATIONS multiple (RACNI)
;
; [RAFLAGS] Flags that control the execution (can be combined):
;
; S Do not send the message to speech recognition
; (dictation) systems
;
; Return values:
; <0 Error descriptor (see $$ERROR^RAERR)
; 0 Ok
;
EXAMINED(RACASE,RAFLAGS) ;
N RACNI,RADFN,RADTI,RAEXEDT,RASSS,RASSSX,RC,TMP
S RADFN=$P(RACASE,U),RADTI=$P(RACASE,U,2),RACNI=$P(RACASE,U,3)
S RAFLAGS=$G(RAFLAGS)
;
;--- Exclude speech recognition (dictation) systems if necessary
I RAFLAGS["S" S RC=$$SPRSUBS(.RASSSX) Q:RC $S(RC<0:RC,1:0)
;
;--- Generate and send the message
S RAEXEDT=1 D EXM^RAHLRPC
Q 0
;
;***** SENDS "REPORT" HL7 MESSAGES (ORU)
;
; RACASE Exam/case identifiers
; ^01: IEN of the patient in the file #70 (RADFN)
; ^02: IEN in the REGISTERED EXAMS multiple (RADTI)
; ^03: IEN in the EXAMINATIONS multiple (RACNI)
;
; [RAFLAGS] Flags that control the execution (can be combined):
;
; S Do not send the message to speech recognition
; (dictation) systems
;
; Return values:
; <0 Error descriptor (see $$ERROR^RAERR)
; 0 Ok
;
REPORT(RACASE,RAFLAGS) ;
N RACNI,RADFN,RADTI,RAMSG,RASSS,RASSSX,RC,RPTIEN,TMP
S RADFN=$P(RACASE,U),RADTI=$P(RACASE,U,2),RACNI=$P(RACASE,U,3)
S RAFLAGS=$G(RAFLAGS)
;
;--- Get the report IEN
S TMP=$$EXAMIENS^RAMAGU04(RACASE)
S RPTIEN=$$GET1^DIQ(70.03,TMP,17,"I",,"RAMSG")
Q:$G(DIERR) $$DBS^RAERR("RAMSG",-9,70.03,TMP)
Q:RPTIEN'>0 0 ; No report yet
;
;--- Send messages only for verified or released reports
S TMP=$$RPTSTAT^RAMAGU12(RPTIEN) Q:TMP<0 TMP
S TMP=$P(TMP,U) Q:(TMP'="V")&(TMP'="R")&(TMP'="EF") 0
;
;--- Exclude speech recognition (dictation) systems if necessary
I RAFLAGS["S" S RC=$$SPRSUBS(.RASSSX) Q:RC $S(RC<0:RC,1:0)
;
;--- Generate and send the message
D RPT^RAHLRPC
Q 0
;
;***** COMPILES A LIST OF SPEACH RECOGNITION SUBSCRIBERS
;
; .RASSSX Reference to a local array where the list of
; speech recognition subscribers is returned to:
;
; RASSSX(EvtDrvrIEN,SubscriberIEN) = EvtDrvrName
;
; EvtDrvrIEN and SubscriberIEN are record numbers
; in the PROTOCOL file (#101).
;
; [.RASSS] Reference to a local array where the list of
; related HL7 applications is returned to:
;
; RASSS(HL7AppIEN) = ""
;
; HL7AppIEN is a record number in the HL7
; APPLICATION PARAMETER file (#771).
;
; Return values:
; <0 Error descriptor (see $$ERROR^RAERR)
; 0 Ok
; >0 Nowhere to send
;
SPRSUBS(RASSSX,RASSS) ;
N APPLST,IEN,RABUF,RAMSG,RC
K RASSS,RASSSX
S RC=$$APPLST(.APPLST) Q:RC<0 RC
;--- Select only those HL7 applications that do not have
; 'S:Speech Recognition' in the APPLICATION TYPE field of
;--- the RAD/NUC MED HL7 APPLICATION EXCEPTION file (#79.7).
S IEN=0
F S IEN=$O(APPLST(IEN)) Q:IEN'>0 D
. I $D(^RA(79.7,IEN,0)) D Q:RC="S"
. . S RC=$$GET1^DIQ(79.7,IEN_",",1.3,"I",,"RAMSG")
. S RASSS(IEN)=""
;--- Quit if all recipients should be skipped
Q:$D(RASSS)<10 1
;--- Build the list of excluded subscriber protocols
D GETSUB^RAHLRS1(.RASSS,.RASSSX)
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAMAGHL 5431 printed Oct 16, 2024@18:37:31 Page 2
RAMAGHL ;HCIOFO/SG - ORDERS/EXAMS API (HL7 UTILITIES) ; 2/25/09 3:30pm
+1 ;;5.0;Radiology/Nuclear Medicine;**90**;Mar 16, 1998;Build 20
+2 ;
+3 ; This routine uses the following IAs:
+4 ;
+5 ; #872 Access to the file #101 (controlled)
+6 ;
+7 QUIT
+8 ;
+9 ;***** RETURNS THE LIST OF ACTIVE HL7 APPLICATIONS
+10 ;
+11 ; .APPLST Reference to a local variable where the list
+12 ; of active HL7 applications associated with the
+13 ; RA REG*, RA EXAMINED*, RA CANCEL*, and RA RPT*
+14 ; HL7 protocols (as receiving applications) will
+15 ; be returned to.
+16 ; APPLST(
+17 ; HL7AppIEN) HL7 application name
+18 ;
+19 ; Return values:
+20 ; <0 Error descriptor (see $$ERROR^RAERR)
+21 ; 0 Ok
+22 ;
APPLST(APPLST) ;
+1 NEW IEN,NAME,PART,PIEN,PL,RAMSG,ROOT,SUBSLST
+2 KILL APPLST
+3 ;--- Build the list of subscriber IENs
+4 SET ROOT=$$ROOT^DILFD(101,,1)
+5 FOR PART="RA REG","RA EXAMINED","RA CANCEL","RA RPT"
Begin DoDot:1
+6 SET NAME=$ORDER(@ROOT@("B",PART),-1)
SET PL=$LENGTH(PART)
+7 FOR
SET NAME=$ORDER(@ROOT@("B",NAME))
if $EXTRACT(NAME,1,PL)'=PART
QUIT
Begin DoDot:2
+8 SET PIEN=0
+9 FOR
SET PIEN=$ORDER(@ROOT@("B",NAME,PIEN))
if PIEN'>0
QUIT
Begin DoDot:3
+10 SET IEN=0
+11 FOR
SET IEN=$ORDER(@ROOT@(PIEN,775,IEN))
if IEN'>0
QUIT
Begin DoDot:4
+12 SET SUBSLST(+@ROOT@(PIEN,775,IEN,0))=""
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+13 ;--- Build the list of receiving application IENs
+14 SET PIEN=0
+15 FOR
SET PIEN=$ORDER(SUBSLST(PIEN))
if PIEN'>0
QUIT
Begin DoDot:1
+16 SET IEN=+$$GET1^DIQ(101,PIEN_",",770.2,"I",,"RAMSG")
+17 if IEN>0
SET APPLST(IEN)=""
End DoDot:1
+18 ;--- Check if the applications are active and get their names
+19 SET IEN=0
+20 FOR
SET IEN=$ORDER(APPLST(IEN))
if IEN'>0
QUIT
Begin DoDot:1
+21 IF $PIECE($$GETAPP^HLCS2(IEN),U,2)="i"
KILL APPLST(IEN)
QUIT
+22 SET APPLST(IEN)=$$GET1^DIQ(771,IEN_",",.01,,,"RAMSG")
End DoDot:1
+23 ;---
+24 QUIT 0
+25 ;
+26 ;***** SENDS "EXAMINED" HL7 MESSAGES (ORM)
+27 ;
+28 ; RACASE Exam/case identifiers
+29 ; ^01: IEN of the patient in the file #70 (RADFN)
+30 ; ^02: IEN in the REGISTERED EXAMS multiple (RADTI)
+31 ; ^03: IEN in the EXAMINATIONS multiple (RACNI)
+32 ;
+33 ; [RAFLAGS] Flags that control the execution (can be combined):
+34 ;
+35 ; S Do not send the message to speech recognition
+36 ; (dictation) systems
+37 ;
+38 ; Return values:
+39 ; <0 Error descriptor (see $$ERROR^RAERR)
+40 ; 0 Ok
+41 ;
EXAMINED(RACASE,RAFLAGS) ;
+1 NEW RACNI,RADFN,RADTI,RAEXEDT,RASSS,RASSSX,RC,TMP
+2 SET RADFN=$PIECE(RACASE,U)
SET RADTI=$PIECE(RACASE,U,2)
SET RACNI=$PIECE(RACASE,U,3)
+3 SET RAFLAGS=$GET(RAFLAGS)
+4 ;
+5 ;--- Exclude speech recognition (dictation) systems if necessary
+6 IF RAFLAGS["S"
SET RC=$$SPRSUBS(.RASSSX)
if RC
QUIT $SELECT(RC<0:RC,1:0)
+7 ;
+8 ;--- Generate and send the message
+9 SET RAEXEDT=1
DO EXM^RAHLRPC
+10 QUIT 0
+11 ;
+12 ;***** SENDS "REPORT" HL7 MESSAGES (ORU)
+13 ;
+14 ; RACASE Exam/case identifiers
+15 ; ^01: IEN of the patient in the file #70 (RADFN)
+16 ; ^02: IEN in the REGISTERED EXAMS multiple (RADTI)
+17 ; ^03: IEN in the EXAMINATIONS multiple (RACNI)
+18 ;
+19 ; [RAFLAGS] Flags that control the execution (can be combined):
+20 ;
+21 ; S Do not send the message to speech recognition
+22 ; (dictation) systems
+23 ;
+24 ; Return values:
+25 ; <0 Error descriptor (see $$ERROR^RAERR)
+26 ; 0 Ok
+27 ;
REPORT(RACASE,RAFLAGS) ;
+1 NEW RACNI,RADFN,RADTI,RAMSG,RASSS,RASSSX,RC,RPTIEN,TMP
+2 SET RADFN=$PIECE(RACASE,U)
SET RADTI=$PIECE(RACASE,U,2)
SET RACNI=$PIECE(RACASE,U,3)
+3 SET RAFLAGS=$GET(RAFLAGS)
+4 ;
+5 ;--- Get the report IEN
+6 SET TMP=$$EXAMIENS^RAMAGU04(RACASE)
+7 SET RPTIEN=$$GET1^DIQ(70.03,TMP,17,"I",,"RAMSG")
+8 if $GET(DIERR)
QUIT $$DBS^RAERR("RAMSG",-9,70.03,TMP)
+9 ; No report yet
if RPTIEN'>0
QUIT 0
+10 ;
+11 ;--- Send messages only for verified or released reports
+12 SET TMP=$$RPTSTAT^RAMAGU12(RPTIEN)
if TMP<0
QUIT TMP
+13 SET TMP=$PIECE(TMP,U)
if (TMP'="V")&(TMP'="R")&(TMP'="EF")
QUIT 0
+14 ;
+15 ;--- Exclude speech recognition (dictation) systems if necessary
+16 IF RAFLAGS["S"
SET RC=$$SPRSUBS(.RASSSX)
if RC
QUIT $SELECT(RC<0:RC,1:0)
+17 ;
+18 ;--- Generate and send the message
+19 DO RPT^RAHLRPC
+20 QUIT 0
+21 ;
+22 ;***** COMPILES A LIST OF SPEACH RECOGNITION SUBSCRIBERS
+23 ;
+24 ; .RASSSX Reference to a local array where the list of
+25 ; speech recognition subscribers is returned to:
+26 ;
+27 ; RASSSX(EvtDrvrIEN,SubscriberIEN) = EvtDrvrName
+28 ;
+29 ; EvtDrvrIEN and SubscriberIEN are record numbers
+30 ; in the PROTOCOL file (#101).
+31 ;
+32 ; [.RASSS] Reference to a local array where the list of
+33 ; related HL7 applications is returned to:
+34 ;
+35 ; RASSS(HL7AppIEN) = ""
+36 ;
+37 ; HL7AppIEN is a record number in the HL7
+38 ; APPLICATION PARAMETER file (#771).
+39 ;
+40 ; Return values:
+41 ; <0 Error descriptor (see $$ERROR^RAERR)
+42 ; 0 Ok
+43 ; >0 Nowhere to send
+44 ;
SPRSUBS(RASSSX,RASSS) ;
+1 NEW APPLST,IEN,RABUF,RAMSG,RC
+2 KILL RASSS,RASSSX
+3 SET RC=$$APPLST(.APPLST)
if RC<0
QUIT RC
+4 ;--- Select only those HL7 applications that do not have
+5 ; 'S:Speech Recognition' in the APPLICATION TYPE field of
+6 ;--- the RAD/NUC MED HL7 APPLICATION EXCEPTION file (#79.7).
+7 SET IEN=0
+8 FOR
SET IEN=$ORDER(APPLST(IEN))
if IEN'>0
QUIT
Begin DoDot:1
+9 IF $DATA(^RA(79.7,IEN,0))
Begin DoDot:2
+10 SET RC=$$GET1^DIQ(79.7,IEN_",",1.3,"I",,"RAMSG")
End DoDot:2
if RC="S"
QUIT
+11 SET RASSS(IEN)=""
End DoDot:1
+12 ;--- Quit if all recipients should be skipped
+13 if $DATA(RASSS)<10
QUIT 1
+14 ;--- Build the list of excluded subscriber protocols
+15 DO GETSUB^RAHLRS1(.RASSS,.RASSSX)
+16 QUIT 0
