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

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

initial load of FOIAVistA 6/30/08 version
File size: 8.8 KB
Line 
1DGENQRY1 ;ALB/CJM - API for ENROLLMENT QUERIES (continued); 4-SEP-97 ; 5/14/02 9:57am
2 ;;5.3;REGISTRATION;**147,232,363,472**;Aug 13,1993
3 ;
4BATCH ;
5 ;Description: This procedure will re-send all queries still outstanding
6 ;with status of TRANSMITTED with QUERY DT/TM of more than 2 days in the
7 ;past.
8 ;
9 ;Input:
10 ; None
11 ;Output:
12 ; The ENROLLMENT QUERY LOG file is updated with all the query activity. New queries to HEC are generated where necessary.
13 ;
14 N QRY,DATE
15 S DATE=$$FMADD^XLFDT(DT,-2)
16 F S DATE=$O(^DGEN(27.12,"ADS",DATE),-1) Q:'DATE D
17 .S QRY=0
18 .F S QRY=$O(^DGEN(27.12,"ADS",DATE,QRY)) Q:'QRY D
19 ..I '$$RESEND(QRY) ;then something went wrong, but continue
20 Q
21 ;
22RECEIVE(IEN,ERRORMSG,RMSGID) ;
23 ;Description: This function will update the query log to show status
24 ;RECEIVED. If the NOTIFY field is contains a user to notify, it will
25 ;also send the notification message.
26 ;Input:
27 ; IEN - internal entry number of a record in the ENROLLMENT QUERY LOG
28 ; ERRORMSG - error message to include in notification (optional)
29 ; RMSGID - message id from the response
30 ;
31 ;Output:
32 ; Function Value - 1 if successful, 0 otherwise.
33 ;
34 N SUCCESS,DGQRY,DATA,IEN2,DGQRY2
35 S SUCCESS=0
36 ;
37 D
38 .Q:'$G(IEN)
39 .Q:'$$GET^DGENQRY(IEN,.DGQRY)
40 .;
41 .;try to get a lock, but proceed anyway
42 .I $$LOCK^DGENQRY(DGQRY("DFN"))
43 .;
44 .;if the query was retransmitted, then update the status of the patient's last query
45 .I DGQRY("STATUS")=2 D
46 ..S IEN2=$$FINDLAST^DGENQRY(DGQRY("DFN"))
47 ..Q:'IEN2
48 ..Q:'$$GET^DGENQRY(IEN2,.DGQRY2)
49 ..I DGQRY2("FIRST")=DGQRY("FIRST") S IEN=IEN2 M DGQRY=DGQRY2
50 .;
51 .S DATA(.03)=$S($L($G(ERRORMSG)):4,1:3)
52 .S DGQRY("STATUS")=DATA(.03)
53 .S DATA(.06)=$$NOW^XLFDT
54 .S DGQRY("RESPONSE")=DATA(.06)
55 .S DATA(1)=$G(ERRORMSG)
56 .S DATA(.07)=$G(RMSGID)
57 .S DGQRY("RESPONSEID")=DATA(.07)
58 .S DGQRY("ERROR")=DATA(1)
59 .Q:'$$UPD^DGENDBS(27.12,IEN,.DATA)
60 .;
61 .I DGQRY("NOTIFY") I '$$NOTIFY(.DGQRY)
62 .;
63 .S SUCCESS=1
64 ;
65 D:$G(DGQRY("DFN")) UNLOCK^DGENQRY(DGQRY("DFN"))
66 Q SUCCESS
67 ;
68NOTIFY(DGQRY) ;
69 ;Description: send notification of reply received for enrollment query.
70 ;
71 ;Input:
72 ; DGQRY() - array containing the ENROLLMENT QUERY LOG record (pass by reference)
73 ;
74 ;Output:
75 ; Function Value: 1 on success, 0 on failure
76 ;
77 N PATIENT,TEXT,XMDUZ,XMTEXT,XMSUB,XMSTRIP,XMROU,XMY,XMZ,XMDF
78 Q:'$$GET^DGENPTA($G(DGQRY("DFN")),.PATIENT) 0
79 ;
80 S XMDF=""
81 S (XMDUN,XMDUZ)="Registration Enrollment Module"
82 S XMSUB="Enrollment/Eligibility Query Reply: "_PATIENT("NAME")
83 S XMY(DGQRY("NOTIFY"))=""
84 S XMTEXT="TEXT("
85 S TEXT(1)="A reply to the enrollment/eligibility query that you sent has been received."
86 S TEXT(2)=" "
87 S TEXT(3)="Patient Name : "_PATIENT("NAME")
88 S TEXT(4)="SSN : "_PATIENT("SSN")
89 S TEXT(5)="Query Date/Time: "_$$FMTE^XLFDT(DGQRY("FIRST"),"1")
90 S TEXT(6)="Query Status : "_$$EXTERNAL^DILFD(27.12,.03,"F",DGQRY("STATUS"))
91 ;
92 I $L(DGQRY("ERROR")) D
93 .S TEXT(7)=" "
94 .S TEXT(8)="The following problem was encountered:"
95 .S TEXT(9)=" "
96 .S TEXT(10)=DGQRY("ERROR")
97 ;
98 D ^XMD
99 Q 1
100 ;
101CLOSE(IEN,ERROR) ;
102 ;Description: This function can be used to change a query with status
103 ;of TRANSMITTED to a status of CLOSED. This will prevent retransmission.
104 ;It can be used, for example, when an unsolicited enrollment message is
105 ;received while a query is still outstanding.
106 ;Input:
107 ; IEN: The ien of a record in the ENROLLMENT QUERY LOG file.
108 ;
109 ;Output:
110 ; Function Value - 1 if successful, 0 otherwise.
111 ; ERROR - if unsuccessful, returns an error message (optional, pass by reference)
112 ;
113 N SUCCESS,DGQRY,DATA
114 S SUCCESS=0
115 S ERROR=""
116 ;
117 D
118 .I '$G(IEN) S ERROR="ENTRY IN ENROLLMENT QUERY LOG DOES NOT EXIST" Q
119 .Q:'$$GET^DGENQRY(IEN,.DGQRY)
120 .I '$$LOCK^DGENQRY(DGQRY("DFN")) S ERROR="UNABLE TO LOCK ENROLLMENT QUERY LOG" Q
121 .I DGQRY("STATUS") S ERROR="QUERY STATUS IS NOT TRANSMITTED" Q
122 .;
123 .S DATA(.03)=1
124 .I '$$UPD^DGENDBS(27.12,IEN,.DATA,.ERROR) S ERROR="UNABLE TO UPDATE ENROLLMENT QUERY LOG WITH NEW STATUS" Q
125 .;
126 .S SUCCESS=1
127 ;
128 D UNLOCK^DGENQRY(DGQRY("DFN"))
129 Q SUCCESS
130 ;
131RESEND(IEN,ERROR) ;
132 ;Description: Used to re-send an outstanding query.
133 ;Input:
134 ; IEN - ien of a record in the ENROLLMENT QUERY LOG. It identifies the query to be re-sent.
135 ;Output:
136 ; Function Value - 1 if successful, 0 otherwise.
137 ; ERROR - if unsuccessful returns a mssg (pass by reference, optional)
138 ;
139 N SUCCESS,DGQRY,DATA
140 S SUCCESS=0
141 S ERROR=""
142 ;
143 D
144 .I '$G(IEN) S ERROR="ENTRY IN ENROLLMENT QUERY LOG DOES NOT EXIST" Q
145 .Q:'$$GET^DGENQRY(IEN,.DGQRY)
146 .I '$$LOCK^DGENQRY(DGQRY("DFN")) S ERROR="UNABLE TO LOCK ENROLLMENT QUERY LOG" Q
147 .I DGQRY("STATUS") S ERROR="QUERY STATUS IS NOT TRANSMITTED" Q
148 .S DATA(.03)=2
149 .I '$$UPD^DGENDBS(27.12,IEN,.DATA,.ERROR) S ERROR="UNABLE TO UPDATE ENROLLMENT QUERY LOG WITH NEW STATUS" Q
150 .I '$$SEND(DGQRY("DFN"),DGQRY("NOTIFY"),DGQRY("FIRST"),.ERROR) Q
151 .S SUCCESS=1
152 ;
153 D UNLOCK^DGENQRY(DGQRY("DFN"))
154 Q SUCCESS
155 ;
156SEND(DFN,NOTIFY,FIRST,ERROR) ;
157 ;Description: This function is used to send an ENROLLMENT/ELIGIBILITY
158 ;QUERY to HEC for a particular patient.
159 ;
160 ;Input:
161 ; DFN - the patient for whom to send the query
162 ; NOTIFY - who should receive notification when the query reply is
163 ; received. Is a pointer to the NEW USER file. (Optional)
164 ; FIRST - DATE/TIME to enter to the FIRST DT/TIME field of the
165 ; ENROLLMENT QUERY LOG file (Optional)
166 ;
167 ;Output:
168 ; Function Value - 1 on success, 0 on failure.
169 ; ERROR - if unsuccessful, this variable will return an error message, (pass by reference) (optional)
170 ;
171 ; quit if enrollment transmit query to HEC switch is off
172 I '$$ON^DGENQRY Q 0
173 ;
174 N LAST,DGQRY,MSGID,SUCCESS,SENT
175 ;
176 S SUCCESS=1
177 I '$$LOCK^DGENQRY($G(DFN)) S SUCCESS=0,ERROR="UNABLE TO LOCK ENROLLMENT QUERY LOG"
178 S LAST=$$FINDLAST^DGENQRY(DFN)
179 I SUCCESS,LAST,$$GET^DGENQRY(LAST,.DGQRY),'DGQRY("STATUS") S SUCCESS=0,ERROR="ENROLLMENT/ELIGIBILITY QUERY ALREADY SENT"
180 D:SUCCESS
181 .S SENT=$$MSG(DFN,.MSGID,.ERROR)
182 .I 'SENT S SUCCESS=0 Q
183 .S DGQRY("DFN")=DFN
184 .S DGQRY("SENT")=SENT
185 .S DGQRY("STATUS")=0
186 .S DGQRY("MSGID")=MSGID
187 .S DGQRY("NOTIFY")=$G(NOTIFY)
188 .S DGQRY("FIRST")=$S($G(FIRST):FIRST,1:SENT)
189 .S DGQRY("RESPONSE")=""
190 .S DGQRY("RESPONSEID")=""
191 .I '$$LOG^DGENQRY(.DGQRY) S SUCCESS=0,ERROR="UNABLE TO ENTER QUERY TO ENROLLMENT QUERY LOG" Q
192 .;
193SENDQ ;
194 D UNLOCK^DGENQRY($G(DFN))
195 Q SUCCESS
196 ;
197MSG(DFN,MSGID,ERROR) ; Send enrollment/eligibility query to HEC
198 ;
199 ;Input:
200 ; DFN - Pointer to the patient in file #2
201 ;Output
202 ; Function Value - if successful, returns 1, otherwise returns 0
203 ; MSGID - if successful, returns the message id assigned by the HL7 package (pass by reference)
204 ; ERROR - if unsuccessful,returns an error message (pass by reference)
205 ;
206 N HLSDT,HLMTN,HLDAP,HLEVN,HLERR,HLDA,HLDAN,HLDT,HLDT1,HLECH,HLFS,HLNDAP,HLNDAP0,HLPID,HLQ,HLVER,HLMID,SUCCESS,DGPAT
207 N HL,HLARYTYP,HLFORMAT,HLRESLT
208 ;
209 K HLA("HLS") ;DG*5.3.472
210 S SUCCESS=0
211 ;
212 ; - init HL7 variables
213 S HLMTN="QRY"
214 S HLDAP="IVM"
215 S HLEID="VAMC "_$P($$SITE^VASITE,"^",3)_" QRY-Z11 SERVER"
216 S HLEID=$O(^ORD(101,"B",HLEID,0))
217 D INIT^HLFNC2(HLEID,.HL)
218 I $G(HL)]"" S HLERR=$P(HL,"^",2)
219 I '$D(HLERR) D CREATE^HLTF(.HLMID,.HLMTIEN,.HLDT,.HLDT1)
220 S HLEVN=0 ; initialize event counter
221 S HLSDT=$$NOW^XLFDT
222 I $D(HLERR) S ERROR=HLERR G MSGQ
223 ;
224 I '$$GET^DGENPTA(DFN,.DGPAT) S ERROR="PATIENT NOT FOUND" G MSGQ
225 I (DGPAT("SEX")="") S ERROR="PATIENT SEX IS REQUIRED" G MSGQ
226 I (DGPAT("DOB")="") S ERROR="PATIENT DATE OF BIRTH IS REQUIRED" G MSGQ
227 I (DGPAT("SSN")="") S ERROR="PATIENT SSN IS REQUIRED" G MSGQ
228 ;
229 ; - build HL7 query (QRY) msg and send
230 D QRD,QRF
231 S HLARYTYP="LM" ;DG*5.3*472
232 S HLFORMAT=1
233 D GENERATE^HLMA(HLEID,HLARYTYP,HLFORMAT,.HLRESLT)
234 I $P($G(HLRESLT),"^",2)]"" S HLERR=$P(HLRESLT,"^",3)
235 I $D(HLERR) S ERROR=HLERR G MSGQ
236 S SUCCESS=HLSDT
237 ;
238 S MSGID=+HLRESLT
239 ;
240MSGQ ; - exit and clean-up
241 D KILL^HLTRANS
242 K HLA("HLS") ;DG*5.3*472
243 Q SUCCESS
244 ;
245QRD ; Build (HL7) QRD segment for patient
246 N QUERY
247 S $P(QUERY,HLFS,1)=$$HLDATE^HLFNC(HLDT) ; date/time query generated
248 S $P(QUERY,HLFS,2)="R" ; query format code (record oriented format)
249 S $P(QUERY,HLFS,3)="I" ; query priority (immediate)
250 S $P(QUERY,HLFS,4)=DFN ; query ID (DFN)
251 S $P(QUERY,HLFS,7)="1~RD" ; quanity limited request (1 record)
252 S $P(QUERY,HLFS,8)=DGPAT("SSN") ; who subject filter (SSN)
253 S $P(QUERY,HLFS,9)="OTH" ; what subject filter
254 S $P(QUERY,HLFS,10)="ENROLLMENT" ;What department data code
255 S $P(QUERY,HLFS,12)="T" ; query results level (full results)
256 S HLA("HLS",1)="QRD"_HLFS_QUERY ;DG*5.3*472
257 Q
258 ;
259 ;
260QRF ; Build HL7 (QRF) segment for patient
261 N FILTER
262 S $P(FILTER,HLFS,1)="IVM" ; where subject filter (IVM Center)
263 S $P(FILTER,HLFS,4)=$$HLDATE^HLFNC(DGPAT("DOB")) ; what user qualifier (DOB)
264 S $P(FILTER,HLFS,5)=DGPAT("SEX") ; other subj. query filter (sex)
265 S HLA("HLS",2)="QRF"_HLFS_FILTER ;DG*5.3*472
266 Q
Note: See TracBrowser for help on using the repository browser.