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

MDCPHL7A.m

Go to the documentation of this file.
  1. MDCPHL7A ;HINES OIFO/BJ - CliO HL7 Handler/validator;09 Aug 2006
  1. ;;1.0;CLINICAL PROCEDURES;**16**;Apr 01, 2004;Build 280
  1. ;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. ; This routine uses the following IAs:
  1. ; #10106 - $$FMDATE^HLFNC HL7 (supported)
  1. ; # 2165 - GENACK^HLMA1 HL7 (supported)
  1. ; # 2434 - $$DONTPURG^HLUTIL HL7 (supported)
  1. ;
  1. ;;only call via line tags.
  1. Q
  1. ;
  1. EN ;
  1. ; Main processing routine used by VistA HL7 subsystem
  1. ; Parameters -
  1. ; Covert (preset local variables) -
  1. ; See HL*1.6*56 guide, pg 9-4.
  1. ; HLMTIENS - The message ID
  1. ; HLNODE - Current message segment: set by HLNEXT;
  1. ; HLNODE(N) - Continuation nodes for current segment.
  1. ; HLQUIT - will be less than 1 if there are no more nodes.
  1. ;
  1. ; Returns -
  1. ; None
  1. ;
  1. ; We get the message instrument, date/time, and IEN.
  1. ;
  1. N MDCPMSH,MDCPID,MDCPFS,MDCPV1,MDCPLOC,MDCPINST,MDCPDTTM,MDCPIEN
  1. S MDCPFS=$G(HLREC("FS"))
  1. I MDCPFS="" S MDCPFS=$G(HL("FS"))
  1. F X HLNEXT Q:HLQUIT'>0 D
  1. .S:$P($G(HLNODE),MDCPFS)="MSH" MDCPMSH=HLNODE
  1. .S:$P($G(HLNODE),MDCPFS)="PID" MDCPID=HLNODE
  1. .S:$P($G(HLNODE),MDCPFS)="PV1" MDCPV1=HLNODE
  1. ;
  1. S MDCPINST=$P($G(MDCPMSH),MDCPFS,4)
  1. S MDCPDTTM=$$HL72FMDT($P($G(MDCPMSH),MDCPFS,7))
  1. S MDCPLOC=$P($G(MDCPV1),MDCPFS,4)
  1. S MDCPLOC=$P(MDCPLOC,$E(HL("ECH"),1),1)
  1. ;
  1. ; Check for XPAR setting to ignore this location (Entity = IGNORE_mdcploc)
  1. I MDCPLOC]"",$$GET^XPAR("SYS","MD PARAMETERS","IGNORE_"_MDCPLOC)=1 Q
  1. ;
  1. ; First, we log the message:
  1. S MDCPIEN=$$LOG(MDCPINST,$G(MDCPORD),MDCPDTTM,HLMTIEN,HLMTIENS,MDCPLOC)
  1. ;
  1. ; Next, we tell HL7 not to deep-six the message. We'll release the message
  1. ; later once we're sure that everything was okay both here and GUI-side.
  1. I $$DONTPURG^HLUTIL<0 D UPDRSN^MDCPHL7B(.MDCPTMP,MDCPIEN,"Unable to set the DONT PURGE flag for this message.")
  1. ;
  1. S MDCPSTAT=2 ; Assume everything will be ready to process
  1. ;
  1. ; Validate the PID segment and Device.
  1. I '$$VALPID(MDCPIEN,MDCPID) D
  1. .D UPDRSN^MDCPHL7B(.MDCPTMP,MDCPIEN,"Invalid patient identifying information for patient")
  1. .S MDCPSTAT=3
  1. ;
  1. ; Now to see if a mapping table exists
  1. I '$$VALMAP(MDCPIEN,MDCPINST) D
  1. .D UPDRSN^MDCPHL7B(.MDCPTMP,MDCPIEN,"Invalid device information.")
  1. .S MDCPSTAT=3
  1. ;
  1. ; Try and get the location - won't error out if it's not there
  1. D VALLOC(MDCPIEN,MDCPLOC)
  1. ;
  1. ; Status 2 = "Awaiting Processing", 3 = "Error"
  1. D UPDATERP^MDCPHL7B(.MDCPERR,MDCPIEN,MDCPSTAT)
  1. ;
  1. ; Finally, we tell HL7 to ack the message, as not to leave the device hanging.
  1. ;
  1. I $G(HL("APAT"))["AL" D
  1. .N MDCPRSLT,MDCPMSG
  1. .S HLA("HLA",1)="MSA"_MDCPFS_"AA"_MDCPFS_HL("MID")
  1. .D GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"LM",1,.MDCPRSLT)
  1. .I +$P($G(MDCPRSLT),U,2) D
  1. ..S MDCPSTAT="E"
  1. ..S MDCPMSG=$P(MDCPRSLT,U,3)
  1. .E D
  1. ..S MDCPSTAT="M"
  1. ..S MDCPMSG="Message acked successfully."
  1. ;
  1. Q
  1. ;
  1. LOG(MDCPINST,MDCPORD,MDCPDTTM,MDCPHL7,MDCPHDR,MDCPLOC) ; We need to make an entry in 704.002 for this message.
  1. ; Parameters -
  1. ; Overt:
  1. ; MDCPINST - The name of the instrument sending the message.
  1. ; MDCPORD - The order identifier returned from the instrument.
  1. ; MDCPDTTM - The date/time of the observation.
  1. ; MDCPHL7- The HL7 message id in file 773.
  1. ; MDCPHDR- The ID of the HL7 message in file 772 (for the MSH segment)
  1. ; MDCPLOC- The reported location of the patient in this HL7 message
  1. ;
  1. ; Returns -
  1. ; IEN of entry in 704.002.
  1. ;
  1. N MDCPFDA,MDCPID,MDCPRSLT,MDCPER,MDCPINS1,MDCPINS2,MDCPSTIN
  1. ;
  1. D GETGUID^MDCLIO1(.MDCPID)
  1. F Q:'$D(^MDC(704.002,"PK",MDCPID)) D GETGUID^MDCLIO1(.MDCPID)
  1. S MDCPFDA(704.002,"+1,",.01)=MDCPID
  1. S MDCPFDA(704.002,"+1,",.02)=1
  1. S MDCPFDA(704.002,"+1,",.04)=MDCPHDR
  1. S MDCPFDA(704.002,"+1,",.05)=MDCPHL7
  1. S MDCPFDA(704.002,"+1,",.08)=MDCPDTTM
  1. S MDCPFDA(704.002,"+1,",.11)=$G(MDCPLOC)
  1. D UPDATE^DIE("","MDCPFDA","MDCPRSLT","MDCPER")
  1. I '$D(MDCPER) Q MDCPRSLT(1)
  1. Q -1
  1. ;
  1. VALPID(MDCPIEN,MDCPID) ; Validate an HL7 PID segment.
  1. ;
  1. ; Note: This line tag assumes that all of the required segments are on the first
  1. ; PID segment part to come through. According to the HL7 v 2.4 spec, fields
  1. ; 3, 5, 6, 9, 10, 11, 13, 14, 15, 16, 17, and 18 (we're only interested in
  1. ; fields up to 19) can each hold up to 250 characters. However, this is not
  1. ; something we'd expect to see in real life.
  1. ;
  1. ; The Value in field 3,1 is expected to be canonic. If it is not present, we'll look at field 19.
  1. ; If field 19 is not present, then we drop back and punt.
  1. ; Parameters -
  1. ; Overt:
  1. ; MDCPIEN: The IEN of the message in the CP RESULT REPORT file
  1. ; MDCPID: The PID segment of the message to validate.
  1. ; Covert:
  1. ; None.
  1. ;
  1. ; The things that we're going to look at:
  1. ; =======================================
  1. ; Sequence Description
  1. ; - 3,1 Patient DFN or SSN(if given)
  1. ; - 5,1 Patient Last Name
  1. ; - 5,2 Patient First Name
  1. ; - 5,3 Patient Middle Name
  1. ; - 7 Patient DOB
  1. ; - 8 Patient Sex
  1. ; - * Patient SSN:
  1. ; If the SSN is given in the Patient ID array in segment 3, it needs to match what is in the DB
  1. ; If the SSN is given in sequence 19, it needs to match what is in the DB
  1. ; If the SSN is given in both places, both SSNs need to be identical.
  1. ;
  1. ; Result:
  1. ; Returns 0 if PID is invalid, 1 if PID is valid
  1. ;
  1. ; Note: $$FMNAME^XLFNAME appears courtesy of IA #3065 (public).
  1. ;
  1. N MDCPFDA,MDCPDFN,MDCPNAME,MDCPDOB,MDCPSEX,MDCPSSN,MDCPIX,MDCPSCRN,MDCPTMP,MDCPSTAT
  1. ;
  1. S MDCPSSN=$P(MDCPID,HL("FS"),4)
  1. S MDCPSSN=$P(MDCPSSN,$E(HL("ECH"),1))
  1. ;
  1. ;Right now, as part of the HL7 Spec, we're allowing them to send either SSN or last initial/last 4. It is my
  1. ;current understanding that the Patient Safety committee is going to require a full SSN for a match. So, we may
  1. ;end out modifying this item.
  1. S MDCPIX=$S(MDCPSSN?9N:"SSN",1:"")
  1. I MDCPIX="" D UPDRSN^MDCPHL7B(.MDCPTMP,MDCPIEN,"The SSN in PID-3 is not in a recognized format")
  1. ;
  1. S MDCPDOB=$P(MDCPID,HL("FS"),8),MDCPDOB=$$FMDATE^HLFNC(MDCPDOB)
  1. S:MDCPDOB?7N1".24" MDCPDOB=$$FMADD^XLFDT(MDCPDOB\1,1,0,0,0)
  1. S MDCPDOB=MDCPDOB\1
  1. S MDCPSEX=$E($P(MDCPID,HL("FS"),9),1,1)
  1. ;S MDCPNAME=$$FMNAME^HLFNC($P(MDCPID,HL("FS"),6),HL("ECH"))
  1. S MDCPNAME=$$FMNAME^XLFNAME($P(MDCPID,HL("FS"),6),"S",$E(HL("ECH")))
  1. S MDCPSCRN="I $P(^DPT(Y,0),U,1)="""_MDCPNAME_""",$P(^DPT(Y,0),U,2)="""_MDCPSEX_""",$P(^DPT(Y,0),U,3)="""_MDCPDOB_""""
  1. S MDCPDFN=$$FIND1^DIC(2,"","X",MDCPSSN,"SSN",MDCPSCRN)
  1. S MDCPSTAT=$S(+$G(MDCPDFN)>0:+MDCPDFN,1:"0")
  1. ; Now to save the info into the log.
  1. S:MDCPDFN>0 MDCPFDA(704.002,MDCPIEN_",",.06)=MDCPDFN ; Only file if valid pt found
  1. S MDCPFDA(704.002,MDCPIEN_",",.21)=MDCPNAME_"|"_MDCPSSN_"|"_MDCPDOB_"|"_MDCPSEX_"|"
  1. D FILE^DIE("K","MDCPFDA")
  1. Q MDCPSTAT
  1. ;
  1. VALMAP(MDCPIEN,MDCPINST) ; Validate an incoming device to a mapping table
  1. ; Purpose -
  1. ; This line tag will take an incoming HL7 Sending Application and ensure
  1. ; that it has a mapping table in the TERM_MAPPING_TABLE file (704.108)
  1. ; Compare is done on field SOURCE_ID (#.21) via the 'SOURCE' x-ref
  1. ;
  1. N MDCPFDA,MDVALID
  1. S MDVALID=$$FIND1^DIC(704.108,"","X",MDCPINST,"HL7")
  1. S MDCPFDA(704.002,MDCPIEN_",",.31)=MDCPINST
  1. S MDCPFDA(704.002,MDCPIEN_",",.03)=$S(MDVALID>0:$$GET1^DIQ(704.108,MDVALID_",",.01),1:"")
  1. D FILE^DIE("K","MDCPFDA")
  1. Q (MDVALID>0)
  1. ;
  1. VALLOC(MDCPIEN,MDCPLOC) ; Validate an incoming location to File 44
  1. N MDCPFDA,MDVALID
  1. S MDVALID=$$FIND1^DIC(44,"","X",MDCPLOC,"B")
  1. S MDCPFDA(704.002,MDCPIEN_",",.11)=MDCPLOC
  1. ;S MDCPFDA(704.002,MDCPIEN_",",**NEED A FIELD FOR THIS ITEM**)=$S(MDVALID>0:MDVALID,1:"")
  1. D FILE^DIE("K","MDCPFDA")
  1. Q
  1. ;
  1. BLDARRY(MDCPVAL,MDCPSEP) ; Build an array
  1. ;
  1. ; Purpose-
  1. ; This line tag will take the incoming string in MDCPVAL and will parse it based on the separator MDCPSEP.
  1. ; It will then build a local array with each node containing a piece delimited by MDCPSEP. As an example,
  1. ; given that MDCPVAL="This^is^a^test~string" and MDCPSEP="^", then when this line tag is done processing,
  1. ;
  1. ; MDCPVAL="This^is^a^test~string"
  1. ; MDCPVAL(1)="This"
  1. ; MDCPVAL(2)="is"
  1. ; MDCPVAL(3)="a"
  1. ; MDCPVAL(4)="test~string"
  1. ;
  1. ; Parameters
  1. ; MDCPVAL - The string to parse. Passed _by_reference_
  1. ; MDCPSEP - The separator
  1. ;
  1. ; Note: For now, this call is NOT meant to be invoked outside of MDCPHVLD
  1. ;
  1. N I,J,MDCPTEMP S I=1,J=0
  1. S MDCPTEMP=MDCPVAL
  1. F S MDCPVAL(I)=$P(MDCPTEMP,MDCPSEP,I) S I=I+1 Q:MDCPVAL(I-1)=""
  1. K MDCPVAL(I-1)
  1. Q
  1. ;
  1. HL72FMDT(MDHL7) ; Convert an HL7 Date/Time to Fileman
  1. ; Check for YYYYMMDDhhmmss pattern first
  1. Q:MDHL7'?14N.E -1
  1. S MDRET=($E(MDHL7,1,4)-1700)_$E(MDHL7,5,6)_$E(MDHL7,7,8)
  1. S MDRET=MDRET+("."_$E(MDHL7,9,14))
  1. ; Check for .24 - Even the ancient Mayan calendar understands what zero means :(
  1. I MDRET?7N1".24" S MDRET=$$FMADD^XLFDT(MDRET\1,1,0,0,0)
  1. ; Check for YYYYMMDDhhmmss-nn offset because not everyone is on central time :)
  1. I MDHL7?14N1"-"1.2N S MDRET=$$FMADD^XLFDT(MDRET,0,+$P(MDHL7,"-",2)*-1,0,0)
  1. Q MDRET
  1. ;