MAGDHOWA ;WOIFO/PMK - Route traditional 1.6 HL7 ADT messages via HLO ;17 Nov 2017 9:36 AM
;;3.0;IMAGING;**138,183**;Mar 19, 2002;Build 11;Sep 03, 2013
;; Per VHA Directive 2004-038, this routine should not be modified.
;; +---------------------------------------------------------------+
;; | Property of the US Government. |
;; | No permission to copy or redistribute this software is given. |
;; | Use of unreleased versions of this software requires the user |
;; | to execute a written test agreement with the VistA Imaging |
;; | Development Office of the Department of Veterans Affairs, |
;; | telephone (301) 734-0100. |
;; | The Food and Drug Administration classifies this software as |
;; | a medical device. As such, it may not be changed in any way. |
;; | Modifications to this software may result in an adulterated |
;; | medical device under 21CFR820, the use of which is considered |
;; | to be a violation of US Federal Statutes. |
;; +---------------------------------------------------------------+
;;
;
; Supported IA #4716 reference ^HLOAPI function calls
; Supported IA #4717 reference ^HLOAPI1 function calls
;
; The ADT A01, A02, A03, A11, A12, and A13 messages for commercial
; PACS were created by patch MAG*3.0*49.
; The ADT A08 and A47 messages were created by patch MAG*3.0*183.
; They are transmitted using the traditional 1.6 HL7 package.
;
; The HL7 for clinical specialties uses the new HL7 Optimized package.
;
; This routine is referenced by subscriber protocols to the original
; six HL7 event drivers and the two new ones for A08 and A47.
; It enables the HL7 1.6 messages to be routed using the new HL7
; Optimized package. In this way, all of the clinical specialty
; systems deal with just the HL7 Optimized package.
;
;
; There are eight MAG CPACS ADT event drivers:
; MAG CPACS A01 - Inpatient admission
; MAG CPACS A02 - Patient transfer
; MAG CPACS A03 - Patient discharge
; MAG CPACS A08 - Update patient information
; MAG CPACS A11 - Cancel inpatient admission
; MAG CPACS A12 - Cancel patient transfer
; MAG CPACS A13 - Cancel patient discharge
; MAG CPACS A47 - Change patient identifier list
;
; There are eight MAG CPACS ADT HL7 1.6 subscribers:
; MAG CPACS A01 SUBS - Routes inpatient admissions
; MAG CPACS A02 SUBS - Routes patient transfers
; MAG CPACS A03 SUBS - Routes patient discharges
; MAG CPACS A08 SUBS - Update patient information
; MAG CPACS A11 SUBS - Routes admission cancellations
; MAG CPACS A12 SUBS - Routes transfer cancellations
; MAG CPACS A13 SUBS - Routes discharge cancellations
; MAG CPACS A47 SUBS - Routes change patient identifier list
; All of these use the HL7 logical link MAG CPACS
;
; There are eight MAG CPACS ADT HLO subscribers that call this routine:
; MAG CPACS A01 SUBS-HLO - Routes inpatient admissions
; MAG CPACS A02 SUBS-HLO - Routes patient transfers
; MAG CPACS A03 SUBS-HLO - Routes patient discharges
; MAG CPACS A08 SUBS-HLO - Update patient information
; MAG CPACS A11 SUBS-HLO - Routes admission cancellations
; MAG CPACS A12 SUBS-HLO - Routes transfer cancellations
; MAG CPACS A13 SUBS-HLO - Routes discharge cancellations
; MAG CPACS A47 SUBS-HLO - Routes change patient identifier list
;
; All eight new MAG CPACS ADT HLO subscribers call this routine - each
; protocol file (#101) entry has PROCESSING ROUTINE: D ENTRY^MAGDHOWA
;
;
ENTRY ; subscriber entry point
N HLMSTATE,MSGTYPE
;
S MSGTYPE="ADT"
;
D INPUT
;
D OUTPUT
Q
;
INPUT ; get the generated HL7 message and save it in HLO's HLMSTATE
N A,B,C,ERROR,EVENT,S1,S2,S3,S4,S5
I $E($G(HLARYTYP),1)="G" M A=^TMP("HLS",$J)
E I $E($G(HLARYTYP),1)="L" M A=HLA("HLS")
E Q ; no input data <-----------------------------
;
S A(1)=HLREC("HDR")
;
; $$PARSE converts HL7 message "A" to HL7 tree ("B")
;
S X=$$PARSE^MAG7UP("A","B")
;
; "C" will contain the HL7 HLO tree, just the fifth subscript level
;
S S1="" F S S1=$O(B(S1)) Q:S1="" D
. S S2="" F S S2=$O(B(S1,S2)) Q:S2="" D
. . ;
. . ; store segment name at (S1,0,1,1,1) node
. . I S2=0 S C(S1,0,1,1,1)=B(S1,0) Q
. . ;
. . S S3="" F S S3=$O(B(S1,S2,S3)) Q:S3="" D
. . . S S4="" F S S4=$O(B(S1,S2,S3,S4)) Q:S4="" D
. . . . S S5="" F S S5=$O(B(S1,S2,S3,S4,S5)) Q:S5="" D
. . . . . S C(S1,S2,S3,S4,S5)=B(S1,S2,S3,S4,S5)
. . . . . Q
. . . . Q
. . . Q
. . Q
. Q
;
I C(2,0,1,1,1)="EVN" D
. S EVENT=C(2,1,1,1,1) ; ADT event type from the EVN message
. Q
E S EVENT="O01" ; unknown event? <-------------------------------
;
; build the HLO structure with all the segments, after the MSH
D INIT^MAGDHOW2(MSGTYPE,EVENT)
S S1=1 F S S1=$O(C(S1)) Q:S1="" D
. N SEGMENT,SUCCESS
. M SEGMENT=C(S1)
. S SUCCESS=$$ADDSEG^HLOAPI(.HLMSTATE,.SEGMENT,.ERROR)
. I 'SUCCESS D
. . N MSG,SUBJECT,VARIABLES
. . S SUBJECT="Clinical Specialty HL7 Generation"
. . S MSG(1)="An error occurred in INPUT^"_$T(+0)_" where the ADDSEG^HLOAPI"
. . S MSG(2)="invocation failed. The error message is as follows:"
. . S MSG(3)=""""_SUCCESS_""""
. . S VARIABLES("HLMSTATE")=""
. . S VARIABLES("SEGMENT")=""
. . S VARIABLES("ERROR")=""
. . S VARIABLES("C")=""
. . D ERROR^MAGDHOWA(SUBJECT,.MSG,.VARIABLES)
. . Q
. Q
Q
;
OUTPUT ; send the HL7 message using HLO's subscription list
N DIC,DO,HL7SUBLIST,MESSAGES,PARMS,SUCCESS,X,Y
;
; send the message via subscription list
S DIC=779.4,DIC(0)="BX",X="MAGD ADT" D ^DIC
S HL7SUBLIST=$P(Y,"^",1) ; Y should equal "<ien>^MAGD ADT"
S PARMS("SENDING APPLICATION")="MAGD SENDER"
S PARMS("SUBSCRIPTION IEN")=HL7SUBLIST
; the HLO private queue name is the name of the subscription list
S PARMS("QUEUE")=$E($$GET1^DIQ(779.4,HL7SUBLIST,.01),1,20) ; private queue, 20 char max.
S SUCCESS=$$SENDSUB^HLOAPI1(.HLMSTATE,.PARMS,.MESSAGES)
I 'SUCCESS D
. N MSG,SUBJECT,VARIABLES
. S SUBJECT="Clinical Specialty HL7 Generation"
. S MSG(1)="An error occurred in OUTPUT^"_$T(+0)_" where the SENDSUB^HLOAPI1"
. S MSG(2)="invocation failed. The error message is as follows:"
. S MSG(3)=""""_SUCCESS_""""
. S VARIABLES("HLMSTATE")=""
. S VARIABLES("PARMS")=""
. D ERROR^MAGDHOWA(SUBJECT,.MSG,.VARIABLES)
. Q
Q
;
ERROR(SUBJECT,MSG,VARIABLES) ; error logging subroutine
N APP,I,PLACE,VAR
;
S PLACE=$$PLACE^MAGBAPI(+$G(DUZ(2)))
S APP="CPRS_DICOM_and_HL7"
;
K ^TMP($J,"MAGQ",PLACE,APP)
D ADD("Message:"),ADD("")
F I=1:1 Q:'$D(MSG(I)) D ADD(MSG(I))
D ADD(""),ADD("Variables:"),ADD("")
S VAR="" F S VAR=$O(VARIABLES(VAR)) Q:VAR="" D
. I '$D(@VAR) D ADD(VAR_" (undefined)") ; undefined
. E I $D(@VAR)=1 D ADD(VAR_"="_@VAR) ; scalar
. E D ; array
. . N A
. . S A=VAR F D Q:A="" ; traverse the array
. . . I $D(@A)#2 D ADD(A_"="_@A)
. . . S A=$Q(@A)
. . . Q
. . Q
. Q
D ADD("End of Message")
D MAILSHR^MAGQBUT1(PLACE,APP,SUBJECT) ; sent the mail message
Q
;
ADD(X) ; add a line to the email message
N LASTIEN
S LASTIEN=$O(^TMP($J,"MAGQ",PLACE,APP,""),-1)
S ^TMP($J,"MAGQ",PLACE,APP,LASTIEN+1)=X
Q
;
TEST ; this tests the email error trap
; S DUZ=126,DUZ(2)=660 - set these appropriately before calling TEST
N ARRAY,SCALAR,SUBJECT,UNDEFINED
S ARRAY="This is test"
S ARRAY(1)="Still testing"
S ARRAY("B")="More testing"
S ARRAY("C",1,2,3,4,5)="Additional testing"
S SCALAR="This is a very bad error"
; S UNDEFINED=
S VARIABLES("ARRAY")=""
S VARIABLES("SCALAR")=""
S VARIABLES("UNDEFINED")=""
S SUBJECT="Testing Clinical Specialty HL7 Generation Error Handling"
S MSG(1)="This simulated error occurred in TEST^"_$T(+0)_"."
S MSG(2)="This error tests the email messages that are used"
S MSG(3)="to report the error."
D ERROR^MAGDHOWA(SUBJECT,.MSG,.VARIABLES)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDHOWA 8031 printed Oct 16, 2024@18:00:55 Page 2
MAGDHOWA ;WOIFO/PMK - Route traditional 1.6 HL7 ADT messages via HLO ;17 Nov 2017 9:36 AM
+1 ;;3.0;IMAGING;**138,183**;Mar 19, 2002;Build 11;Sep 03, 2013
+2 ;; Per VHA Directive 2004-038, this routine should not be modified.
+3 ;; +---------------------------------------------------------------+
+4 ;; | Property of the US Government. |
+5 ;; | No permission to copy or redistribute this software is given. |
+6 ;; | Use of unreleased versions of this software requires the user |
+7 ;; | to execute a written test agreement with the VistA Imaging |
+8 ;; | Development Office of the Department of Veterans Affairs, |
+9 ;; | telephone (301) 734-0100. |
+10 ;; | The Food and Drug Administration classifies this software as |
+11 ;; | a medical device. As such, it may not be changed in any way. |
+12 ;; | Modifications to this software may result in an adulterated |
+13 ;; | medical device under 21CFR820, the use of which is considered |
+14 ;; | to be a violation of US Federal Statutes. |
+15 ;; +---------------------------------------------------------------+
+16 ;;
+17 ;
+18 ; Supported IA #4716 reference ^HLOAPI function calls
+19 ; Supported IA #4717 reference ^HLOAPI1 function calls
+20 ;
+21 ; The ADT A01, A02, A03, A11, A12, and A13 messages for commercial
+22 ; PACS were created by patch MAG*3.0*49.
+23 ; The ADT A08 and A47 messages were created by patch MAG*3.0*183.
+24 ; They are transmitted using the traditional 1.6 HL7 package.
+25 ;
+26 ; The HL7 for clinical specialties uses the new HL7 Optimized package.
+27 ;
+28 ; This routine is referenced by subscriber protocols to the original
+29 ; six HL7 event drivers and the two new ones for A08 and A47.
+30 ; It enables the HL7 1.6 messages to be routed using the new HL7
+31 ; Optimized package. In this way, all of the clinical specialty
+32 ; systems deal with just the HL7 Optimized package.
+33 ;
+34 ;
+35 ; There are eight MAG CPACS ADT event drivers:
+36 ; MAG CPACS A01 - Inpatient admission
+37 ; MAG CPACS A02 - Patient transfer
+38 ; MAG CPACS A03 - Patient discharge
+39 ; MAG CPACS A08 - Update patient information
+40 ; MAG CPACS A11 - Cancel inpatient admission
+41 ; MAG CPACS A12 - Cancel patient transfer
+42 ; MAG CPACS A13 - Cancel patient discharge
+43 ; MAG CPACS A47 - Change patient identifier list
+44 ;
+45 ; There are eight MAG CPACS ADT HL7 1.6 subscribers:
+46 ; MAG CPACS A01 SUBS - Routes inpatient admissions
+47 ; MAG CPACS A02 SUBS - Routes patient transfers
+48 ; MAG CPACS A03 SUBS - Routes patient discharges
+49 ; MAG CPACS A08 SUBS - Update patient information
+50 ; MAG CPACS A11 SUBS - Routes admission cancellations
+51 ; MAG CPACS A12 SUBS - Routes transfer cancellations
+52 ; MAG CPACS A13 SUBS - Routes discharge cancellations
+53 ; MAG CPACS A47 SUBS - Routes change patient identifier list
+54 ; All of these use the HL7 logical link MAG CPACS
+55 ;
+56 ; There are eight MAG CPACS ADT HLO subscribers that call this routine:
+57 ; MAG CPACS A01 SUBS-HLO - Routes inpatient admissions
+58 ; MAG CPACS A02 SUBS-HLO - Routes patient transfers
+59 ; MAG CPACS A03 SUBS-HLO - Routes patient discharges
+60 ; MAG CPACS A08 SUBS-HLO - Update patient information
+61 ; MAG CPACS A11 SUBS-HLO - Routes admission cancellations
+62 ; MAG CPACS A12 SUBS-HLO - Routes transfer cancellations
+63 ; MAG CPACS A13 SUBS-HLO - Routes discharge cancellations
+64 ; MAG CPACS A47 SUBS-HLO - Routes change patient identifier list
+65 ;
+66 ; All eight new MAG CPACS ADT HLO subscribers call this routine - each
+67 ; protocol file (#101) entry has PROCESSING ROUTINE: D ENTRY^MAGDHOWA
+68 ;
+69 ;
ENTRY ; subscriber entry point
+1 NEW HLMSTATE,MSGTYPE
+2 ;
+3 SET MSGTYPE="ADT"
+4 ;
+5 DO INPUT
+6 ;
+7 DO OUTPUT
+8 QUIT
+9 ;
INPUT ; get the generated HL7 message and save it in HLO's HLMSTATE
+1 NEW A,B,C,ERROR,EVENT,S1,S2,S3,S4,S5
+2 IF $EXTRACT($GET(HLARYTYP),1)="G"
MERGE A=^TMP("HLS",$JOB)
+3 IF '$TEST
IF $EXTRACT($GET(HLARYTYP),1)="L"
MERGE A=HLA("HLS")
+4 ; no input data <-----------------------------
IF '$TEST
QUIT
+5 ;
+6 SET A(1)=HLREC("HDR")
+7 ;
+8 ; $$PARSE converts HL7 message "A" to HL7 tree ("B")
+9 ;
+10 SET X=$$PARSE^MAG7UP("A","B")
+11 ;
+12 ; "C" will contain the HL7 HLO tree, just the fifth subscript level
+13 ;
+14 SET S1=""
FOR
SET S1=$ORDER(B(S1))
if S1=""
QUIT
Begin DoDot:1
+15 SET S2=""
FOR
SET S2=$ORDER(B(S1,S2))
if S2=""
QUIT
Begin DoDot:2
+16 ;
+17 ; store segment name at (S1,0,1,1,1) node
+18 IF S2=0
SET C(S1,0,1,1,1)=B(S1,0)
QUIT
+19 ;
+20 SET S3=""
FOR
SET S3=$ORDER(B(S1,S2,S3))
if S3=""
QUIT
Begin DoDot:3
+21 SET S4=""
FOR
SET S4=$ORDER(B(S1,S2,S3,S4))
if S4=""
QUIT
Begin DoDot:4
+22 SET S5=""
FOR
SET S5=$ORDER(B(S1,S2,S3,S4,S5))
if S5=""
QUIT
Begin DoDot:5
+23 SET C(S1,S2,S3,S4,S5)=B(S1,S2,S3,S4,S5)
+24 QUIT
End DoDot:5
+25 QUIT
End DoDot:4
+26 QUIT
End DoDot:3
+27 QUIT
End DoDot:2
+28 QUIT
End DoDot:1
+29 ;
+30 IF C(2,0,1,1,1)="EVN"
Begin DoDot:1
+31 ; ADT event type from the EVN message
SET EVENT=C(2,1,1,1,1)
+32 QUIT
End DoDot:1
+33 ; unknown event? <-------------------------------
IF '$TEST
SET EVENT="O01"
+34 ;
+35 ; build the HLO structure with all the segments, after the MSH
+36 DO INIT^MAGDHOW2(MSGTYPE,EVENT)
+37 SET S1=1
FOR
SET S1=$ORDER(C(S1))
if S1=""
QUIT
Begin DoDot:1
+38 NEW SEGMENT,SUCCESS
+39 MERGE SEGMENT=C(S1)
+40 SET SUCCESS=$$ADDSEG^HLOAPI(.HLMSTATE,.SEGMENT,.ERROR)
+41 IF 'SUCCESS
Begin DoDot:2
+42 NEW MSG,SUBJECT,VARIABLES
+43 SET SUBJECT="Clinical Specialty HL7 Generation"
+44 SET MSG(1)="An error occurred in INPUT^"_$TEXT(+0)_" where the ADDSEG^HLOAPI"
+45 SET MSG(2)="invocation failed. The error message is as follows:"
+46 SET MSG(3)=""""_SUCCESS_""""
+47 SET VARIABLES("HLMSTATE")=""
+48 SET VARIABLES("SEGMENT")=""
+49 SET VARIABLES("ERROR")=""
+50 SET VARIABLES("C")=""
+51 DO ERROR^MAGDHOWA(SUBJECT,.MSG,.VARIABLES)
+52 QUIT
End DoDot:2
+53 QUIT
End DoDot:1
+54 QUIT
+55 ;
OUTPUT ; send the HL7 message using HLO's subscription list
+1 NEW DIC,DO,HL7SUBLIST,MESSAGES,PARMS,SUCCESS,X,Y
+2 ;
+3 ; send the message via subscription list
+4 SET DIC=779.4
SET DIC(0)="BX"
SET X="MAGD ADT"
DO ^DIC
+5 ; Y should equal "<ien>^MAGD ADT"
SET HL7SUBLIST=$PIECE(Y,"^",1)
+6 SET PARMS("SENDING APPLICATION")="MAGD SENDER"
+7 SET PARMS("SUBSCRIPTION IEN")=HL7SUBLIST
+8 ; the HLO private queue name is the name of the subscription list
+9 ; private queue, 20 char max.
SET PARMS("QUEUE")=$EXTRACT($$GET1^DIQ(779.4,HL7SUBLIST,.01),1,20)
+10 SET SUCCESS=$$SENDSUB^HLOAPI1(.HLMSTATE,.PARMS,.MESSAGES)
+11 IF 'SUCCESS
Begin DoDot:1
+12 NEW MSG,SUBJECT,VARIABLES
+13 SET SUBJECT="Clinical Specialty HL7 Generation"
+14 SET MSG(1)="An error occurred in OUTPUT^"_$TEXT(+0)_" where the SENDSUB^HLOAPI1"
+15 SET MSG(2)="invocation failed. The error message is as follows:"
+16 SET MSG(3)=""""_SUCCESS_""""
+17 SET VARIABLES("HLMSTATE")=""
+18 SET VARIABLES("PARMS")=""
+19 DO ERROR^MAGDHOWA(SUBJECT,.MSG,.VARIABLES)
+20 QUIT
End DoDot:1
+21 QUIT
+22 ;
ERROR(SUBJECT,MSG,VARIABLES) ; error logging subroutine
+1 NEW APP,I,PLACE,VAR
+2 ;
+3 SET PLACE=$$PLACE^MAGBAPI(+$GET(DUZ(2)))
+4 SET APP="CPRS_DICOM_and_HL7"
+5 ;
+6 KILL ^TMP($JOB,"MAGQ",PLACE,APP)
+7 DO ADD("Message:")
DO ADD("")
+8 FOR I=1:1
if '$DATA(MSG(I))
QUIT
DO ADD(MSG(I))
+9 DO ADD("")
DO ADD("Variables:")
DO ADD("")
+10 SET VAR=""
FOR
SET VAR=$ORDER(VARIABLES(VAR))
if VAR=""
QUIT
Begin DoDot:1
+11 ; undefined
IF '$DATA(@VAR)
DO ADD(VAR_" (undefined)")
+12 ; scalar
IF '$TEST
IF $DATA(@VAR)=1
DO ADD(VAR_"="_@VAR)
+13 ; array
IF '$TEST
Begin DoDot:2
+14 NEW A
+15 ; traverse the array
SET A=VAR
FOR
Begin DoDot:3
+16 IF $DATA(@A)#2
DO ADD(A_"="_@A)
+17 SET A=$QUERY(@A)
+18 QUIT
End DoDot:3
if A=""
QUIT
+19 QUIT
End DoDot:2
+20 QUIT
End DoDot:1
+21 DO ADD("End of Message")
+22 ; sent the mail message
DO MAILSHR^MAGQBUT1(PLACE,APP,SUBJECT)
+23 QUIT
+24 ;
ADD(X) ; add a line to the email message
+1 NEW LASTIEN
+2 SET LASTIEN=$ORDER(^TMP($JOB,"MAGQ",PLACE,APP,""),-1)
+3 SET ^TMP($JOB,"MAGQ",PLACE,APP,LASTIEN+1)=X
+4 QUIT
+5 ;
TEST ; this tests the email error trap
+1 ; S DUZ=126,DUZ(2)=660 - set these appropriately before calling TEST
+2 NEW ARRAY,SCALAR,SUBJECT,UNDEFINED
+3 SET ARRAY="This is test"
+4 SET ARRAY(1)="Still testing"
+5 SET ARRAY("B")="More testing"
+6 SET ARRAY("C",1,2,3,4,5)="Additional testing"
+7 SET SCALAR="This is a very bad error"
+8 ; S UNDEFINED=
+9 SET VARIABLES("ARRAY")=""
+10 SET VARIABLES("SCALAR")=""
+11 SET VARIABLES("UNDEFINED")=""
+12 SET SUBJECT="Testing Clinical Specialty HL7 Generation Error Handling"
+13 SET MSG(1)="This simulated error occurred in TEST^"_$TEXT(+0)_"."
+14 SET MSG(2)="This error tests the email messages that are used"
+15 SET MSG(3)="to report the error."
+16 DO ERROR^MAGDHOWA(SUBJECT,.MSG,.VARIABLES)
+17 QUIT
