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

XUMF4.m

Go to the documentation of this file.
  1. XUMF4 ;OIFO-OAK/RAM - Institution File Clean Up; 06/28/00
  1. ;;8.0;KERNEL;**206,209,212,261**;Jul 10, 1995
  1. ;
  1. ;
  1. EN ; -- entry point
  1. ;
  1. K ^TMP("XUMF ARRAY",$J)
  1. ;
  1. N PARAM,XUMFLAG,ERROR,TEST,ERR
  1. ;
  1. S (ERROR,XUMFLAG,TEST)=0
  1. ;
  1. I $P($$PARAM^HLCS2,U,3)="T" S TEST=1
  1. ;
  1. L +^TMP("XUMF ARRAY",$J):0 D:'$T
  1. .S ERROR="1^another process is using the Master File Server"
  1. ;
  1. I ERROR D EXIT1 Q
  1. ;
  1. I '$D(^TMP("XUMF ARRAY",$J)) D
  1. .W !!,"...connecting with master file server..."
  1. .D MFS0
  1. ;
  1. I ERROR D EXIT1 Q
  1. ;
  1. I '$D(^TMP("XUMF ARRAY",$J)) D D EXIT1 Q
  1. .S ERROR="1^Connection to master file server failed!"
  1. ;
  1. D FTCLEAN^XUMF4A I ERROR D EXIT1 Q
  1. ;
  1. K ^TMP("XUMF ARRAY",$J),^TMP("XUMF MFS",$J)
  1. ;
  1. W !!,"...connecting with master file server..."
  1. D MFS1
  1. ;
  1. I ERROR D EXIT1 Q
  1. ;
  1. I '$D(^TMP("XUMF ARRAY",$J)) D Q
  1. .S ERROR="1^Connection to master file server failed!"
  1. .D EXIT1
  1. ;
  1. D EN^VALM("XUMF NAME")
  1. ;
  1. D EXIT1
  1. ;
  1. Q
  1. ;
  1. RDSN ; - resolve duplicate station number
  1. ;
  1. I '$O(@VALMAR@("INDEX",0)) D Q
  1. .W !!,"No duplicates to select from!",!
  1. .S VALMBCK="R" H 2
  1. ;
  1. N ENTRY,VALMY,DA,DR,DIE,STA,MERGED,FROM
  1. ;
  1. D EN^VALM2(XQORNOD(0),"OS")
  1. Q:'$D(VALMY) Q:'$D(VALMAR)
  1. ;
  1. S DA=@VALMAR@("INDEX",+$O(VALMY(0)))
  1. S DR="99///@",DIE=4
  1. I DA D
  1. .I $O(^HLCS(870,"C",DA,0)) D Q
  1. ..W !!?20,"Pointed to by HL7 Logical Link"
  1. ..W !?22,"*select other entry*",!!
  1. .D ^DIE
  1. ;
  1. D @($E($P(VALMAR,"XUMF ",2),1,4)_"^XUMF4")
  1. S VALMBCK="R"
  1. ;
  1. Q
  1. ;
  1. ;
  1. DSTA ; -- duplicate station #s
  1. ;
  1. K ^TMP("XUMF DSTA",$J),^TMP("XUMF TMP",$J)
  1. ;
  1. I 'XUMFLAG D LOCAL
  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:'$D(^TMP("XUMF ARRAY",$J,STA))
  1. ..S ^TMP("XUMF TMP",$J,STA,IEN)=$P(^DIC(4,IEN,0),U)
  1. ;
  1. S STA="",(VALMCNT,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 VALMCNT=VALMCNT+1
  1. ..S VAR="",NAME=$P(^TMP("XUMF TMP",$J,STA,IEN),U)
  1. ..S VAR=$$SETFLD^VALM1(VALMCNT,VAR,"ENTRY NUMBER")
  1. ..S VAR=$$SETFLD^VALM1(STA,VAR,"STATION NUMBER")
  1. ..S VAR=$$SETFLD^VALM1(NAME,VAR,"INSTITUTION NAME")
  1. ..S VAR=$$SETFLD^VALM1(IEN,VAR,"IEN")
  1. ..D SET^VALM10(VALMCNT,VAR,VALMCNT)
  1. ..S @VALMAR@("INDEX",VALMCNT)=IEN
  1. ;
  1. D:'VALMCNT
  1. .S VAR="",VAR=$$SETFLD^VALM1("***No duplicates***",VAR,"INSTITUTION NAME")
  1. .S VALMCNT=1
  1. .D SET^VALM10(VALMCNT,VAR,VALMCNT)
  1. ;
  1. K ^TMP("XUMF TMP",$J)
  1. ;
  1. Q
  1. ;
  1. LOCAL ; -- auto-delete local/duplicate station numbers
  1. ;
  1. W !!,"This action will auto-delete local/duplicate station numbers."
  1. N Y S DIR(0)="Y",DIR("B")="YES" W !
  1. S DIR("A")="Do you wish to proceed"
  1. D ^DIR K DIR I 'Y Q
  1. ;
  1. S XUMFLAG=1
  1. D DXRF
  1. ;
  1. N IEN,STA,STANUM,VAR,NAME,FLAG,CNT
  1. ;
  1. S STA="",(IEN,CNT)=0
  1. F S STA=$O(^DIC(4,"D",STA)) Q:STA="" D
  1. .Q:'$O(^DIC(4,"D",STA,+$O(^DIC(4,"D",STA,0))))
  1. .S FLAG=0
  1. .F S IEN=$O(^DIC(4,"D",STA,IEN)) Q:'IEN D
  1. ..S:$O(^HLCS(870,"C",IEN,0)) FLAG=1
  1. .Q:'FLAG
  1. .F S IEN=$O(^DIC(4,"D",STA,IEN)) Q:'IEN D
  1. ..Q:$O(^HLCS(870,"C",IEN,0))
  1. ..W !?5,"deleting duplicate station number ",STA," from IEN: ",IEN
  1. ..H 1
  1. ..S DR="99///@",DIE=4,DA=IEN,CNT=CNT+1
  1. ..N IEN,STA,FLAG D ^DIE
  1. I CNT D EOP S CNT=0
  1. ;
  1. S STA="",IEN=0
  1. F S STA=$O(^DIC(4,"D",STA)) Q:STA="" D
  1. .Q:$D(^TMP("XUMF ARRAY",$J,STA))
  1. .Q:'$D(^TMP("XUMF ARRAY",$J))
  1. .F S IEN=$O(^DIC(4,"D",STA,IEN)) Q:'IEN D
  1. ..S DR="99///@",DIE=4,DA=IEN,CNT=CNT+1
  1. ..W !?5,"deleting local station number ",STA," from IEN: ",IEN
  1. ..H 1
  1. ..N IEN,STA D ^DIE
  1. I CNT D EOP S CNT=0
  1. ;
  1. Q
  1. ;
  1. ;
  1. DXRF ; -- re-index "D" cross-reference
  1. ;
  1. N DIK
  1. ;
  1. K ^DIC(4,"D")
  1. ;
  1. S DIK="^DIC(4,",DIK(1)="99^D" D ENALL^DIK
  1. ;
  1. Q
  1. ;
  1. ;
  1. LLCL ; -- local data
  1. ;
  1. K ^TMP("XUMF LLCL",$J)
  1. ;
  1. N STA,IEN,STANUM,VAR,NAME,FTYP
  1. ;
  1. S STA="",VALMCNT=0
  1. F S STA=$O(^DIC(4,"D",STA)) Q:STA="" D
  1. .S IEN=$O(^DIC(4,"D",STA,0))
  1. .S FTYP=$P($G(^DIC(4.1,+$G(^DIC(4,+IEN,3)),0)),U)
  1. .Q:$D(^TMP("XUMF ARRAY",$J,STA))
  1. .S VALMCNT=VALMCNT+1
  1. .S VAR="",NAME=$P(^DIC(4,IEN,0),U)
  1. .S VAR=$$SETFLD^VALM1(STA,VAR,"STATION NUMBER")
  1. .S VAR=$$SETFLD^VALM1(NAME,VAR,"INSTITUTION NAME")
  1. .S VAR=$$SETFLD^VALM1(IEN,VAR,"IEN")
  1. .S VAR=$$SETFLD^VALM1(FTYP,VAR,"FACILITY TYPE")
  1. .D SET^VALM10(VALMCNT,VAR,VALMCNT)
  1. .S @VALMAR@("INDEX",VALMCNT)=IEN
  1. ;
  1. D:'VALMCNT
  1. .S VAR="",VAR=$$SETFLD^VALM1("***None found***",VAR,"INSTITUTION NAME")
  1. .D SET^VALM10(1,VAR,1)
  1. ;
  1. Q
  1. ;
  1. ;
  1. NATL ; -- national data to merge
  1. ;
  1. K ^TMP("XUMF NATL",$J)
  1. ;
  1. N STA,VAR,NAME,TYPE,STATE
  1. ;
  1. S STA="",VALMCNT=0
  1. F S STA=$O(^TMP("XUMF ARRAY",$J,STA)) Q:STA="" D
  1. .Q:$D(^DIC(4,"D",STA))
  1. .S VALMCNT=VALMCNT+1
  1. .S VAR="",NAME=$P(^TMP("XUMF ARRAY",$J,STA),U,2)
  1. .S TYPE=$P($P(^TMP("XUMF ARRAY",$J,STA),U,5),"~")
  1. .S STATE=$P(^TMP("XUMF ARRAY",$J,STA),U,8)
  1. .S VAR=$$SETFLD^VALM1(STA,VAR,"STATION NUMBER")
  1. .S VAR=$$SETFLD^VALM1(NAME,VAR,"NATIONAL NAME")
  1. .S VAR=$$SETFLD^VALM1(STATE,VAR,"STATE")
  1. .S VAR=$$SETFLD^VALM1(TYPE,VAR,"TYPE")
  1. .D SET^VALM10(VALMCNT,VAR,VALMCNT)
  1. ;
  1. D:'VALMCNT
  1. .S VAR="",VAR=$$SETFLD^VALM1("***None found***",VAR,"NATIONAL NAME")
  1. .D SET^VALM10(1,VAR,1)
  1. ;
  1. Q
  1. ;
  1. ;
  1. NAME ; -- compare INSTITUTION name vs national name
  1. ;
  1. K ^TMP("XUMF NAME",$J),^TMP("XUMF TABLE",$J)
  1. ;
  1. N STA,IEN,NAME,GOLD,NAME,VAR,ARRAY
  1. ;
  1. D DXRF
  1. ;
  1. S STA="",(IEN,VALMCNT)=0
  1. F S STA=$O(^DIC(4,"D",STA)) Q:STA="" D
  1. .S IEN=$O(^DIC(4,"D",STA,0))
  1. .S GOLD=$P($G(^TMP("XUMF ARRAY",$J,STA)),U,2)
  1. .S NAME=$P(^DIC(4,IEN,0),U)
  1. .S ^TMP("XUMF TABLE",$J,STA,IEN)=NAME_U_GOLD
  1. ;
  1. F S STA=$O(^TMP("XUMF ARRAY",$J,STA)) Q:STA="" D
  1. .Q:$D(^TMP("XUMF TABLE",$J,STA))
  1. .S NAME=$P(^TMP("XUMF ARRAY",$J,STA),U,2)
  1. .S ^TMP("XUMF TABLE",$J,STA,9999)="^"_NAME
  1. ;
  1. S (IEN,VALMCNT)=0
  1. F S STA=$O(^TMP("XUMF TABLE",$J,STA)) Q:STA="" D
  1. .F S IEN=$O(^TMP("XUMF TABLE",$J,STA,IEN)) Q:'IEN D
  1. ..S GOLD=$P(^TMP("XUMF TABLE",$J,STA,IEN),U,2)
  1. ..S NAME=$P(^TMP("XUMF TABLE",$J,STA,IEN),U)
  1. ..S VALMCNT=VALMCNT+1,VAR=""
  1. ..S VAR=$$SETFLD^VALM1(STA,VAR,"STATION NUMBER")
  1. ..S VAR=$$SETFLD^VALM1(NAME,VAR,"INSTITUTION NAME")
  1. ..S VAR=$$SETFLD^VALM1(GOLD,VAR,"GOLD NAME")
  1. ..D SET^VALM10(VALMCNT,VAR,VALMCNT)
  1. ;
  1. D:'VALMCNT
  1. .S VAR="",VAR=$$SETFLD^VALM1("***None found***",VAR,"INSTITUTION NAME")
  1. .D SET^VALM10(1,VAR,1)
  1. ;
  1. K ^TMP("XUMF TABLE",$J)
  1. ;
  1. Q
  1. ;
  1. ;
  1. MFS0 ; -- get national facility type file from Master File Server
  1. ;
  1. D FACTYP^XUMF4A
  1. D STATE^XUMF4A
  1. ;
  1. S PARAM("LLNK")="XUMF MFR^XUMF "_$S('TEST:"FORUM",1:"TEST")
  1. S PARAM("PROTOCOL")=$O(^ORD(101,"B","XUMF MFQ",0))
  1. ;
  1. W !!,"...getting FACILITY TYPE file..."
  1. D MAIN^XUMFP(4.1,"ALL",7,.PARAM,.ERROR) Q:ERROR
  1. D MAIN^XUMFI(4.1,"ALL",7,.PARAM,.ERROR) Q:ERROR
  1. D MAIN^XUMFH
  1. ;
  1. Q
  1. ;
  1. MFS1 ; -- get national facility type file from Master File Server
  1. ;
  1. S PARAM("LLNK")="XUMF MFR^XUMF "_$S('TEST:"FORUM",1:"TEST")
  1. S PARAM("PROTOCOL")=$O(^ORD(101,"B","XUMF MFQ",0))
  1. ;
  1. W !!,"...getting INSTITUTION file..."
  1. W !,"...please wait...(approx. 5 minutes)..."
  1. D MAIN^XUMFP(4,"ALL",7,.PARAM,.ERROR) Q:ERROR
  1. D MAIN^XUMFI(4,"ALL",7,.PARAM,.ERROR) Q:ERROR
  1. D MAIN^XUMFH
  1. ;
  1. Q
  1. ;
  1. EXIT ; -- cleanup and quit
  1. ;
  1. K:$D(VALMAR) @VALMAR
  1. ;
  1. Q
  1. ;
  1. EXIT1 ;
  1. ;
  1. K ^TMP("XUMF ARRAY",$J),^TMP("XUMF MFS",$J)
  1. K ^TMP("DIERR",$J)
  1. ;
  1. L -^TMP("XUMF ARRAY",$J)
  1. ;
  1. I ERROR D
  1. .N XMY S XMY("G.XUMF INSTITUTION")=""
  1. .D EM^XUMFH(ERROR,.ERR,"IFR CLEANUP",.XMY)
  1. .W !!,ERROR,!,$G(ERR),!
  1. ;
  1. Q
  1. ;
  1. EOP ; -- End-of-Page
  1. ;
  1. S DIR(0)="E"
  1. D ^DIR,CLEAR^VALM1
  1. S VALMBCK="R"
  1. ;
  1. Q
  1. ;