XIPMAILB ;OOIFO/SO- SCAN STATE(#5) FILE FOR EXCEPTIONS;6:41 AM 4 Feb 2006;12/30/05 07:38
;;8.0;KERNEL;**378**;Jul 10, 1995;Build 59
; Checking State file for NAME duplicates
N I1,LN,ERR,ERRTBL
S LN=1,ERR=0
S XIPM("B",LN)="Begin checking STATE(#5)...",LN=LN+1
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,ERRTBL=""
.. F S I2=$O(Z("DILIST",I2)) Q:'I2 D
... I $D(ERRTBL($P(Z("DILIST",I2,0),U))) Q ; Already reported error
... S XIPM("B",LN)="IEN: "_$P(Z("DILIST",I2,0),U)_", State: "_$P(Z("DILIST",I2,0),U,2)_", is a duplicate State NAME(#.01)"
... S LN=LN+1,ERR=1
... S ERRTBL($P(Z("DILIST",I2,0),U))="" ; Table IEN
... Q
.. Q
. K ERRTBL S ERRTBL=""
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 D
... I $D(ERRTBL($P(Z("DILIST",I2,0),U))) Q ; Already reported error
... S XIPM("B",LN)="IEN: "_$P(Z("DILIST",I2,0),U)_", ABREV: "_$P(Z("DILIST",I2,0),U,3)_", is a duplicate State ABBREVIATION(#1)"
... S LN=LN+1,ERR=1
... S ERRTBL($P(Z("DILIST",I2,0),U))="" ; Table IEN
... Q
.. Q
. K ERRTBL S ERRTBL=""
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 D
... I $D(ERRTBL($P(Z("DILIST",I2,0),U))) Q ; Already reported error
... S XIPM("B",LN)="IEN: "_$P(Z("DILIST",I2,0),U)_", VA CODE: "_$P(Z("DILIST",I2,0),U,4)_", is a duplicate State VA STATE CODE(#2)"
... S LN=LN+1,ERR=1=""
... S ERRTBL($P(Z("DILIST",I2,0),U))="" ; Table IEN
... Q
.. Q
. Q
TC ; Now check for missing States against table
N TMP,I,DATA
F I=1:1 S DATA=$T(D5+I) Q:$P(DATA,";;",2)["EOD" D
. 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=^DIC(5,I1,0)
. I '$P(X,U,5) Q ;Not a recognized VHA/AAC State
. S X=$P(X,U,1,3)
. I $D(TMP(X)) S TMP(X)=1 Q
. S XIPM("B",LN)="IEN: "_I1_", NAME: "_$P(X,U,1)_", ABREV: "_$P(X,U,2)_", VA CODE: "_$P(X,U,3)_", is not a recognized VistA State",LN=LN+1,ERR=1
. Q
S I1=""
F S I1=$O(TMP(I1)) Q:I1="" I TMP(I1)="" D
. S XIPM("B",LN)="NAME: "_$P(I1,U,1)_", ABREV: "_$P(I1,U,2)_", VA CODE: "_$P(I1,U,3)_", State not found in STATE(#5) file",LN=LN+1,ERR=1
.Q
EXIT I 'ERR S XIPM("B",LN)="No problems found."
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
;;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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXIPMAILB 5346 printed Sep 23, 2025@19:38:35 Page 2
XIPMAILB ;OOIFO/SO- SCAN STATE(#5) FILE FOR EXCEPTIONS;6:41 AM 4 Feb 2006;12/30/05 07:38
+1 ;;8.0;KERNEL;**378**;Jul 10, 1995;Build 59
+2 ; Checking State file for NAME duplicates
+3 NEW I1,LN,ERR,ERRTBL
+4 SET LN=1
SET ERR=0
+5 SET XIPM("B",LN)="Begin checking STATE(#5)..."
SET LN=LN+1
+6 SET I1=0
+7 FOR
SET I1=$ORDER(^DIC(5,I1))
if 'I1
QUIT
Begin DoDot:1
+8 ;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
SET ERRTBL=""
+10 FOR
SET I2=$ORDER(Z("DILIST",I2))
if 'I2
QUIT
Begin DoDot:3
+11 ; Already reported error
IF $DATA(ERRTBL($PIECE(Z("DILIST",I2,0),U)))
QUIT
+12 SET XIPM("B",LN)="IEN: "_$PIECE(Z("DILIST",I2,0),U)_", State: "_$PIECE(Z("DILIST",I2,0),U,2)_", is a duplicate State NAME(#.01)"
+13 SET LN=LN+1
SET ERR=1
+14 ; Table IEN
SET ERRTBL($PIECE(Z("DILIST",I2,0),U))=""
+15 QUIT
End DoDot:3
+16 QUIT
End DoDot:2
+17 KILL ERRTBL
SET ERRTBL=""
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
Begin DoDot:3
+11 ; Already reported error
IF $DATA(ERRTBL($PIECE(Z("DILIST",I2,0),U)))
QUIT
+12 SET XIPM("B",LN)="IEN: "_$PIECE(Z("DILIST",I2,0),U)_", ABREV: "_$PIECE(Z("DILIST",I2,0),U,3)_", is a duplicate State ABBREVIATION(#1)"
+13 SET LN=LN+1
SET ERR=1
+14 ; Table IEN
SET ERRTBL($PIECE(Z("DILIST",I2,0),U))=""
+15 QUIT
End DoDot:3
+16 QUIT
End DoDot:2
+17 KILL ERRTBL
SET ERRTBL=""
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
Begin DoDot:3
+11 ; Already reported error
IF $DATA(ERRTBL($PIECE(Z("DILIST",I2,0),U)))
QUIT
+12 SET XIPM("B",LN)="IEN: "_$PIECE(Z("DILIST",I2,0),U)_", VA CODE: "_$PIECE(Z("DILIST",I2,0),U,4)_", is a duplicate State VA STATE CODE(#2)"
+13 SET LN=LN+1
SET ERR=1=""
+14 ; Table IEN
SET ERRTBL($PIECE(Z("DILIST",I2,0),U))=""
+15 QUIT
End DoDot:3
+16 QUIT
End DoDot:2
+17 QUIT
End DoDot:1
TC ; Now check for missing States against table
+1 NEW TMP,I,DATA
+2 FOR I=1:1
SET DATA=$TEXT(D5+I)
if $PIECE(DATA,";;",2)["EOD"
QUIT
Begin DoDot:1
+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=^DIC(5,I1,0)
+12 ;Not a recognized VHA/AAC State
IF '$PIECE(X,U,5)
QUIT
+13 SET X=$PIECE(X,U,1,3)
+14 IF $DATA(TMP(X))
SET TMP(X)=1
QUIT
+15 SET XIPM("B",LN)="IEN: "_I1_", NAME: "_$PIECE(X,U,1)_", ABREV: "_$PIECE(X,U,2)_", VA CODE: "_$PIECE(X,U,3)_", is not a recognized VistA State"
SET LN=LN+1
SET ERR=1
+16 QUIT
End DoDot:1
+17 SET I1=""
+18 FOR
SET I1=$ORDER(TMP(I1))
if I1=""
QUIT
IF TMP(I1)=""
Begin DoDot:1
+19 SET XIPM("B",LN)="NAME: "_$PIECE(I1,U,1)_", ABREV: "_$PIECE(I1,U,2)_", VA CODE: "_$PIECE(I1,U,3)_", State not found in STATE(#5) file"
SET LN=LN+1
SET ERR=1
+20 QUIT
End DoDot:1
EXIT IF 'ERR
SET XIPM("B",LN)="No problems found."
+1 QUIT
+2 ;
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 ;;08^COLORADO^CO^1^1
+13 ;;09^CONNECTICUT^CT^1^1
+14 ;;10^DELAWARE^DE^1^1
+15 ;;11^DISTRICT OF COLUMBIA^DC^1^1
+16 ;;93^EUROPE^EU^1^0
+17 ;;64^FEDERATED STATES OF MICRONESIA^FM^1^1
+18 ;;12^FLORIDA^FL^1^1
+19 ;;90^FOREIGN COUNTRY^FG^1^0
+20 ;;13^GEORGIA^GA^1^1
+21 ;;66^GUAM^GU^1^1
+22 ;;15^HAWAII^HI^1^1
+23 ;;16^IDAHO^ID^1^1
+24 ;;17^ILLINOIS^IL^1^1
+25 ;;18^INDIANA^IN^1^1
+26 ;;19^IOWA^IA^1^1
+27 ;;20^KANSAS^KS^1^1
+28 ;;21^KENTUCKY^KY^1^1
+29 ;;22^LOUISIANA^LA^1^1
+30 ;;23^MAINE^ME^1^1
+31 ;;61^MANITOBA^MB^1^0
+32 ;;68^MARSHALL ISLANDS^MH^1^1
+33 ;;24^MARYLAND^MD^1^1
+34 ;;25^MASSACHUSETTS^MA^1^1
+35 ;;92^MEXICO^MX^1^0
+36 ;;26^MICHIGAN^MI^1^1
+37 ;;27^MINNESOTA^MN^1^1
+38 ;;28^MISSISSIPPI^MS^1^1
+39 ;;29^MISSOURI^MO^1^1
+40 ;;30^MONTANA^MT^1^1
+41 ;;31^NEBRASKA^NE^1^1
+42 ;;32^NEVADA^NV^1^1
+43 ;;62^NEW BRUNSWICK^NB^1^0
+44 ;;33^NEW HAMPSHIRE^NH^1^1
+45 ;;34^NEW JERSEY^NJ^1^1
+46 ;;35^NEW MEXICO^NM^1^1
+47 ;;36^NEW YORK^NY^1^1
+48 ;;63^NEWFOUNDLAND^NF^1^0
+49 ;;37^NORTH CAROLINA^NC^1^1
+50 ;;38^NORTH DAKOTA^ND^1^1
+51 ;;69^NORTHERN MARIANA ISLANDS^MP^1^1
+52 ;;73^NORTHWEST TERRITORIES^NT^1^0
+53 ;;65^NOVA SCOTIA^NS^1^0
+54 ;;94^NUNAVUT PROVINCE^NU^1^0
+55 ;;39^OHIO^OH^1^1
+56 ;;40^OKLAHOMA^OK^1^1
+57 ;;75^ONTARIO^ON^1^0
+58 ;;41^OREGON^OR^1^1
+59 ;;70^PALAU^PW^1^0
+60 ;;42^PENNSYLVANIA^PA^1^1
+61 ;;96^PHILIPPINES^PH^1^0
+62 ;;77^PRINCE EDWARD ISLAND^PE^1^0
+63 ;;72^PUERTO RICO^PR^1^1
+64 ;;80^QUEBEC^QC^1^0
+65 ;;44^RHODE ISLAND^RI^1^1
+66 ;;82^SASKATCHEWAN^SK^1^0
+67 ;;45^SOUTH CAROLINA^SC^1^1
+68 ;;46^SOUTH DAKOTA^SD^1^1
+69 ;;47^TENNESSEE^TN^1^1
+70 ;;48^TEXAS^TX^1^1
+71 ;;74^U.S. MINOR OUTLYING ISLANDS^UM^1^1
+72 ;;49^UTAH^UT^1^1
+73 ;;50^VERMONT^VT^1^1
+74 ;;78^VIRGIN ISLANDS^VI^1^1
+75 ;;51^VIRGINIA^VA^1^1
+76 ;;53^WASHINGTON^WA^1^1
+77 ;;54^WEST VIRGINIA^WV^1^1
+78 ;;55^WISCONSIN^WI^1^1
+79 ;;56^WYOMING^WY^1^1
+80 ;;83^YUKON TERRITORY^YT^1^0
+81 ;;99999^EOD^EOD^EOD^EOD
