source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDVWHLI3.m@ 767

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

initial load of WorldVistAEHR
File size: 6.7 KB
RevLine 
[613]1SDVWHLI3 ;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 ;
19CYCLE(SDDFN,SDCLIEN,SDDATE,SDAPPT,ERETURN) ;PID,PV1,PV2,NTE,NTE
20 N SDFNNAME,SDFNSSN,TEMP,OUTIN,SDLOCATE
21 ;;;N EXTRET,ERROR2,LOCACKCD,ACKCDER,TEMP8,SEG
22 ;;;N ERR,ERROR3,HLMSTATE,WHO,APPARMS,XQ,RETURN1 ; NEW ONES SO CANNOT USE OLD HLMSTATE TO RETURN REAL ACK
23 I IJCOUNT#2=0 G OVER8 ; EVERY OTHER (EVEN) APPOINTMENT IN SAME MESSAGE NOT REPEAT INITIALIZATION
24 S EXTRET=0
25 ;S SEG=""
26 S ERROR2=""
27 S XQ=""
28 ;
29 ;
30 ; SEND ACK MESSAGE COMMENTED OUT BELOW. INSTEAD JUST SEND NORMAL MESSAGE WITH ADDED SEGMENTS
31 ;
32 ;;;;S APPARMS("ACK CODE")="AA"
33 ;;;;S APPARMS("ACCEPT ACK TYPE")="NE"
34 ;;;;I (ERROR'="")!(SDCOUNT<0) D
35 ;;;;.S APPARMS("ACK CODE")="AE"
36 ;;;.S APPARMS("ERROR MESSAGE")=ERROR_"^"_SDCOUNT
37 ;;;;S APPARMS("MESSAGE TYPE")="ACK"
38 ;;;;;S APPARMS("EVENT")="A19"
39 ;;
40 ;;
41 S APPARMS("MESSAGE TYPE")="ADT"
42 S APPARMS("EVENT")="A19" ; RESPONSE
43 S APPARMS("COUNTRY")="USA"
44 S APPARMS("FIELD SEPARATOR")="|"
45 S APPARMS("ENCODING CHARACTERS")="^~\&"
46 S APPARMS("VERSION")=2.4
47 ;
48 ;
49 S APPARMS("SECURITY")=MSGCTRL
50 ;
51 S ERR=""
52 S ERROR3=""
53 S ERROR1=""
54 ;
55 ;
56 I '$$NEWMSG^HLOAPI(.APPARMS,.HLMSTATE,.ERROR3) S ERETURN="NEW MESSAGE ERROR"
57 ;
58 I (ERETURN'=0)!(ERROR'="")!(SDCOUNT<0)!(ERROR1'="")!(IER'=1) S EXTRET=$$ERRORW^SDVWHLI1(XQ)
59 ;
60 D
61 .D SET^HLOAPI(.SEG,"QRD",0)
62 .D SET^HLOAPI(.SEG,$$HLDATE^HLFNC($$NOW^XLFDT(),"TS"),1)
63 .D SET^HLOAPI(.SEG,ORDRSORT,8)
64 .;I (ERROR="")&(SDCOUNT'="") D SET^HLOAPI(.SEG,SDCOUNT,11)
65 .D SET^HLOAPI(.SEG,SDCOUNT,11)
66 .;
67 .;
68 .;
69 .;; ADD SEGMENT
70 .I '$$ADDSEG^HLOAPI(.HLMSTATE,.SEG) S ERR="QRD"
71 .I $D(ERROR2) D
72 ..;
73 .E D
74 ..;
75 ;;CREATE SEGMENT PID
76 ; PUT IN INTERNAL PATIENTID, NAME AND SSN
77 ;
78 ;
79OVER8 ;
80 D SET^HLOAPI(.SEG,"PID",0)
81 D SET^HLOAPI(.SEG,SDDFN,3)
82 S SDFNNAME=$P($G(^DPT(SDDFN,0)),"^",1)
83 D SET^HLOAPI(.SEG,SDFNNAME,5)
84 S SDFNSSN=$P($G(^DPT(SDDFN,0)),"^",9)
85 D SET^HLOAPI(.SEG,SDFNSSN,19)
86 ;
87 ;; ADD SEGMENT
88 I '$$ADDSEG^HLOAPI(.HLMSTATE,.SEG) S ERETURN="PID"
89 ;
90 ;NEXT PV1 SEGMENT
91 ;
92 ;CREATE SEGMENT PV1
93 ;
94 ;
95 D SET^HLOAPI(.SEG,"PV1",0)
96 ; IF NOT ADMITTED THEN OUTPATIENT
97 S OUTIN="O"
98 D SET^HLOAPI(.SEG,OUTIN,2) ;PATIENT CLASS
99 D SET^HLOAPI(.SEG,SDCLIEN,3) ;HOSP LOCATION IEN
100 S TEMP=$P(SDAPPT,"^",18)
101 S TEMP=$P(TEMP,";",1)
102 D SET^HLOAPI(.SEG,TEMP,10) ;HOSPITAL SERVICE > PURPOSE OF VISIT(IEN)
103 S TEMP=$P(SDAPPT,"^",13)
104 S TEMP=$P(TEMP,";",1)
105 D SET^HLOAPI(.SEG,TEMP,18) ; PATIENT TYPE > PRIMARY STOP CODE IEN
106 S TEMP=$P(SDAPPT,"^",14)
107 S TEMP=$P(TEMP,";",1)
108 D SET^HLOAPI(.SEG,TEMP,41) ; PATIENT TYPE > CREDIT STOP CODE IEN
109 D SET^HLOAPI(.SEG,$$HLDATE^HLFNC(SDDATE,"TS"),44) ; APPOINTMENT/UNSCHEDULED VISIT DATE
110 ;
111 ;
112 ;
113 ;; ADD SEGMENT
114 I '$$ADDSEG^HLOAPI(.HLMSTATE,.SEG) S ERETURN="PV1"
115 ;
116 ;NEXT PV2 SEGMENT
117 ;
118 ;CREATE SEGMENT PV2
119 ;
120 ;
121 D SET^HLOAPI(.SEG,"PV2",0)
122 ; GET PURPOSE OF VISIT AGAIN
123 ;IF UNSCHEDULED VISIT SET ELIGIBILITY IN PV2-7
124 S TEMP=$P(SDAPPT,"^",18)
125 S TEMP=$P(TEMP,";",1)
126 I TEMP=4 D
127 .S TEMP=$P(SDAPPT,"^",8)
128 .S TEMP=$P(TEMP,";",1)
129 .D SET^HLOAPI(.SEG,OUTIN,7) ;ELIGIBILITY
130 D SET^HLOAPI(.SEG,$$HLDATE^HLFNC(SDDATE,"TS"),8) ; DESIRED EXPECTED APPOINTMENT/UNSCHEDULED VISIT DATE
131 S TEMP=$P(SDAPPT,"^",3)
132 D SET^HLOAPI(.SEG,TEMP,24) ;APPOINTMENT/UNSCHEDULED VISIT STATUS
133 S TEMP=$P(SDAPPT,"^",16)
134 D SET^HLOAPI(.SEG,$$HLDATE^HLFNC(TEMP,"TS"),46) ; DATE APPOINTMENT/UNSCHEDULED VISIT ACTUALLY MADE
135 ;
136 ;
137 ;
138 ;; ADD SEGMENT
139 I '$$ADDSEG^HLOAPI(.HLMSTATE,.SEG) S ERETURN="PV2"
140 ;
141 ;NEXT NTE SEGMENT FOR EXTERNAL LOCATION NAME
142 ;
143 ;CREATE SEGMENT NTE
144 ;
145 ;
146 ;
147 D SET^HLOAPI(.SEG,"NTE",0)
148 S SDLOCATE=$P($G(^SC(SDCLIEN,0)),"^",1)
149 D SET^HLOAPI(.SEG,"SDLOCATE="_""""_SDLOCATE_"""",3)
150 ;
151 ;;
152 ;
153 ;; ADD SEGMENT
154 I '$$ADDSEG^HLOAPI(.HLMSTATE,.SEG) S ERETURN="NTE"_SDLOCATE
155 ;
156 ;NEXT NTE SEGMENT FOR SDAPPT
157 ;
158 ;CREATE SEGMENT NTE
159 ;
160 ;FIRST CONVERT ALL FM DATE/TIMES TO EXTERNAL FORMAT
161 ;
162 ; FIELDS 1,9,11,16,17,19,20,21,24,25
163 S DATETIM=$P(SDAPPT,"^",1)
164 S Y=DATETIM D DD^%DT S $P(SDAPPT,"^",1)=Y
165 S DATETIM=$P(SDAPPT,"^",9)
166 S Y=DATETIM D DD^%DT S $P(SDAPPT,"^",9)=Y
167 S DATETIM=$P(SDAPPT,"^",11)
168 S Y=DATETIM D DD^%DT S $P(SDAPPT,"^",11)=Y
169 S DATETIM=$P(SDAPPT,"^",16)
170 S Y=DATETIM D DD^%DT S $P(SDAPPT,"^",16)=Y
171 S DATETIM=$P(SDAPPT,"^",17)
172 S Y=DATETIM D DD^%DT S $P(SDAPPT,"^",17)=Y
173 S DATETIM=$P(SDAPPT,"^",19)
174 S Y=DATETIM D DD^%DT S $P(SDAPPT,"^",19)=Y
175 S DATETIM=$P(SDAPPT,"^",20)
176 S Y=DATETIM D DD^%DT S $P(SDAPPT,"^",20)=Y
177 S DATETIM=$P(SDAPPT,"^",21)
178 S Y=DATETIM D DD^%DT S $P(SDAPPT,"^",21)=Y
179 S DATETIM=$P(SDAPPT,"^",124)
180 S Y=DATETIM D DD^%DT S $P(SDAPPT,"^",24)=Y
181 S DATETIM=$P(SDAPPT,"^",25)
182 S Y=DATETIM D DD^%DT S $P(SDAPPT,"^",25)=Y
183 ;
184 ;
185 D SET^HLOAPI(.SEG,"NTE",0)
186 ;TAKE OUT "^" AND REPLACE WITH "#" AS "^" IN NOT A CHARACTER
187 ;THAT CAN BE USED IN HL7 DATA PART OF SEGMENT
188 S TEMP8=SDAPPT
189 D REPLACE(.TEMP8)
190 S SDAPPT=TEMP8
191 D SET^HLOAPI(.SEG,SDAPPT,3)
192 ;
193 ;; ADD SEGMENT
194 I '$$ADDSEG^HLOAPI(.HLMSTATE,.SEG) S ERETURN="NTE"_SDAPPT
195 ;
196 ;SKIP MESSAGE IF ODD IJCOUNT AND ICOUNT'=SDCOUNT
197 I (IJCOUNT#2'=0)&(IJCOUNT'=SDCOUNT) Q
198 ; DEFINE SENDING AND RECEIVING PARAMETERS
199 S APPARMS("SENDING APPLICATION")="VWSD RECEIVER"
200 S APPARMS("ACCEPT ACK TYPE")="NE" ;"AL"
201 ;S APPARMS("APP ACK RESPONSE")="APPACKRR^SDVWHLIN"
202 ;S APPARMS("ACCEPT ACK RESPONSE")="MSGPROC^SDVWHLIN"
203 ;REVERSE BELOW
204 S APPARMS("ACCEPT ACK RESPONSE")="APPACKRR^SDVWHLIN" ; WHEN COMIT ACK , SU OR AE RETURN MADE
205 S APPARMS("APP ACK RESPONSE")="MSGPROC^SDVWHLIN" ; WHEN NO ACK RETURN MADE
206 S APPARMS("APP ACK TYPE")="NE" ;"AL"
207 S WHO("RECEIVING APPLICATION")="VWSD HLO EXT"
208 S WHO("FACILITY LINK NAME")="VWSD_PEASL"
209 ;
210 ;SEND MESSAGE
211 ;
212 S ERROR3=""
213 S RETURN1=$$SENDONE^HLOAPI1(.HLMSTATE,.APPARMS,.WHO,.ERROR3)
214 ;;;;;I '$$SENDONE^HLOAPI1(.HLMSTATE,.APPARMS,.WHO,.ERROR3) Q ;Q "ERR="_ERR_" ERROR="_ERROR
215 ;;
216 I IJCOUNT'=SDCOUNT H 5
217 ;
218 ;
219 Q
220REPLACE(TEMP8) ;
221 N REST,LEN8,L8,PIEC8
222 S REST=TEMP8
223 S LEN8=$L(TEMP8)
224 F Q:REST="" D
225 .S PIEC8=$P(TEMP8,"^",1)
226 .S L8=$L(PIEC8)+2
227 .I L8>LEN8 D
228 ..S REST="" I $E(TEMP8,LEN8,LEN8)="^" S $E(TEMP8,LEN8,LEN8)="#"
229 .E D
230 ..S REST=$E(TEMP8,L8,LEN8)
231 .I (PIEC8'="")&(REST'="") D
232 ..S TEMP8=PIEC8_"#"_REST
233 Q
Note: See TracBrowser for help on using the repository browser.