source: WorldVistAEHR/trunk/r/VISTA_OFFICE_EHR-VEPE/VEPERI1.m@ 1000

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

initial load of WorldVistAEHR

File size: 7.8 KB
Line 
1VEPERI1 ;DAOU/WCJ - Incoming HL7 messages ;2-MAY-2005
2 ;;1.0;VOEB;;Jun 12, 2005
3 ;;;VISTA OFFICE/EHR;
4 ;;Per VHA Directive 10-93-142, this routine should not be modified.
5 ;
6 ;**Program Description**
7 ; This program parses each incoming HL7 messageS.
8 Q
9 ;
10 ; Put the HL7 record into an array that is easier to work with
11 ; (Something similar to table)
12 ;
13 ; This got a little bit tricky since some segments repeat and
14 ; segment within those segments repeat. Some arbitrary limits
15 ; were imposed to be able to handle this.
16 ; 1) A segment may only repeat 9 times. (no more than 9 IN1's)
17 ; 2) Only 4 repeating segments may be within each other.
18 ; IN1 could repeat 9 times. Within IN1, IN3 can repeat 9 times.
19 ; Another segment could repeat within the IN3, and another within
20 ; that one, but that's it.
21 ;
22PARSE(HL7IN,HLP,HLF,DEL,FE,MSGEVNT,HLMTIEN) ;
23 N I,SEG,DATA,ELEMENT,SETID,SEQ,SI,EVENT,TMP,J,K,LEVEL,TMP,BIT,OLDSETID
24 ;
25 S EVENT=$$FIND1^DIC(19904.15,,,MSGEVNT)
26 I EVENT="" S FE=$$FATALERR^VEPERI6(1,"HL7","UNSUPPORTED EVENT IN FILE 19905.15",HLMTIEN)
27 S FE=0,SETID=""
28 ;
29 F I=1:1 Q:'$D(HL7IN(I)) D Q:FE
30 . S DATA="",SEQ=0
31 . F J=0:1 Q:'$D(HL7IN(I,J)) D Q:FE
32 .. S DATA=DATA_HL7IN(I,J)
33 .. Q:DATA=""
34 .. ; check if it's a segment on the first level.
35 .. ; this means it is not within a repeating segment
36 .. I 'J D
37 ... S SEG=$P(DATA,DEL(1))
38 ... I $$FIND1^DIC(19904.151,",1,","C","SEG") S SETID=""
39 .. F K=1:1:$L(DATA,DEL(1)) D Q:FE
40 ... ;
41 ... ; look at the first sequence in a segment, see if it is a repeating segement
42 ... ; by looking for SET ID in the table
43 ... I 'J,'SEQ D Q:FE
44 .... Q:$P($G(HLF("TBL",SEG,SEQ+1,0)),U,2)'["SET ID"
45 .... S SI=$P(DATA,DEL(1),K+1)
46 .... I SI>9 S FE=$$FATALERR^VEPERI6(1,"DATA",SEG_" "_SEQ_" "_SETID_" "_" TOO MANY SETID'S - LIMIT 9",HLMTIEN,.HLP) Q
47 .... S TMP=SEG
48 .... F BIT=3:-1:0 S TMP=$P(HLF("TBL",TMP),U,4) Q:TMP=""
49 .... I TMP'="" S FE=$$FATALERR^VEPERI6(1,"DATA",SEG_" "_SEQ_" "_SETID_" "_" TOO MANY REPEATING SEGMENTS - LIMIT 4",HLMTIEN,.HLP) Q
50 .... I BIT=3 S SETID=0
51 .... S TMP=SI_"E"_BIT
52 .... I BIT=$G(LEVEL) S SETID=OLDSETID
53 .... S OLDSETID=SETID,LEVEL=BIT
54 .... S SETID=SETID+TMP
55 ... I K=$L(DATA,DEL(1)),$D(HL7IN(I,J+1)) Q
56 ... S ELEMENT=$P(DATA,DEL(1),K)
57 ... I ELEMENT]"" D
58 .... S ELEMENT=$$UP^VEPERIU(ELEMENT)
59 .... S HLP(SEG,$S(SETID]"":SETID,1:1000),SEQ)=ELEMENT
60 ... S SEQ=SEQ+1
61 .. S DATA=$P(DATA,DEL(1),K)
62 Q
63 ;
64 ; This runs through all the data sent it.
65 ; It will further parse fields within segments (such as address)
66 ; It also does execute code for mapping validation.
67 ; It runs though the input transform to make sure the values
68 ; are valid. Sometimes, it is set to skip the input trans if
69 ; doing so would cause an error.
70 ;
71VALIDATE(HLP,HLF,FE,DEL,HLMTIEN) ;
72 N SEG,SEQ,SETID,REQ,PM,X,OK,PMEXE,XSTR,FILE,FIELD,DATAELEM,INTRANS
73 N DIQUIET,PTR,FIELDS,SKIPTRAN,TMP,BIT,SI
74 ;
75 S DIQUIET=1
76 S FE=0
77 ;
78 ; Start looping through the table and parsed data.
79 ; It actually loops through the table, but frequently checks
80 ; on the parsed data. It needs to use the table because some
81 ; required data may be missing.
82 ;
83 S SEG="" F S SEG=$O(HLF("TBL",SEG)) Q:SEG=""!FE D
84 . ;
85 . ; Make sure all required segments are there
86 . I +$P(HLF("TBL",SEG),U,3),'$D(HLP(SEG)) D Q ; required segment not present
87 .. S FE=$$FATALERR^VEPERI6(1,"HL7",SEG_" REQUIRED SEGMENT MISSING",HLMTIEN,.HLP)
88 . ;
89 . Q:'$D(HLP(SEG)) ; If no data in this segment, no need to validate
90 . ;
91 . S SEQ="" F S SEQ=$O(HLF("TBL",SEG,SEQ)) Q:SEQ=""!(FE) D
92 .. ;
93 .. S REQ=$P(HLF("TBL",SEG,SEQ,0),U,5) ; required
94 .. S PM=$P(HLF("TBL",SEG,SEQ,0),U,6) ; pattern matching
95 .. S XSTR=$G(HLF("TBL",SEG,SEQ,1)) ; execute string
96 .. ;
97 .. S SETID=0 F S SETID=$O(HLP(SEG,SETID)) Q:SETID=""!(FE) D
98 ... S (DATAELEM,X)=$G(HLP(SEG,SETID,SEQ))
99 ... ;
100 ... ; This next section was added to handle the Next of Kin data
101 ... ; NK1 and NK2 are seperate fields in Vista, not mulitply occurring ones.
102 ... ; SET ID 1 needs to get stored in one place
103 ... ; SET ID 2 gets stored in another
104 ... ; If a segment is repeating and is being stored in a muliply occuring field,
105 ... ; SET ID will be 1. This is because the data is sored in the same field in Vista
106 ... ; just another occurance of the multiple.
107 ... ;
108 ... S (FILE,FIELD,FIELDS)=""
109 ... I $O(HLF("TBL",SEG,SEQ,"SETID",0)) D Q:FE
110 .... ;
111 .... ; Only SET ID 1 defined for this one.
112 .... I '$O(HLF("TBL",SEG,SEQ,"SETID",1)) D Q
113 ..... S FILE=$O(HLF("TBL",SEG,SEQ,"SETID",1,""))
114 ..... S FIELDS=$O(HLF("TBL",SEG,SEQ,"SETID",1,FILE,""))
115 .... ;
116 .... ; Need to figure out which SET ID we are talking about.
117 .... ; SET ID is currently a four digist number of potential SET ID's
118 .... ; SET ID 2300 could be the 3rd IN3 withine the 2nd IN1. So, set ID is either
119 .... ; 2 or 3.
120 .... S TMP=SEG
121 .... F BIT=1:1:4 S TMP=$P(HLF("TBL",TMP),U,4) Q:TMP=""
122 .... S SI=$E(SETID,BIT)
123 .... ;
124 .... ; Get the file and fields for that SET ID
125 .... I $D(HLF("TBL",SEG,SEQ,"SETID",SI)) D Q
126 ..... S FILE=$O(HLF("TBL",SEG,SEQ,"SETID",SI,""))
127 ..... S FIELDS=$O(HLF("TBL",SEG,SEQ,"SETID",SI,FILE,""))
128 .... ;
129 .... ; More than one SET ID defined in table yet not this one. Time to bug out.
130 .... S FE=$$FATALERR^VEPERI6(1,"DATA OR TABLE",SEG_" "_SEQ_" "_SETID,HLMTIEN,.HLP)
131 ... ;
132 ... ; This is supposedly a required field
133 ... I REQ D Q:FE
134 .... I $G(HLP(SEG,SETID,SEQ))="" S FE=$$FATALERR^VEPERI6(1,"DATA",SEG_" "_SEQ_" "_SETID_" MISSING",HLMTIEN,.HLP) Q
135 ... ;
136 ... ; Not much to do with this field past this point if it ain't there
137 ... Q:X=""
138 ... ;
139 ... ; Pattern Match the field
140 ... I PM]"" D Q:FE
141 .... S OK=0
142 .... S PMEXE="I "_PM_" S OK=1"
143 .... X PMEXE
144 .... I 'OK S FE=$$FATALERR^VEPERI6(1,"DATA",SEG_" "_SEQ_" "_X_" "_PMEXE,HLMTIEN,.HLP) Q
145 ... ;
146 ... ; This is an execute string. Mostly used for data mapping.
147 ... ; If X is different going out than coming in, store it.
148 ... I XSTR]"" D Q:FE
149 .... S OK=0
150 .... X XSTR
151 .... I 'OK S FE=$$FATALERR^VEPERI6(1,"DATA",SEG_" "_SEQ_" "_X_" "_XSTR,HLMTIEN,.HLP) Q
152 .... I X'=DATAELEM S HLP(SEG,SETID,SEQ,0)=X,DATAELEM=X
153 ... ;
154 ... ; If there is no place to store the data, no need to continue
155 ... I FILE=""!(FIELDS="") Q
156 ... ;
157 ... ; This next section loops through FIELDS since mutiple Vista Fields can go into
158 ... ; one HL7 field. Address is an an example. This only works if the fields are in
159 ... ; the same file.
160 ... N FLDLOOP
161 ... F FLDLOOP=1:1:$L(FIELDS,",") D Q:FE
162 .... S FIELD=$P(FIELDS,",",FLDLOOP)
163 .... N X
164 .... S X=$P(DATAELEM,DEL(2),FLDLOOP)
165 .... S INTRANS="",SKIPTRAN=$P($G(HLF("MAP",FILE,FIELD)),U,4)
166 .... ;
167 .... ; Need to skip the input trans on some fields becasue they cause errors. Some
168 .... ; input trans expect certain variables to be there or are dependent on other
169 .... ; fields. AT this time, we can only use the stand alone checks here.
170 .... I 'SKIPTRAN S INTRANS=$$GET1^DID(FILE,FIELD,,"INPUT TRANSFORM")
171 .... ;
172 .... ; If there is data and an input transform then let's do it.
173 .... I X]"",INTRANS]"" D Q:FE
174 ..... X INTRANS
175 ..... I '$D(X) D Q ; if X is not defined, input transform killed it
176 ...... S FE=$$FATALERR^VEPERI6(1,"DATA",SEG_" "_SEQ_" "_DATAELEM_" "_INTRANS,HLMTIEN,.HLP)
177 .... ;
178 .... ; If X made it this far, we ought to save it
179 .... I X]"" S HLF("DATA",FILE,FIELD,SETID)=X
180 .... ;
181 .... ; It this field is a pointer to another field, we need to see if LAYGO is allowed
182 .... ; or if the data is in the pointed to file.
183 .... I $P(HLF("MAP",FILE,FIELD),U,5) D
184 ..... Q:'$P(HLF("MAP",FILE,FIELD),U,6) ; if laygo is allowed, do not check
185 ..... S PTR=$P(HLF("MAP",FILE,FIELD),U,5)
186 ..... K RESULTS
187 ..... D FIND^DIC(PTR,,"@;.01","MO",X,,,,,"RESULTS")
188 ..... I '+RESULTS("DILIST",0) S FE=$$FATALERR^VEPERI6(1,"DATA",SEG_" "_SEQ_" "_SETID_" "_X_" PTR NO MATCHES",HLMTIEN,.HLP) Q
189 ..... I +RESULTS("DILIST",0)>1 S FE=$$FATALERR^VEPERI6(1,"DATA",SEG_" "_SEQ_" "_SETID_" "_X_" PTR TO MANY MATCHES",HLMTIEN,.HLP) Q
190 ..... S HLF("DATA",FILE,FIELD,SETID)=RESULTS("DILIST","ID",1,.01)
191 Q
Note: See TracBrowser for help on using the repository browser.