Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XU8P378A

XU8P378A.m

Go to the documentation of this file.
XU8P378A ;OOIFO/SO- XU378 POST-INSTALL ;6:00 AM  7 Mar 2006
 ;;8.0;KERNEL;**378**;Jul 10, 1995;Build 59
E5 ; Edit State file first
 D MES^XPDUTL("Begin STATE(#5) file update...")
 I '$$FIND1^DIC(.11,"","X","ADUALC","IX") D
 . N DIK
 . K ^DIC(5,"C")
 . S DIK="^DIC(5,"
 . S DIK(1)="1^C"
 . D ENALL^DIK
 . S DIK(1)="2^C"
 . D ENALL^DIK
 ;
 N I,DATA,TBL
 F I=1:1 S DATA=$T(D5+I) Q:$P(DATA,";;",2)["EOD"  D
 . S DATA=$P(DATA,";;",2)
 . N DIC,Y,VAC,STATE,ABB,DLAYGO,AAC,USP
 . S VAC=$P(DATA,U,1)
 . S STATE=$P(DATA,U,2)
 . S ABB=$P(DATA,U,3)
 . S AAC=$P(DATA,U,4)
 . S USP=$P(DATA,U,5)
 . S DIC="^DIC(5,",DIC(0)="FZX",D="C",X=VAC D IX^DIC
 . I Y<0 Q
 . N X,X1
 . S X=Y(0)
 . S X1=$P(X,U,3)_U_$P(X,U,1)_U_$P(X,U,2)
T1 . I $P(DATA,U,1,3)'=X1 Q
 . N DIE,DA,DR
 . S DIE="^DIC(5,"
 . S DA=+Y
 . S DR="2.1///^S X=AAC;2.2///^S X=USP"
 . F  L +^DIC(5,DA,0):1 Q:$T  H 5
 . D ^DIE
 . L -^DIC(5,DA,0)
 . S TBL(VAC)=""
 . Q
 ;
 ; Flag all entries not previously found as non-AAC
 N IEN S IEN=0
 F  S IEN=$O(^DIC(5,IEN)) Q:'IEN  D
 . N X
 . S X=$P(^DIC(5,IEN,0),U,3)
 . I X'="",$D(TBL(X)) Q
 . N DIE,DA,DR
 . S DIE="^DIC(5,"
 . S DA=IEN
 . S DR="2.1///0;2.2///0"
 . F  L +^DIC(5,DA,0):1 Q:$T  H 5
 . D ^DIE
 . L -^DIC(5,DA,0)
 . Q
 D MES^XPDUTL("Finished STATE(#5) file update.")
 ;
E513 ; Edit 5.13
 D MES^XPDUTL("Begin COUNTY CODE(#5.13) file corrections...")
 N I,DATA
 F I=1:1 S DATA=$T(D513+I) Q:$P(DATA,";;",2)["EOD"  D
 . S DATA=$P(DATA,";;",2)
 . N CODE,COUNTY,STATE,DIC,D
 . S CODE=$P(DATA,U,1)
 . S COUNTY=$E($P(DATA,U,2),1,25)
 . S STATE=$P(DATA,U,3)
 . S DIC="^XIP(5.13,",DIC(0)="FZX",D="B",X=CODE D IX^DIC
 . I Y<1 D
 .. N DLAYGO,DIC
 .. S DLAYGO=5.13,DIC="^XIP(5.13,",DIC(0)="L"
 .. S X=CODE
 .. D FILE^DICN
 .. Q
 . N DIE,DA,DR
 . S DIE="^XIP(5.13,",DA=+Y
 . S DR="1///^S X=COUNTY;2///^S X=STATE"
 . F  L +^XIP(5.13,DA,0):1 Q:$T  H 5
 . D ^DIE
 . L -^XIP(5.13,DA,0)
 . Q
 D MES^XPDUTL("Finished COUNTY CODE(#5.13) file corrections.")
 ;
P513 ; Fix any broken State pointers in 5.13
 D MES^XPDUTL("Begin COUNTY CODE(#5.13) file pointer corrections...")
 N IEN S IEN=0
 F  S IEN=$O(^XIP(5.13,IEN)) Q:'IEN  D
 . N FIPS S FIPS=$E($P(^XIP(5.13,IEN,0),U),1,2)
 . N DIC
 . S DIC="^DIC(5,",DIC(0)="FZX",D="C",X=FIPS D IX^DIC
 . I Y<1 Q
 . N STATE S STATE=$P(Y,U,2)
 . N DIE,DA,DR
 . S DIE="^XIP(5.13,"
 . S DA=IEN
 . F  L +^XIP(5.13,DA,0):1 Q:$T  H 5
 . S DR="2///^S X=STATE"
 . L -^XIP(5.13,DA,0)
 . D ^DIE
 . Q
 D MES^XPDUTL("Finished COUNTY CODE(#5.13) file pointer corrections...")
 ;
 Q
 ;
D5 ;VA STATE CODE^NAME^ABBREVIATION^AAC RECOGNIZED^US STATE OR POSSESSION
 ;;01^ALABAMA^AL^1^1
 ;;02^ALASKA^AK^1^1
 ;;58^ALBERTA^AB^1^0
 ;;60^AMERICAN SAMOA^AS^1^1
 ;;04^ARIZONA^AZ^1^1
 ;;05^ARKANSAS^AR^1^1
 ;;87^ARMED FORCES AF,EU,ME,CA^AE^1^1
 ;;85^ARMED FORCES AMER (EXC CANADA)^AA^1^1
 ;;88^ARMED FORCES PACIFIC^AP^1^1
 ;;59^BRITISH COLUMBIA^BC^1^0
 ;;06^CALIFORNIA^CA^1^1
 ;;91^CANADA^CANAD^0^0
 ;;08^COLORADO^CO^1^1
 ;;09^CONNECTICUT^CT^1^1
 ;;10^DELAWARE^DE^1^1
 ;;11^DISTRICT OF COLUMBIA^DC^1^1
 ;;93^EUROPE^EU^1^0
 ;;64^FEDERATED STATES OF MICRONESIA^FM^1^1
 ;;12^FLORIDA^FL^1^1
 ;;90^FOREIGN COUNTRY^FG^1^0
 ;;13^GEORGIA^GA^1^1
 ;;66^GUAM^GU^1^1
 ;;15^HAWAII^HI^1^1
 ;;16^IDAHO^ID^1^1
 ;;17^ILLINOIS^IL^1^1
 ;;18^INDIANA^IN^1^1
 ;;19^IOWA^IA^1^1
 ;;20^KANSAS^KS^1^1
 ;;21^KENTUCKY^KY^1^1
 ;;22^LOUISIANA^LA^1^1
 ;;23^MAINE^ME^1^1
 ;;61^MANITOBA^MB^1^0
 ;;68^MARSHALL ISLANDS^MH^1^1
 ;;24^MARYLAND^MD^1^1
 ;;25^MASSACHUSETTS^MA^1^1
 ;;92^MEXICO^MX^1^0
 ;;26^MICHIGAN^MI^1^1
 ;;27^MINNESOTA^MN^1^1
 ;;28^MISSISSIPPI^MS^1^1
 ;;29^MISSOURI^MO^1^1
 ;;30^MONTANA^MT^1^1
 ;;31^NEBRASKA^NE^1^1
 ;;32^NEVADA^NV^1^1
 ;;62^NEW BRUNSWICK^NB^1^0
 ;;33^NEW HAMPSHIRE^NH^1^1
 ;;34^NEW JERSEY^NJ^1^1
 ;;35^NEW MEXICO^NM^1^1
 ;;36^NEW YORK^NY^1^1
 ;;63^NEWFOUNDLAND^NF^1^0
 ;;37^NORTH CAROLINA^NC^1^1
 ;;38^NORTH DAKOTA^ND^1^1
 ;;69^NORTHERN MARIANA ISLANDS^MP^1^1
 ;;73^NORTHWEST TERRITORIES^NT^1^0
 ;;65^NOVA SCOTIA^NS^1^0
 ;;94^NUNAVUT PROVINCE^NU^1^0
 ;;39^OHIO^OH^1^1
 ;;40^OKLAHOMA^OK^1^1
 ;;75^ONTARIO^ON^1^0
 ;;41^OREGON^OR^1^1
 ;;70^PALAU^PW^1^0
 ;;42^PENNSYLVANIA^PA^1^1
 ;;96^PHILIPPINES^PH^1^0
 ;;77^PRINCE EDWARD ISLAND^PE^1^0
 ;;72^PUERTO RICO^PR^1^1
 ;;80^QUEBEC^QC^1^0
 ;;44^RHODE ISLAND^RI^1^1
 ;;82^SASKATCHEWAN^SK^1^0
 ;;45^SOUTH CAROLINA^SC^1^1
 ;;46^SOUTH DAKOTA^SD^1^1
 ;;47^TENNESSEE^TN^1^1
 ;;48^TEXAS^TX^1^1
 ;;74^U.S. MINOR OUTLYING ISLANDS^UM^1^1
 ;;49^UTAH^UT^1^1
 ;;50^VERMONT^VT^1^1
 ;;78^VIRGIN ISLANDS^VI^1^1
 ;;51^VIRGINIA^VA^1^1
 ;;53^WASHINGTON^WA^1^1
 ;;54^WEST VIRGINIA^WV^1^1
 ;;55^WISCONSIN^WI^1^1
 ;;56^WYOMING^WY^1^1
 ;;83^YUKON TERRITORY^YT^1^0
 ;;99999^EOD^EOD^EOD^EOD
 ;
D513 ;FIPS CODE^COUNTY NAME^STATE
 ;;17183^VERMILION^ILLINOIS
 ;;29186^ST. GENEVIEVE^MISSOURI
 ;;58260^ALBERTA^ALBERTA
 ;;87260^ARMED FORCES AF,EU,ME,CA^ARMED FORCES AF,EU,ME,CA
 ;;87000^ARMED FORCES^ARMED FORCES AF,EU,ME,CA
 ;;85260^ARMED FORCES AMER (EXC CANADA)^ARMED FORCES AMER (EXC CANADA)
 ;;85000^ARMED FORCES^ARMED FORCES AMER (EXC CANADA)
 ;;88260^ARMED FORCES PACIFIC^ARMED FORCES PACIFIC
 ;;88000^ARMED FORCES^ARMED FORCES PACIFIC
 ;;59260^BRITISH COLUMBIA^BRITISH COLUMBIA
 ;;91260^CANADA^CANADA
 ;;93999^EUROPE^EUROPE
 ;;90999^ALL OTHER FOREIGN^FOREIGN COUNTRY
 ;;61260^MANITOBA^MANITOBA
 ;;92595^MEXICO^MEXICO
 ;;62260^NEW BRUNSWICK^NEW BRUNSWICK
 ;;63260^NEWFOUNDLAND^NEWFOUNDLAND
 ;;73260^NORTHWEST TERRITORIES^NORTHWEST TERRITORIES
 ;;65260^NOVA SCOTIA^NOVA SCOTIA
 ;;94260^NUNAVUT PROVINCE^NUNAVUT PROVINCE
 ;;75260^ONTARIO^ONTARIO
 ;;96725^PHILIPINES^PHILIPPINES
 ;;77260^PRINCE EDWARD ISLAND^PRINCE EDWARD ISLAND
 ;;80260^QUEBEC^QUEBEC
 ;;82260^SASKATCHEWAN^SASKATCHEWAN
 ;;74200^JOHNSTON ISLAND^U.S. MINOR OUTLYING ISLANDS
 ;;74300^MIDWAY ISLANDS^U.S. MINOR OUTLYING ISLANDS
 ;;74450^WAKE ISLAND^U.S. MINOR OUTLYING ISLANDS
 ;;74350^NAVASSA ISLAND^U.S. MINOR OUTLYING ISLANDS
 ;;74050^BAKER ISLAND^U.S. MINOR OUTLYING ISLANDS
 ;;74100^HOWLAND ISLAND^U.S. MINOR OUTLYING ISLANDS
 ;;74150^JARVIS ISLAND^U.S. MINOR OUTLYING ISLANDS
 ;;74250^KINGMAN REEF^U.S. MINOR OUTLYING ISLANDS
 ;;74400^PALMYRA ATOLL^U.S. MINOR OUTLYING ISLANDS
 ;;74999^ALL OTHER^U.S. MINOR OUTLYING ISLANDS
 ;;83260^YUKON TERRITORY^YUKON TERRITORY
 ;;99999^EOD^EOD