Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Implementing the HL7 protocol
Message
From
03/07/2002 20:00:36
John Ryan
Captain-Cooker Appreciation Society
Taumata Whakatangi ..., New Zealand
 
General information
Forum:
Visual FoxPro
Category:
Third party products
Miscellaneous
Thread ID:
00672373
Message ID:
00675168
Views:
547
This message has been marked as the solution to the initial question of the thread.
Kirk

If you need to parse HL7 in VFP, you can have this for free! This particular variant is not pure HL7 but it isn't hard to customise...

I've peeled this out of a whole comms class, error handling removed as it doesn't help show how it all works. I have not tested it outside the class, so you will need to do some work to manage the data you extract.

First you need a hl7.h file so you can define segments and value positions etc. Check the following and make sure it matches what you need:
< file hl7.h >
#DEFINE MESSAGE_HEADER_SEGMENT "MSG_HDR"
#DEFINE MESSAGE_ACK_SEGMENT "MSG_ACK"
#DEFINE MESSAGE_DATETIME 8
#DEFINE MESSAGE_CONTROL_ID 9
#DEFINE MESSAGE_SENDER 5

#DEFINE PATIENT_IDENTIFICATION_SEGMENT "PAT_IDF"
#DEFINE PATIENT_NHI_ID 2
#DEFINE PATIENT_INTERNAL_ID 3
#DEFINE PATIENT_SURNAME 5
#DEFINE PATIENT_FIRSTNAME 6
#DEFINE PATIENT_INITIAL 7
#DEFINE PATIENT_DOB 8
#DEFINE PATIENT_GENDER 9
#DEFINE PATIENT_ADD1 10
#DEFINE PATIENT_ADD2 11
#DEFINE PATIENT_ADD3 12
#DEFINE PATIENT_ADD4 13

#DEFINE OBSERVATION_REQUEST_SEGMENT "OBS_REQ"
#DEFINE OBSERVATION_SET_ID 4
#DEFINE OBSERVATION_SET_DATE 11
#DEFINE OBSERVATION_REPORT_DATE 9
#DEFINE OBSERVATION_TYPE 6
#DEFINE OBSERVATION_TITLE 7

#DEFINE HAEM_RESULT "FBE"

#DEFINE RESULT_SEGMENT "OBS_RES"
#DEFINE VALUE_TYPE 3
#DEFINE VALUE1_TITLE 4
#DEFINE VALUE_VALUE 8
#DEFINE VALUE_UNITS 9
#DEFINE VALUE_RANGE 10
#DEFINE VALUE_FLAG 11
#DEFINE VALUE_EXTRA_TITLE 7
#DEFINE VALUE_EXTRA_TYPE 6
Next, you can easily move HL7 messages into a cursor in VFP and scan it. Here's how we do it: note that this is out of a class, when it says This.Getsegment() and This.Peeldate(), I'ver added the code it refers to, at the bottom. This is very old code, pre Y2K as you can tell from PeelDate(), if you want to fix and return I'll be delighted!
#include hl7.h


create cursor cursor1 (resultrow C(254))

LOCAL lcRowType,lcStatusSoFar,lcHeader,;
	lcPat_id,;
	lcRequestType,lcResult,llParsingError,lcFile1,lcFullheader
	
*---in this case, lcFile is filename for a HL7 message.
*---Ensure file suffix exists...
*---otherwise import etc fails.
IF ! "." $ lcFile
	lcFile=RTRIM(lcFile)+"."
ENDIF

APPEND FROM (lcFile) DELIMITED
*---now you have a cursor with the whole message...
*---it can contain lots of patients and results, no problem

