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