source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGENUPL1.m@ 1578

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

initial load of WorldVistAEHR

File size: 8.1 KB
Line 
1DGENUPL1 ;ALB/CJM,ISA/KWP,CKN - PROCESS INCOMING (Z11 EVENT TYPE) HL7 MESSAGES ; 2/25/02 1:39pm
2 ;;5.3;REGISTRATION;**147,222,232,314,397,379,407,363,673,653**;Aug 13,1993;Build 2
3 ;
4 ;
5PARSE(MSGIEN,MSGID,CURLINE,ERRCOUNT,DGPAT,DGELG,DGENR,DGCDIS,DGOEIF,DGSEC,DGNTR,DGMST) ;
6 ;Description: This function parses the HL7 segments. It creates arrays
7 ;defined by the PATIENT, ENROLLMENT, ELIGIBILY, CATASTROPHIC DISABILITY,
8 ;OEF/OIF CONFLICT objects.
9 ;Field values are put in DHCP format and the validity at the
10 ;field level is tested. Fields to be deleted are set to "@".
11 ;
12 ;Input:
13 ; MSGIEN - the ien of the HL7 message in the HL7 MESSAGE TEXT file (772)
14 ; MSGID -message control id of HL7 msg in the MSH segment
15 ; CURLINE - the subscript of the PID segment of the current message (pass by reference)
16 ; ERRCOUNT - is a count of the number of messages in the batch that can not be processed (pass by ref)
17 ;
18 ;Output:
19 ; Function Value: Returns 1 on success, 0 on failure.
20 ; CURLINE - upon leaving the procedure this parameter should be set to the end of the current message.
21 ; ERRCOUNT - set to count of messages that were not processed due to errors encountered. (pass by ref)
22 ; DGPAT - array defined by the PATIENT object. (pass by ref)
23 ; DGENR - array defined by the PATIENT ENROLLMENT object. (pass by ref)
24 ; DGELG - array defined by the PATIENT ELIGIBILITY object. (pass by ref)
25 ; DGCDIS - array defined by the CATASTROPHIC DISABILITY object. (pass by ref)
26 ; DGSEC - array defined by the PATIENT SECURITY object. (pass by ref)
27 ; DGOEIF - array defined by the OEF/OIF CONFLICT object. (pass by ref)
28 ; DGNTR - array defined for NTR data.
29 ; DGMST - array defined for MST data.
30 N SEG,ERROR,COUNT,QFLG,NFLG
31 ;
32 K DGEN,DGPAT,DGELG,DGCDIS,DGNTR,DGMST
33 ;
34 S ERROR=0,NFLG=1
35 F SEG="PID","ZPD","ZIE","ZIO","ZEL" D Q:ERROR
36 .D:NFLG NXTSEG^DGENUPL(MSGIEN,.CURLINE,.SEG)
37 .I SEG="ZIO",SEG("TYPE")'="ZIO" S NFLG=0 Q
38 .I SEG("TYPE")=SEG D Q
39 ..D:(SEG'="ZEL") @SEG^DGENUPL2
40 ..D:(SEG="ZEL") ZEL^DGENUPL2(1)
41 ..S NFLG=1
42 .D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),SEG_" SEGMENT MISSING OR OUT OF ORDER",.ERRCOUNT)
43 .S ERROR=1
44 .;
45 .;possible that in a bad message we are now past the end
46 .S CURLINE=CURLINE-1
47 ;
48 I 'ERROR F COUNT=2:1 D NXTSEG^DGENUPL(MSGIEN,CURLINE,.SEG) Q:(SEG("TYPE")'="ZEL") D Q:ERROR
49 .S CURLINE=CURLINE+1
50 .D ZEL^DGENUPL2(COUNT)
51 ;Phase II Add the capability to accept more than 1 ZCD
52 I 'ERROR F SEG="ZEN","ZMT","ZCD" D Q:ERROR
53 .D NXTSEG^DGENUPL(MSGIEN,.CURLINE,.SEG)
54 .I SEG("TYPE")=SEG D
55 ..D @SEG^DGENUPL2
56 .E D
57 ..D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),SEG_" SEGMENT MISSING OR OUTOF ORDER",.ERRCOUNT)
58 ..S ERROR=1
59 ..;
60 ..;possible that in a bad message we are now past the end
61 ..S CURLINE=CURLINE-1
62 ;
63 I 'ERROR F COUNT=2:1 D NXTSEG^DGENUPL(MSGIEN,CURLINE,.SEG) Q:(SEG("TYPE")'="ZCD") D Q:ERROR
64 .S CURLINE=CURLINE+1
65 .D ZCD^DGENUPL2
66 ;
67 ; Purple Heart/OEF-OIF Addition of optional ZMH segment
68 ; Modified handling of ZSP and ZRD to accomodate ZMH
69 ;
70 I 'ERROR D Q:ERROR $S(ERROR:0,1:1)
71 .D NXTSEG^DGENUPL(MSGIEN,.CURLINE,.SEG)
72 .I SEG("TYPE")="ZSP" D ZSP^DGENUPL2 Q
73 .D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),SEG_" SEGMENT MISSING OR OUT OF ORDER",.ERRCOUNT)
74 .S ERROR=1
75 .;possible that in a bad message we are now past the end
76 .S CURLINE=CURLINE-1
77 ;
78 ;Modified following code to receive multiple ZMH segment for
79 ;Military service information - DG*5.3*653
80 I 'ERROR D Q:ERROR $S(ERROR:0,1:1)
81 .D NXTSEG^DGENUPL(MSGIEN,.CURLINE,.SEG)
82 .S QFLG=0 F D Q:QFLG
83 . . I SEG("TYPE")'="ZMH" S QFLG=1 Q
84 . . D ZMH^DGENUPL2,NXTSEG^DGENUPL(MSGIEN,.CURLINE,.SEG)
85 .I SEG("TYPE")="ZRD" D ZRD^DGENUPL2 Q
86 .D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),SEG_" SEGMENT MISSING OR OUT OF ORDER",.ERRCOUNT)
87 .S ERROR=1
88 .;possible that in a bad message we are now past the end
89 .S CURLINE=CURLINE-1
90 ;
91 I 'ERROR F COUNT=2:1 D NXTSEG^DGENUPL(MSGIEN,CURLINE,.SEG) Q:(SEG("TYPE")'="ZRD") D Q:ERROR
92 .S CURLINE=CURLINE+1
93 .D ZRD^DGENUPL2
94 ;
95 I 'ERROR F D Q:(ERROR!(SEG("TYPE")'="OBX"))
96 .;possible if OBX segment not present that we are now past the end
97 .I SEG("TYPE")'="OBX" S CURLINE=CURLINE-1 Q
98 .D OBX^DGENUPL2
99 .S CURLINE=CURLINE+1
100 .D NXTSEG^DGENUPL(MSGIEN,CURLINE,.SEG)
101 ;
102 Q $S(ERROR:0,1:1)
103 ;
104CONVERT(VAL,DATATYPE,ERROR) ;
105 ;Description: Converts the value found in the HL7 segment to DHCP format
106 ;
107 ;Input:
108 ; VAL - value parsed from the HL7 segment
109 ; DATATYPE: indicates the type of conversion necessary
110 ; "DATE" - needs to be converted to FM format
111 ; "TS" - time stamp, needs to be converted to FM format
112 ; "Y/N" - 0->"N",1->"Y"
113 ; "1/0" - "Y"->1,"N"->0
114 ; "INSTITUTION" - needs to convert the station number with suffix to a point to the INSTITUTION file
115 ; "ELIGIBILITY" - VAL is a pointer to the national eligibility code file (#8.1), needs to be converted to a local eligibility code (file #8)
116 ;
117 ; "MT" - VAL is a Means Test Status code, it needs to be converted
118 ; to a pointer to the Means Test Status file
119 ; Phase II convert code to RSN IEN for DGCDIS object
120 ; "CDRSN" data type converts the codes diagnosis,procedure,condition to RSN IEN. (HL7TORSN^DGENA5)
121 ; "EXT" convert from code to abbreviation
122 ; "POS" convert from Period of Service code to a point to Period of Service file
123 ;OUTPUT:
124 ; Function Value - the result of the conversion
125 ; ERROR - set to 1 if an error is detected, 0 otherwise (optional,pass by ref)
126 ;
127 S ERROR=0
128 D
129 .I VAL="" Q
130 .I VAL="""""" S VAL="@" Q
131 .I $G(DATATYPE)="EXT" D Q
132 ..S VAL=$$HLTOLIMB^DGENA5(VAL)
133 .I $G(DATATYPE)="CDRSN" D Q
134 ..S VAL=$$HL7TORSN^DGENA5(VAL)
135 .I ($G(DATATYPE)="MT") D Q
136 ..S VAL=$O(^DG(408.32,"AC",1,VAL,0))
137 ..I 'VAL S ERROR=1
138 .I ($G(DATATYPE)="DATE") D Q
139 ..I $L(VAL)'=8 S ERROR=1 Q
140 ..S VAL=$$FMDATE^HLFNC(VAL)
141 ..I ((VAL'=+VAL)!($L($P(VAL,"."))<7)) S ERROR=1
142 .I ($G(DATATYPE)="TS") D Q
143 ..I $L(VAL)<8 S ERROR=1 Q
144 ..S VAL=$$FMDATE^HLFNC(VAL)
145 ..I ((VAL'=+VAL)!($L($P(VAL,"."))<7)) S ERROR=1
146 .I ($G(DATATYPE)="Y/N") D Q
147 ..I VAL=0 S VAL="N" Q
148 ..I VAL=1 S VAL="Y" Q
149 ..S ERROR=1
150 .I ($G(DATATYPE)="1/0") D Q
151 ..I VAL="N" S VAL=0 Q
152 ..I VAL="Y" S VAL=1 Q
153 ..S ERROR=1
154 .I ($G(DATATYPE)="ELIGIBILITY") D Q
155 ..S VAL=$$MAP(VAL)
156 ..I 'VAL S ERROR=1
157 .I ($G(DATATYPE)="INSTITUTION") D Q
158 ..N OLDVAL
159 ..S OLDVAL=VAL
160 ..S VAL=$O(^DIC(4,"D",OLDVAL,0))
161 ..I 'VAL S VAL=$O(^DIC(4,"D",(+OLDVAL),0))
162 ..I 'VAL S ERROR=1
163 .I ($G(DATATYPE)="POS") D Q
164 ..N OLDVAL
165 ..S OLDVAL=VAL
166 ..S VAL=$O(^DIC(21,"D",OLDVAL,0))
167 Q VAL
168 ;
169MAP(VALUE) ;
170 ;Description: Tries to map an eligibility code from file #8.1 (the national MAS ELIGIBILITY CODE file) to file #8 (the local ELIGIBILITY CODE file)
171 ;
172 ;Input: VALUE - ien of an entry in file #8.1
173 ;
174 ;Output: Function value - NULL if mapping is not found, otherwise returns an ien of entry in file #8
175 ;
176 N ECODE,NODE,COUNT,NAME
177 ;try to choose a code from file 8 to use that is appropriate
178 S (COUNT,ECODE)=0
179 ;
180 F S ECODE=$O(^DIC(8,"D",VALUE,ECODE)) Q:'ECODE D
181 .S NODE=$G(^DIC(8,ECODE,0))
182 .;put code on list if active
183 .I (NODE'=""),'$P(NODE,"^",7) S ECODE(ECODE)=$P(NODE,"^"),COUNT=COUNT+1
184 ;
185 ;only one match found, so use it
186 Q:COUNT=1 $O(ECODE(0))
187 ;
188 ;no match found
189 Q:'COUNT ""
190 ;
191 ;multiple matches found, try to match by name
192 I COUNT>1 D
193 .S ECODE=0
194 .S NAME=$P($G(^DIC(8.1,VALUE,0)),"^")
195 .F S ECODE=$O(ECODE(ECODE)) Q:'ECODE Q:ECODE(ECODE)=NAME
196 Q ECODE
197 ;
198ACCEPT(MSGID) ;
199 ;Description: Writes an ack (AA) to a global to be transmitted later.
200 ;
201 ;Inputs:
202 ; MSGID -message control id of HL7 msg in the MSH segment
203 ;
204 ;Outputs: none
205 ;
206 K HL,HLMID,HLMTIEN,HLDT,HLDT1
207 D INIT^HLFNC2(HLEID,.HL)
208 D CREATE^HLTF(.HLMID,.HLMTIEN,.HLDT,.HLDT1)
209 S HLEVN=1
210 S MID=HLMID_"-"_HLEVN
211 D MSH^HLFNC2(.HL,MID,.HLRES)
212 S ^TMP("HLS",$J,1)=HLRES
213 ;
214 ;it seems HLFS sometimes disappears upon reaching this point
215 I $G(HLFS)="" S HLFS="^"
216 ;
217 S ^TMP("HLS",$J,2)="MSA"_HLFS_"AA"_HLFS_MSGID
218 Q
219 ;
220MVERRORS ;
221 ;Error messages were being deleted from ^TMP("HLS",$J by another package
222 ;during the upload. To fix this, errors are written to another
223 ;subscript, then moved when the error list is complete.
224 ;
225 M ^TMP("HLS",$J)=^TMP("IVM","HLS",$J)
226 K ^TMP("IVM","HLS",$J)
227 Q
Note: See TracBrowser for help on using the repository browser.