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

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

initial load of FOIAVistA 6/30/08 version
File size: 7.5 KB
Line 
1DGQEDEMO ;ALB/RPM - VIC REPLACEMENT DEMOGRAPHICS GETTER API'S ; 9/19/03
2 ;;5.3;Registration;**571**;Aug 13, 1993
3 ;
4 ; This routine contains the following patient demographic data
5 ; retrieval procedures and functions:
6 ; $$GETICN - retrieves patient's national ICN
7 ; $$GETIDS - retrieves patient identifiers
8 ; $$GETNAMEC - retrieves patient's name components
9 ; $$GETADDR - retrieves patient's mailing address
10 ; GETSITE - retrieves local station name and number
11 ;
12 Q ;no direct entry
13 ;
14GETICN(DGDFN) ;retrieve patient national ICN
15 ; This function retrieves the ICN for a patient if the ICN is
16 ; nationally assigned.
17 ;
18 ; Supported References:
19 ; DBIA #2701: $$GETICN^MPIF001, $$IFLOCAL^MPIF001
20 ;
21 ; Input:
22 ; DGDFN - (required) pointer to patient in PATIENT (#2) file
23 ;
24 ; Output:
25 ; Function value - returns National ICN on success, 0 on failure
26 ;
27 N DGICN
28 ;
29 S DGICN=0
30 I $G(DGDFN)>0,$D(^DPT(DGDFN,0)) D
31 . ;
32 . S DGICN=$$GETICN^MPIF001(DGDFN)
33 . S DGICN=$S(DGICN>0:$P(DGICN,"V",1),1:0)
34 . Q:'DGICN
35 . ;
36 . I $$IFLOCAL^MPIF001(DGDFN) S DGICN=0
37 ;
38 Q DGICN
39 ;
40 ;
41GETIDS(DGDFN,DGIDS) ;retrieve patient identifiers
42 ; This function retrieves identifying information for a patient
43 ; in the PATIENT (#2) file and places it in an array format.
44 ;
45 ; Supported Reference:
46 ; DBIA #10035: Direct global reference of patient's zero
47 ; node in the PATIENT (#2) file
48 ;
49 ; Input:
50 ; DGDFN - (required) ien of patient in PATIENT (#2) file
51 ;
52 ; Output:
53 ; Function value - returns 1 on success, 0 on failure
54 ; DGIDS - output array containing the patient identifying information,
55 ; on success, pass by reference.
56 ; Array subscripts are:
57 ; "DFN" - ien PATIENT (#2) file
58 ; "NAME" - patient name
59 ; "SEX" - patient gender ("M"/"F")
60 ; "SSN" - patient Social Security Number
61 ; "DOB" - patient date of birth (FM format)
62 ;
63 N DGNODE
64 N DGRSLT
65 ;
66 S DGRSLT=0
67 ;
68 I $G(DGDFN)>0,$D(^DPT(DGDFN,0)) D
69 .
70 . ;get zero node of patient record
71 . S DGNODE=$G(^DPT(DGDFN,0))
72 . ;
73 . S DGIDS("DFN")=DGDFN
74 . S DGIDS("NAME")=$P(DGNODE,U)
75 . S DGIDS("SEX")=$P(DGNODE,U,2)
76 . S DGIDS("DOB")=$P(DGNODE,U,3)
77 . S DGIDS("SSN")=$P(DGNODE,U,9)
78 . S DGRSLT=1 ;success
79 ;
80 Q DGRSLT
81 ;
82 ;
83GETNAMC(DGDFN,DGCOMP) ;retrieve name components
84 ; This function retrieves a given patient's name components from the
85 ; NAME COMPONENT (#20) file and places the components in an array
86 ; format. The supported API $$HLNAME^XLFNAME is used to retrieve the
87 ; name components, since it is the only supported Name Standardization
88 ; api that both reads from the NAME COMPONENT (#20) file and returns a
89 ; result that can be easily parsed.
90 ;
91 ; Supported Reference:
92 ; DBIA #3065: $$HLNAME^XLFNAME
93 ;
94 ; Input:
95 ; DGDFN - (required) pointer to patient in PATIENT (#2) file
96 ;
97 ; Output:
98 ; Function value - returns 1 on success, 0 on failure
99 ; DGCOMP - name component array on success, pass by reference
100 ; Array subscripts are:
101 ; "LAST" - Family (last) name
102 ; "FIRST" - Given (first) name
103 ; "MIDDLE" - Middle name
104 ; "SUFFIX" - Name suffix
105 ; "PREFIX" - Name prefix
106 ;
107 N DGSUB ;component array subscripts
108 N DGFLD ;component field position
109 N DGNAMSTR ;XLFNAME name component string
110 N DGPAR ;XLFNAME input parameter array
111 N DGRSLT ;function value
112 ;
113 S DGRSLT=0
114 ;
115 I $G(DGDFN)>0,$D(^DPT(DGDFN,0)) D
116 . S DGFLD=0
117 . S DGPAR("FILE")=2,DGPAR("FIELD")=".01",DGPAR("IENS")=DGDFN_","
118 . S DGNAMSTR=$$HLNAME^XLFNAME(.DGPAR,,U)
119 . F DGSUB="LAST","FIRST","MIDDLE","SUFFIX","PREFIX" D
120 . . S DGFLD=DGFLD+1
121 . . S DGCOMP(DGSUB)=$P(DGNAMSTR,U,DGFLD)
122 . S DGRSLT=1 ;success
123 ;
124 Q DGRSLT
125 ;
126 ;
127GETADDR(DGDFN,DGMADR,DGAERR) ;retrieve patient mailing address
128 ; This funtion selects the mailing address for a patient from the
129 ; available HIPAA confidential address, temporary address, permanent
130 ; address. If the BAD ADDRESS INDICATOR (#.121) of the PATIENT file
131 ; is set, then the facility address will be selected. The selected
132 ; address is placed in an array format.
133 ;
134 ; Supported Reference:
135 ; DBIA #4080: $$BADADR^DGUTL3
136 ;
137 ; Input:
138 ; DGDFN - (required) pointer to patient in PATIENT (#2) file
139 ;
140 ; Output:
141 ; Function value - returns 1 on success, 0 on failure
142 ; DGMADR - array of mailing address fields on success, pass by
143 ; reference
144 ; Array subscripts are:
145 ; "STREET1" - line 1 of street address
146 ; "STREET2" - line 2 of street address
147 ; "STREET3" - line 3 of street address
148 ; "CITY" - city
149 ; "STATE" - state
150 ; "ZIP" - zip code
151 ; "ADRTYPE" - address type
152 ; [1:perm.; 2:temp.; 3:conf.; 4:facility]
153 ; DGAERR - error message text defined on failure, pass by reference
154 ;
155 N DGADDR ;address array in ADD^VAPDT format
156 N DGRSLT ;function value
157 N DGTYPE ;address type
158 ;
159 S DGRSLT=0
160 S DGTYPE=0
161 ;
162 I $G(DGDFN)>0,$D(^DPT(DGDFN,0)) D ;exit block on first error
163 . ;
164 . ;select between permanent, temporary and confidential addresses
165 . S DGTYPE=$$GETPTCA^DGQEUT3(DGDFN,.DGADDR)
166 . ;
167 . ;get facility address when no address, foreign address, or
168 . ;bad address indicator is set
169 . I 'DGTYPE!($$ISFRGN^DGQEUT3(.DGADDR))!(+$$BADADR^DGUTL3(DGDFN)>0) D
170 . . S DGTYPE=4 ;facility address
171 . . I '$$GETFADD^DGQEUT3(.DGADDR) D
172 . . . S DGAERR="Unable to retrieve facility address."
173 . Q:$D(DGAERR)
174 . ;
175 . ;load mailing address array with retrieved address
176 . S DGMADR("STREET1")=$G(DGADDR(1))
177 . S DGMADR("STREET2")=$G(DGADDR(2))
178 . S DGMADR("STREET3")=$G(DGADDR(3))
179 . S DGMADR("CITY")=$G(DGADDR(4))
180 . S DGMADR("STATE")=$G(DGADDR(5))
181 . S DGMADR("ZIP")=$G(DGADDR(6))
182 . S DGMADR("ADRTYPE")=DGTYPE
183 . S DGRSLT=1 ;success
184 ;
185 Q DGRSLT
186 ;
187 ;
188GETSITE(DGFAC) ;retrieve the local site station number and name
189 ; This procedure retrieves the local site's name and station number
190 ; and places them in an array format. A valid DUZ(2) is used to
191 ; determine the station number and name. $$SITE^VASITE() is used
192 ; when DUZ(2) is undefined or invalid.
193 ;
194 ; Supported References:
195 ; DBIA #2171: $$STA^XUAF4, $$NAME^XUAF4
196 ; DBIA #10112: $$SITE^VASITE
197 ;
198 ; Input:
199 ; none
200 ;
201 ; Output:
202 ; DGFAC - array of facility information
203 ; Array subscripts are:
204 ; "FACNUM" - station number
205 ; "FACNAME" - facility name
206 ;
207 N DGERR
208 N DGIEN
209 N DGINST ;pointer to INSTITUTION (#4) file
210 ;
211 I $G(DUZ(2))>0,$D(^DIC(4,DUZ(2))) D
212 . S DGINST=DUZ(2)
213 E D
214 . S DGINST=$P($$SITE^VASITE(),U)
215 ;
216 S DGFAC("FACNUM")=$$STA^XUAF4(DGINST)
217 S DGFAC("FACNAME")=$$NAME^XUAF4(DGINST)
218 S DGFAC("VISN")=$$GETVISN(DGINST)
219 ;
220 Q
221 ;
222GETVISN(DGINST) ;retrieve VISN for an institution
223 ; This function checks for a "VISN" entry in the ASSOCIATIONS
224 ; (#14) multiple field in the INSTITUTION (#4) file for a given
225 ; institution. If a "VISN" entry exists, then the PARENT OF ASSOCIATION
226 ; (#1) subfield value is returned.
227 ;
228 ; DBIA: #10090 - Read entire INSTITUTION (#4) file with FileMan
229 ;
230 ; Input:
231 ; DGINST - pointer to INSTITUTION (#4) file
232 ;
233 ; Output:
234 ; Function value - VISN name on success, "" on failure
235 ;
236 N DGERR ;FM error array
237 N DGVISN ;function value
238 ;
239 S DGVISN=""
240 I $G(DGINST),$D(^DIC(4,DGINST)) D
241 . S DGIEN=$$FIND1^DIC(4.014,","_DGINST_",","","VISN","B","","DGERR")
242 . Q:('DGIEN!($D(DGERR)))
243 . ;
244 . S DGVISN=$$GET1^DIQ(4.014,DGIEN_","_DGINST_",",1,"E","","DGERR")
245 ;
246 Q DGVISN
Note: See TracBrowser for help on using the repository browser.