MAG7UP ;WOIFO/MLH,PMK - Imaging - HL7 - utilities - break out message into a parse tree ;25 May 2017 2:30 PM
;;3.0;IMAGING;**11,51,183**;MAR 19, 2002;Build 11;JUN 16, 2006
;; 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. |
;; +---------------------------------------------------------------+
;;
Q
;
PARSE(XMSG,XTREE) ; break the HL7 message lines into a parse tree
;
; INPUT: The single-dimensional array of message lines
;
; OUTPUT: The parse tree, in the structure
; @XTREE@(NSEG,0) segment name
; @XTREE@(NSEG,NFLD,NREP,NCMP,NSCM) element data
; @XTREE@("B",SEGID,NSEG) null
;
N I,J,K,L,M,X,Z ; --------------------- scratch vars
N IMSG ; ------------------------------ message array index
N ISUBSEG ; --------------------------- index of continuation data for long segs
N ISUCC ; ----------------------------- successor element index
N FERR ; ------------------------------ error flag
N SEG ; ------------------------------- segment data
N SEGTAG ; ---------------------------- segment ID ("0th" piece)
N UFS,UCS,URS,UEC,USS ;---------------- HL7 delimiters (universal)
N ENC ;-------------------------------- HL7 encoding characters
N UFSESC,UCSESC,URSESC,UECESC,USSESC ;- HL7 escape sequences for delimiters (universal)
N PATTERN ; --------------------------- pattern match for spanned record
N NSEG ; ------------------------------ segment number in the parse tree
N NSEGINPT ; -------------------------- segment number of input HL7 data
N NFLD ; ------------------------------ field number in the segment
N FLD ; ------------------------------- field data
;
S FERR=0 ; assume no error
S IMSG=""
;
; process MSH segment
; If there's a message problem, return it in an NTE segment.
;
S IMSG=$O(@XMSG@(IMSG)) ; array sent?
I IMSG="" D Q FERR ; no
. S FERR=-1
. ; have to use default field separator
. S @XMSG@(0)="NTE|1||"_FERR_";no input array found"
. Q
S SEG=$G(@XMSG@(IMSG)) Q:$E(SEG,1,3)'="MSH" -2 ; an HL7 message?
I $E(SEG,1,3)'="MSH" D Q FERR ; no
. S FERR=-2
. S ISUCC=$O(@XMSG@(IMSG)) S:'ISUCC ISUCC=IMSG+1
. ; have to use default field separator
. S @XMSG@(IMSG+ISUCC/2)="NTE|1||"_FERR_";invalid HL7 message (1st 3 chars must be MSH)"
. Q
;
; set up delimiters and escape sequences
S UFS=$E(SEG,4),@XTREE@(1,1,1,1,1)=UFS
S ENC=$P(SEG,UFS,2),@XTREE@(1,2,1,1,1)=ENC
S UCS=$E(ENC),URS=$E(ENC,2),UEC=$E(ENC,3),USS=$E(ENC,4)
S UFSESC=UEC_"F"_UEC,UCSESC=UEC_"S"_UEC,URSESC=UEC_"R"_UEC,UECESC=UEC_"E"_UEC,USSESC=UEC_"T"_UEC
S PATTERN="1A2AN1"""_UFS_""""
S @XTREE@(1,0)="MSH",@XTREE@("B","MSH",1)=""
F NFLD=3:1:$L(SEG,UFS) S FLD=$P(SEG,UFS,NFLD) D
. I FLD]"" D PROCFLD(XTREE,1,NFLD,FLD)
. Q
; process the remaining segments
S SEG="" ; SEG will be a concatenated series of spanned records
S NSEG=2 ; next segment in the parse tree will be #2
F NSEGINPT=2:1 S IMSG=$O(@XMSG@(IMSG)) Q:IMSG="" D Q:FERR
. S SEG=$G(@XMSG@(IMSG)) Q:SEG=""
. S ISUBSEG="" ; prepare to handle very long HL7 segments (up to 32K)
. F S ISUBSEG=$O(@XMSG@(IMSG,ISUBSEG)) Q:ISUBSEG="" D
. . S SEG=SEG_$G(@XMSG@(IMSG,ISUBSEG))
. . Q
. S SEGTAG=$P(SEG,UFS) I SEGTAG'?1U2.3UN S FERR=-3 Q
. S @XTREE@(NSEG,0)=SEGTAG,@XTREE@("B",SEGTAG,NSEG)=""
. F NFLD=2:1:$L(SEG,UFS) D
. . S FLD=$P(SEG,UFS,NFLD)
. . I FLD]"" D PROCFLD(XTREE,NSEG,NFLD-1,FLD)
. . Q
. S SEG="" ; reinitialize SEG for the next possible concatenation
. S NSEG=NSEG+1 ; increment counter for next segment in the parse tree
. Q
Q FERR
;
PROCFLD(XTREE,XNSEG,XNFLD,XFLD) ; process a field
;
; input: XTREE name of MUMPS array for parse tree ($NA format)
; XNSEG segment number for parse tree
; XNFLD field number for parse tree
; XFLD field data
;
N SG ; ------ segment name
N NREP ; ---- repetition (occurrence) number
N REP ; ----- repetition data
N NCMP ; ---- component number
N CMP ; ----- component data
N NSCM ; ---- subcomponent number
N SCM ; ----- subcomponent data
;
S SG=@XTREE@(XNSEG,0)
; Per DICOM meeting 2004-02-24, reaffirmed that data may need to be
; retrieved above the subcomponent level, and that those data will
; need to be de-escaped because the receiving application won't have
; access to the delimiters from the original message.
S @XTREE@(XNSEG,XNFLD)=$$DEESC(XFLD)
;
; Break out to the lowest delimiter level too. This is not strictly an
; HL7 parse because it does not take actual HL7 (or realm constraining)
; data types into account.
;
F NREP=1:1:$L(XFLD,URS) S REP=$P(XFLD,URS,NREP) I REP]"" D
. F NCMP=1:1:$L(REP,UCS) S CMP=$P(REP,UCS,NCMP) I CMP]"" D
. . ; Per DICOM meeting 2004-02-24, reaffirmed that data may need to be
. . ; retrieved above the subcomponent level, and that those data will
. . ; need to be de-escaped because the receiving application won't have
. . ; access to the delimiters from the original message.
. . S @XTREE@(XNSEG,XNFLD,NREP,NCMP)=$$DEESC(CMP)
. . F NSCM=1:1:$L(CMP,USS) S SCM=$P(CMP,USS,NSCM) I SCM]"" D
. . . S @XTREE@(XNSEG,XNFLD,NREP,NCMP,NSCM)=$$DEESC(SCM)
. . . Q
. . Q
. Q
Q
;
DEESC(XSCM) ; replace escape sequences with delimiter characters
;
; input: XSCM element data before replacement
;
; expects: UFSESC, UCSESC, URSESC, UECESC, USSESC
; delimiter escape sequences
;
; function return: element data after replacement
;
N HIT ; need another pass after each hit
F D Q:'$D(HIT)
. K HIT
. I XSCM[UFSESC S XSCM=$P(XSCM,UFSESC)_UFS_$P(XSCM,UFSESC,2,99999),HIT=1
. I XSCM[UCSESC S XSCM=$P(XSCM,UCSESC)_UCS_$P(XSCM,UCSESC,2,99999),HIT=1
. I XSCM[URSESC S XSCM=$P(XSCM,URSESC)_URS_$P(XSCM,URSESC,2,99999),HIT=1
. I XSCM[UECESC S XSCM=$P(XSCM,UECESC)_UEC_$P(XSCM,UECESC,2,99999),HIT=1
. I XSCM[USSESC S XSCM=$P(XSCM,USSESC)_USS_$P(XSCM,USSESC,2,99999),HIT=1
. Q
Q $E(XSCM,1,510)
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAG7UP 6835 printed Sep 23, 2025@19:35:36 Page 2
MAG7UP ;WOIFO/MLH,PMK - Imaging - HL7 - utilities - break out message into a parse tree ;25 May 2017 2:30 PM
+1 ;;3.0;IMAGING;**11,51,183**;MAR 19, 2002;Build 11;JUN 16, 2006
+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 QUIT
+18 ;
PARSE(XMSG,XTREE) ; break the HL7 message lines into a parse tree
+1 ;
+2 ; INPUT: The single-dimensional array of message lines
+3 ;
+4 ; OUTPUT: The parse tree, in the structure
+5 ; @XTREE@(NSEG,0) segment name
+6 ; @XTREE@(NSEG,NFLD,NREP,NCMP,NSCM) element data
+7 ; @XTREE@("B",SEGID,NSEG) null
+8 ;
+9 ; --------------------- scratch vars
NEW I,J,K,L,M,X,Z
+10 ; ------------------------------ message array index
NEW IMSG
+11 ; --------------------------- index of continuation data for long segs
NEW ISUBSEG
+12 ; ----------------------------- successor element index
NEW ISUCC
+13 ; ------------------------------ error flag
NEW FERR
+14 ; ------------------------------- segment data
NEW SEG
+15 ; ---------------------------- segment ID ("0th" piece)
NEW SEGTAG
+16 ;---------------- HL7 delimiters (universal)
NEW UFS,UCS,URS,UEC,USS
+17 ;-------------------------------- HL7 encoding characters
NEW ENC
+18 ;- HL7 escape sequences for delimiters (universal)
NEW UFSESC,UCSESC,URSESC,UECESC,USSESC
+19 ; --------------------------- pattern match for spanned record
NEW PATTERN
+20 ; ------------------------------ segment number in the parse tree
NEW NSEG
+21 ; -------------------------- segment number of input HL7 data
NEW NSEGINPT
+22 ; ------------------------------ field number in the segment
NEW NFLD
+23 ; ------------------------------- field data
NEW FLD
+24 ;
+25 ; assume no error
SET FERR=0
+26 SET IMSG=""
+27 ;
+28 ; process MSH segment
+29 ; If there's a message problem, return it in an NTE segment.
+30 ;
+31 ; array sent?
SET IMSG=$ORDER(@XMSG@(IMSG))
+32 ; no
IF IMSG=""
Begin DoDot:1
+33 SET FERR=-1
+34 ; have to use default field separator
+35 SET @XMSG@(0)="NTE|1||"_FERR_";no input array found"
+36 QUIT
End DoDot:1
QUIT FERR
+37 ; an HL7 message?
SET SEG=$GET(@XMSG@(IMSG))
if $EXTRACT(SEG,1,3)'="MSH"
QUIT -2
+38 ; no
IF $EXTRACT(SEG,1,3)'="MSH"
Begin DoDot:1
+39 SET FERR=-2
+40 SET ISUCC=$ORDER(@XMSG@(IMSG))
if 'ISUCC
SET ISUCC=IMSG+1
+41 ; have to use default field separator
+42 SET @XMSG@(IMSG+ISUCC/2)="NTE|1||"_FERR_";invalid HL7 message (1st 3 chars must be MSH)"
+43 QUIT
End DoDot:1
QUIT FERR
+44 ;
+45 ; set up delimiters and escape sequences
+46 SET UFS=$EXTRACT(SEG,4)
SET @XTREE@(1,1,1,1,1)=UFS
+47 SET ENC=$PIECE(SEG,UFS,2)
SET @XTREE@(1,2,1,1,1)=ENC
+48 SET UCS=$EXTRACT(ENC)
SET URS=$EXTRACT(ENC,2)
SET UEC=$EXTRACT(ENC,3)
SET USS=$EXTRACT(ENC,4)
+49 SET UFSESC=UEC_"F"_UEC
SET UCSESC=UEC_"S"_UEC
SET URSESC=UEC_"R"_UEC
SET UECESC=UEC_"E"_UEC
SET USSESC=UEC_"T"_UEC
+50 SET PATTERN="1A2AN1"""_UFS_""""
+51 SET @XTREE@(1,0)="MSH"
SET @XTREE@("B","MSH",1)=""
+52 FOR NFLD=3:1:$LENGTH(SEG,UFS)
SET FLD=$PIECE(SEG,UFS,NFLD)
Begin DoDot:1
+53 IF FLD]""
DO PROCFLD(XTREE,1,NFLD,FLD)
+54 QUIT
End DoDot:1
+55 ; process the remaining segments
+56 ; SEG will be a concatenated series of spanned records
SET SEG=""
+57 ; next segment in the parse tree will be #2
SET NSEG=2
+58 FOR NSEGINPT=2:1
SET IMSG=$ORDER(@XMSG@(IMSG))
if IMSG=""
QUIT
Begin DoDot:1
+59 SET SEG=$GET(@XMSG@(IMSG))
if SEG=""
QUIT
+60 ; prepare to handle very long HL7 segments (up to 32K)
SET ISUBSEG=""
+61 FOR
SET ISUBSEG=$ORDER(@XMSG@(IMSG,ISUBSEG))
if ISUBSEG=""
QUIT
Begin DoDot:2
+62 SET SEG=SEG_$GET(@XMSG@(IMSG,ISUBSEG))
+63 QUIT
End DoDot:2
+64 SET SEGTAG=$PIECE(SEG,UFS)
IF SEGTAG'?1U2.3UN
SET FERR=-3
QUIT
+65 SET @XTREE@(NSEG,0)=SEGTAG
SET @XTREE@("B",SEGTAG,NSEG)=""
+66 FOR NFLD=2:1:$LENGTH(SEG,UFS)
Begin DoDot:2
+67 SET FLD=$PIECE(SEG,UFS,NFLD)
+68 IF FLD]""
DO PROCFLD(XTREE,NSEG,NFLD-1,FLD)
+69 QUIT
End DoDot:2
+70 ; reinitialize SEG for the next possible concatenation
SET SEG=""
+71 ; increment counter for next segment in the parse tree
SET NSEG=NSEG+1
+72 QUIT
End DoDot:1
if FERR
QUIT
+73 QUIT FERR
+74 ;
PROCFLD(XTREE,XNSEG,XNFLD,XFLD) ; process a field
+1 ;
+2 ; input: XTREE name of MUMPS array for parse tree ($NA format)
+3 ; XNSEG segment number for parse tree
+4 ; XNFLD field number for parse tree
+5 ; XFLD field data
+6 ;
+7 ; ------ segment name
NEW SG
+8 ; ---- repetition (occurrence) number
NEW NREP
+9 ; ----- repetition data
NEW REP
+10 ; ---- component number
NEW NCMP
+11 ; ----- component data
NEW CMP
+12 ; ---- subcomponent number
NEW NSCM
+13 ; ----- subcomponent data
NEW SCM
+14 ;
+15 SET SG=@XTREE@(XNSEG,0)
+16 ; Per DICOM meeting 2004-02-24, reaffirmed that data may need to be
+17 ; retrieved above the subcomponent level, and that those data will
+18 ; need to be de-escaped because the receiving application won't have
+19 ; access to the delimiters from the original message.
+20 SET @XTREE@(XNSEG,XNFLD)=$$DEESC(XFLD)
+21 ;
+22 ; Break out to the lowest delimiter level too. This is not strictly an
+23 ; HL7 parse because it does not take actual HL7 (or realm constraining)
+24 ; data types into account.
+25 ;
+26 FOR NREP=1:1:$LENGTH(XFLD,URS)
SET REP=$PIECE(XFLD,URS,NREP)
IF REP]""
Begin DoDot:1
+27 FOR NCMP=1:1:$LENGTH(REP,UCS)
SET CMP=$PIECE(REP,UCS,NCMP)
IF CMP]""
Begin DoDot:2
+28 ; Per DICOM meeting 2004-02-24, reaffirmed that data may need to be
+29 ; retrieved above the subcomponent level, and that those data will
+30 ; need to be de-escaped because the receiving application won't have
+31 ; access to the delimiters from the original message.
+32 SET @XTREE@(XNSEG,XNFLD,NREP,NCMP)=$$DEESC(CMP)
+33 FOR NSCM=1:1:$LENGTH(CMP,USS)
SET SCM=$PIECE(CMP,USS,NSCM)
IF SCM]""
Begin DoDot:3
+34 SET @XTREE@(XNSEG,XNFLD,NREP,NCMP,NSCM)=$$DEESC(SCM)
+35 QUIT
End DoDot:3
+36 QUIT
End DoDot:2
+37 QUIT
End DoDot:1
+38 QUIT
+39 ;
DEESC(XSCM) ; replace escape sequences with delimiter characters
+1 ;
+2 ; input: XSCM element data before replacement
+3 ;
+4 ; expects: UFSESC, UCSESC, URSESC, UECESC, USSESC
+5 ; delimiter escape sequences
+6 ;
+7 ; function return: element data after replacement
+8 ;
+9 ; need another pass after each hit
NEW HIT
+10 FOR
Begin DoDot:1
+11 KILL HIT
+12 IF XSCM[UFSESC
SET XSCM=$PIECE(XSCM,UFSESC)_UFS_$PIECE(XSCM,UFSESC,2,99999)
SET HIT=1
+13 IF XSCM[UCSESC
SET XSCM=$PIECE(XSCM,UCSESC)_UCS_$PIECE(XSCM,UCSESC,2,99999)
SET HIT=1
+14 IF XSCM[URSESC
SET XSCM=$PIECE(XSCM,URSESC)_URS_$PIECE(XSCM,URSESC,2,99999)
SET HIT=1
+15 IF XSCM[UECESC
SET XSCM=$PIECE(XSCM,UECESC)_UEC_$PIECE(XSCM,UECESC,2,99999)
SET HIT=1
+16 IF XSCM[USSESC
SET XSCM=$PIECE(XSCM,USSESC)_USS_$PIECE(XSCM,USSESC,2,99999)
SET HIT=1
+17 QUIT
End DoDot:1
if '$DATA(HIT)
QUIT
+18 QUIT $EXTRACT(XSCM,1,510)
+19 ;
