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

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

initial load of FOIAVistA 6/30/08 version
File size: 8.2 KB
Line 
1VAFCADT1 ;ALB/RJS - HL7 PATIENT MOVEMENT EVENTS - APRIL 13,1995
2 ;;5.3;Registration;**91,179**;Jun 06, 1996
3 ;HL7v1.6
4 ;This Routine is executed as an item protocol on the DGPM Patient
5 ;Movement Event Driver. It's purpose is to determine what event
6 ;has occurred. Has an Admission been created ? Has a Transfer with
7 ;an associated Specialty Transfer been deleted ? This routine
8 ;contains the logic to determine this.
9 ;
10 ;In certain instances, one HL7 message will be sent. In other
11 ;instances portions (or the entire) history of an admission may
12 ;be sent.
13 ;
14 ;A Portion of the history will be sent, if that portion
15 ;is affected by the insertion or deletion of an event.
16 ;
17 ;You can run this software in the foreground and turn on a trace of
18 ;this software, by defining the node ^TMP("VAFCADT1",$J)
19 ;
20 Q:'$P($$SEND^VAFHUTL(),"^",2)
21 ;S ^TMP("VAFCADT1",$J)=1
22 N VATRACE,VAFH
23 MERGE VAFH=^UTILITY("DGPM",$J)
24 I '($G(DGQUIET)) D
25 . W !,"Executing HL7 ADT Messaging"
26 . I $D(^TMP("VAFCADT1",$J)) S VATRACE=1
27 I $D(VATRACE) D G EXIT
28 . D INITIZE
29 N ZTDESC,ZTRTN,ZTSAVE,ZTIO,ZTDTH
30 S ZTDESC="HL7 ADT MESSAGE",ZTRTN="INITIZE^VAFCADT1",ZTSAVE("DGPMP")="",ZTSAVE("DGPMA")="",ZTIO="",ZTSAVE("DGPMDA")="",ZTSAVE("DFN")="",ZTDTH=$H,ZTSAVE("VAFH(")=""
31 D ^%ZTLOAD
32EXIT ;
33 I $D(ZTQUEUED) S ZTREQ="@"
34 D KILL^HLTRANS
35 K ^TMP("HLS",$J)
36 Q
37 ;
38INITIZE ;;;can't do v1.6 it here, need event for init
39 ;S HLNDAP="PIMS HL7" D INIT^HLTRANS
40 ;S HLNDAP="PIMS HL7" D INIT^HLFNC2("VAFH "_EVENT,.HL)
41 ;I $D(HLERR) Q
42 ;I $D(HL)<2 Q
43 D EVENT,EXIT
44 Q
45EVENT ;
46 I $G(DGPMP)=""&($G(DGPMA)="") Q
47 N EVENT,TYPE,VAFHDT,ADMSSN,ADMDATE,IEN,PIVOT,PIVCHK,HISTORY
48 N OLDDATE,PV1,GARBAGE,MOVETYPE
49 ;
50 ;I DGPMP="" and DGPMA'="" it means we're adding a new ADMISSION,
51 ;TRANSFER, DISCHARGE, or SPECIALTY TRANSFER to the Patient Movement
52 ;File
53 ;
54 I (DGPMP="")&(DGPMA'="") D G EXIT
55 . ;
56 . D SETVARS^VAFCADT4(DGPMA,DGPMDA) ; TYPE,VAFHDT,ADMSSN,IEN
57 . ;
58 . ;I TYPE=3 it means we're inserting a DISCHARGE
59 . ;
60 . I (TYPE=3) S EVENT="A03" D Q
61 . . W:$D(VATRACE) !,1.3
62 . . S MOVETYPE=$$MOVETYPE^VAFCADT4(DGPMA)
63 . . I MOVETYPE=41 D 41^VAFCADT5(DFN) Q
64 . . I MOVETYPE=46 D 46^VAFCADT5(DFN) Q
65 . . S PIVCHK=$$PIVCHK^VAFHPIVT(DFN,$$ADMDATE^VAFCADT4(ADMSSN),1,ADMSSN_";DGPM(")
66 . . S PIVOT=$$PIVNW^VAFHPIVT(DFN,$$ADMDATE^VAFCADT4(ADMSSN),1,ADMSSN_";DGPM(")
67 . . I +PIVCHK>0 D BLDMSG^VAFCADT2(DFN,"A03",VAFHDT,"05",IEN,+PIVOT) Q
68 . . K HISTORY
69 . . D BLDHIST^VAFCADT3(DFN,ADMSSN,"HISTORY")
70 . . D ENTIRE^VAFCADT4(+PIVOT)
71 . ;
72 . ;I TYPE=1 it means we're inserting an ADMISSION
73 . ;
74 . I (TYPE=1) D Q
75 . . W:$D(VATRACE) !,1.1
76 . . D PIVINIT^VAFCADT4(DFN,$$ADMDATE^VAFCADT4(ADMSSN),ADMSSN)
77 . . D BLDMSG^VAFCADT2(DFN,"A01",VAFHDT,"05",IEN,+PIVOT)
78 . ;
79 . ;I TYPE=2 it means we're inserting a TRANSFER
80 . ;
81 . I (TYPE=2) D Q
82 . . W:$D(VATRACE) !,1.2
83 . . S MOVETYPE=$$MOVETYPE^VAFCADT4(DGPMA)
84 . . I MOVETYPE=13 D 13^VAFCADT5(DFN) Q
85 . . I MOVETYPE=14 D 14^VAFCADT5(DFN) Q
86 . . I MOVETYPE=43 D 43^VAFCADT5(DFN) Q
87 . . I MOVETYPE=44 D 44^VAFCADT5(DFN) Q
88 . . K HISTORY
89 . . D BLDHIST^VAFCADT3(DFN,ADMSSN,"HISTORY")
90 . . D PIVINIT^VAFCADT4(DFN,$$ADMDATE^VAFCADT4(ADMSSN),ADMSSN)
91 . . D ADDING^VAFCADT4(DFN,"A02",VAFHDT,+PIVOT,+PIVCHK) Q
92 . ;
93 . ;I TYPE=6 it means we're inserting a standalone SPECIALTY TRANSFER
94 . ;
95 . I (TYPE=6) D Q
96 . . W:$D(VATRACE) !,1.6
97 . . K HISTORY
98 . . D BLDHIST^VAFCADT3(DFN,ADMSSN,"HISTORY")
99 . . D PIVINIT^VAFCADT4(DFN,$$ADMDATE^VAFCADT4(ADMSSN),ADMSSN)
100 . . D ADDING^VAFCADT4(DFN,"A08",VAFHDT,+PIVOT,+PIVCHK) Q
101 ;
102 ;If DGPMP'="" and DGPMA'="" it means we're editing an existing
103 ;ADMISSION, DISCHARGE, TRANSFER, or SPECIALTY TRANSFER
104 ;
105 I (DGPMP'="")&(DGPMA'="") D G EXIT
106 . ;
107 . D SETVARS^VAFCADT4(DGPMA,DGPMDA)
108 . S EVENT="A08",OLDDATE=$P(DGPMP,"^",1)
109 . K HISTORY
110 . D BLDHIST^VAFCADT3(DFN,ADMSSN,"HISTORY")
111 . I '$D(HISTORY) Q
112 . ;
113 . ;I TYPE=1 it means we're editing an existing ADMISSION
114 . ;
115 . I (TYPE=1) D Q
116 . . W:$D(VATRACE) !,2.1
117 . . ;
118 . . ;If the DATE/TIME of the admission is one of the fields
119 . . ;that's been edited, it demands special treatment
120 . . ;
121 . . I VAFHDT'=OLDDATE D Q
122 . . . K HL D INIT^HLFNC2("VAFC ADT-A11 SERVER",.HL) ; doit here before dgbuild
123 . . . I $D(HL)#2 Q
124 . . . S PV1=$$DGBUILD^VAFHAPV1(DGPMP,",3,7,10,18,44,45")
125 . . . S PIVCHK=$$PIVCHK^VAFHPIVT(DFN,OLDDATE,1,ADMSSN_";DGPM(")
126 . . . ;
127 . . . I +PIVCHK>0 D
128 . . . . S PIVOT=$$PIVNW^VAFHPIVT(DFN,OLDDATE,1,ADMSSN_";DGPM(")
129 . . . . D BLDMSG^VAFCADT2(DFN,"A11",OLDDATE,"05","",+PIVOT,PV1)
130 . . . . S GARBAGE=$$UPDATE^VAFHUTL(+PIVOT,"","",1)
131 . . . S PIVOT=$$PIVNW^VAFHPIVT(DFN,VAFHDT,1,ADMSSN_";DGPM(")
132 . . . D:+PIVOT>0 ENTIRE^VAFCADT4(+PIVOT)
133 . . ;
134 . . I VAFHDT=OLDDATE D Q
135 . . . ;
136 . . . D PIVINIT^VAFCADT4(DFN,VAFHDT,ADMSSN)
137 . . . ;
138 . . . I +PIVCHK'>0 D ENTIRE^VAFCADT4(+PIVOT) Q
139 . . . ;
140 . . . I +PIVCHK>0 D INSERT^VAFCADT4(DFN,"A08",VAFHDT,+PIVOT) Q
141 . ;
142 . ;I TYPE=2 it means we're editing an existing TRANSFER
143 . ;
144 . I (TYPE=2) D Q
145 . . W:$D(VATRACE) !,2.2
146 . . ;
147 . . D PIVINIT^VAFCADT4(DFN,$$ADMDATE^VAFCADT4(ADMSSN),ADMSSN)
148 . . ;
149 . . I VAFHDT'=OLDDATE D Q
150 . . . ;
151 . . . I +PIVCHK'>0 D ENTIRE^VAFCADT4(+PIVOT) Q
152 . . . ;
153 . . . I +PIVCHK>0 D Q
154 . . . . D DELETE^VAFCADT4(DFN,"A12",OLDDATE,+PIVOT,2.2)
155 . . . . D INSERT^VAFCADT4(DFN,"A02",VAFHDT,+PIVOT)
156 . . ;
157 . . I VAFHDT=OLDDATE D Q
158 . . . ;
159 . . . I +PIVCHK'>0 D ENTIRE^VAFCADT4(+PIVOT) Q
160 . . . ;
161 . . . I +PIVCHK>0 D INSERT^VAFCADT4(DFN,"A08",VAFHDT,+PIVOT) Q
162 . ;
163 . ;I TYPE=3 it means we're editing an existing DISCHARGE
164 . ;
165 . I (TYPE=3) D Q
166 . . W:$D(VATRACE) !,2.3
167 . . ;
168 . . D PIVINIT^VAFCADT4(DFN,$$ADMDATE^VAFCADT4(ADMSSN),ADMSSN)
169 . . I VAFHDT'=OLDDATE D Q
170 . . . ;
171 . . . I +PIVCHK'>0 D ENTIRE^VAFCADT4(+PIVOT) Q
172 . . . I +PIVCHK>0 D Q
173 . . . . D BLDMSG^VAFCADT2(DFN,"A13",OLDDATE,"05",IEN,+PIVOT)
174 . . . . D BLDMSG^VAFCADT2(DFN,"A03",VAFHDT,"05",IEN,+PIVOT)
175 . . ;
176 . . I VAFHDT=OLDDATE D Q
177 . . . I +PIVCHK'>0 D ENTIRE^VAFCADT4(+PIVOT) Q
178 . . . I +PIVCHK>0 D BLDMSG^VAFCADT2(DFN,EVENT,VAFHDT,"05",IEN,+PIVOT) Q
179 . ;
180 . ;I TYPE=6 it means we're editing an existing SPECIALTY TRANSFER
181 . ;
182 . I (TYPE=6) D Q
183 . . W:$D(VATRACE) !,2.6
184 . . ;
185 . . D PIVINIT^VAFCADT4(DFN,$$ADMDATE^VAFCADT4(ADMSSN),ADMSSN)
186 . . ;
187 . . I VAFHDT'=OLDDATE D Q
188 . . . ;
189 . . . I +PIVCHK'>0 D ENTIRE^VAFCADT4(+PIVOT) Q
190 . . . ;
191 . . . I +PIVCHK>0 D Q
192 . . . . D DELETE^VAFCADT4(DFN,"A08",OLDDATE,+PIVOT,2.6)
193 . . . . D INSERT^VAFCADT4(DFN,"A08",VAFHDT,+PIVOT)
194 . . ;
195 . . I VAFHDT=OLDDATE D Q
196 . . . ;
197 . . . I +PIVCHK'>0 D ENTIRE^VAFCADT4(+PIVOT) Q
198 . . . ;
199 . . . I +PIVCHK>0 D INSERT^VAFCADT4(DFN,"A08",VAFHDT,+PIVOT) Q
200 ;
201 ;If DGPMP'="" and DGPMA="" it means we're deleting an ADMISSION,
202 ;TRANSFER, DISCHARGE, or SPECIALTY TRANSFER
203 ;
204 I (DGPMP'="")&(DGPMA="") D G EXIT
205 . D SETVARS^VAFCADT4(DGPMP,DGPMDA)
206 . K HISTORY
207 . D BLDHIST^VAFCADT3(DFN,ADMSSN,"HISTORY")
208 . ;
209 . ;If TYPE=1 it means we're deleting an ADMISSION
210 . ;
211 . I (TYPE=1) S EVENT="A11" D Q
212 . . W:$D(VATRACE) !,3.1
213 . . S PIVCHK=$$PIVCHK^VAFHPIVT(DFN,VAFHDT,1,ADMSSN_";DGPM(")
214 . . ;
215 . . I +PIVCHK'>0 Q
216 . . K HL D INIT^HLFNC2("VAFC ADT-A11 SERVER",.HL) ; doit here before dgbuild
217 . . I $D(HL)#2 Q
218 . . S PV1=$$DGBUILD^VAFHAPV1(DGPMP,",3,7,10,18,44,45")
219 . . S PIVOT=$$PIVNW^VAFHPIVT(DFN,VAFHDT,1,ADMSSN_";DGPM(")
220 . . D BLDMSG^VAFCADT2(DFN,EVENT,VAFHDT,"05","",+PIVOT,PV1)
221 . . N GARBAGE
222 . . S GARBAGE=$$UPDATE^VAFHUTL(+PIVOT,"","",1)
223 . ;
224 . ;If TYPE=2 it means we're deleting a TRANSFER
225 . ;
226 . I (TYPE=2) S EVENT="A12" D Q
227 . . W:$D(VATRACE) !,3.2
228 . . ;
229 . . D PIVINIT^VAFCADT4(DFN,$$ADMDATE^VAFCADT4(ADMSSN),ADMSSN)
230 . . ;
231 . . I +PIVCHK'>0 D ENTIRE^VAFCADT4(+PIVOT) Q
232 . . ;
233 . . I +PIVCHK>0 D DELETE^VAFCADT4(DFN,EVENT,VAFHDT,+PIVOT,3.2) Q
234 . ;
235 . ;If TYPE=3 it means we're deleting a DISCHARGE
236 . ;
237 . I (TYPE=3) S EVENT="A13" D Q
238 . . W:$D(VATRACE) !,3.3
239 . . ;
240 . . D PIVINIT^VAFCADT4(DFN,$$ADMDATE^VAFCADT4(ADMSSN),ADMSSN)
241 . . ;
242 . . I +PIVCHK'>0 D ENTIRE^VAFCADT4(+PIVOT) Q
243 . . ;
244 . . I +PIVCHK>0 D BLDMSG^VAFCADT2(DFN,EVENT,VAFHDT,"05","",+PIVOT) Q
245 . ;
246 . ;If TYPE=6 it means we're deleting a SPECIALTY TRANSFER
247 . ;
248 . I (TYPE=6) S EVENT="A08" D Q
249 . . W:$D(VATRACE) !,3.6
250 . . ;
251 . . D PIVINIT^VAFCADT4(DFN,$$ADMDATE^VAFCADT4(ADMSSN),ADMSSN)
252 . . ;
253 . . I +PIVCHK'>0 D ENTIRE^VAFCADT4(+PIVOT) Q
254 . . ;
255 . . I +PIVCHK>0 D DELETE^VAFCADT4(DFN,EVENT,VAFHDT,+PIVOT,3.6) Q
Note: See TracBrowser for help on using the repository browser.