source: FOIAVistA/tag/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/VAFHAPV1.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: 9.1 KB
Line 
1VAFHAPV1 ;ALB/RJS - INPATIENT PV1 SEGMENT ; 10/8/04 11:28am
2 ;;5.3;Registration;**91,209,190,298,494,621**;Aug 13, 1993
3 ;
4 ;The DGBUILD entry point is call used internally by MAS software
5 ;to build a PV1 Segment for deleted Admissions. The DGPMP
6 ;variable, available from the DGPM Event Driver at the time of
7 ;the deletion, makes it possible to construct a partial PV1 segment
8 ;for the deleted record.
9 ;
10 ;06/29/00 ACS - Added sequence 21 (physical treating specialty - ward
11 ;location) and sequence 39 (facility + suffix).
12 ;
13EN(DFN,VAFHDT,VAFSTR,IEN,ALTVISID,SETID,VAFDIAG) ;
14 ;
15 ;This Entry Point builds the HL7 PV1 segment for inpatients.
16 ;
17 ;DFN, VAFHDT, & VAFSTR are the required variables.
18 ;
19 ; DFN = IEN of Patient File
20 ; VAFHDT = Date/Time of Patient Movement
21 ; VAFSTR = HL7 Fields Requested e.g. ",3,7,10"
22 ;
23 ;IEN, ALTVISID, SETID are the optional variables
24 ;
25 ;The optional variable IEN is used for Discharge movements
26 ;because if only Date/Time is passed for a Discharge movement
27 ;no useful information is returned by VADPT.
28 ;
29 ;The optional ALTVISID variable is used to pass in a "Alternate.
30 ;Visit ID" this is a unique number that
31 ;identifies this Admission or episode of care
32 ;
33 ;The optional variable SETID can be used to differentiate
34 ;different sets of data, in messages that may contain multiple
35 ;events or messages.
36 ;
37 ;VAFDIAG, is a passed as a dotted variable. The inpatient diagnosis
38 ;is then returned in this variable.
39 ;
40 N VAFCOMP,RESULT,VAROOT,VA200
41 N CURRENT
42 D KVAR^VADPT
43 S VAFCOMP=$E(HLECH,1)
44 S VAROOT="CURRENT",VAIP("D")=VAFHDT,VA200=1
45 I ($G(IEN)'="") S VAIP("E")=IEN
46 D IN5^VADPT
47 S RESULT=$$BUILD()
48 I $G(ALTVISID)'="" S $P(RESULT,HLFS,51)=ALTVISID
49 I $G(SETID)'="" S $P(RESULT,HLFS,2)=SETID
50 I $G(SETID)="" S $P(RESULT,HLFS,2)=1
51 ;
52EXIT ;
53 Q $G(RESULT)
54 ;
55BUILD() ;Build the PV1 Segment
56 ;
57 ;Required Variables: Array "CURRENT" containing the results
58 ; of a call to VADPT
59 ;
60 ;This entry point is called to build the HL7 PV1 segment from
61 ;data returned by VADPT
62 ;
63 ;It returns a fully encoded HL7 segment, or a partially encoded HL7 segment containing patient class only
64 ;
65 N RESULT,SUBS
66 S RESULT="PV1"_HLFS_HLFS_"I"
67 I $G(CURRENT(1))="" Q RESULT
68 I $G(CURRENT(1))'="" D
69 . S VAFDIAG=CURRENT(9)
70 . ;
71 . ;--Ward, Room, Bed
72 . ;
73 . I VAFSTR[",3," D
74 . . N WARD,ROOM,BED
75 . . S WARD=$$HLQ^VAFHUTL($P(CURRENT(5),"^",2))
76 . . S ROOM=$$HLQ^VAFHUTL($P($P(CURRENT(6),"^",2),"-",1))
77 . . S BED=$$HLQ^VAFHUTL($P($P(CURRENT(6),"^",2),"-",2))
78 . . S $P(RESULT,HLFS,4)=$G(WARD)_VAFCOMP_$G(ROOM)_VAFCOMP_$G(BED)
79 . ;
80 . ;--Attending Physician
81 . ;
82 . I VAFSTR[",7," D
83 . . N ATTNDPTR,ATTNDING
84 . . S ATTNDPTR=$P(CURRENT(18),"^",1)
85 . . ;S:ATTNDPTR'="" ATTNDING=$$HLNAME^HLFNC($P(CURRENT(18),"^",2))
86 . . I $G(ATTNDPTR)'="" D
87 . . . N DGNAME S DGNAME("FILE")=200,DGNAME("IENS")=ATTNDPTR,DGNAME("FIELD")=.01
88 . . . S ATTNDING=$$HLNAME^XLFNAME(.DGNAME,"S",$E($G(HLECH)))
89 . . S $P(RESULT,HLFS,8)=$$HLQ^VAFHUTL($G(ATTNDPTR))_VAFCOMP_$$HLQ^VAFHUTL($G(ATTNDING))
90 . ;
91 . ;--Treating Specialty
92 . ;
93 . I VAFSTR[",10," D
94 . . N SPECPTR,SPECALTY
95 . . S SPECPTR=$P(CURRENT(8),"^",1)
96 . . S:$G(SPECPTR)'="" SPECALTY=$P($G(^DIC(45.7,SPECPTR,0)),"^",2)
97 . . S $P(RESULT,HLFS,11)=$$HLQ^VAFHUTL($G(SPECALTY))
98 . ;
99 . ;--Previous Patient Location
100 . I VAFSTR["6" D
101 . . N WARD,ROOM,BED,ROOMPTR,ROOMBED,MOVEMENT
102 . . S WARD=$$HLQ^VAFHUTL($P(CURRENT(15,4),"^",2))
103 . . S MOVEMENT=$G(CURRENT(15))
104 . . I MOVEMENT D
105 . . . S ROOMPTR=$P(^DGPM(MOVEMENT,0),"^",7)
106 . . . I ROOMPTR D
107 . . . . S ROOMBED=$P(^DG(405.4,ROOMPTR,0),"^",1)
108 . . . . I (ROOMBED'="") D
109 . . . . . S ROOM=$P(ROOMBED,"-",1)
110 . . . . . S BED=$P(ROOMBED,"-",2)
111 . . S $P(RESULT,HLFS,7)=$$HLQ^VAFHUTL($G(WARD))_VAFCOMP_$$HLQ^VAFHUTL($G(ROOM))_VAFCOMP_$$HLQ^VAFHUTL($G(BED))
112 . ;
113 . ;-- Patient Type
114 . I VAFSTR["18" D
115 . .I +$G(^DPT(DFN,"TYPE")) DO
116 . . .S $P(RESULT,HLFS,19)=$P($G(^DG(391,+^("TYPE"),0)),"^",1)
117 . .E S $P(RESULT,HLFS,19)=HLQ
118 . ;
119 . ;--Physical Treating Specialty - Ward Location
120 . ;
121 . I VAFSTR[",21," D
122 . . N VAWARD,VAPHYTS
123 . . ; get ward location pointer
124 . . S VAWARD=$P($G(CURRENT(5)),"^",1) Q:VAWARD=""
125 . . ; get ward treating specialty pointer
126 . . S VAPHYTS=$P($G(^DIC(42,VAWARD,0)),"^",12)
127 . . S $P(RESULT,HLFS,22)=$S(VAPHYTS]"":VAPHYTS,1:HLQ)
128 . . Q
129 . ;
130 . ;--Facility and Suffix
131 . I VAFSTR[",39," D
132 . . N VAFIEN,VAWARD,VAMEDCTR,VAFACSUF
133 . . ; get patient movement IEN, ward loc ptr, med center div ptr
134 . . S VAFIEN=$G(CURRENT(1))
135 . . S VAWARD=$P($G(^DGPM(VAFIEN,0)),"^",6) Q:VAWARD=""
136 . . S VAMEDCTR=$P($G(^DIC(42,VAWARD,0)),"^",11) Q:VAMEDCTR=""
137 . . ; call below returns: inst pointer^inst name^station number w/suffix
138 . . S VAFACSUF=$$SITE^VASITE($G(CURRENT(3)),VAMEDCTR)
139 . . S VAFACSUF=$P(VAFACSUF,"^",3)
140 . . ; move data into the PV1 segment
141 . . S $P(RESULT,HLFS,40)=$S(VAFACSUF]"":VAFACSUF,1:HLQ)
142 . ;
143 . ;Discharge Disposition
144 . I VAFSTR[",36," D ;If Discharge Disposition requested
145 . .N DGDTYP
146 . .S DGDTYP=$P(CURRENT(17,3),"^") S $P(RESULT,HLFS,37)=DGDTYP
147 . ;
148 . ;--Admission Date
149 . ;
150 . I (VAFSTR["44") D
151 . . I ($P(CURRENT(13,1),"^",1)'="") S $P(RESULT,HLFS,45)=$$HLDATE^HLFNC($P(CURRENT(13,1),"^",1),"TS")
152 . . E S $P(RESULT,HLFS,45)=HLQ
153 . ;
154 . ;
155 . ;--Discharge Date
156 . ;
157 . I (VAFSTR["45") D
158 . . I ($P(CURRENT(17,1),"^",1)'="") S $P(RESULT,HLFS,46)=$$HLDATE^HLFNC($P(CURRENT(17,1),"^",1),"TS")
159 . . E S $P(RESULT,HLFS,46)=HLQ
160 ;
161 Q:$$TEST(7,RESULT,HLFS,VAFCOMP) RESULT
162 Q RESULT
163DGBUILD(DGPMP,VAFSTR) ;
164 ;
165 ;Required Variables: DGPMP = 0 node of patient movement
166 ; VAFSTR = HL7 fields requested e.g.
167 ; ",3,7,10"
168 ;
169 ;This entry point builds an HL7 segment from data supplied
170 ;from the 0 node of the Patient movement file in the required
171 ;variable DGPMP. It is an internal PIMS call used to build
172 ;a PV1 segment when the record has already been deleted.
173 ;
174 ;The call returns a fully encoded PV1 segment or a partially encoded
175 ;PV1 segment containing only set id and patient class
176 ;
177 N WARD,BED,ROOM,ATTNDPTR,ATTNDING,SPECPTR,SPECALTY,TRANSACT
178 N ADMPTR,ADMSSN,VAFCOMP,RESULT
179 S RESULT="PV1"_HLFS_1_HLFS_"I" ;Inpatient
180 I $G(DGPMP)="" Q RESULT
181 S TRANSACT=$P(DGPMP,"^",2),VAFCOMP=$E(HLECH,1)
182 I TRANSACT=1 S VAFDIAG=$P(DGPMP,"^",10)
183 E S ADMPTR=$P(DGPMP,"^",14),ADMSSN=$G(^DGPM(ADMPTR,0)),VAFDIAG=$P(ADMSSN,"^",10)
184 ;
185 ;--Ward, Room, Bed
186 ;
187 I VAFSTR[",3," D
188 . N WARD,ROOM,BED
189 . ;
190 . ;--Check node 2 to see if it's a discharge movement
191 . ;
192 . ;
193 . I TRANSACT=3 D
194 . . S $P(RESULT,HLFS,4)=HLQ_VAFCOMP_HLQ_VAFCOMP_HLQ
195 . . ;
196 . . ;--All non discharge events are handled the same
197 . . ;
198 . I TRANSACT'=3 D
199 . . N WARDPTR,ROOMPTR,ROOM,WARD,BED
200 . . S WARDPTR=$P(DGPMP,"^",6)
201 . . S ROOMPTR=$P(DGPMP,"^",7)
202 . . I $G(WARDPTR)'="" S WARD=$P(^DIC(42,WARDPTR,0),"^",1)
203 . . I $G(ROOMPTR)'="" D
204 . . . S ROOM=$P(^DG(405.4,ROOMPTR,0),"^",1)
205 . . . S BED=$P(ROOM,"-",2)
206 . . . S ROOM=$P(ROOM,"-",1)
207 . . S $P(RESULT,HLFS,4)=$$HLQ^VAFHUTL($G(WARD))_VAFCOMP_$$HLQ^VAFHUTL($G(ROOM))_VAFCOMP_$$HLQ^VAFHUTL($G(BED))
208 . ;
209 . ;--Attending Physician
210 . ;
211 I VAFSTR[",7," D
212 . N ATTNDPTR,ATTNDING
213 . S ATTNDPTR=$P(DGPMP,"^",19)
214 . I $G(ATTNDPTR)'="" D
215 . . N DGNAME S DGNAME("FILE")=200,DGNAME("IENS")=ATTNDPTR,DGNAME("FIELD")=.01
216 . . S ATTNDING=$$HLNAME^XLFNAME(.DGNAME,"S",$E($G(HLECH)))
217 . S $P(RESULT,HLFS,8)=$$HLQ^VAFHUTL($G(ATTNDPTR))_VAFCOMP_$$HLQ^VAFHUTL($G(ATTNDING))
218 . ;
219 . ;--Treating Specialty
220 . ;
221 I VAFSTR[",10," D
222 . N SPECPTR,SPECALTY
223 . S SPECPTR=$P(DGPMP,"^",9)
224 . I $G(SPECPTR)'="" S SPECALTY=$P($G(^DIC(45.7,SPECPTR,0)),"^",2)
225 . S $P(RESULT,HLFS,11)=$$HLQ^VAFHUTL($G(SPECALTY))
226 ;
227 ;-- Patient Type
228 I VAFSTR["18" D
229 . I +$G(^DPT(DFN,"TYPE")) DO
230 . . S $P(RESULT,HLFS,19)=$P($G(^DG(391,+^("TYPE"),0)),"^",1)
231 . E S $P(RESULT,HLFS,19)=HLQ
232 ;
233 ;--Physical Treating Specialty - Ward Location
234 ;
235 I VAFSTR[",21," D
236 . N VAWARD,VAPHYTS
237 . ; get ward location pointer
238 . S VAWARD=$P($G(DGPMP),"^",6) Q:VAWARD=""
239 . ; get ward treating specialty
240 . S VAPHYTS=$P($G(^DIC(42,VAWARD,0)),"^",12)
241 . S $P(RESULT,HLFS,22)=$S(VAPHYTS]"":VAPHYTS,1:HLQ)
242 . Q
243 ;
244 ;--Facility and Suffix
245 ;
246 N VAWARD,VAMEDCTR,VAFACSUF
247 I VAFSTR[",39," D
248 . ; get ward location pointer, med center div pointer
249 . S $P(RESULT,HLFS,40)=HLQ
250 . S VAWARD=$P($G(DGPMP),"^",6) Q:VAWARD=""
251 . S VAMEDCTR=$P($G(^DIC(42,VAWARD,0)),"^",11) Q:VAMEDCTR=""
252 . ; call below returns: inst pointer^inst name^station number w/suffix
253 . S VAFACSUF=$$SITE^VASITE($P(DGPMP,"^",1),VAMEDCTR)
254 . S VAFACSUF=$P(VAFACSUF,"^",3)
255 . ; move data into the PV1 segment
256 . S $P(RESULT,HLFS,40)=$S(VAFACSUF]"":VAFACSUF,1:HLQ)
257 ;
258 ;Discharge Disposition
259 ;
260 I VAFSTR[",36," D ;If Discharge Disposition requested
261 . N DGDTYP
262 . S DGDTYP=$P($G(DGPMP),"^",18) ;Discharge type pointer in movement file
263 . S $P(RESULT,HLFS,37)=DGDTYP ;store in variable
264 ;
265 ;--Admission Date
266 ;
267 I (VAFSTR["44") D
268 . I $P(DGPMP,"^",1)="" S $P(RESULT,HLFS,45)=HLQ
269 . E S $P(RESULT,HLFS,45)=$$HLDATE^HLFNC($P(DGPMP,"^",1),"TS")
270 ;
271 Q:$$TEST(8,RESULT,HLFS,VAFCOMP) RESULT
272 Q RESULT
273TEST(COUNTER,STRING,FIELDSEP,COMPNENT) ;
274 N CHAR,LENGTH
275 S LENGTH=$L(STRING)
276NEXT ;
277 I COUNTER>LENGTH Q 0
278 S CHAR=$E(STRING,COUNTER,COUNTER)
279 I $G(CHAR)=FIELDSEP!($G(CHAR)=COMPNENT) S COUNTER=COUNTER+1 G NEXT
280 Q 1
Note: See TracBrowser for help on using the repository browser.