source: FOIAVistA/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGQEUT3.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: 5.5 KB
Line 
1DGQEUT3 ;ALB/RPM - VIC REPLACEMENT UTILITIES #3 ; 12/22/03
2 ;;5.3;Registration;**571**;Aug 13, 1993
3 ;
4 ; This routine contains the following address selection and retrieval
5 ; utilities:
6 ; $$GETFADD - retrieves facility address
7 ; $$GETPTCA - retrieves a confidential, temporary or permanent address
8 ; $$ISCONF - determines if confidential address is active
9 ; $$ISTEMP - determines if temporary address active
10 ; $$ISFRGN - determines if selected address is a foreign address
11 ; $$GETABRV - converts pointer to STATE(#5) file to state abbreviation
12 ;
13 Q ;no direct entry
14 ;
15GETFADD(DGFADD) ;retrieve facility address
16 ; This function retrieves a facility's address from the INSTITUTION(#4)
17 ; file and places the address in an array mapped to be compatible with
18 ; the ADD^VADPT call. A valid DUZ(2) is used to determine the
19 ; pointer to the INSTITUTION(#4) file, otherwise, $$SITE^VASITE() is
20 ; used.
21 ;
22 ; Supported References:
23 ; DBIA #2171: $$PADD^XUAF4
24 ; DBIA #10112: $$SITE^VASITE
25 ;
26 ; Input:
27 ; none
28 ;
29 ; Output:
30 ; DGFADD - facility address array, pass by reference
31 ; Array subscripts are:
32 ; "1" - Street Line 1
33 ; "2" - null
34 ; "3" - null
35 ; "4" - City
36 ; "5" - State (2 character abbreviation)
37 ; "6" - Zip
38 ; Function value - address type on success [4:facility]; 0 on failure
39 ;
40 N DGADR ;return value of $$PADD api
41 N DGINST ;INSTITUTION (#4) file pointer
42 N DGTYPE ;function value address type
43 ;
44 S DGTYPE=0
45 ;
46 I $G(DUZ(2))>0 S DGINST=DUZ(2)
47 E S DGINST=$P($$SITE^VASITE(),U,1)
48 ;
49 I $D(^DIC(4,DGINST)) D
50 . S DGADR=$$PADD^XUAF4(DGINST)
51 . ;
52 . S DGFADD(1)=$P(DGADR,U,1) ;street 1
53 . S DGFADD(2)="" ;placeholder
54 . S DGFADD(3)="" ;placeholder
55 . S DGFADD(4)=$P(DGADR,U,2) ;city
56 . S DGFADD(5)=$P(DGADR,U,3) ;state
57 . S DGFADD(6)=$P(DGADR,U,4) ;zip
58 . ;
59 . ;success
60 . S DGTYPE=4
61 ;
62 Q DGTYPE
63 ;
64GETPTCA(DGDFN,DGADDR) ;select confidential, temporary or permanent address
65 ; This function uses ADD^VADPT to retrieve a patient address array and
66 ; selects the address to be used for mailing. The address selection
67 ; priority is as follows:
68 ; 1) Active "ELIGIBILITY/ENROLLMENT"-category Confidential Address
69 ; 2) Active Temporary Address
70 ; 3) Permanent Address
71 ; The selected address is returned in an array format.
72 ;
73 ; Supported Reference:
74 ; DBIA #10061: ADD^VADPT
75 ;
76 ; Input:
77 ; DGDFN - pointer to patient in PATIENT (#2) file
78 ;
79 ; Output:
80 ; DGADDR - selected address array, pass by reference
81 ; Array subscripts are:
82 ; "1" - Street Line 1
83 ; "2" - Street Line 2
84 ; "3" - Street Line 3
85 ; "4" - City
86 ; "5" - State (abbreviation)
87 ; "6" - Zip
88 ; "7" - County
89 ; Function value - set of codes for address type [1:permanent,
90 ; 2:temporary,3:confidential]
91 ;
92 N DFN ;input parameter for ADD^VADPT
93 N DGI ;generic counter
94 N DGLINE1 ;array node of Street Line 1
95 N DGSUB ;return array subscript
96 N DGTYPE ;function value - address type
97 N VAERR ;error return from VADPT
98 N VAPA ;result array from VADPT
99 ;
100 S DGTYPE=0
101 ;
102 I $G(DGDFN)>0,$D(^DPT(DGDFN,0)) D
103 . S DFN=DGDFN
104 . D ADD^VADPT
105 . ;
106 . ;determine address type
107 . S DGTYPE=$S($$ISCONF(.VAPA,"ELIGIBILITY/ENROLLMENT"):3,$$ISTEMP(.VAPA):2,1:1)
108 . ;
109 . ;copy VADPT array into return array
110 . S DGLINE1=$S(DGTYPE=3:13,1:1)
111 . S DGSUB=0
112 . F DGI=DGLINE1:1:DGLINE1+6 D
113 . . S DGSUB=DGSUB+1
114 . . I DGSUB=5 D ;get state abbreviation
115 . . . S DGADDR(DGSUB)=$$GETABRV($P(VAPA(DGI),U))
116 . . E D
117 . . . S DGADDR(DGSUB)=$P(VAPA(DGI),U)
118 ;
119 Q DGTYPE
120 ;
121 ;
122ISCONF(DGADD,DGCAT) ;is confidential address active?
123 ; This function accepts an address array returned from a call to
124 ; ADD^VADPT and determines if an active confidential address exists
125 ; for the given category.
126 ;
127 ; DGADD - VAPA address array from ADD^VADPT
128 ; DGCAT - confidential address category
129 ;
130 ; Output:
131 ; Function value - 1:confidential address active,0:confidential
132 ; address inactive
133 ;
134 N DGI ;generic counter
135 N DGRSLT ;function value
136 ;
137 S DGRSLT=0
138 I $G(DGADD(12)),$G(DGCAT)]"" D
139 . S DGI=0
140 . F S DGI=$O(DGADD(22,DGI)) Q:'DGI D Q:DGRSLT
141 . . Q:$P($G(DGADD(22,DGI)),U,2)'=DGCAT
142 . . Q:$P($G(DGADD(22,DGI)),U,3)'="Y"
143 . . S DGRSLT=1
144 ;
145 Q DGRSLT
146 ;
147 ;
148ISTEMP(DGADD) ;is temporary address active?
149 ; This function determines if an active temporary address exists.
150 ;
151 ; Input:
152 ; DGADD - address array in VADPT VAPA format
153 ;
154 ; Output:
155 ; Function value - 1 on active temp address, 0 on failure
156 ;
157 Q $G(DGADD(9))>0
158 ;
159 ;
160ISFRGN(DGADD) ;is selected address foreign?
161 ; This function determines if the address selected by VADPT is a
162 ; foreign address.
163 ;
164 ; Input:
165 ; DGADD - address aray in VADPT VAPA format
166 ;
167 ; Output:
168 ; Function value - returns 1 on foreign address, 0 not a foreign
169 ; address
170 ;
171 Q $G(DGADD(7))="999"
172 ;
173 ;
174GETABRV(DGIEN) ;retrieve state abbreviation
175 ; This function retrieves the abbreviation for a state from the STAT
176 ; (#5) file for a given IEN.
177 ;
178 ; Supported Reference:
179 ; DBIA #10056: FileMan Read access to STATE (#5) file
180 ;
181 ; Input:
182 ; DGIEN - pointer to a state in the STATE (#5) file
183 ;
184 ; Output:
185 ; Function value - state abbreviation on success, "" on failure
186 ;
187 N DGABRV ;function value
188 N DGERR ;FM error value
189 ;
190 S DGABRV=""
191 ;
192 I $G(DGIEN)>0,$D(^DIC(5,DGIEN,0)) D
193 . S DGABRV=$$GET1^DIQ(5,DGIEN_",",1,"","","DGERR")
194 . S:$D(DGERR) DGABRV=""
195 ;
196 Q DGABRV
Note: See TracBrowser for help on using the repository browser.