Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: MAG7UP

MAG7UP.m

Go to the documentation of this file.
  1. 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
  1. ;; Per VHA Directive 2004-038, this routine should not be modified.
  1. ;; +---------------------------------------------------------------+
  1. ;; | Property of the US Government. |
  1. ;; | No permission to copy or redistribute this software is given. |
  1. ;; | Use of unreleased versions of this software requires the user |
  1. ;; | to execute a written test agreement with the VistA Imaging |
  1. ;; | Development Office of the Department of Veterans Affairs, |
  1. ;; | telephone (301) 734-0100. |
  1. ;; | The Food and Drug Administration classifies this software as |
  1. ;; | a medical device. As such, it may not be changed in any way. |
  1. ;; | Modifications to this software may result in an adulterated |
  1. ;; | medical device under 21CFR820, the use of which is considered |
  1. ;; | to be a violation of US Federal Statutes. |
  1. ;; +---------------------------------------------------------------+
  1. ;;
  1. Q
  1. ;
  1. PARSE(XMSG,XTREE) ; break the HL7 message lines into a parse tree
  1. ;
  1. ; INPUT: The single-dimensional array of message lines
  1. ;
  1. ; OUTPUT: The parse tree, in the structure
  1. ; @XTREE@(NSEG,0) segment name
  1. ; @XTREE@(NSEG,NFLD,NREP,NCMP,NSCM) element data
  1. ; @XTREE@("B",SEGID,NSEG) null
  1. ;
  1. N I,J,K,L,M,X,Z ; --------------------- scratch vars
  1. N IMSG ; ------------------------------ message array index
  1. N ISUBSEG ; --------------------------- index of continuation data for long segs
  1. N ISUCC ; ----------------------------- successor element index
  1. N FERR ; ------------------------------ error flag
  1. N SEG ; ------------------------------- segment data
  1. N SEGTAG ; ---------------------------- segment ID ("0th" piece)
  1. N UFS,UCS,URS,UEC,USS ;---------------- HL7 delimiters (universal)
  1. N ENC ;-------------------------------- HL7 encoding characters
  1. N UFSESC,UCSESC,URSESC,UECESC,USSESC ;- HL7 escape sequences for delimiters (universal)
  1. N PATTERN ; --------------------------- pattern match for spanned record
  1. N NSEG ; ------------------------------ segment number in the parse tree
  1. N NSEGINPT ; -------------------------- segment number of input HL7 data
  1. N NFLD ; ------------------------------ field number in the segment
  1. N FLD ; ------------------------------- field data
  1. ;
  1. S FERR=0 ; assume no error
  1. S IMSG=""
  1. ;
  1. ; process MSH segment
  1. ; If there's a message problem, return it in an NTE segment.
  1. ;
  1. S IMSG=$O(@XMSG@(IMSG)) ; array sent?
  1. I IMSG="" D Q FERR ; no
  1. . S FERR=-1
  1. . ; have to use default field separator
  1. . S @XMSG@(0)="NTE|1||"_FERR_";no input array found"
  1. . Q
  1. S SEG=$G(@XMSG@(IMSG)) Q:$E(SEG,1,3)'="MSH" -2 ; an HL7 message?
  1. I $E(SEG,1,3)'="MSH" D Q FERR ; no
  1. . S FERR=-2
  1. . S ISUCC=$O(@XMSG@(IMSG)) S:'ISUCC ISUCC=IMSG+1
  1. . ; have to use default field separator
  1. . S @XMSG@(IMSG+ISUCC/2)="NTE|1||"_FERR_";invalid HL7 message (1st 3 chars must be MSH)"
  1. . Q
  1. ;
  1. ; set up delimiters and escape sequences
  1. S UFS=$E(SEG,4),@XTREE@(1,1,1,1,1)=UFS
  1. S ENC=$P(SEG,UFS,2),@XTREE@(1,2,1,1,1)=ENC
  1. S UCS=$E(ENC),URS=$E(ENC,2),UEC=$E(ENC,3),USS=$E(ENC,4)
  1. S UFSESC=UEC_"F"_UEC,UCSESC=UEC_"S"_UEC,URSESC=UEC_"R"_UEC,UECESC=UEC_"E"_UEC,USSESC=UEC_"T"_UEC
  1. S PATTERN="1A2AN1"""_UFS_""""
  1. S @XTREE@(1,0)="MSH",@XTREE@("B","MSH",1)=""
  1. F NFLD=3:1:$L(SEG,UFS) S FLD=$P(SEG,UFS,NFLD) D
  1. . I FLD]"" D PROCFLD(XTREE,1,NFLD,FLD)
  1. . Q
  1. ; process the remaining segments
  1. S SEG="" ; SEG will be a concatenated series of spanned records
  1. S NSEG=2 ; next segment in the parse tree will be #2
  1. F NSEGINPT=2:1 S IMSG=$O(@XMSG@(IMSG)) Q:IMSG="" D Q:FERR
  1. . S SEG=$G(@XMSG@(IMSG)) Q:SEG=""
  1. . S ISUBSEG="" ; prepare to handle very long HL7 segments (up to 32K)
  1. . F S ISUBSEG=$O(@XMSG@(IMSG,ISUBSEG)) Q:ISUBSEG="" D
  1. . . S SEG=SEG_$G(@XMSG@(IMSG,ISUBSEG))
  1. . . Q
  1. . S SEGTAG=$P(SEG,UFS) I SEGTAG'?1U2.3UN S FERR=-3 Q
  1. . S @XTREE@(NSEG,0)=SEGTAG,@XTREE@("B",SEGTAG,NSEG)=""
  1. . F NFLD=2:1:$L(SEG,UFS) D
  1. . . S FLD=$P(SEG,UFS,NFLD)
  1. . . I FLD]"" D PROCFLD(XTREE,NSEG,NFLD-1,FLD)
  1. . . Q
  1. . S SEG="" ; reinitialize SEG for the next possible concatenation
  1. . S NSEG=NSEG+1 ; increment counter for next segment in the parse tree
  1. . Q
  1. Q FERR
  1. ;
  1. PROCFLD(XTREE,XNSEG,XNFLD,XFLD) ; process a field
  1. ;
  1. ; input: XTREE name of MUMPS array for parse tree ($NA format)
  1. ; XNSEG segment number for parse tree
  1. ; XNFLD field number for parse tree
  1. ; XFLD field data
  1. ;
  1. N SG ; ------ segment name
  1. N NREP ; ---- repetition (occurrence) number
  1. N REP ; ----- repetition data
  1. N NCMP ; ---- component number
  1. N CMP ; ----- component data
  1. N NSCM ; ---- subcomponent number
  1. N SCM ; ----- subcomponent data
  1. ;
  1. S SG=@XTREE@(XNSEG,0)
  1. ; Per DICOM meeting 2004-02-24, reaffirmed that data may need to be
  1. ; retrieved above the subcomponent level, and that those data will
  1. ; need to be de-escaped because the receiving application won't have
  1. ; access to the delimiters from the original message.
  1. S @XTREE@(XNSEG,XNFLD)=$$DEESC(XFLD)
  1. ;
  1. ; Break out to the lowest delimiter level too. This is not strictly an
  1. ; HL7 parse because it does not take actual HL7 (or realm constraining)
  1. ; data types into account.
  1. ;
  1. F NREP=1:1:$L(XFLD,URS) S REP=$P(XFLD,URS,NREP) I REP]"" D
  1. . F NCMP=1:1:$L(REP,UCS) S CMP=$P(REP,UCS,NCMP) I CMP]"" D
  1. . . ; Per DICOM meeting 2004-02-24, reaffirmed that data may need to be
  1. . . ; retrieved above the subcomponent level, and that those data will
  1. . . ; need to be de-escaped because the receiving application won't have
  1. . . ; access to the delimiters from the original message.
  1. . . S @XTREE@(XNSEG,XNFLD,NREP,NCMP)=$$DEESC(CMP)
  1. . . F NSCM=1:1:$L(CMP,USS) S SCM=$P(CMP,USS,NSCM) I SCM]"" D
  1. . . . S @XTREE@(XNSEG,XNFLD,NREP,NCMP,NSCM)=$$DEESC(SCM)
  1. . . . Q
  1. . . Q
  1. . Q
  1. Q
  1. ;
  1. DEESC(XSCM) ; replace escape sequences with delimiter characters
  1. ;
  1. ; input: XSCM element data before replacement
  1. ;
  1. ; expects: UFSESC, UCSESC, URSESC, UECESC, USSESC
  1. ; delimiter escape sequences
  1. ;
  1. ; function return: element data after replacement
  1. ;
  1. N HIT ; need another pass after each hit
  1. F D Q:'$D(HIT)
  1. . K HIT
  1. . I XSCM[UFSESC S XSCM=$P(XSCM,UFSESC)_UFS_$P(XSCM,UFSESC,2,99999),HIT=1
  1. . I XSCM[UCSESC S XSCM=$P(XSCM,UCSESC)_UCS_$P(XSCM,UCSESC,2,99999),HIT=1
  1. . I XSCM[URSESC S XSCM=$P(XSCM,URSESC)_URS_$P(XSCM,URSESC,2,99999),HIT=1
  1. . I XSCM[UECESC S XSCM=$P(XSCM,UECESC)_UEC_$P(XSCM,UECESC,2,99999),HIT=1
  1. . I XSCM[USSESC S XSCM=$P(XSCM,USSESC)_USS_$P(XSCM,USSESC,2,99999),HIT=1
  1. . Q
  1. Q $E(XSCM,1,510)
  1. ;