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

XUMF4L1.m

Go to the documentation of this file.
  1. XUMF4L1 ;OIFO-OAK/RAM - Load IMF ;02/21/02
  1. ;;8.0;KERNEL;**217,261**;Jul 10, 1995
  1. ;
  1. ;
  1. EN ; -- entry point
  1. ;
  1. K ^TMP("XUMF ADD",$J),^TMP("XUMF MOD",$J),^TMP("XUMF DEL",$J)
  1. ;
  1. D DSN,GOLD,ASSC,HIST
  1. ;
  1. Q
  1. ;
  1. DSN ; -- clean out local station numbers
  1. ;
  1. N IEN,DIE,DR,DA,XUMF,DIK
  1. ;
  1. S XUMF=1
  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 ^TMP("XUMF DEL",$J,STA,IEN)=""
  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. 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,AGENCY
  1. ;
  1. S XUMF=1
  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:'IEN ^TMP("XUMF ADD",$J,STA)=^TMP("XUMF ARRAY",$J,STA)
  1. .D:IEN MOD
  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")
  1. ..S CNT=CNT+1
  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=1
  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
  1. ;
  1. Q
  1. ;
  1. HIST ; -- history
  1. ;
  1. N IEN,STA,EFFDT,FDA,XUMF,CNT
  1. ;
  1. S XUMF=1
  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
  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. MOD ; if entry modified set TMP
  1. ;
  1. N NAME,FACTYP,VANAME,STANUM,FLAG,PRNT,VISN,STATE,X,Y
  1. ;
  1. Q:'$D(^DIC(4,+IEN,0))
  1. ;
  1. S X=$P(^TMP("XUMF ARRAY",$J,STA),U,2,10)
  1. ;
  1. S NAME=$P($G(^DIC(4,+IEN,0)),U)
  1. S FACTYP=$P($G(^DIC(4.1,+$G(^DIC(4,+IEN,3)),0)),U)
  1. S:FACTYP'="" FACTYP=FACTYP_"~FACILITY TYPE~VA"
  1. S VANAME=$P($G(^DIC(4,+IEN,99)),U,3)
  1. S STANUM=$P($G(^DIC(4,+IEN,99)),U)
  1. S FLAG=$S(+$P($G(^DIC(4,+IEN,99)),U,4):"INACTIVE",1:"")
  1. S PRNT=$P($G(^DIC(4,+$P($G(^DIC(4,+IEN,7,2,0)),U,2),99)),U)
  1. S VISN=$P($G(^DIC(4,+$P($G(^DIC(4,+IEN,7,1,0)),U,2),0)),U)
  1. S:VISN'="" VISN=VISN_"~VISN~VA"
  1. S STATE=$P($G(^DIC(5,+$P($G(^DIC(4,+IEN,0)),U,2),0)),U)
  1. ;
  1. S Y=NAME_U_STANUM_U_"National"_U_FACTYP_U_VANAME_U_FLAG_U_STATE
  1. S Y=Y_U_VISN_U_PRNT
  1. ;
  1. Q:Y=X
  1. ;
  1. S ^TMP("XUMF MOD",$J,STA,"NEW")=X
  1. S ^TMP("XUMF MOD",$J,STA,"OLD")=Y
  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. ;