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/XIPMAILA.m@ 1185

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

initial load of FOIAVistA 6/30/08 version

File size: 5.1 KB
Line 
1XIPMAILA ;OOIFO/SO- SCAN COUNTY CODE(#5.13) FILE FOR EXCEPTIONS;7:33 AM 30 Dec 2005
2 ;;8.0;KERNEL;**378**;Jul 10, 1995;Build 59
3 ; Check file #5.13 v. file #5
4 N IEN,LN,ERR
5 S IEN=0,ERR=0,LN=1
6 S XIPM("A",LN)="Begin checking COUNTY CODE(#5.13) file...",LN=LN+1
7 F S IEN=$O(^XIP(5.13,IEN)) Q:'IEN D
8 . N STATE,COUNTY,D513,D,DIC,X,Y
9 . S X=^XIP(5.13,IEN,0)
10 . S STATE=$E(X,1,2)
11 . S COUNTY=$E(X,3,5)
12 . S D513=X
13 . S DIC="^DIC(5,",DIC(0)="FZ",D="C",X=STATE D IX^DIC ;State valid?
14 . I Y<1 S XIPM("A",LN)="VA STATE CODE: "_STATE_", is missing from the STATE(#5) file.",LN=LN+1,ERR=1 Q
15 . S STATE=+Y
16 . S DIC="^DIC(5,"_+STATE_",1,",DIC(0)="FZ",D="C",X=COUNTY D IX^DIC ;County in State file?
17 . I Y<1 S XIPM("A",LN)="VA COUNTY CODE: "_COUNTY_", is missing from STATE: "_$P(^DIC(5,+STATE,0),U),LN=LN+1,ERR=1 Q
18 . S COUNTY=+Y
19 . ;
20 . ;Is there a ZIP code associated with this FIPS?
21 . I '$D(^XIP(5.12,"AC",IEN)) D
22 .. I $P(D513,U,4)'="" Q ;Inactive FIPS code
23 .. N I,DATA,FLAG S FLAG=0
24 .. ;
25FIPS .. ;Is this FIPS an exception?
26 .. F I=1:1 S DATA=$T(E513+I),DATA=$P(DATA,";;",2) Q:DATA["EOD" S:$P(D513,U)=$P(DATA,U) FLAG=1
27 .. I 'FLAG D S ERR=1 Q
28 ... S XIPM("A",LN)="Invalid COUNTY CODE: "_$P(D513,U)_", County: "_$P(D513,U,2)_", State: "_$P(^DIC(5,+STATE,0),U),LN=LN+1
29 ... S XIPM("A",LN)=" Setting INACTIVE DATE to: "_$$FMTE^XLFDT($G(DT)),LN=LN+1
30 ... N DIERR,ZERR
31 ... S FDA(5.13,IEN_",",3)=$G(DT)
32 ... D FILE^DIE("","FDA","ZERR") ;Set INACTIVE DATE in file 5.13
33 ... I 'STATE Q
34 ... I 'COUNTY Q
35 ... K FDA
36 ... S FDA(5.01,STATE_","_COUNTY_",",5)=$G(DT)
37 ... D FILE^DIE("","FDA","ZERR") ;Set INACTIVE DATE in file 5, sub-file 5.01
38 ... Q
39 .. Q
40 . Q
41EXIT I 'ERR S XIPM("A",LN)="No problems found."
42 Q
43 ;
44 ; File #5.13 Data exceptions
45E513 ;FIPS^COUNTY^STATE
46 ;;12025^DADE^FLORIDA
47 ;;15005^KALAWAO^HAWAII
48 ;;30113^YELLOWSTONE NATIONAL PARK^MONTANA
49 ;;51515^BEDFORD (CITY)^VIRGINIA
50 ;;51595^EMPORIA (CITY)^VIRGINIA
51 ;;51560^CLIFTON FORGE (CITY)^VIRGINIA
52 ;;58260^ALBERTA^ALBERTA
53 ;;59260^BRITISH COLUMBIA^BRITISH COLUMBIA
54 ;;60010^EASTERN (DISTRICT)^AMERICAN SAMOA
55 ;;60020^MANU'A (DISTRICT)^AMERICAN SAMOA
56 ;;60030^ROSE ISLAND^AMERICAN SAMOA
57 ;;60040^SWAINS ISLAND^AMERICAN SAMOA
58 ;;61260^MANITOBA^MANITOBA
59 ;;62260^NEW BRUNSWICK^NEW BRUNSWICK
60 ;;63260^NEWFOUNDLAND^NEWFOUNDLAND
61 ;;64002^CHUUK^FEDERATED STATES OF MICRONESIA
62 ;;64005^KOSRAE^FEDERATED STATES OF MICRONESIA
63 ;;64040^POHNPEI^FEDERATED STATES OF MICRONESIA
64 ;;64060^YAP^FEDERATED STATES OF MICRONESIA
65 ;;65260^NOVA SCOTIA^NOVA SCOTIA
66 ;;68007^AILINGINAE^MARSHALL ISLANDS
67 ;;68010^AILINGLAPLAP^MARSHALL ISLANDS
68 ;;68030^AILUK^MARSHALL ISLANDS
69 ;;68040^ARNO^MARSHALL ISLANDS
70 ;;68050^AUR^MARSHALL ISLANDS
71 ;;68060^BIKAR^MARSHALL ISLANDS
72 ;;68070^BIKINI^MARSHALL ISLANDS
73 ;;68073^BOKAK^MARSHALL ISLANDS
74 ;;68080^EBON^MARSHALL ISLANDS
75 ;;68090^ENEWETAK^MARSHALL ISLANDS
76 ;;68100^ERIKUB^MARSHALL ISLANDS
77 ;;68110^JABAT^MARSHALL ISLANDS
78 ;;68120^JALUIT^MARSHALL ISLANDS
79 ;;68130^JEMO^MARSHALL ISLANDS
80 ;;68140^KILI^MARSHALL ISLANDS
81 ;;68150^KWAJALEIN^MARSHALL ISLANDS
82 ;;68160^LAE^MARSHALL ISLANDS
83 ;;68170^LIB^MARSHALL ISLANDS
84 ;;68180^LIKIEP^MARSHALL ISLANDS
85 ;;68190^MAJURO^MARSHALL ISLANDS
86 ;;68300^MALOELAP^MARSHALL ISLANDS
87 ;;68310^MEJIT^MARSHALL ISLANDS
88 ;;68320^MILI^MARSHALL ISLANDS
89 ;;68330^NAMORIK^MARSHALL ISLANDS
90 ;;68340^NAMU^MARSHALL ISLANDS
91 ;;68350^RONGELAP^MARSHALL ISLANDS
92 ;;68360^RONGRIK^MARSHALL ISLANDS
93 ;;68385^TOKE^MARSHALL ISLANDS
94 ;;68390^UJAE^MARSHALL ISLANDS
95 ;;68400^UJELANG^MARSHALL ISLANDS
96 ;;68410^UTRIK^MARSHALL ISLANDS
97 ;;68420^WOTHO^MARSHALL ISLANDS
98 ;;68430^WOTJE^MARSHALL ISLANDS
99 ;;69085^NORTHERN ISLANDS^NORTHERN MARIANA ISLANDS
100 ;;69100^ROTA^NORTHERN MARIANA ISLANDS
101 ;;69110^SAIPAN^NORTHERN MARIANA ISLANDS
102 ;;69120^TINIAN^NORTHERN MARIANA ISLANDS
103 ;;70002^AIMELIIK^PALAU
104 ;;70004^AIRAI^PALAU
105 ;;70010^ANGAUR^PALAU
106 ;;70050^HATOBOHEI^PALAU
107 ;;70100^KAYANGEL^PALAU
108 ;;70150^KOROR^PALAU
109 ;;70212^MELEKEOK^PALAU
110 ;;70214^NGARAARD^PALAU
111 ;;70218^NGARCHELONG^PALAU
112 ;;70222^NGARDMAU^PALAU
113 ;;70224^NGATPANG^PALAU
114 ;;70226^NGCHESAR^PALAU
115 ;;70227^NGEREMLENGUI^PALAU
116 ;;70228^NGIWAL^PALAU
117 ;;70350^PELELIU^PALAU
118 ;;70370^SONSOROL^PALAU
119 ;;73260^NORTHWEST TERRITORIES^NORTHWEST TERRITORIES
120 ;;74050^BAKER ISLAND^U.S. MINOR OUTLYING ISLANDS
121 ;;74100^HOWLAND ISLAND^U.S. MINOR OUTLYING ISLANDS
122 ;;74150^JARVIS ISLAND^U.S. MINOR OUTLYING ISLANDS
123 ;;74200^JOHNSTON ISLAND^U.S. MINOR OUTLYING ISLANDS
124 ;;74250^KINGMAN REEF^U.S. MINOR OUTLYING ISLANDS
125 ;;74300^MIDWAY ISLANDS^U.S. MINOR OUTLYING ISLANDS
126 ;;74350^NAVASSA ISLAND^U.S. MINOR OUTLYING ISLANDS
127 ;;74400^PALMYRA ATOLL^U.S. MINOR OUTLYING ISLANDS
128 ;;74450^WAKE ISLAND^U.S. MINOR OUTLYING ISLANDS
129 ;;75260^ONTARIO^ONTARIO
130 ;;77260^PRINCE EDWARD ISLAND^PRINCE EDWARD ISLAND
131 ;;80260^QUEBEC^QUEBEC
132 ;;82260^SASKATCHEWAN^SASKATCHEWAN
133 ;;83260^YUKON TERRITORY^YUKON TERRITORY
134 ;;85260^ARMED FORCES AMER (EXC CA^ARMED FORCES AMER (EXC CANADA)
135 ;;87000^ARMED FORCES^ARMED FORCES AF,EU,ME,CA
136 ;;87260^ARMED FORCES AF,EU,ME,CA^ARMED FORCES AF,EU,ME,CA
137 ;;88260^ARMED FORCES PACIFIC^ARMED FORCES PACIFIC
138 ;;90999^ALL OTHER FOREIGN^FOREIGN COUNTRY
139 ;;91260^CANADA^CANADA
140 ;;92595^MEXICO^MEXICO
141 ;;93999^EUROPE^EUROPE
142 ;;94260^NUNAVUT PROVINCE^NUNAVUT PROVINCE
143 ;;96725^PHILIPINES^PHILIPPINES
144 ;;EOD^EOD^EOD
Note: See TracBrowser for help on using the repository browser.