VistA-FOIAVistA/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

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