source: FOIAVistA/tag/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XUMF4A.m@ 628

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

initial load of FOIAVistA 6/30/08 version
File size: 6.2 KB
Line 
1XUMF4A ;CIOFO-SF/RAM - Institution File Clean Up; 06/28/99
2 ;;8.0;KERNEL;**206,209,212,261**;Jul 10, 1995
3 ;
4 ;
5EN ; -- entry point
6 ;
7 I $$CDSN D Q
8 .D MSG^VALM10("Duplicates sta #s exist! -- NOTHING UPDATED!!!")
9 .H 5
10 .S VALMBCK="R"
11 ;
12 W "...working",!
13 D DSN,CSN,GOLD,ASSC,HIST
14 ;
15 K ^TMP("XUMF NAME",$J)
16 D NAME^XUMF4
17 S VALMBG=1
18 S VALMBCK="R"
19 ;
20 Q
21 ;
22DSN ; -- clean out local station numbers
23 ;
24 N IEN,DIE,DR,DA,XUMF,DIK
25 ;
26 S XUMF=7
27 ;
28 S IEN=0
29 F S IEN=$O(^DIC(4,IEN)) Q:'IEN D
30 .S STA=$P($G(^DIC(4,+IEN,99)),U) Q:STA=""
31 .Q:$D(^TMP("XUMF ARRAY",$J,STA))
32 .S DR="99///@",DIE=4,DA=IEN
33 .D
34 ..N IEN D ^DIE
35 ;
36 S STA="",IEN=0
37 F S STA=$O(^DIC(4,"D",STA)) Q:STA="" D
38 .F S IEN=$O(^DIC(4,"D",STA,IEN)) Q:'IEN D
39 ..Q:$P($G(^DIC(4,+IEN,99)),U)=STA
40 ..K ^DIC(4,"D",STA,IEN)
41 ;
42 S DIK="^DIC(4,",DIK(1)="99^D" D ENALL^DIK
43 ;
44 Q
45 ;
46CSN ; -- check/update status
47 ;
48 N IEN,DIE,DR,DA,XUMF,STATUS,STA
49 ;
50 S XUMF=7
51 ;
52 S IEN=0
53 F S IEN=$O(^DIC(4,IEN)) Q:'IEN D
54 .S STA=$P($G(^DIC(4,+IEN,99)),U)
55 .I STA S DR="11///N",DIE=4,DA=IEN D Q
56 ..N IEN D ^DIE
57 .S STATUS=$P(^DIC(4,IEN,0),U,11)
58 .I STATUS="I" S DR="101///I",DIE=4,DA=IEN D
59 ..N IEN D ^DIE
60 .S DR="11///L",DIE=4,DA=IEN D
61 ..N IEN D ^DIE
62 ;
63 Q
64 ;
65GOLD ; -- add missing national data from standard table
66 ;
67 N STA,NAME,FDA,ERROR,IEN,IENS,X,FLAG,CNT
68 N OLDNAME,OLDVANM,STATE,FACTYP,XUMF,STATE,AGENCY
69 ;
70 S XUMF=7
71 ;
72 S STA="",CNT=0
73 F S STA=$O(^TMP("XUMF ARRAY",$J,STA)) Q:STA="" D
74 .S X=^TMP("XUMF ARRAY",$J,STA)
75 .S IEN=$O(^DIC(4,"D",STA,0))
76 .S OLDNAME=$P($G(^DIC(4,+IEN,0)),U,1)
77 .S OLDVANM=$P($G(^DIC(4,+IEN,99)),U,3)
78 .S IENS=$S(IEN:IEN_",",1:"+1,")
79 .S NAME=$P(X,U,2)
80 .S FACTYP=$P(X,U,5)
81 .S VANAME=$P(X,U,6)
82 .S FLAG=$P(X,U,7)
83 .S STATE=$P(X,U,8)
84 .S AGENCY=$P(X,U,17)
85 .K FDA
86 .S FDA(4,IENS,.01)=NAME
87 .S FDA(4,IENS,.02)=STATE
88 .S FDA(4,IENS,99)=STA
89 .S FDA(4,IENS,11)="NATIONAL"
90 .S FDA(4,IENS,13)=$P(FACTYP,"~")
91 .S FDA(4,IENS,100)=VANAME
92 .S FDA(4,IENS,101)=FLAG
93 .S FDA(4,IENS,95)=$P(AGENCY,"~")
94 .D
95 ..N IEN,STA,NAME,VANAME,OLDNAME,OLDVANM
96 ..D UPDATE^DIE("E","FDA",,"ERR")
97 .I 'IEN S IEN=$O(^DIC(4,"D",STA,0))
98 .Q:'IEN
99 .I OLDNAME="" Q
100 .I OLDNAME=NAME,VANAME=OLDVANM Q
101 .S IENS="?+"_DT_","_IEN_","
102 .K FDA
103 .S FDA(4.999,IENS,.01)=DT
104 .S:NAME'=OLDNAME FDA(4.999,IENS,.02)=OLDNAME
105 .S:VANAME'=OLDVANM FDA(4.999,IENS,.03)=OLDVANM
106 .D
107 ..N STA
108 ..D UPDATE^DIE("E","FDA",,"ERR")
109 ..S CNT=CNT+1 I '(CNT#10) W "."
110 ;
111 Q
112 ;
113ASSC ; -- populate associations (parent facility and VISN)
114 ;
115 N IEN,STA,VISN,PARENT,FDA,XUMF,CNT
116 ;
117 S XUMF=7
118 ;
119 S STA="",CNT=0
120 F S STA=$O(^TMP("XUMF ARRAY",$J,STA)) Q:STA="" D
121 .S IEN=$O(^DIC(4,"D",STA,0)) Q:'IEN
122 .S VISN=$P(^TMP("XUMF ARRAY",$J,STA),U,9)
123 .I VISN'="" D
124 ..K FDA
125 ..S IENS="?+1,"_IEN_","
126 ..S FDA(4.014,IENS,.01)="VISN"
127 ..S FDA(4.014,IENS,1)=$P(VISN,"~")
128 ..D
129 ...N IEN,STA
130 ...D UPDATE^DIE("E","FDA")
131 .S PARENT=$P(^TMP("XUMF ARRAY",$J,STA),U,10)
132 .I PARENT'="" D
133 ..K FDA
134 ..S IENS="?+2,"_IEN_","
135 ..S FDA(4.014,IENS,.01)="PARENT FACILITY"
136 ..S FDA(4.014,IENS,1)=PARENT
137 ..D
138 ...N IEN,STA
139 ...D UPDATE^DIE("E","FDA")
140 ...S CNT=CNT+1 I '(CNT#10) W "."
141 ;
142 Q
143 ;
144HIST ; -- history
145 ;
146 N IEN,STA,EFFDT,FDA,XUMF,CNT
147 ;
148 S XUMF=7
149 ;
150 S STA="",CNT=0
151 F S STA=$O(^TMP("XUMF ARRAY",$J,STA)) Q:STA="" D
152 .S IEN=$O(^DIC(4,"D",STA,0)) Q:'IEN
153 .S EFFDT=$P(^TMP("XUMF ARRAY",$J,STA),U,11)
154 .S EFFDT=$$FMDATE^HLFNC(+EFFDT)
155 .I EFFDT D
156 ..S IENS="?+"_EFFDT_","_IEN_","
157 ..K FDA
158 ..S FDA(4.999,IENS,.01)=EFFDT
159 ..S FDA(4.999,IENS,.06)=$P(^TMP("XUMF ARRAY",$J,STA),U,12)
160 ..D
161 ...N IEN,STA
162 ...D UPDATE^DIE("E","FDA")
163 .S EFFDT=$P(^TMP("XUMF ARRAY",$J,STA),U,13)
164 .S EFFDT=$$FMDATE^HLFNC(+EFFDT)
165 .I EFFDT D
166 ..S IENS="?+"_EFFDT_","_IEN_","
167 ..K FDA
168 ..S FDA(4.999,IENS,.01)=EFFDT
169 ..S FDA(4.999,IENS,.05)=$P(^TMP("XUMF ARRAY",$J,STA),U,14)
170 ..D
171 ...N IEN,STA
172 ...D UPDATE^DIE("E","FDA")
173 ...S CNT=CNT+1 I '(CNT#10) W "."
174 ;
175 Q
176 ;
177CDSN() ; -- check for duplicate sta # (true=duplicates, false=none)
178 ;
179 K ^TMP("XUMF TMP",$J)
180 ;
181 N IEN,STA,CNT
182 ;
183 S STA="",IEN=0
184 F S STA=$O(^DIC(4,"D",STA)) Q:STA="" D
185 .F S IEN=$O(^DIC(4,"D",STA,IEN)) Q:'IEN D
186 ..S ^TMP("XUMF TMP",$J,STA,IEN)=$P(^DIC(4,IEN,0),U)
187 ;
188 S STA="",(CNT,IEN)=0
189 F S STA=$O(^TMP("XUMF TMP",$J,STA)) Q:STA="" D
190 .Q:'$O(^TMP("XUMF TMP",$J,STA,+$O(^TMP("XUMF TMP",$J,STA,0))))
191 .F S IEN=$O(^TMP("XUMF TMP",$J,STA,IEN)) Q:'IEN D
192 ..S CNT=CNT+1
193 ;
194 K ^TMP("XUMF TMP",$J)
195 ;
196 Q CNT
197 ;
198CMVD() ; -- check for missing national data
199 ;
200 N STA,CNT
201 ;
202 S CNT=0
203 ;
204 S STA=""
205 F S STA=$O(^TMP("XUMF ARRAY",$J,STA)) Q:STA="" D
206 .Q:$D(^DIC(4,"D",STA))
207 .S CNT=CNT+1
208 ;
209 Q CNT
210 ;
211CHCK ; -- check if clean up is complete
212 ;
213 N VAR,FLD
214 ;
215 K ^TMP("XUMF CHCK",$J)
216 ;
217 S VALMCNT=0
218 ;
219 I $$CDSN D
220 .S VALMCNT=VALMCNT+1,VAR=""
221 .S FLD="Local/Duplicate station #s exist -- use DSTA"
222 .S VAR=$$SETFLD^VALM1(FLD,VAR,"MSG")
223 .D SET^VALM10(VALMCNT,VAR,VALMCNT)
224 ;
225 I $$CMVD D
226 .S VALMCNT=VALMCNT+1,VAR=""
227 .S FLD="INSTITUTION file not updated with NATIONAL data -- use AUTO"
228 .S VAR=$$SETFLD^VALM1(FLD,VAR,"MSG")
229 .D SET^VALM10(VALMCNT,VAR,VALMCNT)
230 ;
231 D:'VALMCNT
232 .S VAR="",FLD="CONGRATULATIONS!!! Update complete!"
233 .S VAR=$$SETFLD^VALM1(FLD,VAR,"MSG")
234 .D SET^VALM10(1,VAR,1)
235 ;
236 Q
237 ;
238FACTYP ;resolve duplicate facility types
239 ;
240 N FT,CNT,IEN,DA,DIE,DR
241 ;
242 S FT="",(CNT,IEN)=0
243 F S FT=$O(^DIC(4.1,"B",FT)) Q:FT="" D
244 .F S IEN=$O(^DIC(4.1,"B",FT,IEN)) Q:'IEN D
245 ..Q:$E(FT,1,2)="ZZ"
246 ..S CNT=CNT+1
247 ..Q:CNT<2
248 ..S DA=IEN,DIE=4.1
249 ..S DR=".01///ZZ"_$P($G(^DIC(4.1,+IEN,0)),U)
250 ..D ^DIE
251 .S CNT=0
252 ;
253 Q
254 ;
255STATE ;resolve duplicate states
256 ;
257 N STATE,CNT,IEN,DA,DIE,DR
258 ;
259 ;name
260 S STATE="",(CNT,IEN)=0
261 F S STATE=$O(^DIC(5,"B",STATE)) Q:STATE="" D
262 .F S IEN=$O(^DIC(5,"B",STATE,IEN)) Q:'IEN D
263 ..Q:$E(STATE,1,2)="ZZ"
264 ..S CNT=CNT+1
265 ..Q:CNT<2
266 ..S DA=IEN,DIE=5
267 ..S DR=".01///ZZ"_$P($G(^DIC(5,+IEN,0)),U)
268 ..D ^DIE
269 .S CNT=0
270 ;
271 ;abbreviation
272 S STATE="",(CNT,IEN)=0
273 F S STATE=$O(^DIC(5,"C",STATE)) Q:STATE="" Q:STATE D
274 .F S IEN=$O(^DIC(5,"C",STATE,IEN)) Q:'IEN D
275 ..Q:$E(STATE,1,2)="ZZ"
276 ..S CNT=CNT+1
277 ..Q:CNT<2
278 ..S DA=IEN,DIE=5
279 ..S DR="1///ZZ"_$P($G(^DIC(5,+IEN,0)),U,2)
280 ..D ^DIE
281 .S CNT=0
282 ;
283 Q
284 ;
285FTCLEAN ; -- add missing facility types
286 ;
287 N NAME,FULL,FDA
288 ;
289 S NAME=""
290 F S NAME=$O(^TMP("XUMF ARRAY",$J,NAME)) Q:NAME="" D
291 .S FULL=$P(^TMP("XUMF ARRAY",$J,NAME),U,3)
292 .D
293 ..K FDA
294 ..S FDA(4.1,"?+1,",.01)=NAME
295 ..S FDA(4.1,"?+1,",1)=FULL
296 ..S FDA(4.1,"?+1,",3)="N"
297 ..N NAME
298 ..D UPDATE^DIE("E","FDA",,"ERR")
299 ;
300 Q
301 ;
Note: See TracBrowser for help on using the repository browser.