source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XUMF4L1.m@ 701

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

initial load of WorldVistAEHR

File size: 4.9 KB
Line 
1XUMF4L1 ;OIFO-OAK/RAM - Load IMF ;02/21/02
2 ;;8.0;KERNEL;**217,261**;Jul 10, 1995
3 ;
4 ;
5EN ; -- entry point
6 ;
7 K ^TMP("XUMF ADD",$J),^TMP("XUMF MOD",$J),^TMP("XUMF DEL",$J)
8 ;
9 D DSN,GOLD,ASSC,HIST
10 ;
11 Q
12 ;
13DSN ; -- clean out local station numbers
14 ;
15 N IEN,DIE,DR,DA,XUMF,DIK
16 ;
17 S XUMF=1
18 ;
19 S IEN=0
20 F S IEN=$O(^DIC(4,IEN)) Q:'IEN D
21 .S STA=$P($G(^DIC(4,+IEN,99)),U) Q:STA=""
22 .Q:$D(^TMP("XUMF ARRAY",$J,STA))
23 .S ^TMP("XUMF DEL",$J,STA,IEN)=""
24 .S DR="99///@",DIE=4,DA=IEN
25 .D
26 ..N IEN D ^DIE
27 ;
28 S STA="",IEN=0
29 F S STA=$O(^DIC(4,"D",STA)) Q:STA="" D
30 .F S IEN=$O(^DIC(4,"D",STA,IEN)) Q:'IEN D
31 ..Q:$P($G(^DIC(4,+IEN,99)),U)=STA
32 ..K ^DIC(4,"D",STA,IEN)
33 ;
34 S DIK="^DIC(4,",DIK(1)="99^D" D ENALL^DIK
35 ;
36 Q
37 ;
38GOLD ; -- add missing national data from standard table
39 ;
40 N STA,NAME,FDA,ERROR,IEN,IENS,X,FLAG,CNT
41 N OLDNAME,OLDVANM,STATE,FACTYP,XUMF,AGENCY
42 ;
43 S XUMF=1
44 ;
45 S STA="",CNT=0
46 F S STA=$O(^TMP("XUMF ARRAY",$J,STA)) Q:STA="" D
47 .S X=^TMP("XUMF ARRAY",$J,STA)
48 .S IEN=$O(^DIC(4,"D",STA,0))
49 .S:'IEN ^TMP("XUMF ADD",$J,STA)=^TMP("XUMF ARRAY",$J,STA)
50 .D:IEN MOD
51 .S OLDNAME=$P($G(^DIC(4,+IEN,0)),U,1)
52 .S OLDVANM=$P($G(^DIC(4,+IEN,99)),U,3)
53 .S IENS=$S(IEN:IEN_",",1:"+1,")
54 .S NAME=$P(X,U,2)
55 .S FACTYP=$P(X,U,5)
56 .S VANAME=$P(X,U,6)
57 .S FLAG=$P(X,U,7)
58 .S STATE=$P(X,U,8)
59 .S AGENCY=$P(X,U,17)
60 .K FDA
61 .S FDA(4,IENS,.01)=NAME
62 .S FDA(4,IENS,.02)=STATE
63 .S FDA(4,IENS,99)=STA
64 .S FDA(4,IENS,11)="National"
65 .S FDA(4,IENS,13)=$P(FACTYP,"~")
66 .S FDA(4,IENS,100)=VANAME
67 .S FDA(4,IENS,101)=FLAG
68 .S FDA(4,IENS,95)=$P(AGENCY,"~")
69 .D
70 ..N IEN,STA,NAME,VANAME,OLDNAME,OLDVANM
71 ..D UPDATE^DIE("E","FDA",,"ERR")
72 .I 'IEN S IEN=$O(^DIC(4,"D",STA,0))
73 .Q:'IEN
74 .I OLDNAME="" Q
75 .I OLDNAME=NAME,VANAME=OLDVANM Q
76 .S IENS="?+"_DT_","_IEN_","
77 .K FDA
78 .S FDA(4.999,IENS,.01)=DT
79 .S:NAME'=OLDNAME FDA(4.999,IENS,.02)=OLDNAME
80 .S:VANAME'=OLDVANM FDA(4.999,IENS,.03)=OLDVANM
81 .D
82 ..N STA
83 ..D UPDATE^DIE("E","FDA")
84 ..S CNT=CNT+1
85 ;
86 Q
87 ;
88ASSC ; -- populate associations (parent facility and VISN)
89 ;
90 N IEN,STA,VISN,PARENT,FDA,XUMF,CNT
91 ;
92 S XUMF=1
93 ;
94 S STA="",CNT=0
95 F S STA=$O(^TMP("XUMF ARRAY",$J,STA)) Q:STA="" D
96 .S IEN=$O(^DIC(4,"D",STA,0)) Q:'IEN
97 .S VISN=$P(^TMP("XUMF ARRAY",$J,STA),U,9)
98 .I VISN'="" D
99 ..K FDA
100 ..S IENS="?+1,"_IEN_","
101 ..S FDA(4.014,IENS,.01)="VISN"
102 ..S FDA(4.014,IENS,1)=$P(VISN,"~")
103 ..D
104 ...N IEN,STA
105 ...D UPDATE^DIE("E","FDA")
106 .S PARENT=$P(^TMP("XUMF ARRAY",$J,STA),U,10)
107 .I PARENT'="" D
108 ..K FDA
109 ..S IENS="?+2,"_IEN_","
110 ..S FDA(4.014,IENS,.01)="PARENT FACILITY"
111 ..S FDA(4.014,IENS,1)=PARENT
112 ..D
113 ...N IEN,STA
114 ...D UPDATE^DIE("E","FDA")
115 ...S CNT=CNT+1
116 ;
117 Q
118 ;
119HIST ; -- history
120 ;
121 N IEN,STA,EFFDT,FDA,XUMF,CNT
122 ;
123 S XUMF=1
124 ;
125 S STA="",CNT=0
126 F S STA=$O(^TMP("XUMF ARRAY",$J,STA)) Q:STA="" D
127 .S IEN=$O(^DIC(4,"D",STA,0)) Q:'IEN
128 .S EFFDT=$P(^TMP("XUMF ARRAY",$J,STA),U,11)
129 .S EFFDT=$$FMDATE^HLFNC(+EFFDT)
130 .I EFFDT D
131 ..S IENS="?+"_EFFDT_","_IEN_","
132 ..K FDA
133 ..S FDA(4.999,IENS,.01)=EFFDT
134 ..S FDA(4.999,IENS,.06)=$P(^TMP("XUMF ARRAY",$J,STA),U,12)
135 ..D
136 ...N IEN,STA
137 ...D UPDATE^DIE("E","FDA")
138 .S EFFDT=$P(^TMP("XUMF ARRAY",$J,STA),U,13)
139 .S EFFDT=$$FMDATE^HLFNC(+EFFDT)
140 .I EFFDT D
141 ..S IENS="?+"_EFFDT_","_IEN_","
142 ..K FDA
143 ..S FDA(4.999,IENS,.01)=EFFDT
144 ..S FDA(4.999,IENS,.05)=$P(^TMP("XUMF ARRAY",$J,STA),U,14)
145 ..D
146 ...N IEN,STA
147 ...D UPDATE^DIE("E","FDA")
148 ...S CNT=CNT+1
149 ;
150 Q
151 ;
152CDSN() ; -- check for duplicate sta # (true=duplicates, false=none)
153 ;
154 K ^TMP("XUMF TMP",$J)
155 ;
156 N IEN,STA,CNT
157 ;
158 S STA="",IEN=0
159 F S STA=$O(^DIC(4,"D",STA)) Q:STA="" D
160 .F S IEN=$O(^DIC(4,"D",STA,IEN)) Q:'IEN D
161 ..S ^TMP("XUMF TMP",$J,STA,IEN)=$P(^DIC(4,IEN,0),U)
162 ;
163 S STA="",(CNT,IEN)=0
164 F S STA=$O(^TMP("XUMF TMP",$J,STA)) Q:STA="" D
165 .Q:'$O(^TMP("XUMF TMP",$J,STA,+$O(^TMP("XUMF TMP",$J,STA,0))))
166 .F S IEN=$O(^TMP("XUMF TMP",$J,STA,IEN)) Q:'IEN D
167 ..S CNT=CNT+1
168 ;
169 K ^TMP("XUMF TMP",$J)
170 ;
171 Q CNT
172 ;
173MOD ; if entry modified set TMP
174 ;
175 N NAME,FACTYP,VANAME,STANUM,FLAG,PRNT,VISN,STATE,X,Y
176 ;
177 Q:'$D(^DIC(4,+IEN,0))
178 ;
179 S X=$P(^TMP("XUMF ARRAY",$J,STA),U,2,10)
180 ;
181 S NAME=$P($G(^DIC(4,+IEN,0)),U)
182 S FACTYP=$P($G(^DIC(4.1,+$G(^DIC(4,+IEN,3)),0)),U)
183 S:FACTYP'="" FACTYP=FACTYP_"~FACILITY TYPE~VA"
184 S VANAME=$P($G(^DIC(4,+IEN,99)),U,3)
185 S STANUM=$P($G(^DIC(4,+IEN,99)),U)
186 S FLAG=$S(+$P($G(^DIC(4,+IEN,99)),U,4):"INACTIVE",1:"")
187 S PRNT=$P($G(^DIC(4,+$P($G(^DIC(4,+IEN,7,2,0)),U,2),99)),U)
188 S VISN=$P($G(^DIC(4,+$P($G(^DIC(4,+IEN,7,1,0)),U,2),0)),U)
189 S:VISN'="" VISN=VISN_"~VISN~VA"
190 S STATE=$P($G(^DIC(5,+$P($G(^DIC(4,+IEN,0)),U,2),0)),U)
191 ;
192 S Y=NAME_U_STANUM_U_"National"_U_FACTYP_U_VANAME_U_FLAG_U_STATE
193 S Y=Y_U_VISN_U_PRNT
194 ;
195 Q:Y=X
196 ;
197 S ^TMP("XUMF MOD",$J,STA,"NEW")=X
198 S ^TMP("XUMF MOD",$J,STA,"OLD")=Y
199 ;
200 Q
201 ;
202FTCLEAN ; -- add missing facility types
203 ;
204 N NAME,FULL,FDA
205 ;
206 S NAME=""
207 F S NAME=$O(^TMP("XUMF ARRAY",$J,NAME)) Q:NAME="" D
208 .S FULL=$P(^TMP("XUMF ARRAY",$J,NAME),U,3)
209 .D
210 ..K FDA
211 ..S FDA(4.1,"?+1,",.01)=NAME
212 ..S FDA(4.1,"?+1,",1)=FULL
213 ..S FDA(4.1,"?+1,",3)="N"
214 ..N NAME
215 ..D UPDATE^DIE("E","FDA",,"ERR")
216 ;
217 Q
218 ;
Note: See TracBrowser for help on using the repository browser.