145 lines
5.1 KiB
Mathematica
145 lines
5.1 KiB
Mathematica
XIPMAILA ;OOIFO/SO- SCAN COUNTY CODE(#5.13) FILE FOR EXCEPTIONS;7:33 AM 30 Dec 2005
|
|
;;8.0;KERNEL;**378**;Jul 10, 1995;Build 59
|
|
; Check file #5.13 v. file #5
|
|
N IEN,LN,ERR
|
|
S IEN=0,ERR=0,LN=1
|
|
S XIPM("A",LN)="Begin checking COUNTY CODE(#5.13) file...",LN=LN+1
|
|
F S IEN=$O(^XIP(5.13,IEN)) Q:'IEN D
|
|
. N STATE,COUNTY,D513,D,DIC,X,Y
|
|
. S X=^XIP(5.13,IEN,0)
|
|
. S STATE=$E(X,1,2)
|
|
. S COUNTY=$E(X,3,5)
|
|
. S D513=X
|
|
. S DIC="^DIC(5,",DIC(0)="FZ",D="C",X=STATE D IX^DIC ;State valid?
|
|
. I Y<1 S XIPM("A",LN)="VA STATE CODE: "_STATE_", is missing from the STATE(#5) file.",LN=LN+1,ERR=1 Q
|
|
. S STATE=+Y
|
|
. S DIC="^DIC(5,"_+STATE_",1,",DIC(0)="FZ",D="C",X=COUNTY D IX^DIC ;County in State file?
|
|
. 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
|
|
. S COUNTY=+Y
|
|
. ;
|
|
. ;Is there a ZIP code associated with this FIPS?
|
|
. I '$D(^XIP(5.12,"AC",IEN)) D
|
|
.. I $P(D513,U,4)'="" Q ;Inactive FIPS code
|
|
.. N I,DATA,FLAG S FLAG=0
|
|
.. ;
|
|
FIPS .. ;Is this FIPS an exception?
|
|
.. 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
|
|
.. I 'FLAG D S ERR=1 Q
|
|
... 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
|
|
... S XIPM("A",LN)=" Setting INACTIVE DATE to: "_$$FMTE^XLFDT($G(DT)),LN=LN+1
|
|
... N DIERR,ZERR
|
|
... S FDA(5.13,IEN_",",3)=$G(DT)
|
|
... D FILE^DIE("","FDA","ZERR") ;Set INACTIVE DATE in file 5.13
|
|
... I 'STATE Q
|
|
... I 'COUNTY Q
|
|
... K FDA
|
|
... S FDA(5.01,STATE_","_COUNTY_",",5)=$G(DT)
|
|
... D FILE^DIE("","FDA","ZERR") ;Set INACTIVE DATE in file 5, sub-file 5.01
|
|
... Q
|
|
.. Q
|
|
. Q
|
|
EXIT I 'ERR S XIPM("A",LN)="No problems found."
|
|
Q
|
|
;
|
|
; File #5.13 Data exceptions
|
|
E513 ;FIPS^COUNTY^STATE
|
|
;;12025^DADE^FLORIDA
|
|
;;15005^KALAWAO^HAWAII
|
|
;;30113^YELLOWSTONE NATIONAL PARK^MONTANA
|
|
;;51515^BEDFORD (CITY)^VIRGINIA
|
|
;;51595^EMPORIA (CITY)^VIRGINIA
|
|
;;51560^CLIFTON FORGE (CITY)^VIRGINIA
|
|
;;58260^ALBERTA^ALBERTA
|
|
;;59260^BRITISH COLUMBIA^BRITISH COLUMBIA
|
|
;;60010^EASTERN (DISTRICT)^AMERICAN SAMOA
|
|
;;60020^MANU'A (DISTRICT)^AMERICAN SAMOA
|
|
;;60030^ROSE ISLAND^AMERICAN SAMOA
|
|
;;60040^SWAINS ISLAND^AMERICAN SAMOA
|
|
;;61260^MANITOBA^MANITOBA
|
|
;;62260^NEW BRUNSWICK^NEW BRUNSWICK
|
|
;;63260^NEWFOUNDLAND^NEWFOUNDLAND
|
|
;;64002^CHUUK^FEDERATED STATES OF MICRONESIA
|
|
;;64005^KOSRAE^FEDERATED STATES OF MICRONESIA
|
|
;;64040^POHNPEI^FEDERATED STATES OF MICRONESIA
|
|
;;64060^YAP^FEDERATED STATES OF MICRONESIA
|
|
;;65260^NOVA SCOTIA^NOVA SCOTIA
|
|
;;68007^AILINGINAE^MARSHALL ISLANDS
|
|
;;68010^AILINGLAPLAP^MARSHALL ISLANDS
|
|
;;68030^AILUK^MARSHALL ISLANDS
|
|
;;68040^ARNO^MARSHALL ISLANDS
|
|
;;68050^AUR^MARSHALL ISLANDS
|
|
;;68060^BIKAR^MARSHALL ISLANDS
|
|
;;68070^BIKINI^MARSHALL ISLANDS
|
|
;;68073^BOKAK^MARSHALL ISLANDS
|
|
;;68080^EBON^MARSHALL ISLANDS
|
|
;;68090^ENEWETAK^MARSHALL ISLANDS
|
|
;;68100^ERIKUB^MARSHALL ISLANDS
|
|
;;68110^JABAT^MARSHALL ISLANDS
|
|
;;68120^JALUIT^MARSHALL ISLANDS
|
|
;;68130^JEMO^MARSHALL ISLANDS
|
|
;;68140^KILI^MARSHALL ISLANDS
|
|
;;68150^KWAJALEIN^MARSHALL ISLANDS
|
|
;;68160^LAE^MARSHALL ISLANDS
|
|
;;68170^LIB^MARSHALL ISLANDS
|
|
;;68180^LIKIEP^MARSHALL ISLANDS
|
|
;;68190^MAJURO^MARSHALL ISLANDS
|
|
;;68300^MALOELAP^MARSHALL ISLANDS
|
|
;;68310^MEJIT^MARSHALL ISLANDS
|
|
;;68320^MILI^MARSHALL ISLANDS
|
|
;;68330^NAMORIK^MARSHALL ISLANDS
|
|
;;68340^NAMU^MARSHALL ISLANDS
|
|
;;68350^RONGELAP^MARSHALL ISLANDS
|
|
;;68360^RONGRIK^MARSHALL ISLANDS
|
|
;;68385^TOKE^MARSHALL ISLANDS
|
|
;;68390^UJAE^MARSHALL ISLANDS
|
|
;;68400^UJELANG^MARSHALL ISLANDS
|
|
;;68410^UTRIK^MARSHALL ISLANDS
|
|
;;68420^WOTHO^MARSHALL ISLANDS
|
|
;;68430^WOTJE^MARSHALL ISLANDS
|
|
;;69085^NORTHERN ISLANDS^NORTHERN MARIANA ISLANDS
|
|
;;69100^ROTA^NORTHERN MARIANA ISLANDS
|
|
;;69110^SAIPAN^NORTHERN MARIANA ISLANDS
|
|
;;69120^TINIAN^NORTHERN MARIANA ISLANDS
|
|
;;70002^AIMELIIK^PALAU
|
|
;;70004^AIRAI^PALAU
|
|
;;70010^ANGAUR^PALAU
|
|
;;70050^HATOBOHEI^PALAU
|
|
;;70100^KAYANGEL^PALAU
|
|
;;70150^KOROR^PALAU
|
|
;;70212^MELEKEOK^PALAU
|
|
;;70214^NGARAARD^PALAU
|
|
;;70218^NGARCHELONG^PALAU
|
|
;;70222^NGARDMAU^PALAU
|
|
;;70224^NGATPANG^PALAU
|
|
;;70226^NGCHESAR^PALAU
|
|
;;70227^NGEREMLENGUI^PALAU
|
|
;;70228^NGIWAL^PALAU
|
|
;;70350^PELELIU^PALAU
|
|
;;70370^SONSOROL^PALAU
|
|
;;73260^NORTHWEST TERRITORIES^NORTHWEST TERRITORIES
|
|
;;74050^BAKER ISLAND^U.S. MINOR OUTLYING ISLANDS
|
|
;;74100^HOWLAND ISLAND^U.S. MINOR OUTLYING ISLANDS
|
|
;;74150^JARVIS ISLAND^U.S. MINOR OUTLYING ISLANDS
|
|
;;74200^JOHNSTON ISLAND^U.S. MINOR OUTLYING ISLANDS
|
|
;;74250^KINGMAN REEF^U.S. MINOR OUTLYING ISLANDS
|
|
;;74300^MIDWAY ISLANDS^U.S. MINOR OUTLYING ISLANDS
|
|
;;74350^NAVASSA ISLAND^U.S. MINOR OUTLYING ISLANDS
|
|
;;74400^PALMYRA ATOLL^U.S. MINOR OUTLYING ISLANDS
|
|
;;74450^WAKE ISLAND^U.S. MINOR OUTLYING ISLANDS
|
|
;;75260^ONTARIO^ONTARIO
|
|
;;77260^PRINCE EDWARD ISLAND^PRINCE EDWARD ISLAND
|
|
;;80260^QUEBEC^QUEBEC
|
|
;;82260^SASKATCHEWAN^SASKATCHEWAN
|
|
;;83260^YUKON TERRITORY^YUKON TERRITORY
|
|
;;85260^ARMED FORCES AMER (EXC CA^ARMED FORCES AMER (EXC CANADA)
|
|
;;87000^ARMED FORCES^ARMED FORCES AF,EU,ME,CA
|
|
;;87260^ARMED FORCES AF,EU,ME,CA^ARMED FORCES AF,EU,ME,CA
|
|
;;88260^ARMED FORCES PACIFIC^ARMED FORCES PACIFIC
|
|
;;90999^ALL OTHER FOREIGN^FOREIGN COUNTRY
|
|
;;91260^CANADA^CANADA
|
|
;;92595^MEXICO^MEXICO
|
|
;;93999^EUROPE^EUROPE
|
|
;;94260^NUNAVUT PROVINCE^NUNAVUT PROVINCE
|
|
;;96725^PHILIPINES^PHILIPPINES
|
|
;;EOD^EOD^EOD
|