SCAN
	
	lcRowType=This.GetSegment(1)
	DO CASE
	CASE lcRowType=MESSAGE_HEADER_SEGMENT
		IF ! EMPTY(lcHeader)
			*---If header already found:
			*---Parsing error.
			llParsingError=.t.
			EXIT
		ELSE
			*---Otherwise pull header identifiers
			lcHeader=This.GetSegment(MESSAGE_CONTROL_ID)
			lcSender_id=This.GetSegment(MESSAGE_SENDER)
			lcFullHeader=RTRIM(resultrow)
		ENDIF
	
	CASE lcRowType=PATIENT_IDENTIFICATION_SEGMENT
		*---Save any results pending...
		*---CHANGE THIS to match your own tables
		*---left here so you know to do it here
		=TableUpdate(0,.t.,'r_haemview')
		
		*---This is a patient....
		lcMembership_id=UPPER(CHRTRAN(This.GetSegment(PATIENT_NHI_ID)," ",""))
		*---hcuid (unique identifier) may have mixed case or spaces...
		*---change the above to match your own format
		lcName=This.GetSegment(PATIENT_SURNAME)+", "+;
			This.GetSegment(PATIENT_FIRSTNAME)+" "+;
			This.GetSegment(PATIENT_INITIAL)
		ldDOB=This.PeelDate(This.GetSegment(PATIENT_DOB)+"    ")
		lcGender=This.GetSegment(PATIENT_GENDER)
		*---Build an address....
		lcAddress=This.GetSegment(PATIENT_ADD1)
		lcTemp=This.GetSegment(PATIENT_ADD2)
		IF ! EMPTY(lcTemp)
			lcAddress=lcAddress+","+lcTemp
		ENDIF
		lcTemp=This.GetSegment(PATIENT_ADD3)
		IF ! EMPTY(lcTemp)
			lcAddress=lcAddress+","+lcTemp
		ENDIF
		lcTemp=This.GetSegment(PATIENT_ADD4)
		IF ! EMPTY(lcTemp)
			lcAddress=lcAddress+","+lcTemp
		ENDIF
		 
	CASE lcRowType=OBSERVATION_REQUEST_SEGMENT
		*---Save any results pending...
		*---CHANGE THIS to match your own tables
		*---left here so you know to do it here
		=TableUpdate(0,.t.,'r_haemview')
		
		lcResult_id=This.GetSegment(OBSERVATION_SET_ID)
		lcResult_id_overall=lcResult_id		
		ldRequestDate=This.PeelDate(This.GetSegment(OBSERVATION_SET_DATE))
		ldReportDate=This.PeelDate(This.GetSegment(OBSERVATION_REPORT_DATE))
		lcRequestType=RTRIM(This.GetSegment(OBSERVATION_TYPE))
		lcRequestTitle=This.GetSegment(OBSERVATION_TITLE)
				
		*---following view is requeried
		*---using result_id as parameter
		*---you might prefer to load it into an object
		SELECT r_haemview
		=Requery()
		IF RECCOUNT()=0
			INSERT INTO r_haemview (sender_id,request_date,membership_id,result_id,result_date,result_title,message) ;
				VALUES(lcSender_id,ldRequestdate,lcMembership_id,lcResult_id,ldReportDate,lcRequestTitle,lcHeader)
		ELSE
			REPLACE sender_id WITH lcSender_id,;
				request_date WITH ldRequestdate,;
				register_id WITH lnRegister_id,;
				result_id WITH lcResult_id,;
				result_date WITH ldReportdate,;
				result_title WITH lcRequesttitle,;
				message WITH lcHeader ;
				IN r_haemview
		ENDIF
		
	
	CASE lcRowType=RESULT_SEGMENT
		
		lcValueType=RTRIM(This.GetSegment(VALUE_TYPE))+RTRIM(This.GetSegment(VALUE_EXTRA_TYPE))
		lcValueTitle=This.GetSegment(VALUE_EXTRA_TITLE)
		
		IF EMPTY(lcValuetitle)
			lcValueTitle=This.GetSegment(VALUE1_TITLE)
		ENDIF
		
		lcValueResult=This.GetSegment(VALUE_VALUE)
		lcValueFlag=This.GetSegment(VALUE_FLAG)
		*---need to check range
		lcValueUnits=This.GetSegment(VALUE_UNITS)
		lcValueRange=STRTRAN(This.GetSegment(VALUE_RANGE),"!S!","^")
			
		*---Manage your results here
		*---in my case they get loaded into a table...
		*---? load into object
		*---? other
	ENDCASE
ENDSCAN

*---Save any results pending...
=TableUpdate(0,.t.,'r_haemview')
		
*---release cursor
USE IN cursor1

FUNCTION GetSegment()
LPARAMETER lnSegment
*---assumes | divider, ? could be rewritten to read from message
LOCAL lnStart,lnEnd
lnStart=AT("|","|"+cursor1.resultrow,lnSegment)
lnFinish=AT("|",cursor1.resultrow+"|",lnSegment)
RETURN CHRTRAN(SUBSTR(cursor1.resultrow,lnStart,lnFinish-lnStart),'"',"")

Function Peeldate()
LPARAMETER lcDate
*---peels date from string parameter
*---NOT INTERNATIONALISED or Y2K-ised- this expects dd/mm/yy
*---needs rewrite using ^yyyy-mm-dd
RETURN CTOT(SUBSTR(lcDate,7,2)+"/"+;
	SUBSTR(lcDate,5,2)+"/"+;
	LEFT(lcDate,4)+" "+;
	SUBSTR(lcDate,9,2)+":"+;
	SUBSTR(lcDate,11,2) )
HTH

If anybody has something better/easier, I'd be delighted to grab it!

Regards

JR
"... They ne'er cared for us
yet: suffer us to famish, and their store-houses
crammed with grain; make edicts for usury, to
support usurers; repeal daily any wholesome act
established against the rich, and provide more
piercing statutes daily, to chain up and restrain
the poor. If the wars eat us not up, they will; and
there's all the love they bear us.
"
-- Shakespeare: Coriolanus, Act 1, scene 1
Previous
Next
Reply
Map
View

Click here to load this message in the networking platform