source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XIPMAILB.m@ 701

Last change on this file since 701 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 5.1 KB
Line 
1XIPMAILB ;OOIFO/SO- SCAN STATE(#5) FILE FOR EXCEPTIONS;6:41 AM 4 Feb 2006;12/30/05 07:38
2 ;;8.0;KERNEL;**378**;Jul 10, 1995;Build 59
3 ; Checking State file for NAME duplicates
4 N I1,LN,ERR,ERRTBL
5 S LN=1,ERR=0
6 S XIPM("B",LN)="Begin checking STATE(#5)...",LN=LN+1
7 S I1=0
8 F S I1=$O(^DIC(5,I1)) Q:'I1 D
9 . I '$D(^DIC(5,I1,0)) Q ;Bogus entry
10NC . D
11 .. ;Duplicate Name check
12 .. N VALUE,DIERR,Z,ZERR
13 .. S VALUE=$P(^DIC(5,I1,0),U)
14 .. I VALUE="" Q ;No NAME
15 .. D FIND^DIC(5,"","@;.01;1;2","MPQX",VALUE,"","","I $P(^(0),U,1)=VALUE","","Z","ZERR")
16 .. I $D(DIERR) Q
17 .. I $P(Z("DILIST",0),U)<2 Q
18 .. N I2
19 .. S I2=0,ERRTBL=""
20 .. F S I2=$O(Z("DILIST",I2)) Q:'I2 D
21 ... I $D(ERRTBL($P(Z("DILIST",I2,0),U))) Q ; Already reported error
22 ... 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)"
23 ... S LN=LN+1,ERR=1
24 ... S ERRTBL($P(Z("DILIST",I2,0),U))="" ; Table IEN
25 ... Q
26 .. Q
27 . K ERRTBL S ERRTBL=""
28AC . D
29 .. ;Duplicate Abbreviation check
30 .. N VALUE,DIERR,Z,ZERR
31 .. S VALUE=$P(^DIC(5,I1,0),U,2)
32 .. I VALUE="" Q ;No ABBREVIATION
33 .. D FIND^DIC(5,"","@;.01;1;2","MPQX",VALUE,"","","I $P(^(0),U,2)=VALUE","","Z","ZERR")
34 .. I $D(DIERR) Q
35 .. I $P(Z("DILIST",0),U)<2 Q
36 .. N I2
37 .. S I2=0
38 .. F S I2=$O(Z("DILIST",I2)) Q:'I2 D
39 ... I $D(ERRTBL($P(Z("DILIST",I2,0),U))) Q ; Already reported error
40 ... 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)"
41 ... S LN=LN+1,ERR=1
42 ... S ERRTBL($P(Z("DILIST",I2,0),U))="" ; Table IEN
43 ... Q
44 .. Q
45 . K ERRTBL S ERRTBL=""
46VC . D
47 .. ;Duplicate VA State Code check
48 .. N VALUE,DIERR,Z,ZERR
49 .. S VALUE=$P(^DIC(5,I1,0),U,3)
50 .. I VALUE="" Q ;No VA STATE CODE
51 .. D FIND^DIC(5,"","@;.01;1;2","MPQX",VALUE,"","","I $P(^(0),U,3)=VALUE","","Z","ZERR")
52 .. I $D(DIERR) Q
53 .. I $P(Z("DILIST",0),U)<2 Q
54 .. N I2
55 .. S I2=0
56 .. F S I2=$O(Z("DILIST",I2)) Q:'I2 D
57 ... I $D(ERRTBL($P(Z("DILIST",I2,0),U))) Q ; Already reported error
58 ... 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)"
59 ... S LN=LN+1,ERR=1=""
60 ... S ERRTBL($P(Z("DILIST",I2,0),U))="" ; Table IEN
61 ... Q
62 .. Q
63 . Q
64TC ; Now check for missing States against table
65 N TMP,I,DATA
66 F I=1:1 S DATA=$T(D5+I) Q:$P(DATA,";;",2)["EOD" D
67 . S DATA=$P(DATA,";;",2)
68 . ; NAME^ABBREVIATION^VA STATE CODE
69 . S TMP($P(DATA,U,2)_U_$P(DATA,U,3)_U_$P(DATA,U,1))=""
70 . Q
71 S I1=0
72 F S I1=$O(^DIC(5,I1)) Q:'I1 D
73 . N X,X1
74 . I '$D(^DIC(5,I1,0))#2 Q
75 . S X=^DIC(5,I1,0)
76 . I '$P(X,U,5) Q ;Not a recognized VHA/AAC State
77 . S X=$P(X,U,1,3)
78 . I $D(TMP(X)) S TMP(X)=1 Q
79 . 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
80 . Q
81 S I1=""
82 F S I1=$O(TMP(I1)) Q:I1="" I TMP(I1)="" D
83 . 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
84 .Q
85EXIT I 'ERR S XIPM("B",LN)="No problems found."
86 Q
87 ;
88D5 ;VA STATE CODE^NAME^ABBREVIATION^AAC RECOGNIZED^US STATE OR POSSESSION
89 ;;01^ALABAMA^AL^1^1
90 ;;02^ALASKA^AK^1^1
91 ;;58^ALBERTA^AB^1^0
92 ;;60^AMERICAN SAMOA^AS^1^1
93 ;;04^ARIZONA^AZ^1^1
94 ;;05^ARKANSAS^AR^1^1
95 ;;87^ARMED FORCES AF,EU,ME,CA^AE^1^1
96 ;;85^ARMED FORCES AMER (EXC CANADA)^AA^1^1
97 ;;88^ARMED FORCES PACIFIC^AP^1^1
98 ;;59^BRITISH COLUMBIA^BC^1^0
99 ;;06^CALIFORNIA^CA^1^1
100 ;;08^COLORADO^CO^1^1
101 ;;09^CONNECTICUT^CT^1^1
102 ;;10^DELAWARE^DE^1^1
103 ;;11^DISTRICT OF COLUMBIA^DC^1^1
104 ;;93^EUROPE^EU^1^0
105 ;;64^FEDERATED STATES OF MICRONESIA^FM^1^1
106 ;;12^FLORIDA^FL^1^1
107 ;;90^FOREIGN COUNTRY^FG^1^0
108 ;;13^GEORGIA^GA^1^1
109 ;;66^GUAM^GU^1^1
110 ;;15^HAWAII^HI^1^1
111 ;;16^IDAHO^ID^1^1
112 ;;17^ILLINOIS^IL^1^1
113 ;;18^INDIANA^IN^1^1
114 ;;19^IOWA^IA^1^1
115 ;;20^KANSAS^KS^1^1
116 ;;21^KENTUCKY^KY^1^1
117 ;;22^LOUISIANA^LA^1^1
118 ;;23^MAINE^ME^1^1
119 ;;61^MANITOBA^MB^1^0
120 ;;68^MARSHALL ISLANDS^MH^1^1
121 ;;24^MARYLAND^MD^1^1
122 ;;25^MASSACHUSETTS^MA^1^1
123 ;;92^MEXICO^MX^1^0
124 ;;26^MICHIGAN^MI^1^1
125 ;;27^MINNESOTA^MN^1^1
126 ;;28^MISSISSIPPI^MS^1^1
127 ;;29^MISSOURI^MO^1^1
128 ;;30^MONTANA^MT^1^1
129 ;;31^NEBRASKA^NE^1^1
130 ;;32^NEVADA^NV^1^1
131 ;;62^NEW BRUNSWICK^NB^1^0
132 ;;33^NEW HAMPSHIRE^NH^1^1
133 ;;34^NEW JERSEY^NJ^1^1
134 ;;35^NEW MEXICO^NM^1^1
135 ;;36^NEW YORK^NY^1^1
136 ;;63^NEWFOUNDLAND^NF^1^0
137 ;;37^NORTH CAROLINA^NC^1^1
138 ;;38^NORTH DAKOTA^ND^1^1
139 ;;69^NORTHERN MARIANA ISLANDS^MP^1^1
140 ;;73^NORTHWEST TERRITORIES^NT^1^0
141 ;;65^NOVA SCOTIA^NS^1^0
142 ;;94^NUNAVUT PROVINCE^NU^1^0
143 ;;39^OHIO^OH^1^1
144 ;;40^OKLAHOMA^OK^1^1
145 ;;75^ONTARIO^ON^1^0
146 ;;41^OREGON^OR^1^1
147 ;;70^PALAU^PW^1^0
148 ;;42^PENNSYLVANIA^PA^1^1
149 ;;96^PHILIPPINES^PH^1^0
150 ;;77^PRINCE EDWARD ISLAND^PE^1^0
151 ;;72^PUERTO RICO^PR^1^1
152 ;;80^QUEBEC^QC^1^0
153 ;;44^RHODE ISLAND^RI^1^1
154 ;;82^SASKATCHEWAN^SK^1^0
155 ;;45^SOUTH CAROLINA^SC^1^1
156 ;;46^SOUTH DAKOTA^SD^1^1
157 ;;47^TENNESSEE^TN^1^1
158 ;;48^TEXAS^TX^1^1
159 ;;74^U.S. MINOR OUTLYING ISLANDS^UM^1^1
160 ;;49^UTAH^UT^1^1
161 ;;50^VERMONT^VT^1^1
162 ;;78^VIRGIN ISLANDS^VI^1^1
163 ;;51^VIRGINIA^VA^1^1
164 ;;53^WASHINGTON^WA^1^1
165 ;;54^WEST VIRGINIA^WV^1^1
166 ;;55^WISCONSIN^WI^1^1
167 ;;56^WYOMING^WY^1^1
168 ;;83^YUKON TERRITORY^YT^1^0
169 ;;99999^EOD^EOD^EOD^EOD
Note: See TracBrowser for help on using the repository browser.