source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDVWHLEX.m@ 1739

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

initial load of WorldVistAEHR
File size: 9.2 KB
RevLine 
[613]1SDVWHLEX ;ENHANCED HL7 ACK RECEIVERS FOR SDAPI and MAKE AN APPOINTMENT REQUEST 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 ;
19MSGPROC ; ACK PROCESSING ROUTINE FOR NO RECEIVE ACKS, ETC FOR SDAPI AND MAKE APPOINTMENT API RETURN DATA
20 Q
21APPACKRR ;MAIN APPLICATION ACK RESPONSE FOR SDAPI AND MAKE APPOINTMENT API RETURN DATA
22 N IER,MSGCTRL,SEG,HLMSTATE,HDR,CONTIN
23APPACKR2 ;
24 S CONTIN=0
25 S MSGCTRL=0
26 S IER=$$APPACKR1(.MSGCTRL,.CONTIN)
27 I (MSGCTRL'=0) S ^XTMP(MSGCTRL,"RETURN")=IER
28 I CONTIN=1 G APPACKR2
29 Q
30APPACKR1(MSGCTRL,CONTIN) ;APPLICATION ACK RESPONSE FOR SDAPI RETURN DATA AND MAKE APPOINTMENT API
31 ; AND MAKE APPT API ACK
32 N HLVWNOVA,HLMSGTMP,AJJ3CNT,AJJ3CNT1,AJJ3CNT2,SSNPATN,AJJ3VIS
33 N APPARMS,ERROR,HLMSGIEN,WHO,QRDSORT,SORTORDR,OVERAPPT ;
34 N SEGTYPE,IRECAPP,ISNDFAC,IEVN,IFLAGA19,IFLAGACK,POSITION
35 N PATIENID,PATIENT,SSN,PATIENTC,SDLOCATI,PRIMCRED,PRIMSTOP
36 N SDDATE,ELIGIB,EXPECTDT,APPTST,DATEAPTM
37 N PIDVALUE,PV1VALUE,PV2VALUE
38 N SDARRAY,SDCOUNT,ERR,TEMP8
39 N SDLOCATE,HOSPLOC,ORDRSORT,MSGMAKAP,COMMENT,X,Y,MSGCTRL1
40 N MSGCTRX,HLMSGIE1
41 ;APPLICATION ACK REPONSE ROUTINE
42 ;
43 ;FOR SDAPI APPLICATION ACK BELOW
44 ;INPUT
45 ;
46 ;OUTPUT IF NO ERRORS AND SDCOUNT RETURNED >0 ( ALL FIELDS IN EXTERNAL FORMAT BELOW)
47 ;.I $E(ORDRSORT,1,1)="P"
48 ;..S ^XTMP(MSGCTRL,"SDAMA301",SSN,SDLOCATE,SDDATE)=SDAPPNT (UP TO 20 PIECES OF 20 SPECIFIED "FLDS: FIELDS IN SDARRAY("FLDS")
49 ;.I $E(ORDRSORT,1,1)="C"
50 ;..S ^XTMP(MSGCTRL,"SDAMA301",SDLOCATE,SSN,SDDATE)=SDAPPNT (UP TO 20 PIECES OF 20 SPECIFIED "FLDS: FIELDS IN SDARRAY("FLDS")
51 ;
52 ; AND S ^XTMP(MSGCTRL,"RETURN")=IER RETURNED
53 ;
54 ;AS EXPLAINED IN CODE BELOW
55 ; FOR ELEMENTS RANGES OF SDLOCATE ( HOSPITAL LOCATION (CLINIC) EXTERNAL FORMAT ) IN APPOINTMENTS RETURNED
56 ; RANGES OF SSN FOR PATIENT'S UNIQUE SSN IN APPOINTMENTS RETURNED
57 ;
58 ;
59 ;RETURN POSITION_"^"_SDCOUNT_"^"_HDR("APP ACK TYPE")
60 ; POSITION IS NUMBER OF RETURNED APPOINTMENTS/VISITS
61 ;
62 ; SDCOUNT IS SAME UNLESS ERROR
63 ; WITH ERROR RETURNS AS
64 ; FROM $$SDAPI^SDAM301 AND OTHER ERRORS FOUND FROM RECEIVING APPLICATION
65 ;
66 ; APP ACK TYPE ACTUALLY RETURNED, IE "AA"OR "AE"
67 ;
68 ; OR ONE OF THE FOLLOWING FROM HIS REPONSE ROUTINE TO THE APPLICATION ACKNOWLEDGE TO THE
69 ; REQUESTING APPLICATION
70 ;
71 ; "STARTMSG"
72 ; "ERR"_$$GET^HLOPRS(.SEQ,1)
73 ; "NOTRETURNED ACK"
74 ; "HOSPLOC"
75 ; VWSD
76 ;PARSE ACK MESSAGE WITH REPEATING ADT RESPONSE (PID,PV1,PV2,NTE,NTE)
77 ;WITH EVENT TYPE A19 WITH APPLICATION REPLY TO PATIENT INQUIRY REQUEST
78 ;
79 ;FOR MAKE APPT API RETURN COMMENT_"^"_HDR("APP ACK TYPE")
80 ; WHERE COMMENT IS AS RETURNED FROM VWSDMKPI CALL RETURN
81 ;
82 ;
83 ;
84 ;PASS THE HEADER AND RETURN INDIVIDUAL VALUES
85 ;
86 S HLVWNOVA=1 ; ALLOW NON-VA STATION NODE WITH ASSOCIATED INSTITUTION
87 ; FOR DETERMINING FACILITY LINK WHEN SENDING APPLICATION BECOMES RECEIVING
88 ; APPLICATION, AND TO FIGURE "SENDING FACILITY LINK"
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 I '$$STARTMSG^HLOPRS(.HLMSTATE,HLMSGIEN,.HDR) Q "STARTMSG"
95 ;
96 ;
97MSG1 ;CHECK RECEIVING APPLICATION
98 ;;S IRECAPP=HDR("RECEIVING APPLICATION")
99 ;W !,"IRECAPP=",IRECAPP
100 ;;S ISNDFAC=HDR("FACILITY LINK NAME")
101 S MSGCTRL1=HDR("SECURITY")
102 ;
103 ;CHECK TO SEE IF RETURN FROM MAKE APPT ( HAS # AND ACK CONDITION AA OR AEFOLLOWING)
104 S MSGCTRX=""
105 I MSGCTRL1["#" D
106 . S MSGCTRL=$P(MSGCTRL1,"#",1)
107 E D
108 .S MSGCTRX=MSGCTRL1
109 ;
110 S IFLAGA19=0
111 S POSITION=0
112 S IEVN=0
113 S SDCOUNT=0
114 S SDLOCATE=""
115 S ORDRSORT=""
116 S MSGMAKAP=0 ;
117 S COMMENT="" ;
118 S SDARRAY=""
119 S ERR=""
120 S AJJ3CNT=0
121 S SEG=""
122 ;I HDR("MESSAGE TYPE")'="ACK" S ERR="NONRETURNED ACK"
123 ; ADVANCE TO EACH SEGMENT IN THE MESSAGE
124 ;
125 S VWSDFLAG=1
126 S AJJ3CNT1=0
127 S AJJ3CNT2=0
128 S AJJ3VIS=0
129SEQ I '$$NEXTSEG^HLOPRS(.HLMSTATE,.SEG) G EXIT
130 ;
131 S VWSDFLAG=VWSDFLAG+1
132 S AJJ3CNT1=AJJ3CNT1+1
133 ;
134 S SEGTYPE=$$GET^HLOPRS(.SEG,0)
135 S AJJ3CNT=AJJ3CNT+1
136 ;
137 ;
138 ; NEED TO GET REQUESTING APPLICATION'S MSGCTRL ID STORED IN SECURITY FIELD IN MSH SEGMENT.
139 ; ALSO IN HLMSTATE OR HDR
140 ;
141 ;CODED BELOW ?
142 I SEGTYPE="MSH" D
143 .;GET SYNC (MSGCTRL) IN SECURITY FIELD
144 .;;;;;;;;;S MSGCTRL=$$GET^HLOPRS(.SEG,8) ; OR GET SECURITY OUT OF HDR OR HLMSTATE, IE HDR("SECURITY) OT HLMSTATE("SECURITY")
145 .;
146 I SEGTYPE="ERR" D
147 .S ERR=$$GET^HLOPRS(.SEG,1)
148 .;
149 I (MSGCTRL1["#")&(SEGTYPE="ERR") G SEQ
150 I SEGTYPE="QRD" D
151 .S QRDSORT=$$GET^HLOPRS(.SEG,8) ; WHO SUBJECT FILTER
152 .S QRDSORT=$P(QRDSORT,",",1) ; P,PS,C,CN
153 .S SDCOUNT=$$GET^HLOPRS(.SEG,11) ; WHAT DATA CD VALUE QUA
154 .;
155 I SEGTYPE="EVN" D
156 . S IEVN=$$GET^HLOPRS(.SEG,1)
157 . ;
158 ;
159 ;NOW GET COMBINATION SEQUENCES OF PID,PV1,PV2,NTE
160 ;
161 ;FOR MAKE APPT BELOW
162 I (MSGCTRL1["#")&(SEGTYPE="PID") G SEQ
163 I SEGTYPE="PID" D
164 . ;S POSITION=POSITION+1
165 . S POSITION=+$P($G(^XTMP(MSGCTRX,"NUMBER")),"^",1)+1
166 . S $P(^XTMP(MSGCTRX,"NUMBER"),"^",1)=POSITION
167 . I MSGCTRX'="" I POSITION=1 S $P(^XTMP(MSGCTRX,"NUMBER"),"^",2)=SDCOUNT
168 . S SDARRAY=""
169 . ;GET PATIENT INTERNAL ID
170 . S PATIENID=$$GET^HLOPRS(.SEG,3)
171 . S PATIENT=$$GET^HLOPRS(.SEG,5)
172 . S SSN=$$GET^HLOPRS(.SEG,19)
173 . S PIDVALUE=PATIENID_"^"_PATIENT_"^"_SSN
174 . ;
175 I (MSGCTRL1["#")&(SEGTYPE="PID") G SEQ
176 I SEGTYPE="PV1" D
177 . S AJJ3VIS=AJJ3VIS+1
178 . ;GET PATIENT INTERNAL ID
179 . S PATIENTC=$$GET^HLOPRS(.SEG,2) ; PATIENT CLASS
180 . S SDLOCID=$$GET^HLOPRS(.SEG,3) ; INTERNAL ID ONLY, EXTERNAL IN NTE SEGMENT
181 . S PURPVISI=$$GET^HLOPRS(.SEG,10) ; HOSPITAL SERVICE (PURPOSE OF VISIT)
182 . S PRIMSTOP=$$GET^HLOPRS(.SEG,18) ; PATIENT TYPE (PRIME STOP CODE)
183 . S PRIMCRED=$$GET^HLOPRS(.SEG,41) ; ACCOUNT STATUS (CREDIT STOP CODE)
184 . S SDDATE=$$GET^HLOPRS(.SEG,44) ; ADMIT-VISIT DATE/TIME
185 . ; CONVERT FROM TS TO FM DATE
186 . S SDDATE=$$FMDATE^HLFNC(SDDATE)
187 . ; THEN FM DATE TO EXTERNAL DATE FORMAT
188 . S Y=SDDATE D DD^%DT S SDDATE=Y
189 . ;
190 . ; S XXXX=$$GET^HLOPRS(.SEG,51) ;
191 . S PVIVALUE=PATIENTC_"^"_SDLOCID_"^"_PURPVISI_"^"_PRIMSTOP_"^"_PRIMCRED_"^"_SDDATE
192 . ;
193 I SEGTYPE="PV2" D
194 . S ELIGIB=$$GET^HLOPRS(.SEG,7) ; VISIT USER ID-ELIGIBILITY FOR UNSCHEDULED VISITS
195 . S EXPECTDT=$$GET^HLOPRS(.SEG,8) ; EXPECTED DATE/TIME
196 . S APPTST=$$GET^HLOPRS(.SEG,24) ;APPOINT STATUS
197 . S DATEAPTM=$$GET^HLOPRS(.SEG,46) ;DATE APPT MADE
198 . S PV2VALUE=ELIGIB_"^"_EXPECTDT_"^"_APPTST_"^"_DATEAPTM
199 . ;
200 I SEGTYPE="NTE" D
201 . S AJJ3CNT2=AJJ3CNT2+1
202 . S TEMP=$$GET^HLOPRS(.SEG,3) ; UP TO 20 PIECES OF DATA FROM ARRAY DEFINITION FOR SDAPI
203 . ;
204 . I $E(TEMP,1,9)="SDLOCATE=" D
205 . .S SDLOCATE=$P(TEMP,"SDLOCATE=",2)
206 . .S SDLOCATE=$P(SDLOCATE,"""",2) ;STRIP OFF LEADING QUOTE
207 . .S SDLOCATE=$P(SDLOCATE,"""",1) ;STRIP OFF TRAILING QUOTE
208 . .;
209 . E D
210 . . S SDARRAY=TEMP
211 . . ;
212 ;EVERY TIME GET A PID SEGMENT INCREMENT POSITION
213 ;AND STUFF IN ^XTMP ARRAY ACCORDING TO SORT ORDER
214 ;
215 ;
216 ;;;;;;;;I MSGCTRL=0 S ERR="ERROR MSGCTRL=0" G SEQ
217 I (SDARRAY'="")&(SDLOCATE="")&(COMMENT="") Q "HOSPLOC"
218 I (SDARRAY'="")&(QRDSORT="")&(COMMENT="") Q "ORDERSORT"
219 I (SDARRAY'="")&(SDCOUNT>0) D
220 .;CONVERT EMBEDDED # IN SDARRAY BACK INTO LEGAL"^" IN DATA
221 .S TEMP8=SDARRAY
222 .D REPLACE1(.TEMP8)
223 .S SDARRAY=TEMP8
224 .I $E(QRDSORT,1,1)="P" D
225 ..S SSNPATN=SSN_"#"_PATIENT
226 ..S ^XTMP(MSGCTRX,"SDAMA301",POSITION)=SSNPATN_"^"_SDLOCATE_"^"_SDDATE_"^"_SDARRAY
227 .I $E(QRDSORT,1,1)="C" D
228 ..S SSNPATN=SSN_"#"_PATIENT
229 ..S ^XTMP(MSGCTRX,"SDAMA301",POSITION)=SDLOCATE_"^"_SSNPATN_"^"_SDDATE_"^"_SDARRAY
230 .;
231 ;
232 I SDARRAY'="" S SDARRAY=""
233 G SEQ
234 ;
235 ;
236EXIT ;
237 ;NOT GO TO NEXT MESSAGE FOR THIS TEST
238 ;
239 ;
240 ;I $$NEXTMSG^HLOPRS(.HLMSTATE,HLMGIEN,.HDR) G SEQ
241 ;
242 ;IF MAKE APPNT API APP ACK RESPONSE ( IE, COMMENT'="")
243 ;RETURN RETURN NOW FROM CAll to VWSDMKPI CALL RETURNED FROM RECEIVING APPLICATION
244 ;
245 ;CHECK TO SEE IF ADDITIONAL MESSAGES
246 ;H 15
247 S HLMSGTMP="AC" ;200000000000
248 S HLMSGIE1=$O(^HLB(HLMSGTMP),-1)
249 I HLMSGIE1'=HLMSGIEN S CONTIN=1
250 ;
251 I MSGCTRL1["#" S MSGCTRL1=$P(MSGCTRL1,"#",2)_"^"_ERR Q MSGCTRL1 ; RETURN FOR MAKE APPT
252 I ERR'="" Q HDR("APP ACK TYPE")_"^"_ERR ; MAKE APPT API RETURN
253 ;
254 S SDCOUNT=+$P($G(^XTMP(MSGCTRX,"NUMBER")),"^",2)
255 I SDCOUNT>0 D
256 .S POSITION=+$P($G(^XTMP(MSGCTRX,"NUMBER")),"^",1)
257 .I POSITION=SDCOUNT S MSGCTRL=MSGCTRX
258 E D
259 . S MSGCTRL=MSGCTRX
260 Q "OK"_"^"_QRDSORT_"^"_SDCOUNT_"^"_POSITION ;SDAPI RETURN
261 ;
262REPLACE1(TEMP8) ;
263 N REST,LEN8,L8,PIEC8
264 S REST=TEMP8
265 S LEN8=$L(TEMP8)
266 F Q:REST="" D
267 .S PIEC8=$P(TEMP8,"#",1)
268 .S L8=$L(PIEC8)+2
269 .I L8>LEN8 D
270 ..S REST="" I $E(TEMP8,LEN8,LEN8)="#" S $E(TEMP8,LEN8,LEN8)="^"
271 .E D
272 ..S REST=$E(TEMP8,L8,LEN8)
273 .I (PIEC8'="")&(REST'="") D
274 ..S TEMP8=PIEC8_"^"_REST
275 Q
Note: See TracBrowser for help on using the repository browser.