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/XU8P378A.m@ 1800

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

initial load of WorldVistAEHR

File size: 6.0 KB
Line 
1XU8P378A ;OOIFO/SO- XU378 POST-INSTALL ;6:00 AM 7 Mar 2006
2 ;;8.0;KERNEL;**378**;Jul 10, 1995;Build 59
3E5 ; Edit State file first
4 D MES^XPDUTL("Begin STATE(#5) file update...")
5 I '$$FIND1^DIC(.11,"","X","ADUALC","IX") D
6 . N DIK
7 . K ^DIC(5,"C")
8 . S DIK="^DIC(5,"
9 . S DIK(1)="1^C"
10 . D ENALL^DIK
11 . S DIK(1)="2^C"
12 . D ENALL^DIK
13 ;
14 N I,DATA,TBL
15 F I=1:1 S DATA=$T(D5+I) Q:$P(DATA,";;",2)["EOD" D
16 . S DATA=$P(DATA,";;",2)
17 . N DIC,Y,VAC,STATE,ABB,DLAYGO,AAC,USP
18 . S VAC=$P(DATA,U,1)
19 . S STATE=$P(DATA,U,2)
20 . S ABB=$P(DATA,U,3)
21 . S AAC=$P(DATA,U,4)
22 . S USP=$P(DATA,U,5)
23 . S DIC="^DIC(5,",DIC(0)="FZX",D="C",X=VAC D IX^DIC
24 . I Y<0 Q
25 . N X,X1
26 . S X=Y(0)
27 . S X1=$P(X,U,3)_U_$P(X,U,1)_U_$P(X,U,2)
28T1 . I $P(DATA,U,1,3)'=X1 Q
29 . N DIE,DA,DR
30 . S DIE="^DIC(5,"
31 . S DA=+Y
32 . S DR="2.1///^S X=AAC;2.2///^S X=USP"
33 . F L +^DIC(5,DA,0):1 Q:$T H 5
34 . D ^DIE
35 . L -^DIC(5,DA,0)
36 . S TBL(VAC)=""
37 . Q
38 ;
39 ; Flag all entries not previously found as non-AAC
40 N IEN S IEN=0
41 F S IEN=$O(^DIC(5,IEN)) Q:'IEN D
42 . N X
43 . S X=$P(^DIC(5,IEN,0),U,3)
44 . I X'="",$D(TBL(X)) Q
45 . N DIE,DA,DR
46 . S DIE="^DIC(5,"
47 . S DA=IEN
48 . S DR="2.1///0;2.2///0"
49 . F L +^DIC(5,DA,0):1 Q:$T H 5
50 . D ^DIE
51 . L -^DIC(5,DA,0)
52 . Q
53 D MES^XPDUTL("Finished STATE(#5) file update.")
54 ;
55E513 ; Edit 5.13
56 D MES^XPDUTL("Begin COUNTY CODE(#5.13) file corrections...")
57 N I,DATA
58 F I=1:1 S DATA=$T(D513+I) Q:$P(DATA,";;",2)["EOD" D
59 . S DATA=$P(DATA,";;",2)
60 . N CODE,COUNTY,STATE,DIC,D
61 . S CODE=$P(DATA,U,1)
62 . S COUNTY=$E($P(DATA,U,2),1,25)
63 . S STATE=$P(DATA,U,3)
64 . S DIC="^XIP(5.13,",DIC(0)="FZX",D="B",X=CODE D IX^DIC
65 . I Y<1 D
66 .. N DLAYGO,DIC
67 .. S DLAYGO=5.13,DIC="^XIP(5.13,",DIC(0)="L"
68 .. S X=CODE
69 .. D FILE^DICN
70 .. Q
71 . N DIE,DA,DR
72 . S DIE="^XIP(5.13,",DA=+Y
73 . S DR="1///^S X=COUNTY;2///^S X=STATE"
74 . F L +^XIP(5.13,DA,0):1 Q:$T H 5
75 . D ^DIE
76 . L -^XIP(5.13,DA,0)
77 . Q
78 D MES^XPDUTL("Finished COUNTY CODE(#5.13) file corrections.")
79 ;
80P513 ; Fix any broken State pointers in 5.13
81 D MES^XPDUTL("Begin COUNTY CODE(#5.13) file pointer corrections...")
82 N IEN S IEN=0
83 F S IEN=$O(^XIP(5.13,IEN)) Q:'IEN D
84 . N FIPS S FIPS=$E($P(^XIP(5.13,IEN,0),U),1,2)
85 . N DIC
86 . S DIC="^DIC(5,",DIC(0)="FZX",D="C",X=FIPS D IX^DIC
87 . I Y<1 Q
88 . N STATE S STATE=$P(Y,U,2)
89 . N DIE,DA,DR
90 . S DIE="^XIP(5.13,"
91 . S DA=IEN
92 . F L +^XIP(5.13,DA,0):1 Q:$T H 5
93 . S DR="2///^S X=STATE"
94 . L -^XIP(5.13,DA,0)
95 . D ^DIE
96 . Q
97 D MES^XPDUTL("Finished COUNTY CODE(#5.13) file pointer corrections...")
98 ;
99 Q
100 ;
101D5 ;VA STATE CODE^NAME^ABBREVIATION^AAC RECOGNIZED^US STATE OR POSSESSION
102 ;;01^ALABAMA^AL^1^1
103 ;;02^ALASKA^AK^1^1
104 ;;58^ALBERTA^AB^1^0
105 ;;60^AMERICAN SAMOA^AS^1^1
106 ;;04^ARIZONA^AZ^1^1
107 ;;05^ARKANSAS^AR^1^1
108 ;;87^ARMED FORCES AF,EU,ME,CA^AE^1^1
109 ;;85^ARMED FORCES AMER (EXC CANADA)^AA^1^1
110 ;;88^ARMED FORCES PACIFIC^AP^1^1
111 ;;59^BRITISH COLUMBIA^BC^1^0
112 ;;06^CALIFORNIA^CA^1^1
113 ;;91^CANADA^CANAD^0^0
114 ;;08^COLORADO^CO^1^1
115 ;;09^CONNECTICUT^CT^1^1
116 ;;10^DELAWARE^DE^1^1
117 ;;11^DISTRICT OF COLUMBIA^DC^1^1
118 ;;93^EUROPE^EU^1^0
119 ;;64^FEDERATED STATES OF MICRONESIA^FM^1^1
120 ;;12^FLORIDA^FL^1^1
121 ;;90^FOREIGN COUNTRY^FG^1^0
122 ;;13^GEORGIA^GA^1^1
123 ;;66^GUAM^GU^1^1
124 ;;15^HAWAII^HI^1^1
125 ;;16^IDAHO^ID^1^1
126 ;;17^ILLINOIS^IL^1^1
127 ;;18^INDIANA^IN^1^1
128 ;;19^IOWA^IA^1^1
129 ;;20^KANSAS^KS^1^1
130 ;;21^KENTUCKY^KY^1^1
131 ;;22^LOUISIANA^LA^1^1
132 ;;23^MAINE^ME^1^1
133 ;;61^MANITOBA^MB^1^0
134 ;;68^MARSHALL ISLANDS^MH^1^1
135 ;;24^MARYLAND^MD^1^1
136 ;;25^MASSACHUSETTS^MA^1^1
137 ;;92^MEXICO^MX^1^0
138 ;;26^MICHIGAN^MI^1^1
139 ;;27^MINNESOTA^MN^1^1
140 ;;28^MISSISSIPPI^MS^1^1
141 ;;29^MISSOURI^MO^1^1
142 ;;30^MONTANA^MT^1^1
143 ;;31^NEBRASKA^NE^1^1
144 ;;32^NEVADA^NV^1^1
145 ;;62^NEW BRUNSWICK^NB^1^0
146 ;;33^NEW HAMPSHIRE^NH^1^1
147 ;;34^NEW JERSEY^NJ^1^1
148 ;;35^NEW MEXICO^NM^1^1
149 ;;36^NEW YORK^NY^1^1
150 ;;63^NEWFOUNDLAND^NF^1^0
151 ;;37^NORTH CAROLINA^NC^1^1
152 ;;38^NORTH DAKOTA^ND^1^1
153 ;;69^NORTHERN MARIANA ISLANDS^MP^1^1
154 ;;73^NORTHWEST TERRITORIES^NT^1^0
155 ;;65^NOVA SCOTIA^NS^1^0
156 ;;94^NUNAVUT PROVINCE^NU^1^0
157 ;;39^OHIO^OH^1^1
158 ;;40^OKLAHOMA^OK^1^1
159 ;;75^ONTARIO^ON^1^0
160 ;;41^OREGON^OR^1^1
161 ;;70^PALAU^PW^1^0
162 ;;42^PENNSYLVANIA^PA^1^1
163 ;;96^PHILIPPINES^PH^1^0
164 ;;77^PRINCE EDWARD ISLAND^PE^1^0
165 ;;72^PUERTO RICO^PR^1^1
166 ;;80^QUEBEC^QC^1^0
167 ;;44^RHODE ISLAND^RI^1^1
168 ;;82^SASKATCHEWAN^SK^1^0
169 ;;45^SOUTH CAROLINA^SC^1^1
170 ;;46^SOUTH DAKOTA^SD^1^1
171 ;;47^TENNESSEE^TN^1^1
172 ;;48^TEXAS^TX^1^1
173 ;;74^U.S. MINOR OUTLYING ISLANDS^UM^1^1
174 ;;49^UTAH^UT^1^1
175 ;;50^VERMONT^VT^1^1
176 ;;78^VIRGIN ISLANDS^VI^1^1
177 ;;51^VIRGINIA^VA^1^1
178 ;;53^WASHINGTON^WA^1^1
179 ;;54^WEST VIRGINIA^WV^1^1
180 ;;55^WISCONSIN^WI^1^1
181 ;;56^WYOMING^WY^1^1
182 ;;83^YUKON TERRITORY^YT^1^0
183 ;;99999^EOD^EOD^EOD^EOD
184 ;
185D513 ;FIPS CODE^COUNTY NAME^STATE
186 ;;17183^VERMILION^ILLINOIS
187 ;;29186^ST. GENEVIEVE^MISSOURI
188 ;;58260^ALBERTA^ALBERTA
189 ;;87260^ARMED FORCES AF,EU,ME,CA^ARMED FORCES AF,EU,ME,CA
190 ;;87000^ARMED FORCES^ARMED FORCES AF,EU,ME,CA
191 ;;85260^ARMED FORCES AMER (EXC CANADA)^ARMED FORCES AMER (EXC CANADA)
192 ;;85000^ARMED FORCES^ARMED FORCES AMER (EXC CANADA)
193 ;;88260^ARMED FORCES PACIFIC^ARMED FORCES PACIFIC
194 ;;88000^ARMED FORCES^ARMED FORCES PACIFIC
195 ;;59260^BRITISH COLUMBIA^BRITISH COLUMBIA
196 ;;91260^CANADA^CANADA
197 ;;93999^EUROPE^EUROPE
198 ;;90999^ALL OTHER FOREIGN^FOREIGN COUNTRY
199 ;;61260^MANITOBA^MANITOBA
200 ;;92595^MEXICO^MEXICO
201 ;;62260^NEW BRUNSWICK^NEW BRUNSWICK
202 ;;63260^NEWFOUNDLAND^NEWFOUNDLAND
203 ;;73260^NORTHWEST TERRITORIES^NORTHWEST TERRITORIES
204 ;;65260^NOVA SCOTIA^NOVA SCOTIA
205 ;;94260^NUNAVUT PROVINCE^NUNAVUT PROVINCE
206 ;;75260^ONTARIO^ONTARIO
207 ;;96725^PHILIPINES^PHILIPPINES
208 ;;77260^PRINCE EDWARD ISLAND^PRINCE EDWARD ISLAND
209 ;;80260^QUEBEC^QUEBEC
210 ;;82260^SASKATCHEWAN^SASKATCHEWAN
211 ;;74200^JOHNSTON ISLAND^U.S. MINOR OUTLYING ISLANDS
212 ;;74300^MIDWAY ISLANDS^U.S. MINOR OUTLYING ISLANDS
213 ;;74450^WAKE ISLAND^U.S. MINOR OUTLYING ISLANDS
214 ;;74350^NAVASSA ISLAND^U.S. MINOR OUTLYING ISLANDS
215 ;;74050^BAKER ISLAND^U.S. MINOR OUTLYING ISLANDS
216 ;;74100^HOWLAND ISLAND^U.S. MINOR OUTLYING ISLANDS
217 ;;74150^JARVIS ISLAND^U.S. MINOR OUTLYING ISLANDS
218 ;;74250^KINGMAN REEF^U.S. MINOR OUTLYING ISLANDS
219 ;;74400^PALMYRA ATOLL^U.S. MINOR OUTLYING ISLANDS
220 ;;74999^ALL OTHER^U.S. MINOR OUTLYING ISLANDS
221 ;;83260^YUKON TERRITORY^YUKON TERRITORY
222 ;;99999^EOD^EOD
Note: See TracBrowser for help on using the repository browser.