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/XU8P328C.m@ 862

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

initial load of WorldVistAEHR
File size: 6.5 KB
Line 
1XU8P328C ;OIFOO/SO- POST INSTALL;7:22 AM 8 Mar 2004
2 ;;8.0;KERNEL;**328**;Jul 10, 1995
3 ;
4DES D MES^XPDUTL("Updating STATE(#5) file's Description.") ;IA# 4293
5 K ^DIC(5,"%D")
6 S ^DIC(5,"%D",0)="^^5^5^3031105^"
7 S ^DIC(5,"%D",1,0)="This file contains the name of the state (or outlying area) as issued"
8 S ^DIC(5,"%D",2,0)="by the Department of Veterans Affairs and issued in M-1, Part I,"
9 S ^DIC(5,"%D",3,0)="Appendix B. These entries should remain as distributed and should not be"
10 S ^DIC(5,"%D",4,0)="edited or updated unless done via a software upgrade or under direction"
11 S ^DIC(5,"%D",5,0)="of VA Central Office."
12 ;
13RIX ;REINDEX THE 'C' XREF OF THE COUNTY MULTIPLE
14 D MES^XPDUTL("Reindexing the ""C"" cross reference of the COUNTY multiple...")
15 N IEN S IEN=0
16 F S IEN=$O(^DIC(5,IEN)) Q:'IEN D
17 . D MES^XPDUTL("Reindexing: "_$P(^DIC(5,IEN,0),U))
18 . K ^DIC(5,IEN,1,"C") ;KILL WHOLE XREF TO REMOVE ZIP CODE XREF
19 . N SIEN S SIEN=0
20 . F S SIEN=$O(^DIC(5,IEN,1,SIEN)) Q:'SIEN D
21 .. N DA S DA=SIEN
22 .. S DA(1)=IEN
23 .. N DIK S DIK="^DIC(5,"_IEN_",1,"
24 .. S DIK(1)="2^C"
25 .. D EN1^DIK
26 D MES^XPDUTL("Finished with reindexing.")
27 ;
28 ;FIX VA COUNTY CODES WHERE WE CAN
29FIX D MES^XPDUTL("Looking for Counties that need VA COUNTY CODES updated...")
30 ;
31 D SALV ;Check to see if only the VA COUNTY CODE needs corrected
32 ;
33 D MES^XPDUTL("Finished updating VA COUNTY CODES.")
34 ;
35 D MD ;Correct DADE to MIAMI-DADE if possible
36 ;
37 ;CHECK COUNTY MULTIPLE FOR DUPLICATES
38 D MES^XPDUTL("Checking for duplicate VA COUNTY CODES...")
39 N XUSW S XUSW=0 ;ZERO IF CLEAN
40 D TEST
41 I XUSW F Q:'XUSW S XUSW=0 D MES^XPDUTL("Checking again for duplicate VA COUNTY CODES") D TEST
42 D MES^XPDUTL("Finished checking for duplicate VA COUNTY CODES.")
43 ;
44 D SYNC ;Sync up County County multiple with file 5.13
45 ;
46 Q
47MD ;CORRECT DADE TO MIAMI-DADE IF POSSIBLE
48 N ST,CO1,CO2
49 D
50 . N DIERR,EM
51 . S ST=+$$FIND1^DIC(5,"","X","FLORIDA","B","","EM")
52 I 'ST D MES^XPDUTL("Can not find ""FLORIDA"" in your STATE(#5) file. Installation Terminated!") Q
53 D
54 . N DIERR,EM
55 . D FIND^DIC(5.01,","_ST_",","@;.01;2","PX","DADE","","B","","","CO1","EM")
56 . D FIND^DIC(5.01,","_ST_",","@;.01;2","PX","MIAMI-DADE","","B","","","CO2","EM")
57 . Q
58 I +$P(CO2("DILIST",0),U)=0,+$P(CO1("DILIST",0),U)>0 D
59 . ; No MIAMI-DADE in County multiple ;Edit the first DADE
60 . N DIERR,FDA,EM
61 . S FDA(5.01,+$P(CO1("DILIST",1,0),U)_","_ST_",",.01)="MIAMI-DADE"
62 . S FDA(5.01,+$P(CO1("DILIST",1,0),U)_","_ST_",",2)="086"
63 . D FILE^DIE("","FDA","EM")
64 . Q
65 I +$P(CO2("DILIST",0),U)=1,$P(CO2("DILIST",1,0),U,3)'="086" D
66 . ;Just need to change VA COUNTY CODE
67 . N DIERR,FDA,EM
68 . S FDA(5.01,+$P(CO2("DILIST",1,0),U)_","_ST_",",2)="086"
69 . D FILE^DIE("","FDA","EM")
70 . Q
71 I +$P(CO2("DILIST",0),U)>1 D
72 . ;Edit all remaining MIAMI-DADEs to ZZ...
73 . N VCC S VCC=999
74 . F I=2:1:$P(CO2("DILIST",0),U) D
75 .. N T S T=0
76 .. F S T=$O(^DIC(5,ST,1,"C",VCC,T)) Q:'T S VCC=VCC-1,T=0
77 .. N FDA,DIERR,EM
78 .. S FDA(5.01,+$P(CO2("DILIST",I,0),U)_","_ST_",",.01)="ZZ"_$P(CO2("DILIST",I,0),U,2)
79 .. S FDA(5.01,+$P(CO2("DILIST",I,0),U)_","_ST_",",2)=VCC
80 .. D FILE^DIE("","FDA","EM")
81 D ;ADD DADE BACK IN FOR HISTORY
82 . N DIERR,FDA,EM
83 . S FDA(5.01,"?+1,"_ST_",",.01)="DADE"
84 . S FDA(5.01,"?+1,"_ST_",",2)="025"
85 . D UPDATE^DIE("","FDA","","EM")
86 . Q
87 Q
88 ;
89SYNC ;SYNC UP COUNTY MULTIPLE WITH FILE 5.13
90 D EP1^XIPSYNC
91LIC ;LIST INACTIVE COUNTIES
92 D MES^XPDUTL("Displaying Inactivated Counties...")
93 N STNM
94 S STNM=""
95 F S STNM=$O(^DIC(5,"B",STNM)) Q:STNM="" D
96 . N ST,CONM
97 . S ST=0,ST=$O(^DIC(5,"B",STNM,ST))
98 . I +$P(^DIC(5,ST,0),U,3)>56,+$P(^(0),U,3)'=72 Q ;NOT US STATE OR PR
99 . S CONM=""
100 . F S CONM=$O(^DIC(5,ST,1,"B",CONM)) Q:CONM="" D
101 .. N CO
102 .. S CO=0,CO=$O(^DIC(5,ST,1,"B",CONM,CO))
103 .. I $P(^DIC(5,ST,1,CO,0),U,5)="" Q
104 .. N X
105 .. S X="State: "_STNM_", County: "_CONM_", County Code: "_$P(^DIC(5,ST,1,CO,0),U,3)_" Inactivated."
106 .. D MES^XPDUTL(X)
107 Q
108 ;
109TEST ;CHECK FOR DUPLICATE VA COUNTY CODES
110 N ST S ST=0 ;STATE FILE IEN
111 F S ST=$O(^DIC(5,ST)) Q:'ST D
112 . I +$P(^DIC(5,ST,0),U,3)>56,+$P(^(0),U,3)'=72 Q ;NOT US STATE OR PR
113 . N FCO S FCO="" ;FIPS COUNTY VALUE
114 . N VCC S VCC=999 ;START AT 999 FOR DUPLICATE COUNTY CODES
115 . F S FCO=$O(^DIC(5,ST,1,"C",FCO)) Q:FCO="" D
116 .. I $L(FCO)>3,FCO'[" " Q ;LOOKING AT ZIP CODES
117 .. N PCO S PCO=0 ;COUNTY IEN
118 .. F S PCO=$O(^DIC(5,ST,1,"C",FCO,PCO)) Q:'PCO D
119 ... N CO,VAL1,VAL2,FST,CNAME,ZZ,Z1,Z2,F1,F2,I
120 ... S CO=$O(^DIC(5,ST,1,"C",FCO,PCO)) Q:'CO D ;IS THERE ANOTHER?
121 .... S VAL1=$P(^DIC(5,ST,1,PCO,0),U)
122 .... S VAL2=$P(^DIC(5,ST,1,CO,0),U)
123 .... S FST=$P(^DIC(5,ST,0),U,3)
124 .... ;WHICH IS CORRECT?
125 .... S CNAME=VAL1 D L513 M Z1=ZZ
126 .... S CNAME=VAL2 D L513 M Z2=ZZ
127 .... S (F1,F2,I)=0
128 .... F S I=$O(Z1("DILIST",I)) Q:'I I $P(Z1("DILIST",I,0),U,2)=FST_FCO S F1=1
129 .... F S I=$O(Z2("DILIST",I)) Q:'I I $P(Z2("DILIST",I,0),U,2)=FST_FCO S F2=1
130 .... I F1,'F2 S VAL="ZZ"_VAL2
131 .... I 'F1,F2 S VAL="ZZ"_VAL1
132 .... I 'F1,'F2 S VAL=$S($E(VAL1,1,2)'="ZZ":"ZZ"_VAL1,1:"ZZ"_VAL2)
133 .... D ;COUNTY CODE OK?
134 ..... N T S T=0
135 ..... F S T=$O(^DIC(5,ST,1,"C",VCC,T)) Q:'T S VCC=VCC-1,T=0
136 .... D MES^XPDUTL("State: "_$P(^DIC(5,ST,0),U)_", County Name: "_CNAME_", VA County Code: "_FCO)
137 .... D MES^XPDUTL(" Changed County Name to: "_VAL_", VA County Code to: "_VCC)
138 .... N DIERR,EM
139 .... S FDA(5.01,CO_","_ST_",",.01)=VAL
140 .... S FDA(5.01,CO_","_ST_",",2)=VCC
141 .... D FILE^DIE("","FDA","EM")
142 .... S VCC=VCC-1,XUSW=1
143 Q
144 ;
145SALV ;LET'S SEE IF ALL WE NEED TO DO IS FIX THE 'VA COUNTY CODE'
146 N ST S ST=0 ;STATE FILE IEN
147 F S ST=$O(^DIC(5,ST)) Q:'ST D
148 . I +$P(^DIC(5,ST,0),U,3)>56,+$P(^(0),U,3)'=72 Q ;NOT US STATE OR PR
149 . N STV S STV=$P(^DIC(5,ST,0),U,3) ;STATE FIPS VALUE
150 . N CNAME S CNAME="" ;COUNTY NAME
151 . F S CNAME=$O(^DIC(5,ST,1,"B",CNAME)) Q:CNAME="" D
152 .. N Y
153 .. N CO S CO=0 ;COUNTY IEN OF STATE FILE
154 .. S CO=$O(^DIC(5,ST,1,"B",CNAME,CO))
155 .. D ;GET LIST OF POSSIBILITIES
156 ... D L513
157 ... I '+ZZ("DILIST",0) Q ;CAN'T FIND COUNTY NAME
158 ... N I S I=0
159 ... F S I=$O(ZZ("DILIST",I)) Q:'I D
160 .... I $E($P(ZZ("DILIST",I,0),U,2),1,2)'=STV Q ;NOT THE STATE WE ARE LOOKING FOR
161 .... N NCOV,OLDCOV,STABB,X,FDA,DIERR
162 .... S NCOV=$E($P(ZZ("DILIST",I,0),U,2),3,5)
163 .... S OLDCOV=$P(^DIC(5,ST,1,CO,0),U,3),STABB=$P(^DIC(5,ST,0),U,2)
164 .... I OLDCOV=NCOV Q ;COUNTY FIPS VALUES MATCH
165 .... S X="Changing VA COUNTY CODE, From: "_OLDCOV_" To: "_NCOV_" County: "_CNAME_" State: "_STABB
166 .... D MES^XPDUTL(X)
167 .... S FDA(5.01,CO_","_ST_",",2)=NCOV
168 .... D FILE^DIE("","FDA","MSG")
169 Q
170 ;
171L513 ;GET A LIST OF COUNTIES WHO'S NAME MATCHES FROM 5.13
172 N DIERR,EM
173 D FIND^DIC(5.13,"","@;.01;1","PX",CNAME,"","C","","","ZZ","EM")
174 Q
Note: See TracBrowser for help on using the repository browser.