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

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

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