MAGDHOW2 ;WOIFO/PMK,DAC,JSL - Capture Consult/GMRC data ;22 Jul 2021 10:13 AM
;;3.0;IMAGING;**138,156,183,208,301**;Mar 19, 2002;Build 6;Nov 16, 2014
;; 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 #2056 reference $$GET1^DIQ function call
; Supported IA #4716 reference ^HLOAPI function calls
; Supported IA #4717 reference ^HLOAPI1 function calls
; Supported IA #5886 reference ^HLOPBLD1 function calls
; Supported IA #6103 reference for reading ^HLA
; Supported IA #6925 to read HLO SUBSCRIPTION REGISTRY (#779.4)
; Supported IA #10103 reference $$DT^XLFDT function call
; Supported IA #10103 reference $$NOW^XLFDT function call
;
;
MESSAGE(SERVICE) ; invoked from ^MAGDHOW1
N CONSULT,ERROR,HL7IEN,HLMSTATE,I,MESSAGES,MSG,NEXT,OBXSEGNO
N PRIORITY,SAVEORCSEG,SUCCESS,TIUDOC,X,Y
;
; P156 DAC - Support for HL7 result messages
I MSGTYPE="ORM" D ; order entry message
. D INIT(MSGTYPE,"O01") ; start building a new HL7 order entry message
. Q
E D ; result message
. D INIT(MSGTYPE,"R01") ; start building a new HL7 result message
. Q
;
D PIDPV1^MAGDHOW2(.HLMSTATE,DFN)
D ORC^MAGDHOW3(.HLMSTATE,GMRCIEN,.SAVEORCSEG)
D OBR^MAGDHOW4(.HLMSTATE,GMRCIEN,.SAVEORCSEG,SERVICE)
D ZDS^MAGDHOW5(.HLMSTATE,GMRCIEN)
D OBX^MAGDHOW5(.HLMSTATE,GMRCIEN)
;
; send the message via subscription list
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")=$$GET1^DIQ(779.4,HL7SUBLIST,.01) ; private queue
S SUCCESS=$$SENDSUB^HLOAPI1(.HLMSTATE,.PARMS,.MESSAGES)
I 'SUCCESS D
. N MSG,SUBJECT,VARIABLES
. S SUBJECT="VistA Imaging Clinical Specialty (CPRS) HL7 Generation"
. S MSG(1)="An error occurred in "_$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")=""
. S VARIABLES("MESSAGES")=""
. D ERROR^MAGDHOWA(SUBJECT,.MSG,.VARIABLES)
. Q
D OUTPUT ; send to DICOM Gateway
;
Q
;
INIT(MSGTYPE,EVENT) ; start building a new HL7 message
N ERROR,PARMS,SUCCESS
S PARMS("COUNTRY")="USA"
S PARMS("CONTINUATION POINTER")=0
S PARMS("EVENT")=EVENT
S PARMS("FIELD SEPARATOR")="|"
S PARMS("ENCODING CHARACTERS")="^~\&"
S PARMS("MESSAGE STRUCTURE")=MSGTYPE_"_"_EVENT
S PARMS("MESSAGE TYPE")=MSGTYPE
S PARMS("PROCESSING MODE")="T"
S PARMS("VERSION")=2.4
S SUCCESS=$$NEWMSG^HLOAPI(.PARMS,.HLMSTATE,.ERROR)
I 'SUCCESS D
. N MSG,SUBJECT,VARIABLES
. S SUBJECT="VistA Imaging Clinical Specialty (CPRS) HL7 Generation"
. S MSG(1)="An error occurred in INIT^"_$T(+0)_" where the NEWMSG^HLOAPI"
. S MSG(2)="invocation failed. The error message is as follows:"
. S MSG(3)=""""_SUCCESS_""""
. S VARIABLES("PARMS")=""
. S VARIABLES("HLMSTATE")=""
. S VARIABLES("ERROR")=""
. D ERROR^MAGDHOWA(SUBJECT,.MSG,.VARIABLES)
. Q
Q
;
PIDPV1(HLMSTATE,DFN) ; build the PID and PV1 segments
; Also invoked by ^MAGT7S to build these segments for Anatomic Pathology - P183 PMK 3/7/17
N HL,HL7ARRAY,HL7SEG,HLECH,HLFS,HLQ,NUL,PID,PV1,SUCCESS
S HLECH=HLMSTATE("HDR","ENCODING CHARACTERS")
S HLFS=HLMSTATE("HDR","FIELD SEPARATOR")
S HLQ="""""" ; null fields are set as "", as opposed to being empty
S HL7ARRAY(1,9,1,1,1)=""
S HL7ARRAY(1,0)="MSH"
S HL7ARRAY(1,1,1,1,1)=HLFS
S HL7ARRAY(1,2,1,1,1)=HLECH
D PID^MAGDHLS(DFN,"HL7ARRAY")
D PV1^MAGDHLS(DFN,"",DT,"HL7ARRAY")
;
S NUL=$$MAKE^MAG7UM("HL7ARRAY","HL7SEG")
S PID=HL7SEG(2)
S PV1=HL7SEG(3)
S SUCCESS=$S($T(MOVESEG^HLOAPI)'="":$$MOVESEG^HLOAPI(.HLMSTATE,PID,.ERROR),1:$$MOVESEG(.HLMSTATE,PID,.ERROR)) ;In case missing HL7 patch
I 'SUCCESS D
. N MSG,SUBJECT,VARIABLES
. S SUBJECT="VistA Imaging Clinical Specialty (CPRS) HL7 Generation"
. S MSG(1)="An error occurred in PIDPV1^"_$T(+0)_" where the MOVESEG^HLOAPI invocation"
. S MSG(2)="for the PID segment failed. The error message is as follows:"
. S MSG(3)=""""_SUCCESS_""""
. S VARIABLES("HLMSTATE")=""
. S VARIABLES("PID")=""
. S VARIABLES("ERROR")=""
. D ERROR^MAGDHOWA(SUBJECT,.MSG,.VARIABLES)
. Q
S SUCCESS=$S($T(MOVESEG^HLOAPI)'="":$$MOVESEG^HLOAPI(.HLMSTATE,PV1,.ERROR),1:$$MOVESEG(.HLMSTATE,PV1,.ERROR)) ;In case missing HL7 patch
I 'SUCCESS D
. N MSG,SUBJECT,VARIABLES
. S SUBJECT="VistA Imaging Clinical Specialty (CPRS) HL7 Generation"
. S MSG(1)="An error occurred in PIDPV1^"_$T(+0)_" where the MOVESEG^HLOAPI invocation"
. S MSG(2)="for the PV1 segment failed. The error message is as follows:"
. S MSG(3)=""""_SUCCESS_""""
. S VARIABLES("HLMSTATE")=""
. S VARIABLES("PID")=""
. S VARIABLES("ERROR")=""
. D ERROR^MAGDHOWA(SUBJECT,.MSG,.VARIABLES)
. Q
Q
;
OUTPUT ; output the messages to ^MAGDHL7
N D0,DEL,FMDATE,FMDATETIME,HLAIEN,HDR,HL7,HL7MSH,I,I1,I2,J,K,MSG,N,X,Y,Z
S HLAIEN=HLMSTATE("BODY")
S HLMSTATE("HDR","RECEIVING APPLICATION")=$G(HLMSTATE("HDR","RECEIVING APPLICATION")) ;IHS
F I=1,2,3 S HLMSTATE("HDR","RECEIVING FACILITY",I)=$G(HLMSTATE("HDR","RECEIVING FACILITY",I)) ;IHS
;
; build the MSH segment
D BUILDHDR^HLOPBLD1(.HLMSTATE,"MSH",.HL7MSH)
;
; copy the two lines of the MSH segment to the HL7 array
S HL7MSH=HL7MSH(1)_HL7MSH(2) ; MSH segment
S DEL=HLMSTATE("HDR","FIELD SEPARATOR")
S $P(HL7MSH,DEL,5)="MAGD-CONSULT" ; receiving application
S $P(HL7MSH,DEL,6)="" ; receiving facility
S J=1,HL7(J)=HL7MSH
;
; copy the body of the message to the HL7 array
; some of the message may be in ^HLA(HLAIEN) - if so, get it first
;
I HLAIEN D ; get the segments that are saved in ^HLA(HLAIEN)
. ; note: segments are separated by a blank line
. S I=0 F S I=$O(^HLA(HLAIEN,1,I)) Q:I="" D
. . S X=$G(^HLA(HLAIEN,1,I,0))
. . I X'="" S J=J+1,HL7(J)=X
. . Q
. Q
;
; get the remainder of the messages from memory
; note: segments are separated by a blank line
S I1=0 F S I1=$O(HLMSTATE("UNSTORED LINES",1,I1)) Q:I1="" D
. S I2=0 F S I2=$O(HLMSTATE("UNSTORED LINES",1,I1,I2)) Q:I2="" D
. . S X=HLMSTATE("UNSTORED LINES",1,I1,I2)
. . I X'="" S J=J+1,HL7(J)=X
. . Q
. Q
;
S N=J ; number of HL7 record lines
S DEL=$E(HL7(1),4) ; field separator
S $P(HL7(1),DEL,5,6)="MAGD-CONSULT"_DEL ; receiving application
;
; get the next node in the ^MAGDHL7 global
S FMDATETIME=$$NOW^XLFDT,FMDATE=$$DT^XLFDT
L +^MAGDHL7(2006.5,0):1E9 ; Background process MUST wait
S D0=$O(^MAGDHL7(2006.5," "),-1)+1
S ^MAGDHL7(2006.5,D0,0)=FMDATE
S:FMDATE'="" ^MAGDHL7(2006.5,"B",FMDATE,D0)=""
S HDR=$G(^MAGDHL7(2006.5,0))
S ^MAGDHL7(2006.5,0)="PACS MESSAGE^2006.5D^"_D0_"^"_($P(HDR,"^",4)+1)
L -^MAGDHL7(2006.5,0)
;
; copy the message to the ^MAGDHL7 global, field by field
S ^MAGDHL7(2006.5,D0,0)=FMDATE_"^"_MSGTYPE_"^"_FMDATETIME
S (I,J)=0 F I=1:1:N S X=HL7(I) D
. S Y=$P(X,DEL)
. F K=2:1:$L(X,DEL) D ; copy the lines to the ^MAGDHL7 global
. . S Z=$P(X,DEL,K)
. . I ($L(Y)+$L(Z))>200 D ; keep lines short for the global
. . . ; output one line of a spanned record
. . . S J=J+1,^MAGDHL7(2006.5,D0,1,J,0)=Y,Y=""
. . . Q
. . S Y=Y_DEL_$P(X,DEL,K)
. . Q
. S J=J+1,^MAGDHL7(2006.5,D0,1,J,0)=Y
. Q
S:FMDATETIME'="" ^MAGDHL7(2006.5,"C",FMDATETIME,D0)="" ; P183 PMK 3/6/17
; The next line must be last, since WAIT^MAGDHRS1
; uses this node to determine that the entry is complete.
S ^MAGDHL7(2006.5,D0,1,0)="^^"_J_"^"_J_"^"_FMDATETIME
;
I $G(CPINVOCATION) D OUTPUT^MAGDHOWP(N) ; copy HL7 message for clinical procedures - P208 PMK 4/12/18
Q
;
;**HL7 P146 routine: HLOAPI
MOVESEG(HLMSTATE,SEG,ERROR) ;Adds a segment built in the 'traditional' way as an array of lines into the message.
;;Input:
;; HLMSTATE() - (pass by reference, required) This array is a workspace for HLO.
;; SEG() - (pass-by-reference, required) Contains the segment. The segement. If the segment is short enough it should consist of only SEG or SEG(1). If longer, additional lines can be added as SEG(<n>).
;;
;;Note#1: The message control segments, including the MSH, BHS & FTS segments, are added automatically, so may not be added by MOVESEG.
;;
;;Output:
;; HLMSTATE() - (pass-by-reference, required) This array is the workspace used by HLO.
;; FUNCTION - returns 1 on success, 0 on failure
;;
;; ERROR (optional, pass by reference) - returns an error message on failure
;;
;
K ERROR
N TYPE,NEWCOUNT,OLDCOUNT,TOARY
;
S NEWCOUNT=1
I $L($G(SEG)) S TOARY(1)=SEG,NEWCOUNT=2
S OLDCOUNT=0
F S OLDCOUNT=$O(SEG(OLDCOUNT)) Q:'OLDCOUNT S TOARY(NEWCOUNT)=SEG(OLDCOUNT),NEWCOUNT=NEWCOUNT+1
S TYPE=$P($G(TOARY(1)),HLMSTATE("HDR","FIELD SEPARATOR")) ;segment type
;
;if a 'generic' app ack MSA was built, add it as the first segment before this one
I $D(HLMSTATE("MSA")) D
.I TYPE'="MSA" N TOARY S TOARY(1)=HLMSTATE("MSA") D ADDSEG^HLOMSG(.HLMSTATE,.TOARY)
.K HLMSTATE("MSA")
;
I ($L(TYPE)'=3) S ERROR="INVALID SEGMENT TYPE" Q 0
I (TYPE="MSH")!(TYPE="BHS")!(TYPE="BTS")!(TYPE="FHS")!(TYPE="FTS") S ERROR="INVALID SEGMENT TYPE" Q 0
I HLMSTATE("BATCH"),'HLMSTATE("BATCH","CURRENT MESSAGE") S ERROR="NO MESSAGES IN BATCH, SO SEGMENTS NOT ALLOWED" Q 0
D ADDSEG^HLOMSG(.HLMSTATE,.TOARY)
Q 1
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDHOW2 10251 printed Oct 16, 2024@18:00:51 Page 2
MAGDHOW2 ;WOIFO/PMK,DAC,JSL - Capture Consult/GMRC data ;22 Jul 2021 10:13 AM
+1 ;;3.0;IMAGING;**138,156,183,208,301**;Mar 19, 2002;Build 6;Nov 16, 2014
+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 #2056 reference $$GET1^DIQ function call
+19 ; Supported IA #4716 reference ^HLOAPI function calls
+20 ; Supported IA #4717 reference ^HLOAPI1 function calls
+21 ; Supported IA #5886 reference ^HLOPBLD1 function calls
+22 ; Supported IA #6103 reference for reading ^HLA
+23 ; Supported IA #6925 to read HLO SUBSCRIPTION REGISTRY (#779.4)
+24 ; Supported IA #10103 reference $$DT^XLFDT function call
+25 ; Supported IA #10103 reference $$NOW^XLFDT function call
+26 ;
+27 ;
MESSAGE(SERVICE) ; invoked from ^MAGDHOW1
+1 NEW CONSULT,ERROR,HL7IEN,HLMSTATE,I,MESSAGES,MSG,NEXT,OBXSEGNO
+2 NEW PRIORITY,SAVEORCSEG,SUCCESS,TIUDOC,X,Y
+3 ;
+4 ; P156 DAC - Support for HL7 result messages
+5 ; order entry message
IF MSGTYPE="ORM"
Begin DoDot:1
+6 ; start building a new HL7 order entry message
DO INIT(MSGTYPE,"O01")
+7 QUIT
End DoDot:1
+8 ; result message
IF '$TEST
Begin DoDot:1
+9 ; start building a new HL7 result message
DO INIT(MSGTYPE,"R01")
+10 QUIT
End DoDot:1
+11 ;
+12 DO PIDPV1^MAGDHOW2(.HLMSTATE,DFN)
+13 DO ORC^MAGDHOW3(.HLMSTATE,GMRCIEN,.SAVEORCSEG)
+14 DO OBR^MAGDHOW4(.HLMSTATE,GMRCIEN,.SAVEORCSEG,SERVICE)
+15 DO ZDS^MAGDHOW5(.HLMSTATE,GMRCIEN)
+16 DO OBX^MAGDHOW5(.HLMSTATE,GMRCIEN)
+17 ;
+18 ; send the message via subscription list
+19 SET PARMS("SENDING APPLICATION")="MAGD SENDER"
+20 SET PARMS("SUBSCRIPTION IEN")=HL7SUBLIST
+21 ; the HLO private queue name is the name of the subscription list
+22 ; private queue
SET PARMS("QUEUE")=$$GET1^DIQ(779.4,HL7SUBLIST,.01)
+23 SET SUCCESS=$$SENDSUB^HLOAPI1(.HLMSTATE,.PARMS,.MESSAGES)
+24 IF 'SUCCESS
Begin DoDot:1
+25 NEW MSG,SUBJECT,VARIABLES
+26 SET SUBJECT="VistA Imaging Clinical Specialty (CPRS) HL7 Generation"
+27 SET MSG(1)="An error occurred in "_$TEXT(+0)_" where the SENDSUB^HLOAPI1"
+28 SET MSG(2)="invocation failed. The error message is as follows:"
+29 SET MSG(3)=""""_SUCCESS_""""
+30 SET VARIABLES("HLMSTATE")=""
+31 SET VARIABLES("PARMS")=""
+32 SET VARIABLES("MESSAGES")=""
+33 DO ERROR^MAGDHOWA(SUBJECT,.MSG,.VARIABLES)
+34 QUIT
End DoDot:1
+35 ; send to DICOM Gateway
DO OUTPUT
+36 ;
+37 QUIT
+38 ;
INIT(MSGTYPE,EVENT) ; start building a new HL7 message
+1 NEW ERROR,PARMS,SUCCESS
+2 SET PARMS("COUNTRY")="USA"
+3 SET PARMS("CONTINUATION POINTER")=0
+4 SET PARMS("EVENT")=EVENT
+5 SET PARMS("FIELD SEPARATOR")="|"
+6 SET PARMS("ENCODING CHARACTERS")="^~\&"
+7 SET PARMS("MESSAGE STRUCTURE")=MSGTYPE_"_"_EVENT
+8 SET PARMS("MESSAGE TYPE")=MSGTYPE
+9 SET PARMS("PROCESSING MODE")="T"
+10 SET PARMS("VERSION")=2.4
+11 SET SUCCESS=$$NEWMSG^HLOAPI(.PARMS,.HLMSTATE,.ERROR)
+12 IF 'SUCCESS
Begin DoDot:1
+13 NEW MSG,SUBJECT,VARIABLES
+14 SET SUBJECT="VistA Imaging Clinical Specialty (CPRS) HL7 Generation"
+15 SET MSG(1)="An error occurred in INIT^"_$TEXT(+0)_" where the NEWMSG^HLOAPI"
+16 SET MSG(2)="invocation failed. The error message is as follows:"
+17 SET MSG(3)=""""_SUCCESS_""""
+18 SET VARIABLES("PARMS")=""
+19 SET VARIABLES("HLMSTATE")=""
+20 SET VARIABLES("ERROR")=""
+21 DO ERROR^MAGDHOWA(SUBJECT,.MSG,.VARIABLES)
+22 QUIT
End DoDot:1
+23 QUIT
+24 ;
PIDPV1(HLMSTATE,DFN) ; build the PID and PV1 segments
+1 ; Also invoked by ^MAGT7S to build these segments for Anatomic Pathology - P183 PMK 3/7/17
+2 NEW HL,HL7ARRAY,HL7SEG,HLECH,HLFS,HLQ,NUL,PID,PV1,SUCCESS
+3 SET HLECH=HLMSTATE("HDR","ENCODING CHARACTERS")
+4 SET HLFS=HLMSTATE("HDR","FIELD SEPARATOR")
+5 ; null fields are set as "", as opposed to being empty
SET HLQ=""""""
+6 SET HL7ARRAY(1,9,1,1,1)=""
+7 SET HL7ARRAY(1,0)="MSH"
+8 SET HL7ARRAY(1,1,1,1,1)=HLFS
+9 SET HL7ARRAY(1,2,1,1,1)=HLECH
+10 DO PID^MAGDHLS(DFN,"HL7ARRAY")
+11 DO PV1^MAGDHLS(DFN,"",DT,"HL7ARRAY")
+12 ;
+13 SET NUL=$$MAKE^MAG7UM("HL7ARRAY","HL7SEG")
+14 SET PID=HL7SEG(2)
+15 SET PV1=HL7SEG(3)
+16 ;In case missing HL7 patch
SET SUCCESS=$SELECT($TEXT(MOVESEG^HLOAPI)'="":$$MOVESEG^HLOAPI(.HLMSTATE,PID,.ERROR),1:$$MOVESEG(.HLMSTATE,PID,.ERROR))
+17 IF 'SUCCESS
Begin DoDot:1
+18 NEW MSG,SUBJECT,VARIABLES
+19 SET SUBJECT="VistA Imaging Clinical Specialty (CPRS) HL7 Generation"
+20 SET MSG(1)="An error occurred in PIDPV1^"_$TEXT(+0)_" where the MOVESEG^HLOAPI invocation"
+21 SET MSG(2)="for the PID segment failed. The error message is as follows:"
+22 SET MSG(3)=""""_SUCCESS_""""
+23 SET VARIABLES("HLMSTATE")=""
+24 SET VARIABLES("PID")=""
+25 SET VARIABLES("ERROR")=""
+26 DO ERROR^MAGDHOWA(SUBJECT,.MSG,.VARIABLES)
+27 QUIT
End DoDot:1
+28 ;In case missing HL7 patch
SET SUCCESS=$SELECT($TEXT(MOVESEG^HLOAPI)'="":$$MOVESEG^HLOAPI(.HLMSTATE,PV1,.ERROR),1:$$MOVESEG(.HLMSTATE,PV1,.ERROR))
+29 IF 'SUCCESS
Begin DoDot:1
+30 NEW MSG,SUBJECT,VARIABLES
+31 SET SUBJECT="VistA Imaging Clinical Specialty (CPRS) HL7 Generation"
+32 SET MSG(1)="An error occurred in PIDPV1^"_$TEXT(+0)_" where the MOVESEG^HLOAPI invocation"
+33 SET MSG(2)="for the PV1 segment failed. The error message is as follows:"
+34 SET MSG(3)=""""_SUCCESS_""""
+35 SET VARIABLES("HLMSTATE")=""
+36 SET VARIABLES("PID")=""
+37 SET VARIABLES("ERROR")=""
+38 DO ERROR^MAGDHOWA(SUBJECT,.MSG,.VARIABLES)
+39 QUIT
End DoDot:1
+40 QUIT
+41 ;
OUTPUT ; output the messages to ^MAGDHL7
+1 NEW D0,DEL,FMDATE,FMDATETIME,HLAIEN,HDR,HL7,HL7MSH,I,I1,I2,J,K,MSG,N,X,Y,Z
+2 SET HLAIEN=HLMSTATE("BODY")
+3 ;IHS
SET HLMSTATE("HDR","RECEIVING APPLICATION")=$GET(HLMSTATE("HDR","RECEIVING APPLICATION"))
+4 ;IHS
FOR I=1,2,3
SET HLMSTATE("HDR","RECEIVING FACILITY",I)=$GET(HLMSTATE("HDR","RECEIVING FACILITY",I))
+5 ;
+6 ; build the MSH segment
+7 DO BUILDHDR^HLOPBLD1(.HLMSTATE,"MSH",.HL7MSH)
+8 ;
+9 ; copy the two lines of the MSH segment to the HL7 array
+10 ; MSH segment
SET HL7MSH=HL7MSH(1)_HL7MSH(2)
+11 SET DEL=HLMSTATE("HDR","FIELD SEPARATOR")
+12 ; receiving application
SET $PIECE(HL7MSH,DEL,5)="MAGD-CONSULT"
+13 ; receiving facility
SET $PIECE(HL7MSH,DEL,6)=""
+14 SET J=1
SET HL7(J)=HL7MSH
+15 ;
+16 ; copy the body of the message to the HL7 array
+17 ; some of the message may be in ^HLA(HLAIEN) - if so, get it first
+18 ;
+19 ; get the segments that are saved in ^HLA(HLAIEN)
IF HLAIEN
Begin DoDot:1
+20 ; note: segments are separated by a blank line
+21 SET I=0
FOR
SET I=$ORDER(^HLA(HLAIEN,1,I))
if I=""
QUIT
Begin DoDot:2
+22 SET X=$GET(^HLA(HLAIEN,1,I,0))
+23 IF X'=""
SET J=J+1
SET HL7(J)=X
+24 QUIT
End DoDot:2
+25 QUIT
End DoDot:1
+26 ;
+27 ; get the remainder of the messages from memory
+28 ; note: segments are separated by a blank line
+29 SET I1=0
FOR
SET I1=$ORDER(HLMSTATE("UNSTORED LINES",1,I1))
if I1=""
QUIT
Begin DoDot:1
+30 SET I2=0
FOR
SET I2=$ORDER(HLMSTATE("UNSTORED LINES",1,I1,I2))
if I2=""
QUIT
Begin DoDot:2
+31 SET X=HLMSTATE("UNSTORED LINES",1,I1,I2)
+32 IF X'=""
SET J=J+1
SET HL7(J)=X
+33 QUIT
End DoDot:2
+34 QUIT
End DoDot:1
+35 ;
+36 ; number of HL7 record lines
SET N=J
+37 ; field separator
SET DEL=$EXTRACT(HL7(1),4)
+38 ; receiving application
SET $PIECE(HL7(1),DEL,5,6)="MAGD-CONSULT"_DEL
+39 ;
+40 ; get the next node in the ^MAGDHL7 global
+41 SET FMDATETIME=$$NOW^XLFDT
SET FMDATE=$$DT^XLFDT
+42 ; Background process MUST wait
LOCK +^MAGDHL7(2006.5,0):1E9
+43 SET D0=$ORDER(^MAGDHL7(2006.5," "),-1)+1
+44 SET ^MAGDHL7(2006.5,D0,0)=FMDATE
+45 if FMDATE'=""
SET ^MAGDHL7(2006.5,"B",FMDATE,D0)=""
+46 SET HDR=$GET(^MAGDHL7(2006.5,0))
+47 SET ^MAGDHL7(2006.5,0)="PACS MESSAGE^2006.5D^"_D0_"^"_($PIECE(HDR,"^",4)+1)
+48 LOCK -^MAGDHL7(2006.5,0)
+49 ;
+50 ; copy the message to the ^MAGDHL7 global, field by field
+51 SET ^MAGDHL7(2006.5,D0,0)=FMDATE_"^"_MSGTYPE_"^"_FMDATETIME
+52 SET (I,J)=0
FOR I=1:1:N
SET X=HL7(I)
Begin DoDot:1
+53 SET Y=$PIECE(X,DEL)
+54 ; copy the lines to the ^MAGDHL7 global
FOR K=2:1:$LENGTH(X,DEL)
Begin DoDot:2
+55 SET Z=$PIECE(X,DEL,K)
+56 ; keep lines short for the global
IF ($LENGTH(Y)+$LENGTH(Z))>200
Begin DoDot:3
+57 ; output one line of a spanned record
+58 SET J=J+1
SET ^MAGDHL7(2006.5,D0,1,J,0)=Y
SET Y=""
+59 QUIT
End DoDot:3
+60 SET Y=Y_DEL_$PIECE(X,DEL,K)
+61 QUIT
End DoDot:2
+62 SET J=J+1
SET ^MAGDHL7(2006.5,D0,1,J,0)=Y
+63 QUIT
End DoDot:1
+64 ; P183 PMK 3/6/17
if FMDATETIME'=""
SET ^MAGDHL7(2006.5,"C",FMDATETIME,D0)=""
+65 ; The next line must be last, since WAIT^MAGDHRS1
+66 ; uses this node to determine that the entry is complete.
+67 SET ^MAGDHL7(2006.5,D0,1,0)="^^"_J_"^"_J_"^"_FMDATETIME
+68 ;
+69 ; copy HL7 message for clinical procedures - P208 PMK 4/12/18
IF $GET(CPINVOCATION)
DO OUTPUT^MAGDHOWP(N)
+70 QUIT
+71 ;
+72 ;**HL7 P146 routine: HLOAPI
MOVESEG(HLMSTATE,SEG,ERROR) ;Adds a segment built in the 'traditional' way as an array of lines into the message.
+1 ;;Input:
+2 ;; HLMSTATE() - (pass by reference, required) This array is a workspace for HLO.
+3 ;; SEG() - (pass-by-reference, required) Contains the segment. The segement. If the segment is short enough it should consist of only SEG or SEG(1). If longer, additional lines can be added as SEG(<n>).
+4 ;;
+5 ;;Note#1: The message control segments, including the MSH, BHS & FTS segments, are added automatically, so may not be added by MOVESEG.
+6 ;;
+7 ;;Output:
+8 ;; HLMSTATE() - (pass-by-reference, required) This array is the workspace used by HLO.
+9 ;; FUNCTION - returns 1 on success, 0 on failure
+10 ;;
+11 ;; ERROR (optional, pass by reference) - returns an error message on failure
+12 ;;
+13 ;
+14 KILL ERROR
+15 NEW TYPE,NEWCOUNT,OLDCOUNT,TOARY
+16 ;
+17 SET NEWCOUNT=1
+18 IF $LENGTH($GET(SEG))
SET TOARY(1)=SEG
SET NEWCOUNT=2
+19 SET OLDCOUNT=0
+20 FOR
SET OLDCOUNT=$ORDER(SEG(OLDCOUNT))
if 'OLDCOUNT
QUIT
SET TOARY(NEWCOUNT)=SEG(OLDCOUNT)
SET NEWCOUNT=NEWCOUNT+1
+21 ;segment type
SET TYPE=$PIECE($GET(TOARY(1)),HLMSTATE("HDR","FIELD SEPARATOR"))
+22 ;
+23 ;if a 'generic' app ack MSA was built, add it as the first segment before this one
+24 IF $DATA(HLMSTATE("MSA"))
Begin DoDot:1
+25 IF TYPE'="MSA"
NEW TOARY
SET TOARY(1)=HLMSTATE("MSA")
DO ADDSEG^HLOMSG(.HLMSTATE,.TOARY)
+26 KILL HLMSTATE("MSA")
End DoDot:1
+27 ;
+28 IF ($LENGTH(TYPE)'=3)
SET ERROR="INVALID SEGMENT TYPE"
QUIT 0
+29 IF (TYPE="MSH")!(TYPE="BHS")!(TYPE="BTS")!(TYPE="FHS")!(TYPE="FTS")
SET ERROR="INVALID SEGMENT TYPE"
QUIT 0
+30 IF HLMSTATE("BATCH")
IF 'HLMSTATE("BATCH","CURRENT MESSAGE")
SET ERROR="NO MESSAGES IN BATCH, SO SEGMENTS NOT ALLOWED"
QUIT 0
+31 DO ADDSEG^HLOMSG(.HLMSTATE,.TOARY)
+32 QUIT 1
+33 ;
