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

XUMF04H.m

Go to the documentation of this file. 
  1. XUMF04H ;BP/RAM - INSTITUTION Handler ;11/16/05
  1.  ;;8.0;KERNEL;**549**;Jul 10, 1995;Build 12
  1.  ;
  1.  ; This routine handles Institution Master File HL7 messages.
  1.  ;
  1. MAIN ; -- entry point
  1.  ;
  1.  Q:$$KSP^XUPARAM("INST")=12000
  1.  ;
  1.  N X,HLFS,HLCS,ERROR,HLRESLTA,IFN,IEN,KEY,VALUE,ROOT,HLSCS,CDSYS,TEXT,ID
  1.  ;
  1.  D INIT,PROCESS,REPLY,EXIT
  1.  ;
  1.  Q
  1.  ;
  1. INIT ; -- initialize
  1.  ;
  1.  S ERROR=0,IEN=""
  1.  S HLFS=HL("FS"),HLCS=$E(HL("ECH")),HLSCS=$E(HL("ECH"),4)
  1.  ;
  1.  Q
  1.  ;
  1. PROCESS ; -- pull message text
  1.  ;
  1.  F  X HLNEXT Q:HLQUIT'>0  D
  1.  .Q:$P(HLNODE,HLFS)=""
  1.  .D @($P(HLNODE,HLFS))
  1.  ;
  1.  Q
  1.  ;
  1. MSH ; -- MSH segment
  1.  ;
  1.  Q
  1.  ;
  1. MSA ; -- MSA segment
  1.  ;
  1.  Q
  1.  ;
  1. QRD ; -- QRD segment
  1.  ;
  1.  Q
  1.  ;
  1. MFI ; -- MFI segment
  1.  ;
  1.  Q
  1.  ;
  1. MFE ; -- MFE segment
  1.  ;
  1.  S KEY=$P(HLNODE,HLFS,5)
  1.  ;
  1.  S ID=$P(KEY,HLCS)
  1.  S TEXT=$P(KEY,HLCS,2)
  1.  S CDSYS=$P(KEY,HLCS,3)
  1.  ;
  1.  I CDSYS="VASTANUM" D  Q
  1.  .S IEN=$O(^DIC(4,"D",ID,0)) Q:IEN
  1.  .S IEN=$O(^DIC(4,"B",TEXT,0))
  1.  ;
  1.  I CDSYS="NPI" D  Q
  1.  .S IEN=$O(^DIC(4,"ANPI",ID,0)) Q:IEN
  1.  .S IEN=$O(^DIC(4,"B",TEXT,0))
  1.  I CDSYS="DMIS" D  Q
  1.  .S IEN=$O(^DIC(4,"XUMFIDX","DMIS",ID,0)) Q:IEN
  1.  .S IEN=$O(^DIC(4,"B",TEXT,0))
  1.  ;
  1.  Q
  1.  ;
  1. ZIN ; -- VHA Institution segment
  1.  ;
  1.  W "."
  1.  ;
  1.  N NAME,FACTYP,OFNME,INACTIVE,STATE,VISN,PARENT,STREET,STREET2,CITY,ZIP
  1.  N STRT1,STRT2,CITY1,STATE1,STANUM,BILLNAME,IEN1,IENS,ERR,ERROR1
  1.  N ZIP1,AGENCY,NPIDT,NPISTAT,NPI,TAX,TAXPC,TAXSTAT,MAMMO,CLIA,DMIS,XXXX
  1.  ;
  1.  D PARSE^XUMFXHL7("HLNODE","XXXX")
  1.  ;
  1.  S STANUM=XXXX(2)
  1.  ;
  1.  I $G(STANUM),CDSYS'="VASTANUM" Q
  1.  ;
  1.  S XUMF=1,ERROR1=""
  1.  ;
  1.  S NAME=XXXX(1)
  1.  S FACTYP=$P(XXXX(4),"~",1)
  1.  S OFNME=XXXX(5)
  1.  S INACTIVE=XXXX(6)
  1.  S STATE=XXXX(7)
  1.  S VISN=XXXX(8)
  1.  S PARENT=XXXX(9)
  1.  S STREET=$P(XXXX(14),"~",1)
  1.  S STREET2=$P(XXXX(14),"~",2)
  1.  S CITY=$P(XXXX(14),"~",3)
  1.  S ZIP=$P(XXXX(14),"~",5)
  1.  S STRT1=$P(XXXX(15),"~",1)
  1.  S STRT2=$P(XXXX(15),"~",2)
  1.  S CITY1=$P(XXXX(15),"~",3)
  1.  S STATE1=$P(XXXX(15),"~",4)
  1.  S ZIP1=$P(XXXX(15),"~",5)
  1.  S AGENCY=$P(XXXX(16),"~")
  1.  S NPI=XXXX(17)
  1.  S NPISTAT=XXXX(18)
  1.  S NPIDT=$$FMDATE^HLFNC(XXXX(19))
  1.  S TAX=XXXX(20)
  1.  S TAXSTAT=XXXX(21)
  1.  S TAXPC=XXXX(22)
  1.  S CLIA=XXXX(23)
  1.  S MAMMO=XXXX(24)
  1.  S DMIS=XXXX(25)
  1.  S BILLNAME=XXXX(26)
  1.  ;
  1.  ; -- new entry
  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.02)=STREET2
  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.02)=STRT2
  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.  S FDA(4,IENS,200)=BILLNAME
  1.  S FDA(4,IENS,99)=STANUM
  1.  D FILE^DIE("E","FDA")
  1.  ;
  1.  I $G(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)=VISN
  1.  .D UPDATE^DIE("E","FDA")
  1.  ;
  1.  I $G(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 UPDATE^DIE("E","FDA")
  1.  ;
  1.  I $G(NPIDT)'="",$G(^DIC(4,IEN,"NPI"))'=NPI D
  1.  .S IENS="?+1,"_IEN_","
  1.  .S FDA(4.042,IENS,.01)=NPIDT
  1.  .S FDA(4.042,IENS,.02)=NPISTAT
  1.  .S FDA(4.042,IENS,.03)=NPI
  1.  .D UPDATE^DIE("E","FDA")
  1.  ;
  1.  I $G(TAX)'="",$P($$TAXORG^XUSTAX(IEN),U)'=TAX D
  1.  .K FDA,ROOT,IDX
  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")
  1.  ;
  1.  I $G(CLIA)'="" D
  1.  .S IENS="?+2,"_IEN_","
  1.  .K FDA
  1.  .S FDA(4.9999,IENS,.01)="CLIA"
  1.  .S FDA(4.9999,IENS,.02)=CLIA
  1.  .D UPDATE^DIE("E","FDA")
  1.  ;
  1.  I $G(MAMMO)'="" D
  1.  .S IENS="?+2,"_IEN_","
  1.  .K FDA
  1.  .S FDA(4.9999,IENS,.01)="MAMMO"
  1.  .S FDA(4.9999,IENS,.02)=MAMMO
  1.  .D UPDATE^DIE("E","FDA")
  1.  ;
  1.  I $G(DMIS)'="" D
  1.  .S IENS="?+2,"_IEN_","
  1.  .K FDA
  1.  .S FDA(4.9999,IENS,.01)="DMIS"
  1.  .S FDA(4.9999,IENS,.02)=DMIS
  1.  .D UPDATE^DIE("E","FDA")
  1.  ;
  1.  Q
  1.  ;
  1. REPLY ; -- master file response
  1.  ;
  1.  Q:HL("MTN")="MFR"
  1.  Q:HL("MTN")="MFK"
  1.  Q:HL("MTN")="ACK"
  1.  ;
  1.  N X
  1.  S X="MSA"_HLFS_$S(ERROR:"AE",1:"AA")_HLFS_HL("MID")_HLFS_$P(ERROR,U,2)
  1.  S ^TMP("HLA",$J,1)=X
  1.  ;
  1.  S HLP("PRIORITY")="I"
  1.  D GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"GM",1,.HLRESLT)
  1.  ;
  1.  ; check for error
  1.  I ($P($G(HLRESLT),U,3)'="") D  Q
  1.  .S ERROR=1_U_$P(HLRESLT,HLFS,3)_U_$P(HLRESLT,HLFS,2)_U_$P(HLRESLT,U)
  1.  ;
  1.  ; successful call, message ID returned
  1.  S ERROR="0^"_$P($G(HLRESLT),U,1)
  1.  ;
  1.  Q
  1.  ;
  1. EXIT ; -- cleanup, and quit
  1.  ;
  1.  Q
  1.  ;