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

XUMF416.m

Go to the documentation of this file.
  1. XUMF416 ;ISS/RAM - Load NPI;12/15/05
  1. ;;8.0;KERNEL;**416**;Jul 10, 1995;Build 5
  1. ;
  1. ; $$PARAM^HLCS2 call supported by IA #3552
  1. ;
  1. Q
  1. ;
  1. BG ; -- background job
  1. ;
  1. N ZTRTN,ZTDESC,ZTDTH
  1. ;
  1. S ZTRTN="EN^XUMF416"
  1. S ZTDESC="XUMF Load NPI"
  1. S ZTDTH=$$NOW^XLFDT
  1. S ZTIO=""
  1. ;
  1. D ^%ZTLOAD
  1. ;
  1. Q
  1. ;
  1. EN ; -- entry point
  1. ;
  1. K ^TMP("XUMF ARRAY",$J)
  1. ;
  1. N PARAM,XUMFLAG,ERROR,TEST
  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 EXIT Q
  1. ;
  1. D MFS0
  1. ;
  1. I ERROR D EXIT Q
  1. ;
  1. I '$D(^TMP("XUMF ARRAY",$J)) D
  1. .S ERROR="1^Connection to master file server failed!"
  1. ;
  1. I ERROR D EXIT Q
  1. ;
  1. D NPI
  1. ;
  1. D EXIT
  1. ;
  1. Q
  1. ;
  1. MFS0 ; -- get NPI from Institution Master File
  1. ;
  1. S PARAM("CDSYS")="NPI"
  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. 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. I '$$FIND1^DIC(4,,"BX","BONHAM PHARMACY") D EM
  1. ;
  1. K ^TMP("XUMF ARRAY",$J),^TMP("XUMF MFS",$J),^TMP("DIERR",$J)
  1. ;
  1. L -^TMP("XUMF ARRAY",$J)
  1. ;
  1. S ZTREQ="@"
  1. ;
  1. Q
  1. ;
  1. NPI ; -- add NPI ID to Institution file
  1. ;
  1. N ID,FDA,ERROR,IEN,IENS,HLNODE,ARRAY,XUMF,STANUM,TAX,TAXPC,TAXSTAT,NPI,NPIDT,NPISTAT,X,ERR,VISN
  1. N NAME,OFNME,AGENCY,FACTYP,STREET,CITY,STATE,ZIP,FDA,PARENT,STRT1,CITY1,STATE1,ZIP1,INACTIVE
  1. ;
  1. S XUMF=1
  1. ;
  1. S ID=""
  1. F S ID=$O(^TMP("XUMF ARRAY",$J,ID)) Q:ID="" D
  1. .K HLNODE
  1. .M HLNODE=^TMP("XUMF ARRAY",$J,ID)
  1. .D UPDATE
  1. ;
  1. Q
  1. ;
  1. UPDATE ;
  1. ;
  1. D SEGPRSE^XUMFXHL7("HLNODE","ARRAY")
  1. ;
  1. S NAME=ARRAY(1)
  1. S STANUM=ARRAY(2)
  1. S FACTYP=$P(ARRAY(4),"~",1)
  1. S OFNME=ARRAY(5)
  1. S INACTIVE=ARRAY(6)
  1. S STATE=ARRAY(7)
  1. S VISN=ARRAY(8)
  1. S PARENT=ARRAY(9)
  1. S STREET=$P(ARRAY(14),"~",2)
  1. S CITY=$P(ARRAY(14),"~",3)
  1. S ZIP=$P(ARRAY(14),"~",5)
  1. S STRT1=$P(ARRAY(15),"~",2)
  1. S CITY1=$P(ARRAY(15),"~",3)
  1. S STATE1=$P(ARRAY(15),"~",4)
  1. S ZIP1=$P(ARRAY(15),"~",5)
  1. S AGENCY=$P(ARRAY(16),"~")
  1. S NPIDT=$$FMDATE^HLFNC(ARRAY(17))
  1. S NPISTAT=ARRAY(18)
  1. S NPI=ARRAY(19)
  1. S TAX=ARRAY(20)
  1. S TAXPC=ARRAY(21)
  1. S TAXSTAT=ARRAY(22)
  1. ;
  1. S IEN=$$IEN^XUMF(4,"NPI",ID)
  1. I 'IEN,$G(STANUM)'="" S IEN=$O(^DIC(4,"D",STANUM,0))
  1. I 'IEN,$D(^DIC(4,"B",NAME)) S IEN=$O(^DIC(4,"B",NAME,0))
  1. ;
  1. I 'IEN D Q:'IEN
  1. .N X,Y S X=NAME
  1. .K DIC S DIC=4,DIC(0)="F"
  1. .D FILE^DICN K DIC
  1. .S IEN=$S(Y="-1":0,1:+Y)
  1. ;
  1. S IENS=IEN_","
  1. ;
  1. K FDA
  1. S FDA(4,IENS,.01)=NAME
  1. S FDA(4,IENS,13)=FACTYP
  1. S FDA(4,IENS,1.01)=STREET
  1. S FDA(4,IENS,1.03)=CITY
  1. S FDA(4,IENS,1.04)=ZIP
  1. S FDA(4,IENS,.02)=STATE
  1. S FDA(4,IENS,4.01)=STRT1
  1. S FDA(4,IENS,4.03)=CITY1
  1. S FDA(4,IENS,4.04)=STATE1
  1. S FDA(4,IENS,4.05)=ZIP1
  1. S FDA(4,IENS,11)="National"
  1. S FDA(4,IENS,100)=OFNME
  1. S FDA(4,IENS,101)=INACTIVE
  1. S FDA(4,IENS,95)=AGENCY
  1. D FILE^DIE("E","FDA","ERR")
  1. ;
  1. K FDA
  1. S IENS="?+1,"_IEN_","
  1. S FDA(4.014,IENS,.01)="VISN"
  1. S FDA(4.014,IENS,1)=VISN
  1. D UPDATE^DIE("E","FDA")
  1. ;
  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 UPDATE^DIE("E","FDA")
  1. ;
  1. S X=$$NPI^XUSNPI("Organization_ID",IEN,NPIDT)
  1. I $S(X=0:1,$$UP^XLFSTR($P(X,U,3))'=NPISTAT:1,NPI'=+X:1,1:0) D
  1. .S X=$$ADDNPI^XUSNPI("Organization_ID",IEN,NPI,NPIDT,$S(NPISTAT="ACTIVE":1,1:0))
  1. ;
  1. S IENS="?+1,"_IEN_","
  1. K FDA
  1. S FDA(4.9999,IENS,.01)="NPI"
  1. S FDA(4.9999,IENS,.02)=NPI
  1. D UPDATE^DIE("E","FDA",,"ERR")
  1. ;
  1. K FDA
  1. S IENS="?+1,"_IEN_","
  1. S FDA(4.043,IENS,.01)=TAX
  1. S FDA(4.043,IENS,.02)=TAXPC
  1. S FDA(4.043,IENS,.03)=TAXSTAT
  1. D UPDATE^DIE("E","FDA",,"ERR")
  1. ;
  1. Q
  1. ;
  1. POST ;
  1. ;
  1. D TAX,STA,OPT
  1. ;
  1. Q
  1. ;
  1. TAX ;
  1. ;
  1. N IENS,FDA
  1. ;
  1. S IENS="?+954,"
  1. K FDA
  1. S FDA(8932.1,IENS,.01)="General Acute Care Hospital"
  1. S FDA(8932.1,IENS,6)="282N00000X"
  1. S FDA(8932.1,IENS,90002)="NON-INDIVIDUAL"
  1. D UPDATE^DIE("E","FDA","IEN","ERR")
  1. ;
  1. S IENS="?+955,"
  1. K FDA
  1. S FDA(8932.1,IENS,.01)="VA FACILITY"
  1. S FDA(8932.1,IENS,6)="261QV0200X"
  1. S FDA(8932.1,IENS,90002)="NON-INDIVIDUAL"
  1. D UPDATE^DIE("E","FDA","IEN","ERR")
  1. ;
  1. S IENS="?+956,"
  1. K FDA
  1. S FDA(8932.1,IENS,.01)="Department of Veterans Affairs (VA) Pharmacy"
  1. S FDA(8932.1,IENS,6)="332100000X"
  1. S FDA(8932.1,IENS,90002)="NON-INDIVIDUAL"
  1. D UPDATE^DIE("E","FDA","IEN","ERR")
  1. ;
  1. Q
  1. ;
  1. OPT ;
  1. ;
  1. N IEN,FDA,IENS
  1. ;
  1. S IEN=$$FIND1^DIC(19,,"B","XUKERNEL")
  1. K FDA
  1. S IENS="?+1,"_IEN_","
  1. S FDA(19.01,IENS,.01)="XUMF LOAD NPI"
  1. D UPDATE^DIE("E","FDA")
  1. ;
  1. Q
  1. ;
  1. STA ;
  1. ;
  1. N STA,IEN,IENS,FDA,FTYP,XUMF
  1. ;
  1. S XUMF=1
  1. ;
  1. S STA=""
  1. F S STA=$O(^DIC(4,"D",STA)) Q:STA="" D
  1. .S IEN=$O(^DIC(4,"D",STA,0))
  1. .S IENS="?+1,"_IEN_","
  1. .K FDA
  1. .S FDA(4.9999,IENS,.01)="VASTANUM"
  1. .S FDA(4.9999,IENS,.02)=STA
  1. .D
  1. ..N IEN,STA
  1. ..D UPDATE^DIE("E","FDA")
  1. ;
  1. Q
  1. ;
  1. DEL ;USE EXTREME CAUTION!!!!
  1. ;
  1. N IEN,NPI,IEN1,FDA,ERR
  1. ;
  1. S IEN=0
  1. F S IEN=$O(^DIC(4,IEN)) Q:'IEN D
  1. .;Q:'$G(^DIC(4,IEN,99))
  1. .S NPI=$G(^DIC(4,IEN,"NPI")) ;Q:'NPI
  1. .K ^DIC(4,"ANPI",+NPI,IEN)
  1. .K ^DIC(4,"NPI42",+NPI,IEN)
  1. .K ^DIC(4,IEN,"NPI")
  1. .K ^DIC(4,IEN,"NPISTATUS")
  1. .K ^DIC(4,IEN,"TAXONOMY")
  1. .K ^DIC(4,"TAXSTATUS","A",IEN)
  1. ;
  1. XXX ;
  1. ;
  1. S NPI=0
  1. F S NPI=$O(^DIC(4,"XUMFIDX","NPI",NPI)) Q:'NPI D
  1. .S IEN=$O(^DIC(4,"XUMFIDX","NPI",NPI,0)) Q:'IEN
  1. .S IEN1=$O(^DIC(4,"XUMFIDX","NPI",NPI,IEN,0)) Q:'IEN1
  1. .;Q:'$G(^DIC(4,IEN,99))
  1. .K FDA
  1. .S FDA(4.9999,IEN1_","_IEN_",",.01)="@"
  1. .D FILE^DIE("E","FDA","ERR")
  1. ;
  1. YYY ;
  1. ;
  1. S IEN=$$FIND1^DIC(870,,"BX","XUMF FORUM")
  1. S IENS=IEN_","
  1. ;
  1. K FDA
  1. S FDA(870,IENS,4.5)=1
  1. S FDA(870,IENS,200.04)=60
  1. S FDA(870,IENS,200.05)=60
  1. D UPDATE^DIE(,"FDA")
  1. ;
  1. Q
  1. ;
  1. EM ;
  1. ;
  1. N X,XMTEXT,XMDUZ,XMSUB
  1. ;
  1. S X(1)="The post install of patch XU*8*416 has completed but the NPI values"
  1. S X(2)="did not get updated in your INSTITUTION (#4) file. Check your HL LOGICAL"
  1. S X(3)="LINK (#870) 'XUMF FORUM.' You should be able to PING the link -- stop/start"
  1. S X(4)="the link if necessary.",X(4.5)=""
  1. S X(5)="After you have verified your XUMF FORUM link use the 'Load Institution"
  1. S X(6)="NPI values' [XUMF LOAD NPI] in the [XUKERNEL] menu to load the NPI values."
  1. S X(7)=""
  1. S X(8)="NOTE: If you are installing in a TEST ACCOUNT then you may disregard this"
  1. S X(9)="message. If you do need to install the NPI values in a test/development"
  1. S X(10)="environment then you must set up the 'XUMF TEST' logical link to connect"
  1. S X(11)="to a test server environment. Hospitals will most likely not wish to update"
  1. S X(12)="the Institution file using HL7 messaging but rather wait until the mirror"
  1. S X(13)="image overwrites the file normally. If you do need to update the test or"
  1. S X(14)="development account and you don't have a test server available then you'll"
  1. S X(16)="need to contact the Institution file developer."
  1. ;
  1. S XMSUB="XUMF NPI ERROR/WARNING/INFO"
  1. S XMY("G.XUMF NPI")="",XMY(DUZ)="",XMDUZ=.5
  1. S XMTEXT="X("
  1. ;
  1. D ^XMD
  1. ;
  1. Q
  1. ;