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