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

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

initial load of FOIAVistA 6/30/08 version
File size: 6.7 KB
Line 
1DGENUPL ;ALB/CJM,ISA/KWP,TDM - PROCESS INCOMING (Z11 EVENT TYPE) HL7 MESSAGES ; 8/11/05 5:21pm
2 ;;5.3;REGISTRATION;**147,222,232,363,472,497,564,677,672**;Aug 13,1993
3 ;Phase II Moved Z11 to DGENUPL7
4ORUZ11(MSGIEN,ERRCOUNT) ;
5 ;Description: This procedure is used to process a batch of ORU~Z11
6 ;messages or a single ORU~Z11 message.The processing consists of
7 ;uploading the patient enrollment and eligibility data.
8 ;
9 ;Input:
10 ; MSGIEN - the ien of the HL7 message in the HL7 MESSAGE TEXT file
11 ;Output:
12 ; ERRCOUNT - count of messages that were not processed due to
13 ; errors encountered (pass by reference)
14 ;
15 N CURLINE,SSN,DOB,SEX,SEG,MSGID,SSN,DFN,ERRMSG,SEG
16 ;
17 K ^TMP("IVM","HLS",$J)
18 ;
19 ;initialize HL7 variable
20 S HLSDT="IVMQ" ;location of error message
21 ;
22 S CURLINE=1
23 D ADVANCE(MSGIEN,.CURLINE)
24 Q:'CURLINE
25 F Q:'CURLINE D D ADVANCE(MSGIEN,.CURLINE)
26 .D GETSEG(MSGIEN,CURLINE,.SEG)
27 .S MSGID=SEG(10)
28 .D NXTSEG(MSGIEN,CURLINE,.SEG)
29 .I SEG("TYPE")'="PID" D ADDERROR(MSGID,,"PID SEGMENT MISSING",.ERRCOUNT) Q
30 .S DFN=$$LOOKUP^DGENPTA(SEG(19),$$FMDATE^HLFNC(SEG(7)),SEG(8),.ERRMSG)
31 .I 'DFN D ADDERROR(MSGID,SEG(19),ERRMSG,.ERRCOUNT) Q
32 .D Z11^DGENUPL7(MSGIEN,MSGID,.CURLINE,DFN,.ERRCOUNT)
33 S HLEVN=+$G(ERRCOUNT) ;# of events included in the reply
34 M ^TMP("HLS",$J)=^TMP("IVM","HLS",$J) ;DG*5.3*472
35 K ^TMP("IVM","HLS",$J)
36 Q
37 ;
38ORFZ11(MSGIEN,MSGID) ;
39 ;Description: This procedure is used to process an ORF~Z11 message
40 ;It uploads the patient enrollment and eligibility data.
41 ;An acknowledgment is returned.
42 ;
43 ;Input:
44 ; MSGIEN - the internal entry number of the HL7 message in the HL7 MESSAGE TEXT file (772)
45 ; MSGID - the message control id from the MSH segment
46 ;
47 ;Output: none
48 ;
49 N CURLINE,DFN,QUERYIEN,QARRAY,QRYMSGID,ERRCOUNT,HECERROR,SEG,DGRESENT
50 ;CURLINE tracks current line in the message
51 ;QUERYIEN the ien of query in the ENROLLMENT QUERY LOG
52 ;QRYMSGID the Message Controll ID of the query
53 ;QARRAY array containing the ENROLLMENT QUERY LOG record
54 ;HECERROR error message returned by HEC in response to query
55 ;DGRESENT flag=1 if query was resent
56 ;
57 S (QUERYIEN,ERRCOUNT)=0
58 ;
59 ;initialize HL7 variable
60 S HLSDT="IVMQ" ;subscript in ^TMP( global for ACK message
61 ;
62 K ^TMP("IVM","HLS",$J)
63 ;
64 S CURLINE=1
65 S HECERROR=""
66 ;
67 D ;drops out on error
68 .D NXTSEG(MSGIEN,.CURLINE,.SEG)
69 .I SEG("TYPE")'="MSA" D ADDERROR(MSGID,,"MISSING MSA SEGMENT",.ERRCOUNT) Q
70 .;trace the reply back to the query
71 .S QRYMSGID=SEG(2)
72 .S QUERYIEN=$$FINDMSG^DGENQRY(QRYMSGID)
73 .I 'QUERYIEN D ADDERROR(MSGID,,"NO RECORD OF QUERY",.ERRCOUNT) Q
74 .I QUERYIEN,'$$GET^DGENQRY(QUERYIEN,.QARRAY) D ADDERROR(MSGID,,"NO RECORD OF QUERY",.ERRCOUNT) Q
75 .S DFN=QARRAY("DFN")
76 .I (SEG(1)="AR")!(SEG(1)="AE") D Q
77 ..;HEC was unable to reply to the query. If due to incorrect patient
78 ..;info, then resend the query, otherwise just log it as unsuccessful
79 ..N SSN,DOB,SEX,DGPAT,HECMSG
80 ..S HECMSG=SEG(3)
81 ..D NXTSEG(MSGIEN,.CURLINE,.SEG)
82 ..Q:(SEG("TYPE")'="QRD")
83 ..S SSN=SEG(8)
84 ..D NXTSEG(MSGIEN,.CURLINE,.SEG)
85 ..Q:(SEG("TYPE")'="QRF")
86 ..S DOB=$$FMDATE^HLFNC(SEG(4))
87 ..S SEX=SEG(5)
88 ..;if patient id info incorrect, resend the query
89 ..I $$GET^DGENPTA(DFN,.DGPAT),((DOB'=DGPAT("DOB"))!(SEX'=DGPAT("SEX"))!(SSN'=DGPAT("SSN"))) I $$RESEND^DGENQRY1(QUERYIEN) S DGRESENT=1 Q
90 ..S HECERROR="HEC UNABLE TO RESPOND TO QUERY- "_HECMSG Q
91 .;
92 .F SEG="QRD","QRF","PID" D NXTSEG(MSGIEN,.CURLINE,.SEG) I SEG("TYPE")'=SEG D ADDERROR(MSGID,,SEG_" SEGMENT MISSING",.ERRCOUNT) Q
93 .S CURLINE=CURLINE-1 ;should point to line before PID
94 .I $$SSN^DGENPTA(DFN)'=SEG(19) D ADDERROR(MSGID,,"SSN DOES NOT MATCH",.ERRCOUNT) Q
95 .D Z11^DGENUPL7(MSGIEN,MSGID,.CURLINE,DFN,.ERRCOUNT)
96 ;
97 ;update the query log
98 I $G(HECERROR)="",ERRCOUNT S HECERROR="UPLOAD FAILED DUE TO CONSISTENCY CHECKS"
99 I '$G(DGRESENT),$$RECEIVE^DGENQRY1(QUERYIEN,HECERROR,MSGID)
100 ;
101 S HLEVN=+$G(ERRCOUNT) ;# of events included in the reply
102 ;
103 ;if there was no error, create an 'AA' ack
104 ;I 'ERRCOUNT D ACCEPT^DGENUPL1(MSGID) ;DG*5.3*472
105 ;D MVERRORS^DGENUPL1 ;DG*5.3*472
106 ;transmit the ack
107 ;********************************************************
108 ;7.12.01;KSD; COMMENTED OUT. DON'T SEND ACK TO ORF
109 ;I $D(HLTRANS) S HLARYTYP="GB",HLFORMAT=1 D GENACK^HLMA1(HLEID,HLMTIENS,HLEIDS,HLARYTYP,HLFORMAT,.HLRESLTA,HLMTIEN)
110 ;
111 Q
112 ;
113ADDERROR(MSGID,SSN,ERRMSG,ERRCOUNT) ;
114 ;Description - writes an error message to a global. It will be
115 ;transmitted in the ack later.
116 ;
117 ;Inputs:
118 ; MSGID -message control id of HL7 msg in the MSH segment
119 ; SSN - patient social security number
120 ; ERRMSG - the error message
121 ; ERRCOUNT - count of errors written so far
122 ;
123 ;Outputs: none
124 ;
125 S ERRCOUNT=+$G(ERRCOUNT)
126 ;
127 I (ERRCOUNT*2)+1=1 D
128 . K HL,HLMID,HLMTIEN,HLDT,HLDT1
129 . D INIT^HLFNC2(HLEID,.HL)
130 . D CREATE^HLTF(.HLMID,.HLMTIEN,.HLDT,.HLDT1)
131 K HLRES
132 S MID=HLMID_"-"_((ERRCOUNT*2)+1)
133 D MSH^HLFNC2(.HL,MID,.HLRES)
134 S ^TMP("IVM","HLS",$J,(ERRCOUNT*2)+1)=HLRES
135 S ^TMP("IVM","HLS",$J,(ERRCOUNT*2)+2)="MSA"_HLFS_"AE"_HLFS_MSGID_HLFS_ERRMSG_" - SSN "_$S($L($G(SSN)):SSN,1:"NOT FOUND")
136 S ERRCOUNT=ERRCOUNT+1
137 ;Put in error message in HECERROR to be included in the NOTIFY message for a solicited query
138 I $D(HECERROR) S HECERROR=ERRMSG
139 Q
140 ;
141NXTSEG(MSGIEN,CURLINE,SEG) ;
142 ;Description: Returns the next segment
143 ;
144 ;Input:
145 ; MSGIEN - ien in HL7 MESSAGE TEXT file
146 ; CURLINE - subscript of the current segment
147 ;
148 ;Output:
149 ; SEG - an array with the fields of the segment (pass by reference)
150 ; CURLINE - upon exiting, will be the subscript of the next segment
151 ;
152 S CURLINE=CURLINE+1
153 D GETSEG(MSGIEN,CURLINE,.SEG)
154 Q
155 ;
156GETSEG(MSGIEN,CURLINE,SEG) ;
157 ;returns the current segment
158 ;
159 ;Input:
160 ; MSGIEN - ien in HL7 MESSAGE TEXT file
161 ; CURLINE - subscript of the current segment
162 ;
163 ;Output:
164 ; SEG - an array with the fields of the segment (pass by reference)
165 ;
166 N SEGMENT,I
167 S:$G(HLFS)="" HLFS=$G(HL("FS")) S:HLFS="" HLFS="^"
168 S SEGMENT=$G(^TMP($J,IVMRTN,CURLINE,0))
169 S SEG("TYPE")=$E(SEGMENT,1,3)
170 ;
171 ;the MSH & BHS segs contain as their first piece the field separator, which makes breaKing the seqment into fields a bit different
172 I (SEG("TYPE")="MSH")!(SEG("TYPE")="BHS") D
173 .S SEG(1)=$E(SEGMENT,4)
174 .F I=2:1:30 S SEG(I)=$P(SEGMENT,HLFS,I)
175 E D
176 .F I=2:1:41 S SEG(I-1)=$P(SEGMENT,HLFS,I)
177 Q
178 ;
179ADVANCE(MSGIEN,CURLINE) ;
180 ;Description: Used to find the begining of the next message in the batch.
181 ;
182 ;Input:
183 ; MSGIEN - ien of message in the HL7 MESSAGE TEXT file.
184 ; CURLINE - current position in the message
185 ;Output:
186 ; CURLINE - starting position of next message in the batch, or 0 if
187 ; the end of the message is reached
188 ;
189 Q:'CURLINE
190 F S CURLINE=$O(^TMP($J,IVMRTN,CURLINE)) Q:'CURLINE Q:$E($G(^TMP($J,IVMRTN,CURLINE,0)),1,3)="MSH"
191 S CURLINE=+CURLINE
192 Q
Note: See TracBrowser for help on using the repository browser.