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

XUMF4A.m

Go to the documentation of this file. 
  1. XUMF4A ;CIOFO-SF/RAM - Institution File Clean Up; 06/28/99
  1.  ;;8.0;KERNEL;**206,209,212,261**;Jul 10, 1995
  1.  ;
  1.  ;
  1. EN ; -- entry point
  1.  ;
  1.  I $$CDSN D  Q
  1.  .D MSG^VALM10("Duplicates sta #s exist! -- NOTHING UPDATED!!!")
  1.  .H 5
  1.  .S VALMBCK="R"
  1.  ;
  1.  W "...working",!
  1.  D DSN,CSN,GOLD,ASSC,HIST
  1.  ;
  1.  K ^TMP("XUMF NAME",$J)
  1.  D NAME^XUMF4
  1.  S VALMBG=1
  1.  S VALMBCK="R"
  1.  ;
  1.  Q
  1.  ;
  1. DSN ; -- clean out local station numbers
  1.  ;
  1.  N IEN,DIE,DR,DA,XUMF,DIK
  1.  ;
  1.  S XUMF=7
  1.  ;
  1.  S IEN=0
  1.  F  S IEN=$O(^DIC(4,IEN)) Q:'IEN  D
  1.  .S STA=$P($G(^DIC(4,+IEN,99)),U) Q:STA=""
  1.  .Q:$D(^TMP("XUMF ARRAY",$J,STA))
  1.  .S DR="99///@",DIE=4,DA=IEN
  1.  .D
  1.  ..N IEN D ^DIE
  1.  ;
  1.  S STA="",IEN=0
  1.  F  S STA=$O(^DIC(4,"D",STA)) Q:STA=""  D
  1.  .F  S IEN=$O(^DIC(4,"D",STA,IEN)) Q:'IEN  D
  1.  ..Q:$P($G(^DIC(4,+IEN,99)),U)=STA
  1.  ..K ^DIC(4,"D",STA,IEN)
  1.  ;
  1.  S DIK="^DIC(4,",DIK(1)="99^D" D ENALL^DIK
  1.  ;
  1.  Q
  1.  ;
  1. CSN ; -- check/update status
  1.  ;
  1.  N IEN,DIE,DR,DA,XUMF,STATUS,STA
  1.  ;
  1.  S XUMF=7
  1.  ;
  1.  S IEN=0
  1.  F  S IEN=$O(^DIC(4,IEN)) Q:'IEN  D
  1.  .S STA=$P($G(^DIC(4,+IEN,99)),U)
  1.  .I STA S DR="11///N",DIE=4,DA=IEN D  Q
  1.  ..N IEN D ^DIE
  1.  .S STATUS=$P(^DIC(4,IEN,0),U,11)
  1.  .I STATUS="I" S DR="101///I",DIE=4,DA=IEN D
  1.  ..N IEN D ^DIE
  1.  .S DR="11///L",DIE=4,DA=IEN D
  1.  ..N IEN D ^DIE
  1.  ;
  1.  Q
  1.  ;
  1. GOLD ; -- add missing national data from standard table
  1.  ;
  1.  N STA,NAME,FDA,ERROR,IEN,IENS,X,FLAG,CNT
  1.  N OLDNAME,OLDVANM,STATE,FACTYP,XUMF,STATE,AGENCY
  1.  ;
  1.  S XUMF=7
  1.  ;
  1.  S STA="",CNT=0
  1.  F  S STA=$O(^TMP("XUMF ARRAY",$J,STA)) Q:STA=""  D
  1.  .S X=^TMP("XUMF ARRAY",$J,STA)
  1.  .S IEN=$O(^DIC(4,"D",STA,0))
  1.  .S OLDNAME=$P($G(^DIC(4,+IEN,0)),U,1)
  1.  .S OLDVANM=$P($G(^DIC(4,+IEN,99)),U,3)
  1.  .S IENS=$S(IEN:IEN_",",1:"+1,")
  1.  .S NAME=$P(X,U,2)
  1.  .S FACTYP=$P(X,U,5)
  1.  .S VANAME=$P(X,U,6)
  1.  .S FLAG=$P(X,U,7)
  1.  .S STATE=$P(X,U,8)
  1.  .S AGENCY=$P(X,U,17)
  1.  .K FDA
  1.  .S FDA(4,IENS,.01)=NAME
  1.  .S FDA(4,IENS,.02)=STATE
  1.  .S FDA(4,IENS,99)=STA
  1.  .S FDA(4,IENS,11)="NATIONAL"
  1.  .S FDA(4,IENS,13)=$P(FACTYP,"~")
  1.  .S FDA(4,IENS,100)=VANAME
  1.  .S FDA(4,IENS,101)=FLAG
  1.  .S FDA(4,IENS,95)=$P(AGENCY,"~")
  1.  .D
  1.  ..N IEN,STA,NAME,VANAME,OLDNAME,OLDVANM
  1.  ..D UPDATE^DIE("E","FDA",,"ERR")
  1.  .I 'IEN S IEN=$O(^DIC(4,"D",STA,0))
  1.  .Q:'IEN
  1.  .I OLDNAME="" Q
  1.  .I OLDNAME=NAME,VANAME=OLDVANM Q
  1.  .S IENS="?+"_DT_","_IEN_","
  1.  .K FDA
  1.  .S FDA(4.999,IENS,.01)=DT
  1.  .S:NAME'=OLDNAME FDA(4.999,IENS,.02)=OLDNAME
  1.  .S:VANAME'=OLDVANM FDA(4.999,IENS,.03)=OLDVANM
  1.  .D
  1.  ..N STA
  1.  ..D UPDATE^DIE("E","FDA",,"ERR")
  1.  ..S CNT=CNT+1 I '(CNT#10) W "."
  1.  ;
  1.  Q
  1.  ;
  1. ASSC ; -- populate associations (parent facility and VISN)
  1.  ;
  1.  N IEN,STA,VISN,PARENT,FDA,XUMF,CNT
  1.  ;
  1.  S XUMF=7
  1.  ;
  1.  S STA="",CNT=0
  1.  F  S STA=$O(^TMP("XUMF ARRAY",$J,STA)) Q:STA=""  D
  1.  .S IEN=$O(^DIC(4,"D",STA,0)) Q:'IEN
  1.  .S VISN=$P(^TMP("XUMF ARRAY",$J,STA),U,9)
  1.  .I VISN'="" D
  1.  ..K FDA
  1.  ..S IENS="?+1,"_IEN_","
  1.  ..S FDA(4.014,IENS,.01)="VISN"
  1.  ..S FDA(4.014,IENS,1)=$P(VISN,"~")
  1.  ..D
  1.  ...N IEN,STA
  1.  ...D UPDATE^DIE("E","FDA")
  1.  .S PARENT=$P(^TMP("XUMF ARRAY",$J,STA),U,10)
  1.  .I PARENT'="" D
  1.  ..K FDA
  1.  ..S IENS="?+2,"_IEN_","
  1.  ..S FDA(4.014,IENS,.01)="PARENT FACILITY"
  1.  ..S FDA(4.014,IENS,1)=PARENT
  1.  ..D
  1.  ...N IEN,STA
  1.  ...D UPDATE^DIE("E","FDA")
  1.  ...S CNT=CNT+1 I '(CNT#10) W "."
  1.  ;
  1.  Q
  1.  ;
  1. HIST ; -- history
  1.  ;
  1.  N IEN,STA,EFFDT,FDA,XUMF,CNT
  1.  ;
  1.  S XUMF=7
  1.  ;
  1.  S STA="",CNT=0
  1.  F  S STA=$O(^TMP("XUMF ARRAY",$J,STA)) Q:STA=""  D
  1.  .S IEN=$O(^DIC(4,"D",STA,0)) Q:'IEN
  1.  .S EFFDT=$P(^TMP("XUMF ARRAY",$J,STA),U,11)
  1.  .S EFFDT=$$FMDATE^HLFNC(+EFFDT)
  1.  .I EFFDT D
  1.  ..S IENS="?+"_EFFDT_","_IEN_","
  1.  ..K FDA
  1.  ..S FDA(4.999,IENS,.01)=EFFDT
  1.  ..S FDA(4.999,IENS,.06)=$P(^TMP("XUMF ARRAY",$J,STA),U,12)
  1.  ..D
  1.  ...N IEN,STA
  1.  ...D UPDATE^DIE("E","FDA")
  1.  .S EFFDT=$P(^TMP("XUMF ARRAY",$J,STA),U,13)
  1.  .S EFFDT=$$FMDATE^HLFNC(+EFFDT)
  1.  .I EFFDT D
  1.  ..S IENS="?+"_EFFDT_","_IEN_","
  1.  ..K FDA
  1.  ..S FDA(4.999,IENS,.01)=EFFDT
  1.  ..S FDA(4.999,IENS,.05)=$P(^TMP("XUMF ARRAY",$J,STA),U,14)
  1.  ..D
  1.  ...N IEN,STA
  1.  ...D UPDATE^DIE("E","FDA")
  1.  ...S CNT=CNT+1 I '(CNT#10) W "."
  1.  ;
  1.  Q
  1.  ;
  1. CDSN() ; -- check for duplicate sta # (true=duplicates, false=none)
  1.  ;
  1.  K ^TMP("XUMF TMP",$J)
  1.  ;
  1.  N IEN,STA,CNT
  1.  ;
  1.  S STA="",IEN=0
  1.  F  S STA=$O(^DIC(4,"D",STA)) Q:STA=""  D
  1.  .F  S IEN=$O(^DIC(4,"D",STA,IEN)) Q:'IEN  D
  1.  ..S ^TMP("XUMF TMP",$J,STA,IEN)=$P(^DIC(4,IEN,0),U)
  1.  ;
  1.  S STA="",(CNT,IEN)=0
  1.  F  S STA=$O(^TMP("XUMF TMP",$J,STA)) Q:STA=""  D
  1.  .Q:'$O(^TMP("XUMF TMP",$J,STA,+$O(^TMP("XUMF TMP",$J,STA,0))))
  1.  .F  S IEN=$O(^TMP("XUMF TMP",$J,STA,IEN)) Q:'IEN  D
  1.  ..S CNT=CNT+1
  1.  ;
  1.  K ^TMP("XUMF TMP",$J)
  1.  ;
  1.  Q CNT
  1.  ;
  1. CMVD() ; -- check for missing national data
  1.  ;
  1.  N STA,CNT
  1.  ;
  1.  S CNT=0
  1.  ;
  1.  S STA=""
  1.  F  S STA=$O(^TMP("XUMF ARRAY",$J,STA)) Q:STA=""  D
  1.  .Q:$D(^DIC(4,"D",STA))
  1.  .S CNT=CNT+1
  1.  ;
  1.  Q CNT
  1.  ;
  1. CHCK ; -- check if clean up is complete
  1.  ;
  1.  N VAR,FLD
  1.  ;
  1.  K ^TMP("XUMF CHCK",$J)
  1.  ;
  1.  S VALMCNT=0
  1.  ;
  1.  I $$CDSN D
  1.  .S VALMCNT=VALMCNT+1,VAR=""
  1.  .S FLD="Local/Duplicate station #s exist -- use DSTA"
  1.  .S VAR=$$SETFLD^VALM1(FLD,VAR,"MSG")
  1.  .D SET^VALM10(VALMCNT,VAR,VALMCNT)
  1.  ;
  1.  I $$CMVD D
  1.  .S VALMCNT=VALMCNT+1,VAR=""
  1.  .S FLD="INSTITUTION file not updated with NATIONAL data -- use AUTO"
  1.  .S VAR=$$SETFLD^VALM1(FLD,VAR,"MSG")
  1.  .D SET^VALM10(VALMCNT,VAR,VALMCNT)
  1.  ;
  1.  D:'VALMCNT
  1.  .S VAR="",FLD="CONGRATULATIONS!!!  Update complete!"
  1.  .S VAR=$$SETFLD^VALM1(FLD,VAR,"MSG")
  1.  .D SET^VALM10(1,VAR,1)
  1.  ;
  1.  Q
  1.  ;
  1. FACTYP ;resolve duplicate facility types
  1.  ;
  1.  N FT,CNT,IEN,DA,DIE,DR
  1.  ;
  1.  S FT="",(CNT,IEN)=0
  1.  F  S FT=$O(^DIC(4.1,"B",FT)) Q:FT=""  D
  1.  .F  S IEN=$O(^DIC(4.1,"B",FT,IEN)) Q:'IEN  D
  1.  ..Q:$E(FT,1,2)="ZZ"
  1.  ..S CNT=CNT+1
  1.  ..Q:CNT<2
  1.  ..S DA=IEN,DIE=4.1
  1.  ..S DR=".01///ZZ"_$P($G(^DIC(4.1,+IEN,0)),U)
  1.  ..D ^DIE
  1.  .S CNT=0
  1.  ;
  1.  Q
  1.  ;
  1. STATE ;resolve duplicate states
  1.  ;
  1.  N STATE,CNT,IEN,DA,DIE,DR
  1.  ;
  1.  ;name
  1.  S STATE="",(CNT,IEN)=0
  1.  F  S STATE=$O(^DIC(5,"B",STATE)) Q:STATE=""  D
  1.  .F  S IEN=$O(^DIC(5,"B",STATE,IEN)) Q:'IEN  D
  1.  ..Q:$E(STATE,1,2)="ZZ"
  1.  ..S CNT=CNT+1
  1.  ..Q:CNT<2
  1.  ..S DA=IEN,DIE=5
  1.  ..S DR=".01///ZZ"_$P($G(^DIC(5,+IEN,0)),U)
  1.  ..D ^DIE
  1.  .S CNT=0
  1.  ;
  1.  ;abbreviation
  1.  S STATE="",(CNT,IEN)=0
  1.  F  S STATE=$O(^DIC(5,"C",STATE)) Q:STATE=""  Q:STATE  D
  1.  .F  S IEN=$O(^DIC(5,"C",STATE,IEN)) Q:'IEN  D
  1.  ..Q:$E(STATE,1,2)="ZZ"
  1.  ..S CNT=CNT+1
  1.  ..Q:CNT<2
  1.  ..S DA=IEN,DIE=5
  1.  ..S DR="1///ZZ"_$P($G(^DIC(5,+IEN,0)),U,2)
  1.  ..D ^DIE
  1.  .S CNT=0
  1.  ;
  1.  Q
  1.  ;
  1. FTCLEAN ; -- add missing facility types
  1.  ;
  1.  N NAME,FULL,FDA
  1.  ;
  1.  S NAME=""
  1.  F  S NAME=$O(^TMP("XUMF ARRAY",$J,NAME)) Q:NAME=""  D
  1.  .S FULL=$P(^TMP("XUMF ARRAY",$J,NAME),U,3)
  1.  .D
  1.  ..K FDA
  1.  ..S FDA(4.1,"?+1,",.01)=NAME
  1.  ..S FDA(4.1,"?+1,",1)=FULL
  1.  ..S FDA(4.1,"?+1,",3)="N"
  1.  ..N NAME
  1.  ..D UPDATE^DIE("E","FDA",,"ERR")
  1.  ;
  1.  Q
  1.  ;