source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDVWHLIN.m@ 1605

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

initial load of WorldVistAEHR
File size: 9.3 KB
RevLine 
[613]1SDVWHLIN ;ENHANCED HL7 RECEIVE APPLICATION DRIVER FOR SDAPI and MAKE AN APPOINTMENT API 11/18/06
2 ;;5.3;Scheduling;**502**;Aug 13, 1993 ;Build 14
3 ; Copyright (C) 2007 WorldVistA
4 ;
5 ; This program is free software; you can redistribute it and/or modify
6 ; it under the terms of the GNU General Public License as published by
7 ; the Free Software Foundation; either version 2 of the License, or
8 ; (at your option) any later version.
9 ;
10 ; This program is distributed in the hope that it will be useful,
11 ; but WITHOUT ANY WARRANTY; without even the implied warranty of
12 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 ; GNU General Public License for more details.
14 ;
15 ; You should have received a copy of the GNU General Public License
16 ; along with this program; if not, write to the Free Software
17 ; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
18 ;
19RECEIVE ;MAIN RECEIVE APPLICATION FOR SDAPI API OR MAKE APPOINTMENT API REQUESTS
20 ; AND MAKE APPT API ACK
21 N APPARMS,ERROR,HLMSGIEN,WHO,SEG,QRDSORT,SORTORDR,OVERAPPT ;
22 N HLMSTATE,HDR
23 N HLVWNOVA
24 N SEGTYPE,IRECAPP,ISNDFAC,IEVN,IFLAGA19,IFLAGACK,POSITION
25 N PATIENID,PATIENT,SSN,PATIENTC,SDLOCATI,PRIMCRED,PRIMSTOP
26 N SDATE,ELIGIB,EXPECTDT,APPTST,DATEAPTM
27 N PIDVALUE,PV1VALUE,PV2VALUE,IFLAG2
28 N SDARRAY,SDCOUNT
29 N SDLOCATE,HOSPLOC,ORDRSORT,MSGMAKAP,COMMENT,EXTER
30 N MAKEAPPT
31 N STARTIM,ENDTIME,CLINIEN,IDX,IFLAG,CLINIEN,FLDS,ACK,ERROR1,XQORMUTE,PCIEN,TEMPC,IER,SD1,SC
32 N SDCLIEN,SDDFN,SDDATE,SDAPPT,STYP,TEMP,VESD,AJJ3CNT,HLMSGTMP,FLDS
33 N AJJ3CNT1,IFLAG2,TEMP1,AJJ3PIEC,AJJ3PIE2,AJJ3CNT2,ERETURN
34 N ILOCATE,SDFNSSN,SDFNNAME
35 ;RECEIVE APPLICATION
36 ; FIRST RECEIVE
37 ; THEN PROCESS
38 ; THEN SEND APPLICATION ACK
39 ;
40 ;FOR SDAPI APPLICATION ACK BELOW
41 ;INPUT
42 ;
43 ;OUTPUT IF NO ERRORS AND SDCOUNT RETURNED NOT =0
44 ;RETURN PID,PV1,PV2,NTE, AND NTE SEGMENTS TO DESCRIBE PATIENT,CLINIC,DATES
45 ;FOR APPPOINTMENS/UNSCHEDULED VISITS FOUND
46 ;
47 ;
48 ;
49 ;AS EXPLAINED IN CODE BELOW
50 ;
51 ;
52 ;RETURN HDR("APP ACK TYPE")_"^"_POSITION_"^"_SDCOUNT_"^"_ERRORS
53 ; POSITION IS NUMBER OF RETURNED APPOINTMENTS/VISITS
54 ; SDCOUNT IS SAME UNLESS ERROR
55 ; AND ERROR RETURNES AS IS
56 ; FROM $$SDAPI^SDAM301
57 ; APP ACK TYPE ACTUALLY RETURNED, IE "AA"
58 ;
59 ; "STARTMSG"
60 ; "ERR"_$$GET^HLOPRS(.SEQ,1)
61 ; "NOTRETURNED ACK"
62 ; "NOT A19 EVENT"
63 ; "HOSPLOC"
64 ; VWSD
65 ;PARSE ACK MESSAGE TYPE WITH REPEATING ADR RESPONSE
66 ;EMBEDDED WITH EVENT TYPE A19
67 ;
68 ;FOR MAKE APPT API
69 ;
70 ; INPUT
71 ;
72 ;
73 ;OUTPUT IF NO ERRORS
74 ;RETURN ACK SEGMENT, ACK CODE AS "AA" OR "AE" , ERROR IN COMMENTS OF ERR SEGMENT IF ANY
75 ;
76 ;
77 ;RETURN HDR("APP ACK TYPE")_"^"_ERRORS
78 ; WHERE COMMENT IS AS RETURNED FROM SDVWMKPI CALL RETURN
79 ;
80 ;
81 ;
82 ;PASS THE HEADER AND RETURN INDIVIDUAL VALUES
83 ;
84 S AJJ3CNT=0
85 S HLVWNOVA=1 ; ALLOW NON-VA STATION NODE WITH ASSOCIATED INSTITUTION
86 ; FOR DETERMINING FACILITY LINK WHEN SENDING APPLICATION BECOMES RECEIVING
87 ; APPLICATION, AND TO FIGURE "SENDING FACILITY LINK"
88 ;
89 S HLMSGTMP="AC" ;200000000000
90 ;^HLB("AC","HL7.VWSD INTERNAL MULTILISTENER:5026VWSD HLO EXT100 XXXXX",200000000XXX)
91 S HLMSGIEN=$O(^HLB(HLMSGTMP),-1)
92 S HDR="" S HLMSTATE=""
93 ;
94 ;
95 I '$$STARTMSG^HLOPRS(.HLMSTATE,HLMSGIEN,.HDR) G OVER2 ;Q "STARTMSG"
96 ;
97MSG1 ;CHECK RECEIVING APPLICATION
98 ;;;;;S IRECAPP=HDR("RECEIVING APPLICATION")
99 ;W !,"IRECAPP=",IRECAPP
100 ;;;;;;S ISNDFAC=HDR("FACILITY LINK NAME")
101 S MSGCTRL=HDR("MESSAGE CONTROL ID") ;HLMSTATE("HDR","MESSAGE CONTROL ID") ;HDR("MESSAGE CONTROL ID") ;OR HLMSTATE(:ID")
102 ;
103 S IFLAGA19=0
104 S POSITION=0
105 ;
106 S IEVN=0 ;0
107 S SDCOUNT=""
108 S SDLOCATE=""
109 S ORDRSORT=""
110 S MSGMAKAP=0 ;
111 S COMMENT="" ;
112 ;
113 ;K SDARRAY
114 ;S SDARRAY=""
115 S FLDS=""
116 ;
117 K SDARRAY
118 ;
119 S SDARRAY=""
120 S ERROR=""
121 S CLINIEN=""
122 S STYP=""
123 S IER=1
124 K SDVWNVAI
125 K ^TMP($J,"SDAMA301")
126 S SEG=""
127 S APPARMS=""
128 S DFN=""
129 S ERETURN=0
130 S ACK=""
131 S MAKEAPPT=0
132 ; ADVANCE TO EACH SEGMENT IN THE MESSAGE
133SEQ I '$$NEXTSEG^HLOPRS(.HLMSTATE,.SEG) G EXIT
134 ;
135 S SEGTYPE=$$GET^HLOPRS(.SEG,0)
136 ;
137 I SEGTYPE="QRF" D
138 .S STARTIM=$$GET^HLOPRS(.SEG,2) ; START TIME
139 .S STARTIM=$$FMDATE^HLFNC(STARTIM) ; TS TO FM
140 .S ENDTIME=$$GET^HLOPRS(.SEG,3) ; END TIME
141 .S ENDTIME=$$FMDATE^HLFNC(ENDTIME)
142 ;
143 I SEGTYPE="EVN" D
144 . S IEVN=$$GET^HLOPRS(.SEG,1) ; FOR SDAPI REQUEST AS EITHER NONE OR "A19" ,MAKE APPOINTMENT API REQUEST AS "A08"
145 ;
146 ;
147 ;BELOW PID, PV1,PV2 FOR RECEIVE MAKE APPOINTMENT API REQUEST PARTICULARS
148 ;
149 I SEGTYPE="PID" D
150 . S POSITION=POSITION+1
151 . S SDARRAY=""
152 . ;GET PATIENT INTERNAL ID
153 . S PATIENID=$$GET^HLOPRS(.SEG,3)
154 . S PATIENT=$$GET^HLOPRS(.SEG,5)
155 . S SSN=$$GET^HLOPRS(.SEG,19)
156 . S PIDVALUE=PATIENID_"^"_PATIENT_"^"_SSN
157 . ;
158 I SEGTYPE="PV1" D
159 . ;GET PATIENT INTERNAL ID
160 . S PATIENTC=$$GET^HLOPRS(.SEG,2) ; PATIENT CLASS
161 . ;S SDLOCID=$$GET^HLOPRS(.SEG,3) ; NOT RECEIVED FROM MAKE APPT REQUEST AS UNKNOWN ( SDLOCATE SENT IN NTE SEGMENT)
162 . S PURPVISI=$$GET^HLOPRS(.SEG,10) ; HOSPITAL SERVICE (PURPOSE OF VISIT)
163 . S PRIMSTOP=$$GET^HLOPRS(.SEG,18) ; PATIENT TYPE (PRIME STOP CODE)
164 . S PRIMCRED=$$GET^HLOPRS(.SEG,41) ; ACCOUNT STATUS (CREDIT STOP CODE)
165 . S SDDATE=$$GET^HLOPRS(.SEG,44) ; ADMIT-VISIT DATE/TIME
166 . ;CONVERT TO FM DATE
167 . S SDDATE=$$FMDATE^HLFNC(SDDATE)
168 . ; S XXXX=$$GET^HLOPRS(.SEG,51) ;
169 . S PV1VALUE=PATIENTC_"^"_PURPVISI_"^"_PRIMSTOP_"^"_PRIMCRED_"^"_SDDATE
170 . ;
171 I SEGTYPE="PV2" D
172 . S ELIGIB=$$GET^HLOPRS(.SEG,7) ; VISIT USER ID-ELIGIBILITY FOR UNSCHEDULED VISITS
173 . S EXPECTDT=$$GET^HLOPRS(.SEG,8) ; EXPECTED DATE/TIME
174 . ;CONVERT TO FM DATE
175 . S EXPECTDT=$$FMDATE^HLFNC(EXPECTDT)
176 . ;S APPTST=$$GET^HLOPRS(.SEG,24) ;APPOINT STATUS
177 . S DATEAPTM=$$GET^HLOPRS(.SEG,46) ;DATE APPT MADE
178 . ;CONVERT TO FM DATE
179 . S DATEAPTM=$$FMDATE^HLFNC(DATEAPTM)
180 . S PV2VALUE=ELIGIB_"^"_EXPECTDT_"^"_DATEAPTM
181 . ;
182 ;
183 ;
184 ;BELOW FOR SDAPI REQUEST RECEIVE AND MAYBE SOME MAKE APPOINTMENT API REQUEST RECEIVE
185 ;
186 S ILOCATE=""
187 I SEGTYPE="NTE" D
188 . S TEMP=$$GET^HLOPRS(.SEG,3) ; UP TO 6 PLUS SDARRAY ELEMENTS
189 . ;CHECK FOR SDVWNVAI
190 . I $E(TEMP,1,9)="SDVWNVAI=" S SDVWNVAI=$P(TEMP,"SDVWNVAI=",2)
191 . I $E(TEMP,1,9)="SDVWNVAI=" Q
192 . ;CHECK FOR STYP=
193 . I $E(TEMP,1,5)="STYP=" S STYP=$P(TEMP,"STYP=",2) S IEVN="A08" ;MUST BE MAKE APPT REQUEST
194 . I $E(TEMP,1,5)="STYP=" Q
195 . I ($E(TEMP,1,11)="SDARRAY(2)=") S ILOCATE=1
196 . I ($E(TEMP,1,9)="SDLOCATE=") S ILOCATE=2
197 . I ($E(TEMP,1,11)="SDARRAY(2)=")!($E(TEMP,1,9)="SDLOCATE=") D
198 . .I ILOCATE=1 S SDLOCATE=$P(TEMP,"SDARRAY(2)=",2)
199 . .I ILOCATE=2 S SDLOCATE=$P(TEMP,"SDLOCATE=",2)
200 . .S SDLOCATE=$P(SDLOCATE,"""",2) ; TAKE OUT FRONT QUOTE
201 . .S SDLOCATE=$P(SDLOCATE,"""",1) ; TAKE OFF ENDING QUOTE
202 . .; CONVERT TO INTERNAL IEN FROM EXTERNAL
203 . .; CHECK FIRST IF SDLOCATE IN B CROSS-REF
204 . .S IDX=""
205 . .S IFLAG=0
206 . . F S IDX=$O(^SC("B",IDX)) Q:(IDX="")!(IFLAG=1) D
207 . . . I IDX=SDLOCATE S IFLAG=1
208 . . I IFLAG=1 D
209 . . . S CLINIEN=0
210 . . . S CLINIEN=$O(^SC("B",SDLOCATE,CLINIEN))
211 . . . S SDARRAY(2)=CLINIEN
212 . . E D
213 . . . S ERROR=ERROR_"^"_"HOSPLOC NOT DEFINED"
214 . . . ;
215 . E D
216 . .;STORE EACH SDARRAY ELEMENT . LOOK FOR SDARRAY("FLDS") AS REQUIRED
217 . .I TEMP["FLDS" S FLDS=1
218 . .;D QUICK(TEMP,.SDARRAY)
219 . . S AJJ3CNT1=0
220 . . S IFLAG2=0
221 . . S TEMP1=""
222 . . ;
223 . . S TEMP="S "_TEMP
224 . . ;G OVER55
225 . . F S AJJ3CNT1=AJJ3CNT1+1 S AJJ3PIEC=$P(TEMP,"""",AJJ3CNT1) Q:(IFLAG2=1) D
226 . . .I AJJ3PIEC'="" D
227 . . . .S AJJ3CNT2=AJJ3CNT1+1 S AJJ3PIE2=$P(TEMP,"""",AJJ3CNT2)
228 . . . .I AJJ3PIE2="" D
229 . . . . .S ILENX=$L(TEMP)
230 . . . . .I $E(TEMP,ILENX,ILENX)="""" D
231 . . . . . .S TEMP1=TEMP1_AJJ3PIEC_""""
232 . . . . .E D
233 . . . . . .S TEMP1=TEMP1_AJJ3PIEC
234 . . . .E D
235 . . . . .S TEMP1=TEMP1_AJJ3PIEC_""""
236 . . .I AJJ3PIEC="" D
237 . . . .S ILENX=$L(TEMP)
238 . . . .I $E(TEMP,ILENX,ILENX)="""" D
239 . . . . .S TEMP1=TEMP1_""
240 . . . . .S IFLAG2=1
241 . . . .E D
242 . . . . .S IFLAG2=1
243OVER55 . .;
244 . . ;
245 . . ;CONVERT SDARRAY TO SDARRAY1 ARRAY
246 . . S TEMP1=$P(TEMP1,"SDARRAY",1)_"SDARRAY1"_$P(TEMP1,"SDARRAY",2)
247 . . X TEMP1
248 . . S AJJ3CNT1=0
249 . . F S AJJ3CNT1=$O(SDARRAY1(AJJ3CNT1)) Q:AJJ3CNT1="" D
250 . . .;
251 . . .S SDARRAY(AJJ3CNT1)=SDARRAY1(AJJ3CNT1)
252 . . ;
253 . .;X TEMP
254 . ;
255 ;EVERY TIME GET A PID SEGMENT INCREMENT POSITION
256 ;
257 ;
258 ;
259 ;
260 G SEQ
261 ;
262 ;
263EXIT ;
264 D OVERX^SDVWHLI2
265OVER2 I (IEVN=0)!(IEVN="A19") K ^TMP($J,"SDAMA301")
266 Q
267 ;;;H 1 I $$NEXTMSG^HLOPRS(.HLMSTATE,HLMSGIEN,.HDR) G MSG1
268 ;;;S AJJ3CNT=AJJ3CNT+1
269 ;;;;I AJJ3CNT>0 Q ; GET OUT EVENTUALLY AS NON-PERSISTANT TASK
270 ;;;;;G OVER2
271 ;
272 ;
273 ;
274 ;
275 Q
276MPKIACK ; APPLICATION ACKNOWLEDGE TO MAKE APPOINTMENT API REQUEST
277 N EXTRET
278 S EXTRET=0
279 ;;
280 S APPARMS("ACK CODE")="AA"
281 S APPARMS("MESSAGE TYPE")="ACK"
282 S APPARMS("SECURITY")=MSGCTRL
283 ;START THE APPLICATION ACKNOWLEDGE MESSAGE
284 ;
285 ;Q
286 S ERROR1=""
287 I (ERETURN'=0)!(ERROR'="")!(IER'=1)!(ERROR1'="") S APPARMS("ACK CODE")="AE"
288 I '$$ACK^HLOAPI2(.HLMSTATE,.APPARMS,.ACK,.ERROR1) S ERETURN="START ACK MESSAGE"
289 ;
290 ;
291 ; ADD ERR SEGMENT IF NEEDED
292 ;
293 I (ERETURN'=0)!(ERROR'="")!(IER'=1)!(ERROR1'="") S EXTRET=$$ERRORW^SDVWHLI1()
294 ;
295 I (ERETURN'=0)!(ERROR'="")!(EXTRET'=0)!(IER'=1)!(ERROR1'="") S APPARMS("ACK CODE")="AE"
296 ;
297 ; SEND APPLICATION ACKNOWLEDGEMENT
298 ;
299 I '$$SENDACK^HLOAPI2(.ACK,.ERROR1) S ERETURN="SENDAPPACK"
300 ;
301 Q
302MSGPROC ; ACK PROCESSING ROUTINE FOR NO RECEIVE ACKS, ETC FOR SDAPI AND MAKE APPOINTMENT API RETURN DATA
303 Q
304APPACKRR ;MAIN APPLICATION ACK RESPONSE FOR SDAPI AND MAKE APPOINTMENT API RETURN DATA
305 Q
Note: See TracBrowser for help on using the repository browser.