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

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

initial load of WorldVistAEHR

File size: 8.8 KB
Line 
1DGENPTA ;ALB/CJM - Patient API - Retrieve Data; 13 JUN 1997
2 ;;5.3;Registration;**121,122,147**;08/13/93
3 ;
4VET(DFN) ;returns 1 if the patient is an eligible veteran
5 ;returns 0 if not a veteran or not eligible
6 ;
7 N VET S VET=0
8 I $G(DFN),$D(^DPT(DFN,0)) D
9 .S VET=1
10 .I $P($G(^DPT(DFN,"VET")),"^")="N" S VET=0
11 .I $P($G(^DPT(DFN,.15)),"^",2) S VET=0
12 Q VET
13 ;
14VET1(DFN) ;returns 1 if the patient is a veteran
15 ;returns 0 if not a veteran
16 ;
17 N VET S VET=0
18 I $G(DFN),$D(^DPT(DFN,0)) D
19 .I $P($G(^DPT(DFN,"VET")),"^")="Y" S VET=1
20 Q VET
21 ;
22ACTIVE(DFN,DGDT) ;
23 ;Description - Used to determine whether or not the patient has had a
24 ; recent epiosode of inpatient or outpatient care.
25 ;Input:
26 ; DFN - ien of record in Patient file
27 ; DGDT - date used to specify how far back to go looking for episode
28 ; of care
29 ;Output -
30 ; returns 1 if recent episode of care, 0 otherwise
31 ;
32 ;!!!!!!! NOTE: This routine is not complete. !!!!!!!!!!!!!!!
33 ; Still need to define how user wants to define an 'active' patient.
34 ;!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
35 ;
36 Q 1
37 ;
38PREF(DFN,FACNAME) ;
39 ;Description: Used to determine the patient's preferred facility.
40 ;Input:
41 ; DFN - an ien of a record in the PATIENT file
42 ;Output:
43 ; Function Value - Returns a pointer to the INSTITUTION file entry that
44 ; is the patient's preferred facility, NULL if the preferred facility
45 ; can not be determined.
46 ; FACNAME - optional parm, pass by reference - returns institution name
47 ;
48 N FAC
49 S (FACNAME,FAC)=""
50 I $D(DFN),$D(^DPT(DFN,0)) S FAC=$P($G(^DPT(DFN,"ENR")),"^",2)
51 S:FAC FACNAME=$P($G(^DIC(4,FAC,0)),"^")
52 Q FAC
53 ;
54DEATH(DFN) ;
55 ;Description: Used to determine whether or not the patient is alive.
56 ;Input:
57 ; DFN - an ien of a record in the PATIENT file
58 ;Output:
59 ; Function Value - Returns 0 if there is no record of the patient's
60 ; death, otherwise returns the patients date of death
61 ;
62 N DATE S DATE=0
63 I $D(DFN),$D(^DPT(DFN,0)) S DATE=$P($G(^DPT(DFN,.35)),"^")
64 I DATE S DATE=(DATE\1) ;get rid of the time portion
65 Q +DATE
66 ;
67GET(DFN,DGPAT) ;
68 ;Description: Returns DGPAT() array with identifing infor for patient
69 ; Input:
70 ; DFN - ien, PATIENT file
71 ; Output:
72 ; Function Value - 1 on success, 0 on failure
73 ; DGPAT() array (pass by reference)
74 ; "DEATH" - date of death
75 ; "DFN" - ien, PATIENT file
76 ; "DOB" - date of birth
77 ; "INELDATE" - INELIGIBLE DATE
78 ; "INELREA" - INELIGIBLE REASON
79 ; "INELDEC" - INELIGIBLE VARO DECISION
80 ; "NAME" - patient name
81 ; "PATYPE" - patient type
82 ; "PID" - Primary Long ID
83 ; "PREFAC" - prefered facility
84 ; "SSN" - Social Security Number
85 ; "SEX" - M=male, F=female
86 ; "VETERAN" - VETERAN (Y/N)? - "Y"=YES,"N"=NO
87 ;
88 N NODE
89 Q:'$G(DFN) 0
90 K DGPAT S DGPAT=""
91 S DGPAT("DFN")=DFN
92 S NODE=$G(^DPT(DFN,0))
93 Q:NODE="" 0
94 S DGPAT("NAME")=$P(NODE,"^")
95 S DGPAT("DOB")=$P(NODE,"^",3)
96 S DGPAT("SEX")=$P(NODE,"^",2)
97 S DGPAT("SSN")=$P(NODE,"^",9)
98 ;
99 S DGPAT("DEATH")=$P($G(^DPT(DFN,.35)),"^")
100 S DGPAT("PATYPE")=$P($G(^DPT(DFN,"TYPE")),"^")
101 S DGPAT("VETERAN")=$P($G(^DPT(DFN,"VET")),"^")
102 S DGPAT("PREFAC")=$P($G(^DPT(DFN,"ENR")),"^",2)
103 S DGPAT("INELDATE")=$P($G(^DPT(DFN,.15)),"^",2)
104 S DGPAT("INELREA")=$P($G(^DPT(DFN,.3)),"^",7)
105 S DGPAT("INELDEC")=$P($G(^DPT(DFN,"INE")),"^",6)
106 S DGPAT("PID")=$P($G(^DPT(DFN,.36)),"^",3)
107 Q 1
108 ;
109SSN(DFN) ;
110 ;Description: Function returns the patient's SSN, or "" on failure.
111 ;
112 Q:'DFN ""
113 Q $P($G(^DPT(DFN,0)),"^",9)
114 ;
115NAME(DFN) ;
116 ;Description: Function returns the patient's NAME, or "" on failure.
117 ;
118 Q:'DFN ""
119 Q $P($G(^DPT(DFN,0)),"^")
120 ;
121EXT(SUB,VAL) ;
122 ;Description: Given the subscript used in the PATIENT object array,
123 ; DGPAT(), and a field value, returns the external representation of
124 ; the value, as defined in the fields output transform of the PATIENT
125 ; file.
126 ;Input:
127 ; SUB - array subscript
128 ; VAL - field value
129 ;Output:
130 ; Function Value - returns the external value of the field
131 ;
132 Q:(($G(SUB)="")!($G(VAL)="")) ""
133 ;
134 N FLD
135 S FLD=$$FIELD^DGENPTA1(SUB)
136 Q:(FLD="") ""
137 Q $$EXTERNAL^DILFD(2,FLD,"F",VAL)
138 ;
139 ;
140VALPAT(DFN) ; --
141 ; Description: This function returns a 1 if the patient DFN is valid, 0 if the patient DFN is not valid.
142 ;
143 ; Input:
144 ; DFN - as pointer to patient in Patient (#2) file
145 ;
146 ; Output:
147 ; Function Value - Is patient (DFN) valid?
148 ; Return 1 if successful, otherwise 0
149 ;
150 ; init variables
151 N DGVALID S DGVALID=0
152 ;
153 ; is patient (DFN) valid?
154 I $G(DFN),$D(^DPT(DFN,0)) S DGVALID=1
155 ;
156 Q DGVALID
157 ;
158 ;
159CURINPAT(DFN) ; --
160 ; Description: This function will determine if the patient is a current inpatient.
161 ;
162 ; Input:
163 ; DFN - IEN of record in Patient (#2) file
164 ;
165 ; Output:
166 ; Function Value - Is patient a current inpatient?
167 ; Return 1 if successful, otherwise 0
168 ;
169 N DGCUR S DGCUR=0
170 ;
171 ; if valid patient, check if current inpatient
172 I $$VALPAT(DFN) D
173 .;
174 .; is patient a current inpatient?
175 .I $G(^DPT(DFN,.105)) S DGCUR=1
176 ;
177 Q DGCUR
178 ;
179 ;
180INPAT(DFN,DGBEG,DGEND) ; --
181 ; Description: This function will determine if a patient was an inpatient between a specified date range.
182 ;
183 ; Input:
184 ; DFN - IEN of record in Patient (#2) file
185 ; DGBEG - as begin date/time for inpatient search
186 ; DGEND - as end date/time for inpatient search
187 ;
188 ; Output:
189 ; Function Value - Was patient an inpatient between date range?
190 ; Return 1 if successful, otherwise 0
191 ;
192 N DGINPAT,DGSDT,DGEDT,DGMOVE,DGTRANS
193 S DGINPAT=0
194 ;
195 ; if not valid patient (DFN) and not valid date range, exit
196 I '$$VALPAT(DFN),'($$RANGE(DGBEG,DGEND)) G INPATQ
197 ;
198 ; init date/time(s)
199 S DGSDT=DGBEG-.0001,DGEDT=DGEND+$S($P(DGEND,".",2)="":.2359,1:"")
200 ;
201 ; use "APRD" x-ref of Patient Movement (#405) file
202 F S DGSDT=$O(^DGPM("APRD",+DFN,DGSDT)) Q:'DGSDT!(DGSDT>DGEDT)!(DGINPAT) D
203 .S DGMOVE=0 F S DGMOVE=$O(^DGPM("APRD",+DFN,DGSDT,DGMOVE)) Q:'DGMOVE!(DGINPAT) D
204 ..; - transaction type of movement
205 ..S DGTRANS=$P($G(^DGPM(DGMOVE,0)),"^",2) ; movement transaction type
206 ..; - if trans type not DISCHARGE, CHECK-IN LODGER, CHECK-OUT LODGER
207 ..I DGTRANS'=3,(DGTRANS'=4),(DGTRANS'=5) S DGINPAT=1
208 ;
209INPATQ Q DGINPAT
210 ;
211 ;
212OUTPAT(DFN,DGBEG,DGEND) ; --
213 ; Description: This function will determine if a patient has an outpatient encounter between a specified date range that has successfully been checked out.
214 ;
215 ; Input:
216 ; DFN - IEN of record in Patient (#2) file
217 ; DGBEG - as begin date/time for outpatient search
218 ; DGEND - as end date/time for outpatient search
219 ;
220 ; Output:
221 ; Function Value - Does patient have outpatient encounter between date
222 ; range that that has successfully been checked out?
223 ; Return 1 if successful, otherwise 0
224 ;
225 N DGOUT,DGSDT,DGEDT,DGOE
226 S DGOUT=0
227 ;
228 ; if not valid patient (DFN) and not valid date range, exit
229 I '$$VALPAT(DFN),'($$RANGE(DGBEG,DGEND)) G OUTPATQ
230 ;
231 ; init date/time(s)
232 S DGSDT=DGBEG-.0001,DGEDT=DGEND+$S($P(DGEND,".",2)="":.2359,1:"")
233 ;
234 ; use "ADFN" x-ref of Outpatient Encounter (#409.68) file
235 F S DGSDT=$O(^SCE("ADFN",+DFN,DGSDT)) Q:'DGSDT!(DGSDT>DGEDT)!(DGOUT) D
236 .;
237 .S DGOE=0 F S DGOE=$O(^SCE("ADFN",+DFN,DGSDT,DGOE)) Q:'DGOE!(DGOUT) D
238 ..; - if encounter checked out, set flag
239 ..I $P($G(^SCE(+DGOE,0)),"^",7) S DGOUT=1
240 ;
241OUTPATQ Q DGOUT
242 ;
243 ;
244RANGE(DGBEG,DGEND) ; --
245 ; Description: This function returns a 1 if two dates are a valid date range, 0 if they are not valid.
246 ;
247 ; Input:
248 ; DGBEG - as begin date of date range
249 ; DGEND - as end date of date range
250 ;
251 ; Output:
252 ; Function Value - Is date range valid?
253 ; Return 1 if successful, otherwise 0
254 ;
255 N DGOK
256 ;
257 S DGOK=0
258 ;
259 ; if input parameters not defined, exit
260 I '$D(DGBEG),('$D(DGEND)) G RANGEQ
261 ;
262 ; remove time from dates
263 S DGBEG=(DGBEG/1),DGEND=(DGEND/1)
264 ;
265 ; if begin date greater than end date, exit
266 I DGBEG>DGEND G RANGEQ
267 ;
268 ; if begin date and end date future dates, exit
269 I DGBEG>DT,(DGEND>DT) G RANGEQ
270 ;
271 S DGOK=1
272 ;
273RANGEQ Q DGOK
274 ;
275LOOKUP(SSN,DOB,SEX,ERROR) ;
276 ;Description: This function will do a search for the patient based on
277 ;the identifying information provided. The function will be successful
278 ;only if a single patient is found matching the identifiers provided.
279 ;
280 ;Inputs:
281 ; SSN - patient Social Security Number
282 ; DOB - patient date of birth (FM format)
283 ; SEX - patient sex
284 ;Outputs:
285 ; Function Value - patient DFN if successful, 0 otherwise
286 ; ERROR - if unsuccessful, an error message is returned (optional, pass by reference)
287 ;
288 N DFN,NODE
289 ;
290 S DFN=$O(^DPT("SSN",SSN,0))
291 I 'DFN S ERROR="SSN NOT FOUND" Q 0
292 I $O(^DPT("SSN",SSN,DFN)) S ERROR="MULTIPLE PATIENTS MATCHING SSN" Q 0
293 S NODE=$G(^DPT(DFN,0))
294 I $P(NODE,"^",2)'=SEX S ERROR="SEX DOES NOT MATCH" Q 0
295 I $E($P(NODE,"^",3),1,3)'=$E(DOB,1,3) S ERROR="DOB DOES NOT MATCH" Q 0
296 I $E($P(NODE,"^",3),4,5),$E($P(NODE,"^",3),4,5)'=$E(DOB,4,5) S ERROR="DOB DOES NOT MATCH" Q 0
297 Q DFN
Note: See TracBrowser for help on using the repository browser.