source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDVWHLI1.m@ 975

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

initial load of WorldVistAEHR

File size: 8.9 KB
Line 
1SDVWHLI1 ;ENHANCED HL7 RECEIVE APPLICATION DRIVER (CONTINUED) 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 ;
19SDAPIACK ; APPLICATION ACKNOWLEDGE TO SDAPI REQUEST
20 N EXTRET,ERROR2,LOCACKCD,ACKCDER,TEMP8,SEG
21 N ERR,ERROR3,HLMSTATE,WHO,APPARMS,XQ,RETURN1,IJCOUNT ; NEW ONES SO CANNOT USE OLD HLMSTATE TO RETURN REAL ACK
22 S EXTRET=0
23 ;S SEG=""
24 S ERROR2=""
25 S XQ=""
26 ;
27 ;
28 ; SEND ACK MESSAGE COMMENTED OUT BELOW. INSTEAD JUST SEND NORMAL MESSAGE WITH ADDED SEGMENTS
29 ;
30 ;;;;S APPARMS("ACK CODE")="AA"
31 ;;;;S APPARMS("ACCEPT ACK TYPE")="NE"
32 ;;;;I (ERROR'="")!(SDCOUNT<0) D
33 ;;;;.S APPARMS("ACK CODE")="AE"
34 ;;;.S APPARMS("ERROR MESSAGE")=ERROR_"^"_SDCOUNT
35 ;;;;S APPARMS("MESSAGE TYPE")="ACK"
36 ;;;;;S APPARMS("EVENT")="A19"
37 ;;
38 ;;
39 S APPARMS("MESSAGE TYPE")="ADT"
40 S APPARMS("EVENT")="A19" ; RESPONSE
41 S APPARMS("COUNTRY")="USA"
42 S APPARMS("FIELD SEPARATOR")="|"
43 S APPARMS("ENCODING CHARACTERS")="^~\&"
44 S APPARMS("VERSION")=2.4
45 ;
46 ;
47 S APPARMS("SECURITY")=MSGCTRL
48 ;ANALOGY FOR ACK FOR MAKE APPT BELOW
49 I MAKEAPPT=1 D
50 .S APPARMS("EVENT")="A08"
51 .I IER=1 D
52 ..S APPARMS("SECURITY")=MSGCTRL_"#"_"AA"
53 .E D
54 ..S APPARMS("SECURITY")=MSGCTRL_"#"_"AE"
55 ;
56 ;
57 ;
58 ;DON'T USE ACK MESSAGE START , JUST REGULAR MESSAGE START
59 ;START THE APPLICATION ACKNOWLEDGE MESSAGE
60 ;;;I '$$ACK^HLOAPI2(.HLMSTATE,.APPARMS,.ACK,.ERROR1) S ERETURN="START ACK MESSAGE"
61 ;;;
62 ;;;
63 ;;;
64 ;;; JUMP OVER THIS AS ADDSEG^HLOAPI DOES NOT RETURN WITH A START APPLICATION ACKNOWLEDGE
65 ;;;D SET^HLOAPI(.SEG,"MSA",0) ;creates an MSA segment
66 ;;;S LOCACKCD="AA"
67 ;;;S ACKCDER=""
68 ;;;I (ERROR'="")!(SDCOUNT<0) D
69 ;;;.S LOCACKCD="AE"
70 ;;;.S ACKCDER=ERROR_"^"_SDCOUNT
71 ;;;D SET^HLOAPI(.SEG,LOCACKCD,1) ; "AA' OR "AE"
72 ;;;D SET^HLOAPI(.SEG,MSGCTRL,2) ;=MSGCTRL
73 ;;;D SET^HLOAPI(.SEG,ACKCDER,3) ;will place the value into the array position
74 ;;;
75 ;;;
76 ;;; ADD SEGMENT
77 ;;;I '$$ADDSEG^HLOAPI(.HLMSTATE,.SEG,.ERROR2) S ERETURN="MSA"
78 ;;;
79 ;
80 ;;CREATE NEW MESSAGE
81 ;;
82 ;
83 S ERR=""
84 S ERROR3=""
85 S ERROR1=""
86 ;
87 I MAKEAPPT=1 D
88 .I '$$NEWMSG^HLOAPI(.APPARMS,.HLMSTATE,.ERROR3) S ERETURN="NEW MESSAGE ERROR"
89 ;
90 I (MAKEAPPT'=1)&(SDCOUNT'>0) D
91 .I '$$NEWMSG^HLOAPI(.APPARMS,.HLMSTATE,.ERROR3) S ERETURN="NEW MESSAGE ERROR"
92 ;JUMP OVER CREATE MSA SEGMENT OURSELF FOR A NON-ACK MESSAGE
93 G OVERA
94 ;Use message control ID in MSH segment for sync flag later in returned application ack
95 ;
96 ;;CREATE SEGMENT
97 ;
98 ;EXPERIMENT . BUILD MSA SEGMENT BY ITSELF
99 ;
100 D SET^HLOAPI(.SEG,"MSA",0) ;creates an MSA segment
101 S LOCACKCD="AA"
102 S ACKCDER=""
103 I (ERROR'="")!(SDCOUNT<0) D
104 .S LOCACKCD="AE"
105 .S ACKCDER=ERROR_"^"_SDCOUNT
106 D SET^HLOAPI(.SEG,LOCACKCD,1) ; "AA' OR "AE"
107 D SET^HLOAPI(.SEG,MSGCTRL,2) ;=MSGCTRL
108 D SET^HLOAPI(.SEG,ACKCDER,3) ;will place the value into the array position
109 ;;;
110 ;;;
111 ;;; ADD SEGMENT
112 I '$$ADDSEG^HLOAPI(.HLMSTATE,.SEG,.ERROR2) S ERETURN="MSA"
113OVERA ;
114 ;
115 ;
116 ;
117 ; ADD ERR SEGMENT IF NEEDED
118 ;
119 ;I (MAKEAPPT=1) I IER=1 S IER=0
120 I (MAKEAPPT=1)!((MAKEAPPT'=1)&(SDCOUNT'>0)) D
121 .I (ERETURN'=0)!(ERROR'="")!(SDCOUNT<0)!(ERROR1'="")!(IER'=1) S EXTRET=$$ERRORW(XQ)
122 ;
123 ;
124 ;;CREATE SEGMENT QRD
125 ;
126 ; PUT N SORT METHOD FOR APPT RETURNED AND SDCOUNT VALUE
127 ; ADD ADT ACK SEGMENT FOR MAKE APPT
128 I MAKEAPPT=1 D
129 .D SET^HLOAPI(.SEG,"PID",0)
130 .D SET^HLOAPI(.SEG,DFN,3)
131 .S SDFNNAME=$P($G(^DPT(DFN,0)),"^",1)
132 .D SET^HLOAPI(.SEG,SDFNNAME,5)
133 .S SDFNSSN=$P($G(^DPT(DFN,0)),"^",9)
134 .D SET^HLOAPI(.SEG,SDFNSSN,19)
135 .;
136 .;; ADD SEGMENT
137 .I '$$ADDSEG^HLOAPI(.HLMSTATE,.SEG) S ERETURN="PID"
138 ;
139 I MAKEAPPT=1 G OVERT
140 I (MAKEAPPT'=1)&(SDCOUNT'>0) D
141 .D SET^HLOAPI(.SEG,"QRD",0)
142 .D SET^HLOAPI(.SEG,$$HLDATE^HLFNC($$NOW^XLFDT(),"TS"),1)
143 .D SET^HLOAPI(.SEG,ORDRSORT,8)
144 .I (ERROR="")&(SDCOUNT'="") D SET^HLOAPI(.SEG,SDCOUNT,11)
145 .;
146 .;
147 .;
148 .;; ADD SEGMENT
149 .I '$$ADDSEG^HLOAPI(.HLMSTATE,.SEG) S ERR="QRD"
150 .I $D(ERROR2) D
151 ..;
152 .E D
153 ..;
154 ;;CREATE SEGMENT EVN
155 ;
156 ; PUT IN ADT A19 RETURN , BUT THIS MAY ALREADY BE THERE FROM APPARMS("EVENT")FROM ORIGINAL RECEIVED MESSAGE, BUT THIS CREATES EVENT
157 ;SEGMENT BELOW NOT ALREADY CREATED SINCE THIS IS REQUIRED TO SEND A NEW MSG WHICH IS WHAT THIS APP ACK IS.
158 ;
159 ;;D SET^HLOAPI(.SEG,"EVN",0)
160 ;;D SET^HLOAPI(.SEG,"A19",1)
161 ;;D SET^HLOAPI(.SEG,$$HLDATE^HLFNC($$NOW^XLFDT(),"TS"),2)
162 ;
163 ;; ADD SEGMENT
164 ;;I '$$ADDSEG^HLOAPI(.HLMSTATE,.SEG) S ERETURN="EVN"
165 ;
166 ;
167 ;
168 ;I ORDRSORT="P" S SDCLIEN=$O(^TMP($J,"SDAMA301",DFN,SDCLIEN)) LAST SDATE
169 ;I ORDRSORT="C" S SDDFN=$O(^TMP($J,"SDAMA301",CLINIEN,SDDFN)) LAST SDDATE
170 ;I ORDRSORT="PS" S SDDATE=$O(^TMP($J,"SDAMA301",PATIENTID,CLINIEN)) LAST SDDATE
171 ;I ORDRSORT="CN" S SDDFN=$O(^TMP($J,"SDAMA301",SDCLIEN,SDDFN)) LAST SDDATE
172 I SDCOUNT>0 D
173 .;CREATE MULTIPLES OF PID,PV1,PV2,NTE,NTE SEGMENTS FOR EACH APPOINTMENT/UNSCHEDULED VISIT RETURNED
174 .;;
175 .;DETERMINE FROM SORT ORDER IF $ORDER NEEDED TO GET DFN OR WHETHER ALREADY SPECIFIED THE SAME AS SUCH IN
176 .;INPUT PARAMETERS
177 .;
178 .;FIRST ORDRSORT="P"
179 .S IJCOUNT=0
180 .I ($P(ORDRSORT,",",1)="P")&($G(SDARRAY("SORT"))="") D
181 ..S SDCLIEN=0
182 ..F S SDCLIEN=$O(^TMP($J,"SDAMA301",DFN,SDCLIEN)) Q:SDCLIEN="" D
183 ...S SDDATE=0 F S SDDATE=$O(^TMP($J,"SDAMA301",DFN,SDCLIEN,SDDATE)) Q:SDDATE="" D
184 ....S SDAPPT=$G(^TMP($J,"SDAMA301",DFN,SDCLIEN,SDDATE))
185 ....S IJCOUNT=IJCOUNT+1
186 ....D CYCLE^SDVWHLI3(DFN,SDCLIEN,SDDATE,SDAPPT,.ERETURN)
187 .I ($P(ORDRSORT,",",1)="P")&($G(SDARRAY("SORT"))="C") D
188 ..S SDCLIEN=0
189 ..F S SDCLIEN=$O(^TMP($J,"SDAMA301",SDCLIEN)) Q:SDCLIEN="" D
190 ...S SDDATE=0 F S SDDATE=$O(^TMP($J,"SDAMA301",SDCLIEN,SDDATE)) Q:SDDATE="" D
191 ....S SDAPPT=$G(^TMP($J,"SDAMA301",SDCLIEN,SDDATE))
192 ....S IJCOUNT=IJCOUNT+1
193 ....D CYCLE^SDVWHLI3(DFN,SDCLIEN,SDDATE,SDAPPT,.ERETURN)
194 .I ($P(ORDRSORT,",",1)="PS") D
195 ..S SDDATE=0 F S SDDATE=$O(^TMP($J,"SDAMA301",DFN,CLINIEN,SDDATE)) Q:SDDATE="" D
196 ...S SDAPPT=$G(^TMP($J,"SDAMA301",DFN,CLINIEN,SDDATE))
197 ...S IJCOUNT=IJCOUNT+1
198 ...D CYCLE^SDVWHLI3(DFN,CLINIEN,SDDATE,SDAPPT,.ERETURN)
199 .I ($P(ORDRSORT,",",1)="C")&($G(SDARRAY("SORT"))="") D
200 ..S SDDFN=0
201 ..F S SDDFN=$O(^TMP($J,"SDAMA301",CLINIEN,SDDFN)) Q:SDDFN="" D
202 ...S SDDATE=0 F S SDDATE=$O(^TMP($J,"SDAMA301",CLINIEN,SDDFN,SDDATE)) Q:SDDATE="" D
203 ....S SDAPPT=$G(^TMP($J,"SDAMA301",CLINIEN,SDDFN,SDDATE))
204 ....S IJCOUNT=IJCOUNT+1
205 ....D CYCLE^SDVWHLI3(SDDFN,CLINIEN,SDDATE,SDAPPT,.ERETURN)
206 .I ($P(ORDRSORT,",",1)="C")&($G(SDARRAY("SORT"))="P") D
207 ..S SDDFN=0
208 ..F S SDDFN=$O(^TMP($J,"SDAMA301",SDDFN)) Q:SDDFN="" D
209 ...S SDDATE=0 F S SDDATE=$O(^TMP($J,"SDAMA301",SDDFN,SDDATE)) Q:SDDATE="" D
210 ....S SDAPPT=$G(^TMP($J,"SDAMA301",SDDFN,SDDATE))
211 ....S IJCOUNT=IJCOUNT+1
212 ....D CYCLE^SDVWHLI3(SDDFN,CLINIEN,SDDATE,SDAPPT,.ERETURN)
213 .I $P(ORDRSORT,",",1)="CN" D
214 ..S SDCLIEN=0
215 ..F S SDDFN=$O(^TMP($J,"SDAMA301",SDCLIEN)) Q:SDCLIEN="" D
216 ...S SDDFN=0
217 ...F S SDDFN=$O(^TMP($J,"SDAMA301",SDCLIEN,SDDFN)) Q:SDDFN="" D
218 ....S SDDATE=0 F S SDDATE=$O(^TMP($J,"SDAMA301",SDCLIEN,SDDFN,SDDATE)) Q:SDDATE="" D
219 .....S SDAPPT=$G(^TMP($J,"SDAMA301",SDCLIEN,SDDFN,SDDATE))
220 .....S IJCOUNT=IJCOUNT+1
221 .....D CYCLE^SDVWHLI3(SDDFN,SDCLIEN,SDDATE,SDAPPT,.ERETURN)
222 I SDCOUNT>0 Q
223 ;
224 ;
225 ;;;;;;I (ERETURN'=0)!(ERROR'="")!(EXTRET'=0)!(SDCOUNT<0)!(ERROR1'="") S APPARMS("ACK CODE")="AE"
226 ;
227 ; NOT SEND APPLICATION ACKNOWLEDGEMENT.JUST REGULAE SEND ONE MESSAGE
228 ;
229 ;;;;;;I $$SENDACK^HLOAPI2(.ACK,.ERROR1) S ERETURN="SENDAPPACK"
230 ;
231 ; DEFINE SENDING AND RECEIVING PARAMETERS
232OVERT S APPARMS("SENDING APPLICATION")="VWSD RECEIVER"
233 S APPARMS("ACCEPT ACK TYPE")="NE" ;"AL"
234 ;S APPARMS("APP ACK RESPONSE")="APPACKRR^SDVWHLIN"
235 ;S APPARMS("ACCEPT ACK RESPONSE")="MSGPROC^SDVWHLIN"
236 ;REVERSE BELOW
237 S APPARMS("ACCEPT ACK RESPONSE")="APPACKRR^SDVWHLIN" ; WHEN COMIT ACK , SU OR AE RETURN MADE
238 S APPARMS("APP ACK RESPONSE")="MSGPROC^SDVWHLIN" ; WHEN NO ACK RETURN MADE
239 S APPARMS("APP ACK TYPE")="NE" ;"AL"
240 S WHO("RECEIVING APPLICATION")="VWSD HLO EXT"
241 S WHO("FACILITY LINK NAME")="VWSD_PEASL"
242 ;
243 ;SEND MESSAGE
244 ;
245 S ERROR3=""
246 S RETURN1=$$SENDONE^HLOAPI1(.HLMSTATE,.APPARMS,.WHO,.ERROR3)
247 ;;;;;I '$$SENDONE^HLOAPI1(.HLMSTATE,.APPARMS,.WHO,.ERROR3) Q ;Q "ERR="_ERR_" ERROR="_ERROR
248 ;;
249 ;
250 Q
251ERRORW(X) ;ERROR SEGMENT (WITH ERETURN'=0,PATIENT,CLINIC,OR OTHER SDCOUNT ERROR )
252 ;;CREATE SEGMENT
253 ;
254 N CONSTRUC,ERROR2
255 S ERROR2=""
256 D SET^HLOAPI(.SEG,"ERR",0)
257 ;
258 S CONSTRUC="ERETURN="_ERETURN_" ERROR="_ERROR_"^"_" IER="_IER_" SDCOUNT="_SDCOUNT
259 ;
260 D SET^HLOAPI(.SEG,CONSTRUC,1)
261 ;
262 ;
263 ;; ADD SEGMENT
264 I '$$ADDSEG^HLOAPI(.HLMSTATE,.SEG) Q "ERR"
265 ;
266 Q 0
Note: See TracBrowser for help on using the repository browser.