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

XU8P328C.m

Go to the documentation of this file. 
  1. XU8P328C ;OIFOO/SO- POST INSTALL;7:22 AM  8 Mar 2004
  1.  ;;8.0;KERNEL;**328**;Jul 10, 1995
  1.  ;
  1. DES D MES^XPDUTL("Updating STATE(#5) file's Description.") ;IA# 4293
  1.  K ^DIC(5,"%D")
  1.  S ^DIC(5,"%D",0)="^^5^5^3031105^"
  1.  S ^DIC(5,"%D",1,0)="This file contains the name of the state (or outlying area) as issued"
  1.  S ^DIC(5,"%D",2,0)="by the Department of Veterans Affairs and issued in M-1, Part I,"
  1.  S ^DIC(5,"%D",3,0)="Appendix B.  These entries should remain as distributed and should not be"
  1.  S ^DIC(5,"%D",4,0)="edited or updated unless done via a software upgrade or under direction"
  1.  S ^DIC(5,"%D",5,0)="of VA Central Office."
  1.  ;
  1. RIX ;REINDEX THE 'C' XREF OF THE COUNTY MULTIPLE
  1.  D MES^XPDUTL("Reindexing the ""C"" cross reference of the COUNTY multiple...")
  1.  N IEN S IEN=0
  1.  F  S IEN=$O(^DIC(5,IEN)) Q:'IEN  D
  1.  . D MES^XPDUTL("Reindexing: "_$P(^DIC(5,IEN,0),U))
  1.  . K ^DIC(5,IEN,1,"C") ;KILL WHOLE XREF TO REMOVE ZIP CODE XREF
  1.  . N SIEN S SIEN=0
  1.  . F  S SIEN=$O(^DIC(5,IEN,1,SIEN)) Q:'SIEN  D
  1.  .. N DA S DA=SIEN
  1.  .. S DA(1)=IEN
  1.  .. N DIK S DIK="^DIC(5,"_IEN_",1,"
  1.  .. S DIK(1)="2^C"
  1.  .. D EN1^DIK
  1.  D MES^XPDUTL("Finished with reindexing.")
  1.  ;
  1.  ;FIX VA COUNTY CODES WHERE WE CAN
  1. FIX D MES^XPDUTL("Looking for Counties that need VA COUNTY CODES updated...")
  1.  ;
  1.  D SALV ;Check to see if only the VA COUNTY CODE needs corrected
  1.  ;
  1.  D MES^XPDUTL("Finished updating VA COUNTY CODES.")
  1.  ;
  1.  D MD ;Correct DADE to MIAMI-DADE if possible
  1.  ;
  1.  ;CHECK COUNTY MULTIPLE FOR DUPLICATES
  1.  D MES^XPDUTL("Checking for duplicate VA COUNTY CODES...")
  1.  N XUSW S XUSW=0 ;ZERO IF CLEAN
  1.  D TEST
  1.  I XUSW F  Q:'XUSW  S XUSW=0 D MES^XPDUTL("Checking again for duplicate VA COUNTY CODES") D TEST
  1.  D MES^XPDUTL("Finished checking for duplicate VA COUNTY CODES.")
  1.  ;
  1.  D SYNC ;Sync up County County multiple with file 5.13
  1.  ;
  1.  Q
  1. MD ;CORRECT DADE TO MIAMI-DADE IF POSSIBLE
  1.  N ST,CO1,CO2
  1.  D
  1.  . N DIERR,EM
  1.  . S ST=+$$FIND1^DIC(5,"","X","FLORIDA","B","","EM")
  1.  I 'ST D MES^XPDUTL("Can not find ""FLORIDA"" in your STATE(#5) file.  Installation Terminated!") Q
  1.  D
  1.  . N DIERR,EM
  1.  . D FIND^DIC(5.01,","_ST_",","@;.01;2","PX","DADE","","B","","","CO1","EM")
  1.  . D FIND^DIC(5.01,","_ST_",","@;.01;2","PX","MIAMI-DADE","","B","","","CO2","EM")
  1.  . Q
  1.  I +$P(CO2("DILIST",0),U)=0,+$P(CO1("DILIST",0),U)>0 D
  1.  . ; No MIAMI-DADE in County multiple ;Edit the first DADE
  1.  . N DIERR,FDA,EM
  1.  . S FDA(5.01,+$P(CO1("DILIST",1,0),U)_","_ST_",",.01)="MIAMI-DADE"
  1.  . S FDA(5.01,+$P(CO1("DILIST",1,0),U)_","_ST_",",2)="086"
  1.  . D FILE^DIE("","FDA","EM")
  1.  . Q
  1.  I +$P(CO2("DILIST",0),U)=1,$P(CO2("DILIST",1,0),U,3)'="086" D
  1.  . ;Just need to change VA COUNTY CODE
  1.  . N DIERR,FDA,EM
  1.  . S FDA(5.01,+$P(CO2("DILIST",1,0),U)_","_ST_",",2)="086"
  1.  . D FILE^DIE("","FDA","EM")
  1.  . Q
  1.  I +$P(CO2("DILIST",0),U)>1 D
  1.  . ;Edit all remaining MIAMI-DADEs to ZZ...
  1.  . N VCC S VCC=999
  1.  . F I=2:1:$P(CO2("DILIST",0),U) D
  1.  .. N T S T=0
  1.  .. F  S T=$O(^DIC(5,ST,1,"C",VCC,T)) Q:'T  S VCC=VCC-1,T=0
  1.  .. N FDA,DIERR,EM
  1.  .. S FDA(5.01,+$P(CO2("DILIST",I,0),U)_","_ST_",",.01)="ZZ"_$P(CO2("DILIST",I,0),U,2)
  1.  .. S FDA(5.01,+$P(CO2("DILIST",I,0),U)_","_ST_",",2)=VCC
  1.  .. D FILE^DIE("","FDA","EM")
  1.  D  ;ADD DADE BACK IN FOR HISTORY
  1.  . N DIERR,FDA,EM
  1.  . S FDA(5.01,"?+1,"_ST_",",.01)="DADE"
  1.  . S FDA(5.01,"?+1,"_ST_",",2)="025"
  1.  . D UPDATE^DIE("","FDA","","EM")
  1.  . Q
  1.  Q
  1.  ;
  1. SYNC ;SYNC UP COUNTY MULTIPLE WITH FILE 5.13
  1.  D EP1^XIPSYNC
  1. LIC ;LIST INACTIVE COUNTIES
  1.  D MES^XPDUTL("Displaying Inactivated Counties...")
  1.  N STNM
  1.  S STNM=""
  1.  F  S STNM=$O(^DIC(5,"B",STNM)) Q:STNM=""  D
  1.  . N ST,CONM
  1.  . S ST=0,ST=$O(^DIC(5,"B",STNM,ST))
  1.  . I +$P(^DIC(5,ST,0),U,3)>56,+$P(^(0),U,3)'=72 Q  ;NOT US STATE OR PR
  1.  . S CONM=""
  1.  . F  S CONM=$O(^DIC(5,ST,1,"B",CONM)) Q:CONM=""  D
  1.  .. N CO
  1.  .. S CO=0,CO=$O(^DIC(5,ST,1,"B",CONM,CO))
  1.  .. I $P(^DIC(5,ST,1,CO,0),U,5)="" Q
  1.  .. N X
  1.  .. S X="State: "_STNM_", County: "_CONM_", County Code: "_$P(^DIC(5,ST,1,CO,0),U,3)_" Inactivated."
  1.  .. D MES^XPDUTL(X)
  1.  Q
  1.  ;
  1. TEST ;CHECK FOR DUPLICATE VA COUNTY CODES
  1.  N ST S ST=0 ;STATE FILE IEN
  1.  F  S ST=$O(^DIC(5,ST)) Q:'ST  D
  1.  . I +$P(^DIC(5,ST,0),U,3)>56,+$P(^(0),U,3)'=72 Q  ;NOT US STATE OR PR
  1.  . N FCO S FCO="" ;FIPS COUNTY VALUE
  1.  . N VCC S VCC=999 ;START AT 999 FOR DUPLICATE COUNTY CODES
  1.  . F  S FCO=$O(^DIC(5,ST,1,"C",FCO)) Q:FCO=""  D
  1.  .. I $L(FCO)>3,FCO'[" " Q  ;LOOKING AT ZIP CODES
  1.  .. N PCO S PCO=0 ;COUNTY IEN
  1.  .. F  S PCO=$O(^DIC(5,ST,1,"C",FCO,PCO)) Q:'PCO  D
  1.  ... N CO,VAL1,VAL2,FST,CNAME,ZZ,Z1,Z2,F1,F2,I
  1.  ... S CO=$O(^DIC(5,ST,1,"C",FCO,PCO)) Q:'CO  D  ;IS THERE ANOTHER?
  1.  .... S VAL1=$P(^DIC(5,ST,1,PCO,0),U)
  1.  .... S VAL2=$P(^DIC(5,ST,1,CO,0),U)
  1.  .... S FST=$P(^DIC(5,ST,0),U,3)
  1.  .... ;WHICH IS CORRECT?
  1.  .... S CNAME=VAL1 D L513 M Z1=ZZ
  1.  .... S CNAME=VAL2 D L513 M Z2=ZZ
  1.  .... S (F1,F2,I)=0
  1.  .... F  S I=$O(Z1("DILIST",I)) Q:'I  I $P(Z1("DILIST",I,0),U,2)=FST_FCO S F1=1
  1.  .... F  S I=$O(Z2("DILIST",I)) Q:'I  I $P(Z2("DILIST",I,0),U,2)=FST_FCO S F2=1
  1.  .... I F1,'F2 S VAL="ZZ"_VAL2
  1.  .... I 'F1,F2 S VAL="ZZ"_VAL1
  1.  .... I 'F1,'F2 S VAL=$S($E(VAL1,1,2)'="ZZ":"ZZ"_VAL1,1:"ZZ"_VAL2)
  1.  .... D  ;COUNTY CODE OK?
  1.  ..... N T S T=0
  1.  ..... F  S T=$O(^DIC(5,ST,1,"C",VCC,T)) Q:'T  S VCC=VCC-1,T=0
  1.  .... D MES^XPDUTL("State: "_$P(^DIC(5,ST,0),U)_", County Name: "_CNAME_", VA County Code: "_FCO)
  1.  .... D MES^XPDUTL("  Changed County Name to: "_VAL_", VA County Code to: "_VCC)
  1.  .... N DIERR,EM
  1.  .... S FDA(5.01,CO_","_ST_",",.01)=VAL
  1.  .... S FDA(5.01,CO_","_ST_",",2)=VCC
  1.  .... D FILE^DIE("","FDA","EM")
  1.  .... S VCC=VCC-1,XUSW=1
  1.  Q
  1.  ;
  1. SALV ;LET'S SEE IF ALL WE NEED TO DO IS FIX THE 'VA COUNTY CODE'
  1.  N ST S ST=0 ;STATE FILE IEN
  1.  F  S ST=$O(^DIC(5,ST)) Q:'ST  D
  1.  . I +$P(^DIC(5,ST,0),U,3)>56,+$P(^(0),U,3)'=72 Q  ;NOT US STATE OR PR
  1.  . N STV S STV=$P(^DIC(5,ST,0),U,3) ;STATE FIPS VALUE
  1.  . N CNAME S CNAME="" ;COUNTY NAME
  1.  .  F  S CNAME=$O(^DIC(5,ST,1,"B",CNAME)) Q:CNAME=""  D
  1.  .. N Y
  1.  .. N CO S CO=0  ;COUNTY IEN OF STATE FILE
  1.  .. S CO=$O(^DIC(5,ST,1,"B",CNAME,CO))
  1.  .. D  ;GET LIST OF POSSIBILITIES
  1.  ... D L513
  1.  ... I '+ZZ("DILIST",0) Q  ;CAN'T FIND COUNTY NAME
  1.  ... N I S I=0
  1.  ... F  S I=$O(ZZ("DILIST",I)) Q:'I  D
  1.  .... I $E($P(ZZ("DILIST",I,0),U,2),1,2)'=STV Q  ;NOT THE STATE WE ARE LOOKING FOR
  1.  .... N NCOV,OLDCOV,STABB,X,FDA,DIERR
  1.  .... S NCOV=$E($P(ZZ("DILIST",I,0),U,2),3,5)
  1.  .... S OLDCOV=$P(^DIC(5,ST,1,CO,0),U,3),STABB=$P(^DIC(5,ST,0),U,2)
  1.  .... I OLDCOV=NCOV Q  ;COUNTY FIPS VALUES MATCH
  1.  .... S X="Changing VA COUNTY CODE, From: "_OLDCOV_" To: "_NCOV_" County: "_CNAME_" State: "_STABB
  1.  .... D MES^XPDUTL(X)
  1.  .... S FDA(5.01,CO_","_ST_",",2)=NCOV
  1.  .... D FILE^DIE("","FDA","MSG")
  1.  Q
  1.  ;
  1. L513 ;GET A LIST OF COUNTIES WHO'S NAME MATCHES FROM 5.13
  1.  N DIERR,EM
  1.  D FIND^DIC(5.13,"","@;.01;1","PX",CNAME,"","C","","","ZZ","EM")
  1.  Q