source: FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAG7UP.m@ 1540

Last change on this file since 1540 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 6.5 KB
Line 
1MAG7UP ;WOIFO/MLH - Imaging - HL7 - utilities - break out message into a parse tree ; 06/03/2005 12:05
2 ;;3.0;IMAGING;**11,51**;26-August-2005
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 ;; | |
11 ;; | The Food and Drug Administration classifies this software as |
12 ;; | a medical device. As such, it may not be changed in any way. |
13 ;; | Modifications to this software may result in an adulterated |
14 ;; | medical device under 21CFR820, the use of which is considered |
15 ;; | to be a violation of US Federal Statutes. |
16 ;; +---------------------------------------------------------------+
17 ;;
18 Q
19 ;
20PARSE(XMSG,XTREE) ; break the HL7 message lines into a parse tree
21 ;
22 ; INPUT: The single-dimensional array of message lines
23 ;
24 ; OUTPUT: The parse tree, in the structure
25 ; @XTREE@(NSEG,0) segment name
26 ; @XTREE@(NSEG,NFLD,NREP,NCMP,NSCM) element data
27 ; @XTREE@("B",SEGID,NSEG) null
28 ;
29 N I,J,K,L,M,X,Z ; --------------------- scratch vars
30 N IMSG ; ------------------------------ message array index
31 N ISUBSEG ; --------------------------- index of continuation data for long segs
32 N ISUCC ; ----------------------------- successor element index
33 N FERR ; ------------------------------ error flag
34 N SEG ; ------------------------------- segment data
35 N SEGTAG ; ---------------------------- segment ID ("0th" piece)
36 N UFS,UCS,URS,UEC,USS ;---------------- HL7 delimiters (universal)
37 N ENC ;-------------------------------- HL7 encoding characters
38 N UFSESC,UCSESC,URSESC,UECESC,USSESC ;- HL7 escape sequences for delimiters (universal)
39 N PATTERN ; --------------------------- pattern match for spanned record
40 N NSEG ; ------------------------------ segment number in the parse tree
41 N NSEGINPT ; -------------------------- segment number of input HL7 data
42 N NFLD ; ------------------------------ field number in the segment
43 N FLD ; ------------------------------- field data
44 ;
45 S FERR=0 ; assume no error
46 S IMSG=""
47 ;
48 ; process MSH segment
49 ; If there's a message problem, return it in an NTE segment.
50 ;
51 S IMSG=$O(@XMSG@(IMSG)) ; array sent?
52 I IMSG="" D Q FERR ; no
53 . S FERR=-1
54 . ; have to use default field separator
55 . S @XMSG@(0)="NTE|1||"_FERR_";no input array found"
56 . Q
57 S SEG=$G(@XMSG@(IMSG)) Q:$E(SEG,1,3)'="MSH" -2 ; an HL7 message?
58 I $E(SEG,1,3)'="MSH" D Q FERR ; no
59 . S FERR=-2
60 . S ISUCC=$O(@XMSG@(IMSG)) S:'ISUCC ISUCC=IMSG+1
61 . ; have to use default field separator
62 . S @XMSG@(IMSG+ISUCC/2)="NTE|1||"_FERR_";invalid HL7 message (1st 3 chars must be MSH)"
63 . Q
64 ;
65 ; set up delimiters and escape sequences
66 S UFS=$E(SEG,4),@XTREE@(1,1,1,1,1)=UFS
67 S ENC=$P(SEG,UFS,2),@XTREE@(1,2,1,1,1)=ENC
68 S UCS=$E(ENC),URS=$E(ENC,2),UEC=$E(ENC,3),USS=$E(ENC,4)
69 S UFSESC=UEC_"F"_UEC,UCSESC=UEC_"S"_UEC,URSESC=UEC_"S"_UEC,UECESC=UEC_"E"_UEC,USSESC=UEC_"T"_UEC
70 S PATTERN="1A2AN1"""_UFS_""""
71 S @XTREE@(1,0)="MSH",@XTREE@("B","MSH",1)=""
72 F NFLD=3:1:$L(SEG,UFS) S FLD=$P(SEG,UFS,NFLD) D
73 . I FLD]"" D PROCFLD(XTREE,1,NFLD,FLD)
74 . Q
75 ; process the remaining segments
76 S SEG="" ; SEG will be a concatenated series of spanned records
77 S NSEG=2 ; next segment in the parse tree will be #2
78 F NSEGINPT=2:1 S IMSG=$O(@XMSG@(IMSG)) Q:IMSG="" D Q:FERR
79 . S SEG=$G(@XMSG@(IMSG)) Q:SEG=""
80 . S ISUBSEG="" ; prepare to handle very long HL7 segments (up to 32K)
81 . F S ISUBSEG=$O(@XMSG@(IMSG,ISUBSEG)) Q:ISUBSEG="" D
82 . . S SEG=SEG_$G(@XMSG@(IMSG,ISUBSEG))
83 . . Q
84 . S SEGTAG=$P(SEG,UFS) I SEGTAG'?1U2.3UN S FERR=-3 Q
85 . S @XTREE@(NSEG,0)=SEGTAG,@XTREE@("B",SEGTAG,NSEG)=""
86 . F NFLD=2:1:$L(SEG,UFS) D
87 . . S FLD=$P(SEG,UFS,NFLD)
88 . . I FLD]"" D PROCFLD(XTREE,NSEG,NFLD-1,FLD)
89 . . Q
90 . S SEG="" ; reinitialize SEG for the next possible concatenation
91 . S NSEG=NSEG+1 ; increment counter for next segment in the parse tree
92 . Q
93 Q FERR
94 ;
95PROCFLD(XTREE,XNSEG,XNFLD,XFLD) ; process a field
96 ;
97 ; input: XTREE name of MUMPS array for parse tree ($NA format)
98 ; XNSEG segment number for parse tree
99 ; XNFLD field number for parse tree
100 ; XFLD field data
101 ;
102 N SG ; ------ segment name
103 N NREP ; ---- repetition (occurrence) number
104 N REP ; ----- repetition data
105 N NCMP ; ---- component number
106 N CMP ; ----- component data
107 N NSCM ; ---- subcomponent number
108 N SCM ; ----- subcomponent data
109 ;
110 S SG=@XTREE@(XNSEG,0)
111 ; Per DICOM meeting 2004-02-24, reaffirmed that data may need to be
112 ; retrieved above the subcomponent level, and that those data will
113 ; need to be de-escaped because the receiving application won't have
114 ; access to the delimiters from the original message.
115 S @XTREE@(XNSEG,XNFLD)=$$DEESC(XFLD)
116 ;
117 ; Break out to the lowest delimiter level too. This is not strictly an
118 ; HL7 parse because it does not take actual HL7 (or realm constraining)
119 ; data types into account.
120 ;
121 F NREP=1:1:$L(XFLD,URS) S REP=$P(XFLD,URS,NREP) I REP]"" D
122 . F NCMP=1:1:$L(REP,UCS) S CMP=$P(REP,UCS,NCMP) I CMP]"" D
123 . . ; Per DICOM meeting 2004-02-24, reaffirmed that data may need to be
124 . . ; retrieved above the subcomponent level, and that those data will
125 . . ; need to be de-escaped because the receiving application won't have
126 . . ; access to the delimiters from the original message.
127 . . S @XTREE@(XNSEG,XNFLD,NREP,NCMP)=$$DEESC(CMP)
128 . . F NSCM=1:1:$L(CMP,USS) S SCM=$P(CMP,USS,NSCM) I SCM]"" D
129 . . . S @XTREE@(XNSEG,XNFLD,NREP,NCMP,NSCM)=$$DEESC(SCM)
130 . . . Q
131 . . Q
132 . Q
133 Q
134 ;
135DEESC(XSCM) ; replace escape sequences with delimiter characters
136 ;
137 ; input: XSCM element data before replacement
138 ;
139 ; expects: UFSESC, UCSESC, URSESC, UECESC, USSESC
140 ; delimiter escape sequences
141 ;
142 ; function return: element data after replacement
143 ;
144 N HIT ; need another pass after each hit
145 F D Q:'$D(HIT)
146 . K HIT
147 . I XSCM[UFSESC S XSCM=$P(XSCM,UFSESC)_UFS_$P(XSCM,UFSESC,2,99999),HIT=1
148 . I XSCM[UCSESC S XSCM=$P(XSCM,UCSESC)_UCS_$P(XSCM,UCSESC,2,99999),HIT=1
149 . I XSCM[URSESC S XSCM=$P(XSCM,URSESC)_URS_$P(XSCM,URSESC,2,99999),HIT=1
150 . I XSCM[UECESC S XSCM=$P(XSCM,UECESC)_UEC_$P(XSCM,UECESC,2,99999),HIT=1
151 . I XSCM[USSESC S XSCM=$P(XSCM,USSESC)_USS_$P(XSCM,USSESC,2,99999),HIT=1
152 . Q
153 Q $E(XSCM,1,510)
154 ;
Note: See TracBrowser for help on using the repository browser.