XU8P378E ;OOIFO/SO- XU378 ENVIRONMENT CHECK ;6:00 AM 4 Feb 2006
;;8.0;KERNEL;**378**;Jul 10, 1995;Build 59
; State file enviroment check
D MES^XPDUTL("Begin STATE(#5) file environment check...")
D MES^XPDUTL(" ")
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 DATA,TMP,TMPERR
N I1 S I1=0
F S I1=$O(^DIC(5,I1)) Q:'I1 D
. I '$D(^DIC(5,I1,0)) Q ;Bogus entry
NC . D
.. ;Duplicate Name check
.. N VALUE,DIERR,Z,ZERR
.. S VALUE=$P(^DIC(5,I1,0),U)
.. I VALUE="" Q ;No NAME
.. D FIND^DIC(5,"","@;.01;1;2","MPQX",VALUE,"","","I $P(^(0),U,1)=VALUE","","Z","ZERR")
.. I $D(DIERR) Q
.. I $P(Z("DILIST",0),U)<2 Q
.. N I2
.. S I2=0
.. F S I2=$O(Z("DILIST",I2)) Q:'I2 S TMPERR(Z("DILIST",I2,0)_"^[F]Duplicate State NAME(#.01)")="",XPDQUIT=2
.. Q
AC . D
.. ;Duplicate Abbreviation check
.. N VALUE,DIERR,Z,ZERR
.. S VALUE=$P(^DIC(5,I1,0),U,2)
.. I VALUE="" Q ;No ABBREVIATION
.. D FIND^DIC(5,"","@;.01;1;2","MPQX",VALUE,"","","I $P(^(0),U,2)=VALUE","","Z","ZERR")
.. I $D(DIERR) Q
.. I $P(Z("DILIST",0),U)<2 Q
.. N I2
.. S I2=0
.. F S I2=$O(Z("DILIST",I2)) Q:'I2 S TMPERR(Z("DILIST",I2,0)_"^[F]Duplicate State ABBREVIATION(#1)")="",XPDQUIT=2
.. Q
VC . D
.. ;Duplicate VA State Code check
.. N VALUE,DIERR,Z,ZERR
.. S VALUE=$P(^DIC(5,I1,0),U,3)
.. I VALUE="" Q ;No VA STATE CODE
.. D FIND^DIC(5,"","@;.01;1;2","MPQX",VALUE,"","","I $P(^(0),U,3)=VALUE","","Z","ZERR")
.. I $D(DIERR) Q
.. I $P(Z("DILIST",0),U)<2 Q
.. N I2
.. S I2=0
.. F S I2=$O(Z("DILIST",I2)) Q:'I2 S TMPERR(Z("DILIST",I2,0)_"^[F]Duplicate State VA STATE CODE(#2)")="",XPDQUIT=2
.. Q
. Q
TC ; Now check for missing States against table
F I=1:1 S DATA=$T(D5+I) Q:$P(DATA,";;",2)["EOD" D
. N X
. S DATA=$P(DATA,";;",2)
. ; NAME^ABBREVIATION^VA STATE CODE
. S TMP($P(DATA,U,2)_U_$P(DATA,U,3)_U_$P(DATA,U,1))=""
. Q
S I1=0
F S I1=$O(^DIC(5,I1)) Q:'I1 D
. N X,X1
. I '$D(^DIC(5,I1,0))#2 Q
. S X=$P(^DIC(5,I1,0),U,1,3)
. I $D(TMP(X)) S TMP(X)=1 Q
. S TMPERR(I1_U_$P(X,U,1)_U_$P(X,U,2)_U_$P(X,U,3)_"^[W]Not a recognized VistA State")=""
. Q
S I1=""
F S I1=$O(TMP(I1)) Q:I1="" I TMP(I1)="" D
. S TMPERR(U_$P(I1,U,1)_U_$P(I1,U,2)_U_$P(I1,U,3)_"^[F]State not found in STATE(#5) file")="",XPDQUIT=2
.Q
E1 I $D(XPDQUIT) D
. S I1=""
. D MES^XPDUTL("IEN^NAME(#.01)^ABBREVIATION(#1)^VA STATE CODE(#2)^[W]arning/[F]ailure Reason")
. F S I1=$O(TMPERR(I1)) Q:I1="" D
.. D MES^XPDUTL(I1)
.. Q
. Q
I $D(XPDQUIT) D MES^XPDUTL(" ")
D MES^XPDUTL("Finished environment check.")
I $D(XPDQUIT) D MES^XPDUTL(">> Environment check failed!")
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^1
;;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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXU8P378E 4957 printed Oct 16, 2024@18:08:17 Page 2
XU8P378E ;OOIFO/SO- XU378 ENVIRONMENT CHECK ;6:00 AM 4 Feb 2006
+1 ;;8.0;KERNEL;**378**;Jul 10, 1995;Build 59
+2 ; State file enviroment check
+3 DO MES^XPDUTL("Begin STATE(#5) file environment check...")
+4 DO MES^XPDUTL(" ")
+5 IF '$$FIND1^DIC(.11,"","X","ADUALC","IX")
Begin DoDot:1
+6 NEW DIK
+7 KILL ^DIC(5,"C")
+8 SET DIK="^DIC(5,"
+9 SET DIK(1)="1^C"
+10 DO ENALL^DIK
+11 SET DIK(1)="2^C"
+12 DO ENALL^DIK
End DoDot:1
+13 ;
+14 NEW DATA,TMP,TMPERR
+15 NEW I1
SET I1=0
+16 FOR
SET I1=$ORDER(^DIC(5,I1))
if 'I1
QUIT
Begin DoDot:1
+17 ;Bogus entry
IF '$DATA(^DIC(5,I1,0))
QUIT
NC Begin DoDot:2
+1 ;Duplicate Name check
+2 NEW VALUE,DIERR,Z,ZERR
+3 SET VALUE=$PIECE(^DIC(5,I1,0),U)
+4 ;No NAME
IF VALUE=""
QUIT
+5 DO FIND^DIC(5,"","@;.01;1;2","MPQX",VALUE,"","","I $P(^(0),U,1)=VALUE","","Z","ZERR")
+6 IF $DATA(DIERR)
QUIT
+7 IF $PIECE(Z("DILIST",0),U)<2
QUIT
+8 NEW I2
+9 SET I2=0
+10 FOR
SET I2=$ORDER(Z("DILIST",I2))
if 'I2
QUIT
SET TMPERR(Z("DILIST",I2,0)_"^[F]Duplicate State NAME(#.01)")=""
SET XPDQUIT=2
+11 QUIT
End DoDot:2
AC Begin DoDot:2
+1 ;Duplicate Abbreviation check
+2 NEW VALUE,DIERR,Z,ZERR
+3 SET VALUE=$PIECE(^DIC(5,I1,0),U,2)
+4 ;No ABBREVIATION
IF VALUE=""
QUIT
+5 DO FIND^DIC(5,"","@;.01;1;2","MPQX",VALUE,"","","I $P(^(0),U,2)=VALUE","","Z","ZERR")
+6 IF $DATA(DIERR)
QUIT
+7 IF $PIECE(Z("DILIST",0),U)<2
QUIT
+8 NEW I2
+9 SET I2=0
+10 FOR
SET I2=$ORDER(Z("DILIST",I2))
if 'I2
QUIT
SET TMPERR(Z("DILIST",I2,0)_"^[F]Duplicate State ABBREVIATION(#1)")=""
SET XPDQUIT=2
+11 QUIT
End DoDot:2
VC Begin DoDot:2
+1 ;Duplicate VA State Code check
+2 NEW VALUE,DIERR,Z,ZERR
+3 SET VALUE=$PIECE(^DIC(5,I1,0),U,3)
+4 ;No VA STATE CODE
IF VALUE=""
QUIT
+5 DO FIND^DIC(5,"","@;.01;1;2","MPQX",VALUE,"","","I $P(^(0),U,3)=VALUE","","Z","ZERR")
+6 IF $DATA(DIERR)
QUIT
+7 IF $PIECE(Z("DILIST",0),U)<2
QUIT
+8 NEW I2
+9 SET I2=0
+10 FOR
SET I2=$ORDER(Z("DILIST",I2))
if 'I2
QUIT
SET TMPERR(Z("DILIST",I2,0)_"^[F]Duplicate State VA STATE CODE(#2)")=""
SET XPDQUIT=2
+11 QUIT
End DoDot:2
+12 QUIT
End DoDot:1
TC ; Now check for missing States against table
+1 FOR I=1:1
SET DATA=$TEXT(D5+I)
if $PIECE(DATA,";;",2)["EOD"
QUIT
Begin DoDot:1
+2 NEW X
+3 SET DATA=$PIECE(DATA,";;",2)
+4 ; NAME^ABBREVIATION^VA STATE CODE
+5 SET TMP($PIECE(DATA,U,2)_U_$PIECE(DATA,U,3)_U_$PIECE(DATA,U,1))=""
+6 QUIT
End DoDot:1
+7 SET I1=0
+8 FOR
SET I1=$ORDER(^DIC(5,I1))
if 'I1
QUIT
Begin DoDot:1
+9 NEW X,X1
+10 IF '$DATA(^DIC(5,I1,0))#2
QUIT
+11 SET X=$PIECE(^DIC(5,I1,0),U,1,3)
+12 IF $DATA(TMP(X))
SET TMP(X)=1
QUIT
+13 SET TMPERR(I1_U_$PIECE(X,U,1)_U_$PIECE(X,U,2)_U_$PIECE(X,U,3)_"^[W]Not a recognized VistA State")=""
+14 QUIT
End DoDot:1
+15 SET I1=""
+16 FOR
SET I1=$ORDER(TMP(I1))
if I1=""
QUIT
IF TMP(I1)=""
Begin DoDot:1
+17 SET TMPERR(U_$PIECE(I1,U,1)_U_$PIECE(I1,U,2)_U_$PIECE(I1,U,3)_"^[F]State not found in STATE(#5) file")=""
SET XPDQUIT=2
+18 QUIT
End DoDot:1
E1 IF $DATA(XPDQUIT)
Begin DoDot:1
+1 SET I1=""
+2 DO MES^XPDUTL("IEN^NAME(#.01)^ABBREVIATION(#1)^VA STATE CODE(#2)^[W]arning/[F]ailure Reason")
+3 FOR
SET I1=$ORDER(TMPERR(I1))
if I1=""
QUIT
Begin DoDot:2
+4 DO MES^XPDUTL(I1)
+5 QUIT
End DoDot:2
+6 QUIT
End DoDot:1
+7 IF $DATA(XPDQUIT)
DO MES^XPDUTL(" ")
+8 DO MES^XPDUTL("Finished environment check.")
+9 IF $DATA(XPDQUIT)
DO MES^XPDUTL(">> Environment check failed!")
+10 QUIT
+11 ;
D5 ;VA STATE CODE^NAME^ABBREVIATION^AAC RECOGNIZED^US STATE OR POSSESSION
+1 ;;01^ALABAMA^AL^1^1
+2 ;;02^ALASKA^AK^1^1
+3 ;;58^ALBERTA^AB^1^0
+4 ;;60^AMERICAN SAMOA^AS^1^1
+5 ;;04^ARIZONA^AZ^1^1
+6 ;;05^ARKANSAS^AR^1^1
+7 ;;87^ARMED FORCES AF,EU,ME,CA^AE^1^1
+8 ;;85^ARMED FORCES AMER (EXC CANADA)^AA^1^1
+9 ;;88^ARMED FORCES PACIFIC^AP^1^1
+10 ;;59^BRITISH COLUMBIA^BC^1^0
+11 ;;06^CALIFORNIA^CA^1^1
+12 ;;91^CANADA^CANAD^0^0
+13 ;;08^COLORADO^CO^1^1
+14 ;;09^CONNECTICUT^CT^1^1
+15 ;;10^DELAWARE^DE^1^1
+16 ;;11^DISTRICT OF COLUMBIA^DC^1^1
+17 ;;93^EUROPE^EU^1^0
+18 ;;64^FEDERATED STATES OF MICRONESIA^FM^1^1
+19 ;;12^FLORIDA^FL^1^1
+20 ;;90^FOREIGN COUNTRY^FG^1^0
+21 ;;13^GEORGIA^GA^1^1
+22 ;;66^GUAM^GU^1^1
+23 ;;15^HAWAII^HI^1^1
+24 ;;16^IDAHO^ID^1^1
+25 ;;17^ILLINOIS^IL^1^1
+26 ;;18^INDIANA^IN^1^1
+27 ;;19^IOWA^IA^1^1
+28 ;;20^KANSAS^KS^1^1
+29 ;;21^KENTUCKY^KY^1^1
+30 ;;22^LOUISIANA^LA^1^1
+31 ;;23^MAINE^ME^1^1
+32 ;;61^MANITOBA^MB^1^0
+33 ;;68^MARSHALL ISLANDS^MH^1^1
+34 ;;24^MARYLAND^MD^1^1
+35 ;;25^MASSACHUSETTS^MA^1^1
+36 ;;92^MEXICO^MX^1^0
+37 ;;26^MICHIGAN^MI^1^1
+38 ;;27^MINNESOTA^MN^1^1
+39 ;;28^MISSISSIPPI^MS^1^1
+40 ;;29^MISSOURI^MO^1^1
+41 ;;30^MONTANA^MT^1^1
+42 ;;31^NEBRASKA^NE^1^1
+43 ;;32^NEVADA^NV^1^1
+44 ;;62^NEW BRUNSWICK^NB^1^0
+45 ;;33^NEW HAMPSHIRE^NH^1^1
+46 ;;34^NEW JERSEY^NJ^1^1
+47 ;;35^NEW MEXICO^NM^1^1
+48 ;;36^NEW YORK^NY^1^1
+49 ;;63^NEWFOUNDLAND^NF^1^0
+50 ;;37^NORTH CAROLINA^NC^1^1
+51 ;;38^NORTH DAKOTA^ND^1^1
+52 ;;69^NORTHERN MARIANA ISLANDS^MP^1^1
+53 ;;73^NORTHWEST TERRITORIES^NT^1^0
+54 ;;65^NOVA SCOTIA^NS^1^0
+55 ;;94^NUNAVUT PROVINCE^NU^1^0
+56 ;;39^OHIO^OH^1^1
+57 ;;40^OKLAHOMA^OK^1^1
+58 ;;75^ONTARIO^ON^1^0
+59 ;;41^OREGON^OR^1^1
+60 ;;70^PALAU^PW^1^1
+61 ;;42^PENNSYLVANIA^PA^1^1
+62 ;;96^PHILIPPINES^PH^1^0
+63 ;;77^PRINCE EDWARD ISLAND^PE^1^0
+64 ;;72^PUERTO RICO^PR^1^1
+65 ;;80^QUEBEC^QC^1^0
+66 ;;44^RHODE ISLAND^RI^1^1
+67 ;;82^SASKATCHEWAN^SK^1^0
+68 ;;45^SOUTH CAROLINA^SC^1^1
+69 ;;46^SOUTH DAKOTA^SD^1^1
+70 ;;47^TENNESSEE^TN^1^1
+71 ;;48^TEXAS^TX^1^1
+72 ;;74^U.S. MINOR OUTLYING ISLANDS^UM^1^1
+73 ;;49^UTAH^UT^1^1
+74 ;;50^VERMONT^VT^1^1
+75 ;;78^VIRGIN ISLANDS^VI^1^1
+76 ;;51^VIRGINIA^VA^1^1
+77 ;;53^WASHINGTON^WA^1^1
+78 ;;54^WEST VIRGINIA^WV^1^1
+79 ;;55^WISCONSIN^WI^1^1
+80 ;;56^WYOMING^WY^1^1
+81 ;;83^YUKON TERRITORY^YT^1^0
+82 ;;99999^EOD^EOD^EOD^EOD
