- 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
- 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
