Tek-Tips is the largest IT community on the Internet today!
Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!
-
Congratulations derfloh on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!
Compile error when trying to build a dll in Foxpro9 2
- Thread starter scarrera
- Start date
Mike Gagnon
Programmer
What is the error?
Mike Gagnon
If you want to get the best response to a question, please check out FAQ184-2483 first.
Mike Gagnon
If you want to get the best response to a question, please check out FAQ184-2483 first.
- Thread starter
- #3
Mike Lewis
Programmer
The message is the answer to your question. Your code contains an ENDDEFINE statement, but that statement has to have a matching DEFINE CLASS statement. In other words, ENDDEFINE is only valid as part of a class definition.
This has got nothing to do with compilation. It just happens that the error was thrown up during a compile.
Mike
__________________________________
Mike Lewis (Edinburgh, Scotland)
Visual FoxPro articles, tips and downloads
This has got nothing to do with compilation. It just happens that the error was thrown up during a compile.
Mike
__________________________________
Mike Lewis (Edinburgh, Scotland)
Visual FoxPro articles, tips and downloads
- Thread starter
- #5
- Thread starter
- #6
this is the code....can I use endif??
Use
Select r
Use
Select Vflart
Use
Select pv1
Use
Select pv2
Use
Select v
Use
Select Defaults
Use
Select luttech
Use
Select lutref
Use
Select lutread
Use
Select LUTOWNA
Use
Select lutown
Use
Select LUTTESTSTEN
Use
Select LUTTEST
Use
Select custpaperless
Use
Select lutsite
Use
Select MSH
Return Mystring
Enddefine
Use
Select r
Use
Select Vflart
Use
Select pv1
Use
Select pv2
Use
Select v
Use
Select Defaults
Use
Select luttech
Use
Select lutref
Use
Select lutread
Use
Select LUTOWNA
Use
Select lutown
Use
Select LUTTESTSTEN
Use
Select LUTTEST
Use
Select custpaperless
Use
Select lutsite
Use
Select MSH
Return Mystring
Enddefine
-
1
- #7
Mike Lewis
Programmer
If that is really the only code, then you can indeed delete the ENDDEFINE. But are you sure you have posted the code correctly? The reason I ask is that the code you have posted does nothing useful, and will in any case generate another error (because the variable MyString is not defined).
Given that this is all new to you, it might be better if you consult the original programmer, or alternatively spend some time learning the fundamentals of VFP, rather than trying to deal with each error as it arises without understanding the theory behind it.
Mike
__________________________________
Mike Lewis (Edinburgh, Scotland)
Visual FoxPro articles, tips and downloads
Given that this is all new to you, it might be better if you consult the original programmer, or alternatively spend some time learning the fundamentals of VFP, rather than trying to deal with each error as it arises without understanding the theory behind it.
Mike
__________________________________
Mike Lewis (Edinburgh, Scotland)
Visual FoxPro articles, tips and downloads
Mike Lewis
Programmer
Just to clarify, when I said it doesn't do anything useful, I really meant that it is a lot of code for something that can be done in a single line. All those USE and SELECT statements could be replaced with a single CLOSE DATABASE ALL.
But that would still leave an error in the RETURN MyString.
Mike
__________________________________
Mike Lewis (Edinburgh, Scotland)
Visual FoxPro articles, tips and downloads
But that would still leave an error in the RETURN MyString.
Mike
__________________________________
Mike Lewis (Edinburgh, Scotland)
Visual FoxPro articles, tips and downloads
- Thread starter
- #9
Olaf Doschke
Programmer
Well, then post more code, or make it available on google drive or one drive.
The error could also be a too early enddefine in a previous line.
First of all, since there is an ENDDEFINE that should have a matching DEFINE somewhere up. Maybe the whole long prg is just one large class definition, maybe you have several classes defined in the file. Maybe someone already edited this code earlier and put in some enddefine, where he actually meant to put in an endproc, thus rendering the end of class definition much too early, rest of code can compile fine in that case until the final unexpected enddefine hits.
One nature of end delimiters is, that some of them are optional: endproc(edure) and endfunc(tion). The start of a procedure or function definition automatically closes the previous (Just like a HTML paragraph tag <p> closes the previous <p> without making a </p> necessary, when the previous HTML section was a paragraph, too. It's of course bad style and HTML validation sites will mark this as error, but ry that in your favorite HTML editor and browser).
Most end delimiters are not optional. Endif and enddefine for example are necessary. And finally, a stray extra enddefine will not work and cause that compile error.
So look back up and count pairs of define/enddefine and procedure/endproc and whether there is an enddefine somewhere in the middle of a class definition not followed by a next DEFINE. That hints on a place actually an endproc should be. And line 1117 could become correct again. It usually is normal a class definition prg ends in enddefine, so the error is likely to be found somewhere up.
Bye, Olaf.
Last thought: Either the code never compiled without error, or someone fiddled with it lately. There's a big chance you get a correcter version from an earlier backup. Some extra code may be missed from that, but the structure of begin/end delimiters should be okay in that backup.
The error could also be a too early enddefine in a previous line.
First of all, since there is an ENDDEFINE that should have a matching DEFINE somewhere up. Maybe the whole long prg is just one large class definition, maybe you have several classes defined in the file. Maybe someone already edited this code earlier and put in some enddefine, where he actually meant to put in an endproc, thus rendering the end of class definition much too early, rest of code can compile fine in that case until the final unexpected enddefine hits.
One nature of end delimiters is, that some of them are optional: endproc(edure) and endfunc(tion). The start of a procedure or function definition automatically closes the previous (Just like a HTML paragraph tag <p> closes the previous <p> without making a </p> necessary, when the previous HTML section was a paragraph, too. It's of course bad style and HTML validation sites will mark this as error, but ry that in your favorite HTML editor and browser).
Most end delimiters are not optional. Endif and enddefine for example are necessary. And finally, a stray extra enddefine will not work and cause that compile error.
So look back up and count pairs of define/enddefine and procedure/endproc and whether there is an enddefine somewhere in the middle of a class definition not followed by a next DEFINE. That hints on a place actually an endproc should be. And line 1117 could become correct again. It usually is normal a class definition prg ends in enddefine, so the error is likely to be found somewhere up.
Bye, Olaf.
Last thought: Either the code never compiled without error, or someone fiddled with it lately. There's a big chance you get a correcter version from an earlier backup. Some extra code may be missed from that, but the structure of begin/end delimiters should be okay in that backup.
Olaf Doschke
Programmer
Just by the way, even though a series of SELECTS and USE closing workareas could mean all tables should be closed, it could also mean some workareas are left open, even if it's just one essential, so I wouldn't touch that. There are better ways to cope with such a situation you want to close all except some alias names always open, but it'll be hard to retrofit those better strategies. For example using multiple private sessions is hard, when an OLEPUBLIC class for a DLL is based on the session class, as proposed by the VFP help. So keep your fingers off of that simplification. It may work at first and not become an obvious problem straight away. Then later you correlate an error with a recent change having nothing to do with the missing alias.
Bye, Olaf.
Bye, Olaf.
- Thread starter
- #12
Thank you all!
Here is the all the code...
*!* Define Class ARTERIAL_L As Session OlePublic
*!* Procedure SEARCHFORPATIENT()
*!* On Error Do errHandler With ;
*!* ERROR( ), Message( ), Message(1), Program( ), Lineno( )
Public MessageOK,m.cReadDrWithComma,mvreportstatus
MessageOK=.T.
CLOSE TABLES ALL
Set NullDisplay To Str(0)
Set Multilocks On
*!* Cursortoxml( "Defaults", "Defaults.XML", 1, 512, 0, "1" )
Xmltocursor("Defaults.XML","Defaults",512)
Select Defaults
If Used ("Pat")
Select Pat
Else
Use Alltrim(Defaults.Dir)+'DATA\Pat' In 0 Shared
Endif
Select Pat
CursorSetProp("Buffering",3)
If Used ("lutsite")
Select lutsite
Else
Use Alltrim(Defaults.Dir)+'DATA\lutsite' In 0 Shared
Endif
If Used ("v")
Select v
Else
Use Alltrim(Defaults.Dir)+'DATA\v' In 0 Shared
Endif
Select v
CursorSetProp("Buffering",3)
If Used ("r")
Select r
Else
Use Alltrim(Defaults.Dir)+'DATA\r' In 0 Shared
Endif
Select r
CursorSetProp("Buffering",3)
If Used ("vflart")
Select vflart
Else
Use Alltrim(Defaults.Dir)+'DATA\vflart' In 0 Shared
Endif
If Used ("LUTTEST")
Select LUTTEST
Else
Use Alltrim(Defaults.Dir)+'DATA\LUTTEST' In 0 Shared
Endif
If Used ("LUTTESTSTEN")
Select LUTTESTSTEN
Else
Use Alltrim(Defaults.Dir)+'DATA\LUTTESTSTEN' In 0 Shared
Endif
If Used ("LUTOWNA")
Select LUTOWNA
Else
Use Alltrim(Defaults.Dir)+'DATA\LUTOWNA' In 0 Shared
Endif
If Used ("luttech")
Select luttech
Else
Use Alltrim(Defaults.Dir)+'DATA\luttech 'In 0 Shared
Endif
If Used ("lutread")
Select lutread
Else
Use Alltrim(Defaults.Dir)+'DATA\lutread 'In 0 Shared
Endif
If Used ("lutref")
Select lutref
Else
Use Alltrim(Defaults.Dir)+'DATA\lutref 'In 0 Shared
Endif
If Used ("lutown")
Select lutown
Else
Use Alltrim(Defaults.Dir)+'DATA\lutown'In 0 Shared
Endif
If Used ("custpaperless")
Select custpaperless
Else
Use Alltrim(Defaults.Dir)+'DATA\custpaperless' In 0 Shared
Endif
If Used ("pv1")
Select pv1
Else
Use Alltrim(Defaults.Dir)+'DATA\pv1' In 0 Shared
Endif
If Used ("pv2")
Select pv2
Else
Use Alltrim(Defaults.Dir)+'DATA\pv2' In 0 Shared
Endif
Create Cursor MSH(Segment C(3),f1 C(4),f2 C(20),F3 C(20),f4 C(20),f5 C(48),f6 C(48),f7 C(26),f8 C(1),f9 C(48),f10 C(80),f11 C(106),;
f12 C(10),f13 C(40),F14 C(40),f15 C(60),F16 C(80),f17 C(80),f18 C(20),F19 C(16),f20 C(25),f21 C(20),F22 C(80),F23 C(60),;
f24 C(1),f25 C(2),f26 C(80),f27 C(60),f28 C(80),F29 C(26),f30 C(1),Id N(10),HL_Message M(4))
&&&&&&&Append the message into the table>>>>>>>>>>>>>>>>>>>>>>
Create Cursor pid(Segment C(3),f1 C(4),f2 C(20),F3 C(20),f4 C(20),f5 C(48),f6 C(48),f7 C(26),f8 C(1),f9 C(48),f10 C(80),f11 C(106),;
f12 C(4),f13 C(40),F14 C(40),f15 C(60),F16 C(80),f17 C(80),f18 C(20),F19 C(16),f20 C(25),f21 C(20),F22 C(80),F23 C(60),;
f24 C(1),f25 C(2),f26 C(80),f27 C(60),f28 C(80),F29 C(26),f30 C(1),Id N(10))
Create Cursor evn(Segment C(3),f1 i Autoinc Nextvalue 1 Step 1,f2 C(20),F3 C(20),f4 C(20),f5 C(48),f6 C(48),f7 C(26),f8 C(1),f9 C(48),f10 C(80),f11 C(106),;
f12 C(4),f13 C(40),F14 C(40),f15 C(60),F16 C(80),f17 C(80),f18 C(20),F19 C(16),f20 C(25),f21 C(20),F22 C(80),F23 C(60),;
f24 C(1),f25 C(2),f26 C(80),f27 C(60),f28 C(80),F29 C(26),f30 C(1),Id N(10))
Create Cursor OBR(Segment C(3),f1 i Autoinc Nextvalue 1 Step 1,f2 C(22),F3 C(22),f4 C(200),f5 C(200),f6 C(26),f7 C(26),f8 C(26),f9 C(20),f10 C(60),f11 C(50),;
f12 C(60),f13 C(254),F14 C(26),f15 C(254),F16 C(80),f17 C(40),f18 C(60),F19 C(60),f20 C(60),f21 C(60),F22 C(26),F23 C(40),;
f24 C(10),f25 C(1),f26 C(254),f27 C(200),f28 C(150),F29 C(200),f30 C(20),f31 C(254),f32 C(200),f33 C(200),f34 C(200),f35 C(200),;
f36 C(26),f37 C(4),F38 C(60),F39 C(200),f40 C(60),f41 C(30),f42 C(1),f43 C(200),f44 C(80),F45 C(80),Id N(10))
Create Cursor OBX(Segment C(3),f1 i Autoinc Nextvalue 1 Step 1;
,f2 C(254),F3 C(254),f4 C(254),f5 M(4),f6 C(48),f7 C(26),f8 C(1),f9 C(48),f10 C(80),f11 C(106),;
f12 C(4),f13 C(40),F14 C(40),f15 C(60),F16 C(80),f17 C(80),f18 C(20),F19 C(16),f20 C(25),f21 C(20),F22 C(80),F23 C(60),;
f24 C(1),f25 C(2),f26 C(80),f27 C(60),f28 C(80),F29 C(26),f30 C(1),Id N(10))
Create Cursor ORC(Segment C(3),f1 i Autoinc Nextvalue 1 Step 1;
,f2 C(254),F3 C(254),f4 C(254),f5 M(4),f6 C(48),f7 C(26),f8 C(1),f9 C(48),f10 C(80),f11 C(106),;
f12 C(4),f13 C(40),F14 C(40),f15 C(60),F16 C(80),f17 C(80),f18 C(20),F19 C(16),f20 C(25),f21 C(20),F22 C(80),F23 C(60),;
f24 C(1),f25 C(2),f26 C(80),f27 C(60),f28 C(80),F29 C(26),f30 C(1),Id N(10))
Create Cursor AL1(Segment C(3),f1 C(4),f2 C(20),F3 C(20),f4 C(20),f5 C(48),f6 C(48),f7 C(26),f8 C(1),f9 C(48),f10 C(80),f11 C(106),;
f12 C(4),f13 C(40),F14 C(40),f15 C(60),F16 C(80),f17 C(80),f18 C(20),F19 C(16),f20 C(25),f21 C(20),F22 C(80),F23 C(60),;
f24 C(1),f25 C(2),f26 C(80),f27 C(60),f28 C(80),F29 C(26),f30 C(1),Id N(10))
Create Cursor pv1c(Segment C(3),f1 C(4),f2 C(20),F3 C(20),f4 C(20),f5 C(48),f6 C(48),f7 C(254),f8 C(254),f9 C(48),f10 C(80),f11 C(106),;
f12 C(4),f13 C(40),F14 C(40),f15 C(60),F16 C(80),f17 C(80),f18 C(20),F19 C(16),f20 C(25),f21 C(20),F22 C(80),F23 C(60),;
f24 C(1),f25 C(2),f26 C(80),f27 C(60),f28 C(80),F29 C(26),f30 C(1),Id N(10))
Select v
Set Order To Tag Xpipattag Of Alltrim(Defaults.Dir)+'DATA\pat.cdx' In Pat
Set Relation To v.xfipattag Into Pat Additive
Set Order To Tag xpivtag Of Alltrim(Defaults.Dir)+'DATA\r.cdx' In r
Set Relation To xpivtag Into r Additive
Set Order To Tag xpivtag Of Alltrim(Defaults.Dir)+'data\pv1.cdx' In pv1
Set Relation To xpivtag Into pv1 Additive
Set Order To Tag xpivtag Of Alltrim(Defaults.Dir)+'data\pv2.cdx' In pv2
Set Relation To xpivtag Into pv2 Additive
Set Order To Tag xpivtag Of Alltrim(Defaults.Dir)+'DATA\vflart.cdx' In vflart
Set Relation To xpivtag Into vflart Additive
Set Order To Tag Xtest Of Alltrim(Defaults.Dir)+'DATA\luttest.cdx' In LUTTEST
Set Relation To Xtest Into LUTTEST Additive
Set Order To Tag Xtech Of Alltrim(Defaults.Dir)+'DATA\luttech.cdx' In luttech
Set Relation To Xtech Into luttech Additive
Set Order To Tag xread Of Alltrim(Defaults.Dir)+'DATA\lutread.cdx' In lutread
Set Relation To v.xread Into lutread Additive
Set Order To Tag Xref Of Alltrim(Defaults.Dir)+'DATA\lutref.cdx' In lutref
Set Relation To Xref Into lutref Additive
Set Order To Tag Xsite Of Alltrim(Defaults.Dir)+'DATA\lutsite.cdx' In lutsite
Set Relation To Xsite Into lutsite Additive
Select LUTTEST
Set Order To Tag Xsten Of Alltrim(Defaults.Dir)+'DATA\lutteststen.cdx' In LUTTESTSTEN
Set Relation To LUTTEST.Xsten Into LUTTESTSTEN
Select v
*Added code to tighten search
Locate For v.xpivtag==Defaults.studyid And v.xfipattag == Defaults.Patientid And v.Xtest == Defaults.Xtest
If Found()
If Used ("msh")
Select MSH
Else
Use Data\MSH In 0 Shared
Endif
Select MSH
Calculate Max (Id)To maxID
Append Blank
Replace Id With maxID+1
Replace MSH.Segment With "MSH"
Replace MSH.f1 With "|"
mvEncoding = Alltrim(Defaults.hl7_enc_cs)+Alltrim(Defaults.hl7_enc_rs)+Alltrim(Defaults.hl7_enc_ec)+Alltrim(Defaults.hl7_enc_ss)
Replace MSH.f2 With mvEncoding
Replace MSH.F3 With Alltrim(Defaults.HL7_sapp)
Replace MSH.f4 With Alltrim(Defaults.hl7_sfac)
Replace MSH.f5 With Alltrim(Defaults.hl7_rapp)
Replace MSH.f6 With Alltrim(Defaults.hl7_rfac)
Replace MSH.f9 With Alltrim(Defaults.hl7_mess)+"^" +Alltrim(Defaults.hl7_eve)
m.yr=Alltrim(Str( Year(Date( ))))
m.mo=Alltrim(Padl(Month(Date( )),2,"0"))
m.day=Alltrim(Padl(Day(Date( )),2,"0"))
m.hour=Alltrim(Padl(Hour(Datetime()),2,"0"))
m.min=Alltrim(Padl(Minute(Datetime()),2,"0"))
m.now= (m.yr+m.mo+m.day+m.hour+m.min)
Replace f7 With m.now
Replace f10 With Alltrim(Str(Pat.Xpipattag))+"-"+Alltrim(Str(Defaults.studyid))
Replace f11 With Alltrim(Defaults.hl7_pid)
Replace f12 With Alltrim(Defaults.hl7_ver)
****Added ver 10.5 include additional fields for HL7
Public abc,mvPatientAge
If Not Empty(Pat.dBirth)
*** Reject negative bithdate
If Empty (v.ddate)
mvPatientAge = Floor((Date()-Pat.dBirth)/365.25)
Else
mvPatientAge = Floor((v.ddate-Pat.dBirth)/365.25)
Endif
If mvPatientAge = -1
mvPatientAge= 0
Endif
mvPatientAge=Alltrim(Str(mvPatientAge))
*** check for pediaictric age month
If Between(Val(mvPatientAge), 0, 1)
If Empty (v.ddate)
mvPatientAge = Floor((Date()-Pat.dBirth)/30.43)
Else
mvPatientAge = Floor((v.ddate-Pat.dBirth)/30.43)
Endif
mvPatientAge=Alltrim(Str(mvPatientAge)+"M")
Endif
*** check for pediaictric age week
If Val(mvPatientAge)=0
If Empty (v.ddate)
mvPatientAge = Floor((Date()-Pat.dBirth)/7)
Else
mvPatientAge = Floor((v.ddate-Pat.dBirth)/7)
Endif
mvPatientAge=Alltrim(Str(mvPatientAge)+"W")
Endif
*** check for pediaictric age day
If Val(mvPatientAge)=0
If Empty (v.ddate)
mvPatientAge = Floor((Date()-Pat.dBirth))
Else
mvPatientAge = Floor((v.ddate-Pat.dBirth))
Endif
mvPatientAge=mvPatientAge +1 &&& to keep patient from being 0 days old
mvPatientAge=Alltrim(Str(mvPatientAge)+"D")
Endif
Else
mvPatientAge=""
Endif
Public mvadmit
Select LUTTEST
abc=''
For i = 1 To 12
mva='v.lt'+Alltrim(Str(i))
If &mva=.T.
mvb='Luttest.Clabt'+Alltrim(Str(i))
If i=1
abc=&mvb
Else
abc=abc+&mvb+","
Endif
If Substr(abc,Lenc(abc))=","
abc=Substr(abc,1,Lenc(abc)-1)
Endif
Endif
Endfor
mvadmit=''
If v.napp=1
mvadmit="Inpatient"
Endif
If v.napp=2
mvadmit="Outpatient"
Endif
If v.napp=3
mvadmit=""
Endif
***Populate the PID Table
If Used ("pid")
Select pid
Else
Use Data\pid In 0
Endif
***Put name in proper format then populate field 5 in PID Table
Select Pat
m.nFirstBlank =At(" ", Pat.xrcname,1)
m.nSecondBlank =At(" ", Pat.xrcname,2)
m.Last=Substr(Pat.xrcname, 1 ,m.nFirstBlank)
m.First=Substr(Pat.xrcname, m.nFirstBlank, m.nSecondBlank- m.nFirstBlank)
m.middle=Substr(Pat.xrcname, m.nSecondBlank)
Select pid
Append Blank
Select pid
Replace Segment With "PID"
m.num=Alltrim(Str(Pat.Xpipattag))
If Empty(Pat.cextpatid)=.F.
Replace F3 With Pat.cextpatid
Else
Replace F3 With m.num
Endif
Replace f2 With Alltrim(Pat.Xrcssn)
If Empty(Pat.hl7_name)
Replace pid.f5 With Alltrim(m.Last)+"^"+Alltrim(m.First)+"^"+Alltrim(m.middle)
Else
&&Changed name here for proper parsing now store the name in pat table exactly the way i receive it.
Replace pid.f5 With Alltrim(Pat.hl7_name)
Endif
m.yr=Alltrim(Str( Year(Pat.dBirth)))
m.mo=Alltrim(Padl(Month(Pat.dBirth),2,"0"))
m.day=Alltrim(Padl(Day(Pat.dBirth),2,"0"))
*!* m.hour=Alltrim(Padl(Hour(v.ddatetime),2,"0"))
*!* m.min=Alltrim(Padl(Minute(v.ddatetime),2,"0"))
m.constantdobdateandtime= (m.yr+m.mo+m.day)
*!* +m.hour+m.min)
*!* ?m.constantdobdateandtime
Replace f7 With (m.constantdobdateandtime)
Replace pid.f8 With Pat.cmf
*!* REPLACE HL7_new WITH .F.
Replace Id With maxID+1
&& added for common orders Account #
Replace pid.f20 With Alltrim(v.cAccession)
********************
**** PV1 **********
*******************
Select pv1c
Append Blank
Select pv1c
Replace Segment With "PV1c"
Do Case
Case v.napp=1
Replace pv1c.f2 With 'I'
Case v.napp=2
Replace pv1c.f2 With 'O'
Otherwise
Replace pv1c.f2 With ''
Endcase
mvreadName=''
mvreadName=Alltrim(lutread.corgin_id)+"^"
For i = 1 To Alines(namearray,Alltrim(lutread.Name)," ")
mvreadName=mvreadName+namearray(i)+"^"
Endfor
*!* mvreadName=mvreadName+Alltrim(lutread.Degree)
Replace pv1c.f7 With Alltrim(mvreadName)
mvrefName=''
mvrefName=Alltrim(lutref.corgin_id)+"^"
For q = 1 To Alines(namearray,Alltrim(lutref.Name)," ")
mvrefName=mvrefName+namearray(q)+"^"
Endfor
*!* mvrefName=mvrefName+Alltrim(lutref.Degree)
Replace pv1c.f8 With Alltrim(mvrefName)
********************
**** ORC **********
*******************
If Used ("ORC")
Select ORC
Else
Use Data\ORC In 0
Endif
Select ORC
Append Blank
Select ORC
Replace Segment With "ORC"
*added code to check to see if message has been sent before if changed send C=Changed.
If v.lrepcomp=.T.
If Empty(v.drepalt)
Replace f25 With "F"
m.yr=Alltrim(Str( Year(v.drepcomp)))
m.mo=Alltrim(Padl(Month(v.drepcomp),2,"0"))
m.day=Alltrim(Padl(Day(v.drepcomp),2,"0"))
m.hour=Alltrim(Padl(Hour(v.drepcomp),2,"0"))
m.min=Alltrim(Padl(Minute(v.drepcomp),2,"0"))
m.now= (m.yr+m.mo+m.day+m.hour+m.min)
Replace F22 With m.now
Else
Replace f25 With "C"
m.yr=Alltrim(Str( Year(v.drepalt)))
m.mo=Alltrim(Padl(Month(v.drepalt),2,"0"))
m.day=Alltrim(Padl(Day(v.drepalt),2,"0"))
m.hour=Alltrim(Padl(Hour(v.drepalt),2,"0"))
m.min=Alltrim(Padl(Minute(v.drepalt),2,"0"))
m.now= (m.yr+m.mo+m.day+m.hour+m.min)
Replace F22 With m.now
Endif
Else
Replace f25 With Defaults.result_sta
Endif
&&Added code for Order ID for Common order DR.Kings site.
Replace ORC.F3 With Alltrim(v.cORC_3)
Replace ORC.f4 With Alltrim(v.cOBR_2)
********************
**** OBR **********
*******************
If Used ("OBR")
Select OBR
Else
Use Data\OBR In 0
Endif
Select OBR
Append Blank
Select OBR
Replace Segment With "OBR"
m.num=Alltrim(Str(v.xpivtag))
Replace f4 With m.num + "^" + Alltrim(V.Cprocedure)
Replace f5 With m.num + "^" + Alltrim(Defaults.obr_filler)
*OBR7 needs the original Study date and never changes.
m.yr=Alltrim(Str( Year(v.ddatetime)))
m.mo=Alltrim(Padl(Month(v.ddatetime),2,"0"))
m.day=Alltrim(Padl(Day(v.ddatetime),2,"0"))
m.hour=Alltrim(Padl(Hour(v.ddatetime),2,"0"))
m.min=Alltrim(Padl(Minute(v.ddatetime),2,"0"))
m.constantstudydateandtime= (m.yr+m.mo+m.day+m.hour+m.min)
Replace f7 With (m.constantstudydateandtime)
Replace f8 With (m.constantstudydateandtime)
Replace Id With maxID+1
m.yr=Alltrim(Str( Year(Date( ))))
m.mo=Alltrim(Padl(Month(Date( )),2,"0"))
m.day=Alltrim(Padl(Day(Date( )),2,"0"))
m.hour=Alltrim(Padl(Hour(Datetime()),2,"0"))
m.min=Alltrim(Padl(Minute(Datetime()),2,"0"))
m.now= (m.yr+m.mo+m.day+m.hour+m.min)
Replace F22 With m.now
Replace f24 With Defaults.Diagnostic
*added code to check to see if message has been sent before if changed send C=Changed.
*!* If v.lrepcomp=.T.
If Empty(v.drepalt)
Replace f25 With "F"
m.yr=Alltrim(Str( Year(v.drepcomp)))
m.mo=Alltrim(Padl(Month(v.drepcomp),2,"0"))
m.day=Alltrim(Padl(Day(v.drepcomp),2,"0"))
m.hour=Alltrim(Padl(Hour(v.drepcomp),2,"0"))
m.min=Alltrim(Padl(Minute(v.drepcomp),2,"0"))
m.sec=Alltrim(Padl(Sec(v.drepcomp),2,"0"))
m.now= (m.yr+m.mo+m.day+m.hour+m.min+m.sec)
Replace F22 With m.now
Else
Replace f25 With "C"
m.yr=Alltrim(Str( Year(v.drepalt)))
m.mo=Alltrim(Padl(Month(v.drepalt),2,"0"))
m.day=Alltrim(Padl(Day(v.drepalt),2,"0"))
m.hour=Alltrim(Padl(Hour(v.drepalt),2,"0"))
m.min=Alltrim(Padl(Minute(v.drepalt),2,"0"))
m.sec=Alltrim(Padl(Sec(v.drepcomp),2,"0"))
m.now= (m.yr+m.mo+m.day+m.hour+m.min+m.sec)
Replace F22 With m.now
Endif
*!* Else
*!* Replace f25 With Defaults.result_sta
*!* Endif
&&Added code for Order ID for Common order
Replace OBR.f2 With '1'
Replace OBR.F3 With Alltrim(v.cORC_3)
*!* Replace OBR.f4 With Alltrim(v.cOBR_2)
Replace OBR.F3 With Alltrim(v.cOBR_2)
&&Referring Doc Added Dupage
mvHL7Ref=''
For i = 1 To Alines(refArray,Alltrim(lutref.Name)," ")
If i >1
mvHL7Ref=mvHL7Ref+"^"+refArray(i)
Else
mvHL7Ref=mvHL7Ref+refArray(i)
Endif
Endfor
Replace OBR.f17 With Alltrim(lutref.corgin_id)+"^"+mvHL7Ref
*!* Replace OBR.f5 With Alltrim(v.cobr_4)
&&Added code for Meditech they require obr.20
Replace OBR.f21 With Alltrim(lutown.cobr20)
&&Changed code here for Guthrie the needed site in OBR21
*!* Replace OBR.F22 With Alltrim(lutsite.site)
&&Bassett
Select OBR
Replace OBR.f32 With Alltrim(lutread.corgin_id)+"^"+Alltrim(lutread.Name)+"^"+m.now
*!* && Basset change 3/13/2012
*!* Replace OBR.f12 With v.cobr_11
*!* Replace OBR.f33 With ALLTRIM(lutread.Name)
&&&&Added code to parse HL7 correct format
&&&&Added code to parse HL7 correct format
m.nCharactersInLine=75-10
***********************Cleveland Clinic Formatted***********************************************************
If v.xind =0;
OR v.xind =1;
AND Isblank(v.xind)=.T.
Else
For mycount=1 To 46
indication="LUTTEST.I"+Alltrim(Str(mycount))
ind=Alines(indArray,&indication,"-")
If mycount= v.xind
mvindication=indArray(1)
Do addobx
If ind>1
Replace OBX.F22 With indArray(2)
Else
Replace OBX.F22 With ''
Endif
Endif
Endfor
Endif
*!* For gncount= 1 To 3
*!* Do addobx
*!* Endfor
Do addobx
Replace f5 With Padc(Alltrim(lutown.Inst),m.nCharactersInLine-10," ")
*!* Do addobx
Do addobx
Replace f5 With Padc(Alltrim(lutown.Address1)+" "+Alltrim(lutown.City)+" "+Alltrim(lutown.State)+" ";
+Alltrim(lutown.zip),m.nCharactersInLine-10," ")
*!* For gncount= 1 To 3
*!* Do addobx
*!* Endfor
Do addobx
Replace f5 With Padc(Alltrim(lutown.Title),m.nCharactersInLine-10," ")
Do addobx
If Isblank(Pat.cextpatid)
mvMRN=Alltrim(Pat.Xrcssn)
Else
mvMRN=Alltrim(Pat.cextpatid)
Endif
Do addobx
Replace f5 With"NAME: "+Alltrim(Pat.xrcname)+" ";
+Alltrim(Defaults.PID_2)+" "+mvMRN
* +"CLINIC NO.: "+Alltrim(Pat.Xrcssn)
Do addobx
Do addobx
Replace f5 With "TEST: "+Alltrim(v.cprocedure)
*!* Do addobx
Select Vflart
If Isblank(Vflart.mTech)=.F.
Do addobx
Do addobx
Replace OBX.f5 With "TECH NOTES:"
Select Vflart
Do addobx
Replace OBX.f5 With Alltrim(Vflart.mTech)
Endif
*!* Select r
*!* Locate For xpivtag = r.xpivtag
Select r
If Isblank(r.mhmemo)=.F.
Do addobx
Do addobx
Replace OBX.f5 With Upper("History NOTES:")
Select r
Set Memowidth To 75
For gncount = 1 To Memlines(r.mhmemo)
Do addobx
Replace OBX.f5 With Mline(r.mhmemo,gncount)
Endfor
Endif
*!* Do addobx
If v.xind =0;
OR v.xind =1;
AND Isblank(v.xind)=.T.
Else
For mycount=1 To 46
indication="LUTTEST.I"+Alltrim(Str(mycount))
If mycount= v.xind
Do addobx
Replace OBX.f5 With "PRIMARY INDICATION: "+ &indication
Do addobx
Endif
Endfor
Endif
*!* *!* &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
*!* &&&&&&&&&&&&&&&&&&&Clincal Observations&&&&&&&&&&&&&
Do addobx
Replace OBX.f5 With "CLINICAL OBSERVATIONS:"
Select r
Scan For r.xpivtag = v.xpivtag &&&&Pull out all the risk Factors and clinical observations
Select LUTTEST
Scan For Xtest = r.Xtest
For clincalcount=17 To 46
myclin="r.h"+Alltrim(Str(clincalcount))+""
myhis="LUTTEST.h"+Alltrim(Str(clincalcount))+""
If Isblank(&myclin)=.F.
Do addobx
Replace OBX.f5 With Space(10) +&myhis +": "+&myclin
Endif
Endfor
Endscan
Endscan
&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
&&&&&&&&&&&&&&&&&&& RISK FACTORS &&&&&&&&&&&&&
Select r
Scan For r.xpivtag = v.xpivtag &&&&Pull out all the risk Factors and clinical observations
Select LUTTEST
Scan For Xtest = r.Xtest
For clincalcount=1 To 16
myclin="r.h"+Alltrim(Str(clincalcount))+""
myhis="LUTOWNA.r"+Alltrim(Str(clincalcount))+""
If Isblank(&myclin)=.F.
Do addobx
Replace OBX.f5 With "RISK FACTORS:"
Exit
Endif
Endfor
Endscan
Endscan
Select r
Scan For r.xpivtag = v.xpivtag &&&&Pull out all the risk Factors and clinical observations
Select LUTTEST
Scan For Xtest = r.Xtest
For clincalcount=1 To 16
myclin="r.h"+Alltrim(Str(clincalcount))+""
myhis="LUTOWNA.r"+Alltrim(Str(clincalcount))+""
If Isblank(&myclin)=.F.
Do addobx
Replace OBX.f5 With Space(10) +&myhis +": "+&myclin
Endif
Endfor
Endscan
Endscan
*!* Quality of care
Select v
If Isblank(v.Qmemo)=.F.
Do addobx
Replace OBX.f5 With "QUALITY OF CARE:"
Select vfext
Do addobx
Replace OBX.f5 With Alltrim(v.Qmemo)
Endif
*!* *!* Tech Notes
*!* Select vfext
*!* If Isblank(vfext.Qmemo)=.F.
*!* Do addobx
*!* Replace OBX.f5 With "TECH NOTES:"
*!* Select vfext
*!* Replace OBX.f5 With Alltrim(vfext.mTech)
*!* Endif
*!* IMPRESSIONS
Select Vflart
If Isblank(Vflart.mimpress)=.F.
Do addobx
Replace OBX.f5 With "IMPRESSIONS:"
Do addobx
Replace OBX.f5 With Alltrim(Vflart.mimpress)
Endif
&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
Select OBX
Do addobx
Select OBX
Do addobx
Select OBX
Public mvReadSignature
If Not Empty(lutread.Name)
mvLastLength=At(" ",lutread.Name)
mvReadSignature=Alltrim(Substr(lutread.Name,mvLastLength))+" "+Alltrim(Substr(lutread.Name,1,mvLastLength))+" "+Alltrim(lutread.Degree)
Else
mvReadSignature=""
Endif
If v.lrepcomp=.T.
Replace OBX.f5 With "Signed electronically by " + mvReadSignature
Do addobx
Select OBX
m.hour=Alltrim(Str(Hour(v.drepcomp)))
If m.hour='13' Or m.hour='14' Or m.hour='15' Or m.hour='16' Or m.hour='17' Or m.hour='18' Or m.hour='19' Or m.hour='20' Or m.hour='21' Or m.hour='22' Or m.hour='23' Or m.hour='24'
Do Case
Case m.hour='13'
m.hour='01'
Case m.hour='14'
m.hour='02'
Case m.hour='15'
m.hour='03'
Case m.hour='16'
m.hour='04'
Case m.hour='17'
m.hour='05'
Case m.hour='18'
m.hour='06'
Case m.hour='19'
m.hour='07'
Case m.hour='20'
m.hour='08'
Case m.hour='21'
m.hour='09'
Case m.hour='22'
m.hour='10'
Case m.hour='23'
m.hour='11'
Case m.hour='24'
m.hour='12'
Endcase
If Minute(v.drepcomp)<10
m.minutes="0"+Alltrim(Str(Minute(v.drepcomp)))
Else
m.minutes=Alltrim(Str(Minute(v.drepcomp)))
Endif
If Substr(m.hour,1,1)="0"
Replace OBX.f5 With "at "+Substr(m.hour,2)+":"+m.minutes+" PM on " +Cdow(v.drepcomp)+", "+Cmonth(v.drepcomp)+" "+Alltrim(Str(Day(v.drepcomp)))+", "+Alltrim(Str(Year(v.drepcomp)))
Else
Replace OBX.f5 With "at "+m.hour+":"+m.minutes+" PM on " +Cdow(v.drepcomp)+", "+Cmonth(v.drepcomp)+" "+Alltrim(Str(Day(v.drepcomp)))+", "+Alltrim(Str(Year(v.drepcomp)))
Endif
Else
If Minute(v.drepcomp)<10
m.minutes="0"+Alltrim(Str(Minute(v.drepcomp)))
Else
m.minutes=Alltrim(Str(Minute(v.drepcomp)))
Endif
If Substr(m.hour,1,1)="0"
Replace OBX.f5 With "at "+Substr(m.hour,2)+":"+m.minutes+" AM on " +Cdow(v.drepcomp)+", "+Cmonth(v.drepcomp)+" "+Alltrim(Str(Day(v.drepcomp)))+", "+Alltrim(Str(Year(v.drepcomp)))
Else
Replace OBX.f5 With "at "+m.hour+":"+m.minutes+" AM on " +Cdow(v.drepcomp)+", "+Cmonth(v.drepcomp)+" "+Alltrim(Str(Day(v.drepcomp)))+", "+Alltrim(Str(Year(v.drepcomp)))
Endif
Endif
Else
Replace OBX.f5 With "READ BY: "+mvReadSignature
Endif
If Empty(v.drepalt)=.F.
Do addobx
Select v
m.hour=Alltrim(Str(Hour(v.drepalt)))
If m.hour='13' Or m.hour='14' Or m.hour='15' Or m.hour='16' Or m.hour='17' Or m.hour='18' Or m.hour='19' Or m.hour='20' Or m.hour='21' Or m.hour='22' Or m.hour='23' Or m.hour='24'
Do Case
Case m.hour='13'
m.hour='01'
Case m.hour='14'
m.hour='02'
Case m.hour='15'
m.hour='03'
Case m.hour='16'
m.hour='04'
Case m.hour='17'
m.hour='05'
Case m.hour='18'
m.hour='06'
Case m.hour='19'
m.hour='07'
Case m.hour='20'
m.hour='08'
Case m.hour='21'
m.hour='09'
Case m.hour='22'
m.hour='10'
Case m.hour='23'
m.hour='11'
Case m.hour='24'
m.hour='12'
Endcase
If Minute(v.drepalt)<10
m.minutes="0"+Alltrim(Str(Minute(v.drepalt)))
Else
m.minutes=Alltrim(Str(Minute(v.drepalt)))
Endif
If Substr(m.hour,1,1)="0"
Replace OBX.f5 With "Altered at "+Substr(m.hour,2)+":"+m.minutes+" PM on " +Cdow(v.drepalt)+", "+Cmonth(v.drepalt)+" "+Alltrim(Str(Day(v.drepalt)))+", "+Alltrim(Str(Year(v.drepalt)))
Else
Replace OBX.f5 With "Altered at "+m.hour+":"+m.minutes+" PM on " +Cdow(v.drepalt)+", "+Cmonth(v.drepalt)+" "+Alltrim(Str(Day(v.drepalt)))+", "+Alltrim(Str(Year(v.drepalt)))
Endif
Else
If Minute(v.drepalt)<10
m.minutes="0"+Alltrim(Str(Minute(v.drepalt)))
Else
m.minutes=Alltrim(Str(Minute(v.drepalt)))
Endif
If Substr(m.hour,1,1)="0"
Replace OBX.f5 With "Altered at "+Substr(m.hour,2)+":"+m.minutes+" AM on " +Cdow(v.drepalt)+", "+Cmonth(v.drepalt)+" "+Alltrim(Str(Day(v.drepalt)))+", "+Alltrim(Str(Year(v.drepalt)))
Else
Replace OBX.f5 With "Altered at "+m.hour+":"+m.minutes+" AM on " +Cdow(v.drepalt)+", "+Cmonth(v.drepalt)+" "+Alltrim(Str(Day(v.drepalt)))+", "+Alltrim(Str(Year(v.drepalt)))
Endif
Endif
Endif
Endif
************** Embedded Digital Reports *************************************
Select OBX
Scan
Replace OBX.F3 With Alltrim(v.cobr_4)
If Alltrim(OBX.f2)=="RP"
Else
Replace OBX.f2 With Alltrim(Defaults.obx_value)
Endif
Replace F3 With Alltrim(Defaults.obx_id)
Replace OBX.f4 With Alltrim(Defaults.obx_obs_su)
Replace Segment With "OBX"
Replace F16 With Alltrim(lutread.corgin_id)+"^"+Alltrim(lutread.Name)+"^"+m.now
Endscan
If custpaperless.Lrep_path=.T.
Select OBX
Append Blank
Replace F3 With Alltrim(Defaults.obx_id)
Replace f4 With Alltrim(Defaults.obx_obs_su)
Replace Segment With "OBX"
Do Case
Case custpaperless.LPathunc=.T.
Replace f2 With "RP"
x=Alltrim(v.cDigreport)
Replace OBX.f5 With x
Case custpaperless.led=.T.
*Kalida Health
*For the PDF - OBX:5 OBX with "ED" in OBX:2 set up as follows: This should be a coded Base64 PDF.
*copy what you have in OBX:5 to OBX:5.5
* add OBX:5.1 should be blank
* OBX:5.2 = "IMAGE"
* OBX:5.3 = "PDF"
* OBX:5.4 = "BASE64"
Replace f2 With "ED"
x=Strconv(Filetostr(Alltrim(v.cDigreport)),13)
Replace OBX.f5 With "" + "^IMAGE" + "^PDF" + "^BASE64^" + x
Case custpaperless.Lpathurl=.T.
Replace f2 With "RP"
x=Alltrim(custpaperless.cprefix)+Alltrim(v.cDigreport)
Replace OBX.f5 With x
Endcase
Endif
********************************************************************************************
Select OBX
GOTO TOP
Scan
If Alltrim(OBX.f2)=="ED"
Else
Replace OBX.f2 With ""
Endif
Endscan
********************************************************************************************
*!* One more correction. For OBX:3 please use order alias and description that is OBR:4.
*!* In the last message you should have seen this "VASL0012^Venous Lower Unilateral" in OBR:4.
Select OBX
GOTO TOP
Scan
If Alltrim(OBX.f2)=="ED"
ELSE
Replace OBX.f3 With Alltrim(V.Cobr_4)
*!* Replace OBX.f3 With m.num + "^" + Alltrim(V.Cprocedure)
Endif
ENDSCAN
********************************************************************************************
Select MSH
Replace HL_Message With ;
ALLTRIM(Segment)+Alltrim(f1)+Alltrim(f2)+"|"+Alltrim(F3)+"|"+Alltrim(f4)+"|"+;
ALLTRIM(f5)+"|"+Alltrim(f6)+"|"+Alltrim(f7)+"|"+Alltrim(f8)+"|"+Alltrim(f9)+"|"+Alltrim(f10)+;
"|"+Alltrim(f11)+"|"+Alltrim(f12)+"|"+Alltrim(f13)
&&&PID
Select MSH
Replace HL_Message With HL_Message + Chr(13)
Select MSH
Replace HL_Message With HL_Message;
+Alltrim(pid.Segment)+"|"+Alltrim(Str(OBR.f1))+"|"+Alltrim(pid.f2)+"|"+Alltrim(pid.F3)+"|"+Alltrim(pid.f4)+"|"+;
ALLTRIM(pid.f5)+"|"+Alltrim(pid.f6)+"|"+Alltrim(pid.f7)+"|"+Alltrim(pid.f8)+"|"+Alltrim(pid.f9)+"|"+Alltrim(pid.f10);
+Alltrim(pid.f11)+"|"+Alltrim(pid.f12)+"|"+Alltrim(pid.f13)+"|"+Alltrim(pid.F14)+"|"+Alltrim(pid.f15)+"|"+Alltrim(pid.F16);
+Alltrim(pid.f17)+"|"+Alltrim(pid.f18)+"|"+Alltrim(pid.F19)+"|"+Alltrim(pid.f20)+"|"+Alltrim(pid.f21)+"|"+Alltrim(pid.F22);
+Alltrim(pid.F23)+"|"+Alltrim(pid.f24)+"|"+Alltrim(pid.f25)+"|"+Alltrim(pid.f26)+"|"+Alltrim(pid.f27)+"|"+Alltrim(pid.f28);
+Alltrim(pid.F29)+"|"+Alltrim(pid.f30)
&&&Pv1
If Defaults.cpv1 = .T.
&&&PV1
Select MSH
Replace HL_Message With HL_Message + Chr(13)
Select MSH
Replace HL_Message With HL_Message;
+Alltrim(pv1c.Segment)+"|"+Alltrim(Str(OBR.f1))+"|"+Alltrim(pv1c.f2)+"|"+Alltrim(pv1c.F3)+"|"+Alltrim(pv1c.f4)+"|"+;
ALLTRIM(pv1c.f5)+"|"+Alltrim(pv1c.f6)+"|"+Alltrim(pv1c.f7)+"|"+Alltrim(pv1c.f8)+"|"+Alltrim(pv1c.f9)+"|"+Alltrim(pv1c.f10);
+Alltrim(pv1c.f11)+"|"+Alltrim(pv1c.f12)+"|"+Alltrim(pv1c.f13)+"|"+Alltrim(pv1c.F14)+"|"+Alltrim(pv1c.f15)+"|"+Alltrim(pv1c.F16);
+Alltrim(pv1c.f17)+"|"+Alltrim(pv1c.f18)+"|"+Alltrim(pv1c.F19)+"|"+Alltrim(pv1c.f20)+"|"+Alltrim(pv1c.f21)+"|"+Alltrim(pv1c.F22);
+Alltrim(pv1c.F23)+"|"+Alltrim(pv1c.f24)+"|"+Alltrim(pv1c.f25)+"|"+Alltrim(pv1c.f26)+"|"+Alltrim(pv1c.f27)+"|"+Alltrim(pv1c.f28);
+Alltrim(pv1c.F29)+"|"+Alltrim(pv1c.f30)
Endif
&&&Pv2
If Defaults.cpv2 = .T.
mvpv2="PV2"
For q = 1 To 37
mvField="f"+Alltrim(Str(q))
mvpv2=mvpv2+"|"+Alltrim(pv2.&mvField)
Endfor
Select MSH
Replace HL_Message With HL_Message + Chr(13)
Select MSH
Replace HL_Message With HL_Message;
+mvpv2
Endif
&&OCR
If Defaults.corc = .T.
Select MSH
Replace HL_Message With HL_Message + Chr(13)
Select MSH
Replace HL_Message With HL_Message;
+ Alltrim(ORC.Segment)+"|"+Alltrim(Str(ORC.f1))+"|"+Alltrim(ORC.f2)+"|"+Alltrim(ORC.F3);
+"|"+Alltrim(ORC.f4)+"|"+ORC.f5+"|"+Alltrim(ORC.f6);
+"|"+Alltrim(ORC.f7)+"|"+Alltrim(ORC.f8)+"|"+Alltrim(ORC.f9)+"|"+Alltrim(ORC.f10)+"|"+Alltrim(ORC.f11)+"|"+Alltrim(ORC.f12);
+"|"+Alltrim(ORC.f13)+"|"+Alltrim(ORC.F14)+"|"+Alltrim(ORC.f15)+"|"+Alltrim(ORC.F16)+"|"+Alltrim(ORC.f17)
Endif
&&OBR
Select MSH
Replace HL_Message With HL_Message + Chr(13)
Select MSH
Replace HL_Message With HL_Message;
+Alltrim(OBR.Segment)+"|"+Alltrim(OBR.f2)+"|"+Alltrim(OBR.F3)+"|"+Alltrim(OBR.f4)+"|"+;
ALLTRIM(OBR.f5)+"|"+Alltrim(OBR.f6)+"|"+Alltrim(OBR.f7)+"|"+Alltrim(OBR.f8)+"|"+Alltrim(OBR.f9)+"|"+Alltrim(OBR.f10);
+"|"+Alltrim(OBR.f11)+"|"+Alltrim(OBR.f12)+"|"+Alltrim(OBR.f13)+"|"+Alltrim(OBR.F14)+"|"+Alltrim(OBR.f15)+"|"+;
ALLTRIM(OBR.F16)+"|"+Alltrim(OBR.f17)+"|"+Alltrim(OBR.f18)+"|"+Alltrim(OBR.F19)+"|"+Alltrim(OBR.f20)+"|"+"|"+;
ALLTRIM(OBR.f21)+"|"+Alltrim(OBR.F22)+"|"+Alltrim(OBR.F23)+"|"+Alltrim(OBR.f24)+"|"+Alltrim(OBR.f25)+"|"+Alltrim(OBR.f26);
+"|"+Alltrim(OBR.f27)+"|"+Alltrim(OBR.f28)+"|"+Alltrim(OBR.F29)+"|"+Alltrim(OBR.f30)+"|"+Alltrim(OBR.f31)+"|"+;
ALLTRIM(OBR.f32)+"|"+Alltrim(OBR.f33)+"|"+Alltrim(OBR.f34)+ "|"+Chr(13)
&&OBX
Select OBX
Scan
Replace MSH.HL_Message With MSH.HL_Message + Alltrim(OBX.Segment)+"|"+Alltrim(Str(OBX.f1))+"|"+Alltrim(OBX.f2)+"|"+Alltrim(OBX.F3);
+"|"+Alltrim(OBX.f4)+"|"+OBX.f5+"|"+Alltrim(OBX.f6);
+"|"+Alltrim(OBX.f7)+"|"+Alltrim(OBX.f8)+"|"+Alltrim(OBX.f9)+"|"+Alltrim(OBX.f10)+"|"+Alltrim(OBX.f11)+"|"+Alltrim(OBX.f12);
+"|"+Alltrim(OBX.f13)+"|"+Alltrim(OBX.F14)+"|"+Alltrim(OBX.f15)+"|"+Alltrim(OBX.F16)+"|"+Alltrim(OBX.f17);
+Chr(13)
Endscan
Select OBX
If MessageOK=.F.
Mystring="Failed"
Else
Mystring=MSH.HL_Message
Endif
Select v
Replace d7SendAck With Datetime()
Replace v.LhL7sent With .T.
Select v
Set Multilocks On
CursorSetProp("Buffering",3)
If Not Tableupdate(1,.F.,"v")
Tablerevert(.T.,'v')
*!* mvSuccessful = "Unsuccessful"
Else
Select v
=Tableupdate(.T.)
Endif
Set Relation To
Select Pat
Use
Select r
Use
Select Vflart
Use
Select pv1
Use
Select pv2
Use
Select v
Use
Select Defaults
Use
Select luttech
Use
Select lutref
Use
Select lutread
Use
Select LUTOWNA
Use
Select lutown
Use
Select LUTTESTSTEN
Use
Select LUTTEST
Use
Select custpaperless
Use
Select lutsite
Use
Select MSH
Return Mystring
Endproc
*!* Enddefine
Procedure errHandler
Parameter merror, Mess, mess1, mprog, mlineno
MessageOK=.F.
mvAck= 'Error number: ' + Ltrim(Str(merror))+Chr(13)+;
'Error message: ' + Mess +Chr(13)+;
'Line of code with error: ' + mess1 +Chr(13)+;
'Line number of error: ' + Ltrim(Str(mlineno))+Chr(13)+;
'Program with error: ' + mprog
*If Ack is good add to log and delete file otherwise resend
*****************************************************************************************************************
Set Safety Off
Mystring="Failed"
If File('log.txt')
Else
Strtofile("",'log.txt',0)
Endif
mvHourNow=Hour(Datetime())
Alltrim(Str(Hour(Datetime())))
If mvHourNow>12
For gnhour = 13 To 24
If mvHourNow==gnhour
mvTime=Alltrim(Str(gnhour-12))
mvAMPM='PM'
Endif
Endfor
Else
mvTime=Alltrim(Str(Hour(Datetime())))
mvAMPM='AM'
Endif
mvMinute=Alltrim(Str(Minute(Datetime())))
If Lenc(mvMinute)=1
mvMinute="0"+mvMinute
Endif
mvloginfo="Patient Name: "+Alltrim(Pat.xrcname)+Chr(13)+Chr(10)+;
"Study Date: "+Dtoc(v.ddate)+Chr(13)+Chr(10)+;
"Test Performed: "+Alltrim(v.cprocedure)
login=""+Chr(13)+Chr(10)+;
"HL7 Message: Failed "+ Chr(13);
+" "+Dtoc(Date())+" "+mvTime+":"+mvMinute+" "+mvAMPM+"."+Chr(13)+Chr(10)+;
mvloginfo+ Chr(13)+mvAck+"........................................................................"+Chr(13)+Chr(10)
xLog=Filetostr('log.txt')
Strtofile(login+Substr(xLog,1,10000),'log.txt',0)
Return Mystring
Cancel
Endproc
Procedure addobx
Select OBX
Append Blank
*!* Replace OBX.f2 With Alltrim(Defaults.obx_value)
*!* Replace F3 With Alltrim(Defaults.obx_value)
*!* Replace f4 With Defaults.obx_obs_su+"^"
*!* Replace Segment With "OBX"
*!* Replace f16 With Alltrim(lutread.corgin_id)+"^"+Alltrim(lutread.Name)+"^"+m.now
Endproc
Here is the all the code...
*!* Define Class ARTERIAL_L As Session OlePublic
*!* Procedure SEARCHFORPATIENT()
*!* On Error Do errHandler With ;
*!* ERROR( ), Message( ), Message(1), Program( ), Lineno( )
Public MessageOK,m.cReadDrWithComma,mvreportstatus
MessageOK=.T.
CLOSE TABLES ALL
Set NullDisplay To Str(0)
Set Multilocks On
*!* Cursortoxml( "Defaults", "Defaults.XML", 1, 512, 0, "1" )
Xmltocursor("Defaults.XML","Defaults",512)
Select Defaults
If Used ("Pat")
Select Pat
Else
Use Alltrim(Defaults.Dir)+'DATA\Pat' In 0 Shared
Endif
Select Pat
CursorSetProp("Buffering",3)
If Used ("lutsite")
Select lutsite
Else
Use Alltrim(Defaults.Dir)+'DATA\lutsite' In 0 Shared
Endif
If Used ("v")
Select v
Else
Use Alltrim(Defaults.Dir)+'DATA\v' In 0 Shared
Endif
Select v
CursorSetProp("Buffering",3)
If Used ("r")
Select r
Else
Use Alltrim(Defaults.Dir)+'DATA\r' In 0 Shared
Endif
Select r
CursorSetProp("Buffering",3)
If Used ("vflart")
Select vflart
Else
Use Alltrim(Defaults.Dir)+'DATA\vflart' In 0 Shared
Endif
If Used ("LUTTEST")
Select LUTTEST
Else
Use Alltrim(Defaults.Dir)+'DATA\LUTTEST' In 0 Shared
Endif
If Used ("LUTTESTSTEN")
Select LUTTESTSTEN
Else
Use Alltrim(Defaults.Dir)+'DATA\LUTTESTSTEN' In 0 Shared
Endif
If Used ("LUTOWNA")
Select LUTOWNA
Else
Use Alltrim(Defaults.Dir)+'DATA\LUTOWNA' In 0 Shared
Endif
If Used ("luttech")
Select luttech
Else
Use Alltrim(Defaults.Dir)+'DATA\luttech 'In 0 Shared
Endif
If Used ("lutread")
Select lutread
Else
Use Alltrim(Defaults.Dir)+'DATA\lutread 'In 0 Shared
Endif
If Used ("lutref")
Select lutref
Else
Use Alltrim(Defaults.Dir)+'DATA\lutref 'In 0 Shared
Endif
If Used ("lutown")
Select lutown
Else
Use Alltrim(Defaults.Dir)+'DATA\lutown'In 0 Shared
Endif
If Used ("custpaperless")
Select custpaperless
Else
Use Alltrim(Defaults.Dir)+'DATA\custpaperless' In 0 Shared
Endif
If Used ("pv1")
Select pv1
Else
Use Alltrim(Defaults.Dir)+'DATA\pv1' In 0 Shared
Endif
If Used ("pv2")
Select pv2
Else
Use Alltrim(Defaults.Dir)+'DATA\pv2' In 0 Shared
Endif
Create Cursor MSH(Segment C(3),f1 C(4),f2 C(20),F3 C(20),f4 C(20),f5 C(48),f6 C(48),f7 C(26),f8 C(1),f9 C(48),f10 C(80),f11 C(106),;
f12 C(10),f13 C(40),F14 C(40),f15 C(60),F16 C(80),f17 C(80),f18 C(20),F19 C(16),f20 C(25),f21 C(20),F22 C(80),F23 C(60),;
f24 C(1),f25 C(2),f26 C(80),f27 C(60),f28 C(80),F29 C(26),f30 C(1),Id N(10),HL_Message M(4))
&&&&&&&Append the message into the table>>>>>>>>>>>>>>>>>>>>>>
Create Cursor pid(Segment C(3),f1 C(4),f2 C(20),F3 C(20),f4 C(20),f5 C(48),f6 C(48),f7 C(26),f8 C(1),f9 C(48),f10 C(80),f11 C(106),;
f12 C(4),f13 C(40),F14 C(40),f15 C(60),F16 C(80),f17 C(80),f18 C(20),F19 C(16),f20 C(25),f21 C(20),F22 C(80),F23 C(60),;
f24 C(1),f25 C(2),f26 C(80),f27 C(60),f28 C(80),F29 C(26),f30 C(1),Id N(10))
Create Cursor evn(Segment C(3),f1 i Autoinc Nextvalue 1 Step 1,f2 C(20),F3 C(20),f4 C(20),f5 C(48),f6 C(48),f7 C(26),f8 C(1),f9 C(48),f10 C(80),f11 C(106),;
f12 C(4),f13 C(40),F14 C(40),f15 C(60),F16 C(80),f17 C(80),f18 C(20),F19 C(16),f20 C(25),f21 C(20),F22 C(80),F23 C(60),;
f24 C(1),f25 C(2),f26 C(80),f27 C(60),f28 C(80),F29 C(26),f30 C(1),Id N(10))
Create Cursor OBR(Segment C(3),f1 i Autoinc Nextvalue 1 Step 1,f2 C(22),F3 C(22),f4 C(200),f5 C(200),f6 C(26),f7 C(26),f8 C(26),f9 C(20),f10 C(60),f11 C(50),;
f12 C(60),f13 C(254),F14 C(26),f15 C(254),F16 C(80),f17 C(40),f18 C(60),F19 C(60),f20 C(60),f21 C(60),F22 C(26),F23 C(40),;
f24 C(10),f25 C(1),f26 C(254),f27 C(200),f28 C(150),F29 C(200),f30 C(20),f31 C(254),f32 C(200),f33 C(200),f34 C(200),f35 C(200),;
f36 C(26),f37 C(4),F38 C(60),F39 C(200),f40 C(60),f41 C(30),f42 C(1),f43 C(200),f44 C(80),F45 C(80),Id N(10))
Create Cursor OBX(Segment C(3),f1 i Autoinc Nextvalue 1 Step 1;
,f2 C(254),F3 C(254),f4 C(254),f5 M(4),f6 C(48),f7 C(26),f8 C(1),f9 C(48),f10 C(80),f11 C(106),;
f12 C(4),f13 C(40),F14 C(40),f15 C(60),F16 C(80),f17 C(80),f18 C(20),F19 C(16),f20 C(25),f21 C(20),F22 C(80),F23 C(60),;
f24 C(1),f25 C(2),f26 C(80),f27 C(60),f28 C(80),F29 C(26),f30 C(1),Id N(10))
Create Cursor ORC(Segment C(3),f1 i Autoinc Nextvalue 1 Step 1;
,f2 C(254),F3 C(254),f4 C(254),f5 M(4),f6 C(48),f7 C(26),f8 C(1),f9 C(48),f10 C(80),f11 C(106),;
f12 C(4),f13 C(40),F14 C(40),f15 C(60),F16 C(80),f17 C(80),f18 C(20),F19 C(16),f20 C(25),f21 C(20),F22 C(80),F23 C(60),;
f24 C(1),f25 C(2),f26 C(80),f27 C(60),f28 C(80),F29 C(26),f30 C(1),Id N(10))
Create Cursor AL1(Segment C(3),f1 C(4),f2 C(20),F3 C(20),f4 C(20),f5 C(48),f6 C(48),f7 C(26),f8 C(1),f9 C(48),f10 C(80),f11 C(106),;
f12 C(4),f13 C(40),F14 C(40),f15 C(60),F16 C(80),f17 C(80),f18 C(20),F19 C(16),f20 C(25),f21 C(20),F22 C(80),F23 C(60),;
f24 C(1),f25 C(2),f26 C(80),f27 C(60),f28 C(80),F29 C(26),f30 C(1),Id N(10))
Create Cursor pv1c(Segment C(3),f1 C(4),f2 C(20),F3 C(20),f4 C(20),f5 C(48),f6 C(48),f7 C(254),f8 C(254),f9 C(48),f10 C(80),f11 C(106),;
f12 C(4),f13 C(40),F14 C(40),f15 C(60),F16 C(80),f17 C(80),f18 C(20),F19 C(16),f20 C(25),f21 C(20),F22 C(80),F23 C(60),;
f24 C(1),f25 C(2),f26 C(80),f27 C(60),f28 C(80),F29 C(26),f30 C(1),Id N(10))
Select v
Set Order To Tag Xpipattag Of Alltrim(Defaults.Dir)+'DATA\pat.cdx' In Pat
Set Relation To v.xfipattag Into Pat Additive
Set Order To Tag xpivtag Of Alltrim(Defaults.Dir)+'DATA\r.cdx' In r
Set Relation To xpivtag Into r Additive
Set Order To Tag xpivtag Of Alltrim(Defaults.Dir)+'data\pv1.cdx' In pv1
Set Relation To xpivtag Into pv1 Additive
Set Order To Tag xpivtag Of Alltrim(Defaults.Dir)+'data\pv2.cdx' In pv2
Set Relation To xpivtag Into pv2 Additive
Set Order To Tag xpivtag Of Alltrim(Defaults.Dir)+'DATA\vflart.cdx' In vflart
Set Relation To xpivtag Into vflart Additive
Set Order To Tag Xtest Of Alltrim(Defaults.Dir)+'DATA\luttest.cdx' In LUTTEST
Set Relation To Xtest Into LUTTEST Additive
Set Order To Tag Xtech Of Alltrim(Defaults.Dir)+'DATA\luttech.cdx' In luttech
Set Relation To Xtech Into luttech Additive
Set Order To Tag xread Of Alltrim(Defaults.Dir)+'DATA\lutread.cdx' In lutread
Set Relation To v.xread Into lutread Additive
Set Order To Tag Xref Of Alltrim(Defaults.Dir)+'DATA\lutref.cdx' In lutref
Set Relation To Xref Into lutref Additive
Set Order To Tag Xsite Of Alltrim(Defaults.Dir)+'DATA\lutsite.cdx' In lutsite
Set Relation To Xsite Into lutsite Additive
Select LUTTEST
Set Order To Tag Xsten Of Alltrim(Defaults.Dir)+'DATA\lutteststen.cdx' In LUTTESTSTEN
Set Relation To LUTTEST.Xsten Into LUTTESTSTEN
Select v
*Added code to tighten search
Locate For v.xpivtag==Defaults.studyid And v.xfipattag == Defaults.Patientid And v.Xtest == Defaults.Xtest
If Found()
If Used ("msh")
Select MSH
Else
Use Data\MSH In 0 Shared
Endif
Select MSH
Calculate Max (Id)To maxID
Append Blank
Replace Id With maxID+1
Replace MSH.Segment With "MSH"
Replace MSH.f1 With "|"
mvEncoding = Alltrim(Defaults.hl7_enc_cs)+Alltrim(Defaults.hl7_enc_rs)+Alltrim(Defaults.hl7_enc_ec)+Alltrim(Defaults.hl7_enc_ss)
Replace MSH.f2 With mvEncoding
Replace MSH.F3 With Alltrim(Defaults.HL7_sapp)
Replace MSH.f4 With Alltrim(Defaults.hl7_sfac)
Replace MSH.f5 With Alltrim(Defaults.hl7_rapp)
Replace MSH.f6 With Alltrim(Defaults.hl7_rfac)
Replace MSH.f9 With Alltrim(Defaults.hl7_mess)+"^" +Alltrim(Defaults.hl7_eve)
m.yr=Alltrim(Str( Year(Date( ))))
m.mo=Alltrim(Padl(Month(Date( )),2,"0"))
m.day=Alltrim(Padl(Day(Date( )),2,"0"))
m.hour=Alltrim(Padl(Hour(Datetime()),2,"0"))
m.min=Alltrim(Padl(Minute(Datetime()),2,"0"))
m.now= (m.yr+m.mo+m.day+m.hour+m.min)
Replace f7 With m.now
Replace f10 With Alltrim(Str(Pat.Xpipattag))+"-"+Alltrim(Str(Defaults.studyid))
Replace f11 With Alltrim(Defaults.hl7_pid)
Replace f12 With Alltrim(Defaults.hl7_ver)
****Added ver 10.5 include additional fields for HL7
Public abc,mvPatientAge
If Not Empty(Pat.dBirth)
*** Reject negative bithdate
If Empty (v.ddate)
mvPatientAge = Floor((Date()-Pat.dBirth)/365.25)
Else
mvPatientAge = Floor((v.ddate-Pat.dBirth)/365.25)
Endif
If mvPatientAge = -1
mvPatientAge= 0
Endif
mvPatientAge=Alltrim(Str(mvPatientAge))
*** check for pediaictric age month
If Between(Val(mvPatientAge), 0, 1)
If Empty (v.ddate)
mvPatientAge = Floor((Date()-Pat.dBirth)/30.43)
Else
mvPatientAge = Floor((v.ddate-Pat.dBirth)/30.43)
Endif
mvPatientAge=Alltrim(Str(mvPatientAge)+"M")
Endif
*** check for pediaictric age week
If Val(mvPatientAge)=0
If Empty (v.ddate)
mvPatientAge = Floor((Date()-Pat.dBirth)/7)
Else
mvPatientAge = Floor((v.ddate-Pat.dBirth)/7)
Endif
mvPatientAge=Alltrim(Str(mvPatientAge)+"W")
Endif
*** check for pediaictric age day
If Val(mvPatientAge)=0
If Empty (v.ddate)
mvPatientAge = Floor((Date()-Pat.dBirth))
Else
mvPatientAge = Floor((v.ddate-Pat.dBirth))
Endif
mvPatientAge=mvPatientAge +1 &&& to keep patient from being 0 days old
mvPatientAge=Alltrim(Str(mvPatientAge)+"D")
Endif
Else
mvPatientAge=""
Endif
Public mvadmit
Select LUTTEST
abc=''
For i = 1 To 12
mva='v.lt'+Alltrim(Str(i))
If &mva=.T.
mvb='Luttest.Clabt'+Alltrim(Str(i))
If i=1
abc=&mvb
Else
abc=abc+&mvb+","
Endif
If Substr(abc,Lenc(abc))=","
abc=Substr(abc,1,Lenc(abc)-1)
Endif
Endif
Endfor
mvadmit=''
If v.napp=1
mvadmit="Inpatient"
Endif
If v.napp=2
mvadmit="Outpatient"
Endif
If v.napp=3
mvadmit=""
Endif
***Populate the PID Table
If Used ("pid")
Select pid
Else
Use Data\pid In 0
Endif
***Put name in proper format then populate field 5 in PID Table
Select Pat
m.nFirstBlank =At(" ", Pat.xrcname,1)
m.nSecondBlank =At(" ", Pat.xrcname,2)
m.Last=Substr(Pat.xrcname, 1 ,m.nFirstBlank)
m.First=Substr(Pat.xrcname, m.nFirstBlank, m.nSecondBlank- m.nFirstBlank)
m.middle=Substr(Pat.xrcname, m.nSecondBlank)
Select pid
Append Blank
Select pid
Replace Segment With "PID"
m.num=Alltrim(Str(Pat.Xpipattag))
If Empty(Pat.cextpatid)=.F.
Replace F3 With Pat.cextpatid
Else
Replace F3 With m.num
Endif
Replace f2 With Alltrim(Pat.Xrcssn)
If Empty(Pat.hl7_name)
Replace pid.f5 With Alltrim(m.Last)+"^"+Alltrim(m.First)+"^"+Alltrim(m.middle)
Else
&&Changed name here for proper parsing now store the name in pat table exactly the way i receive it.
Replace pid.f5 With Alltrim(Pat.hl7_name)
Endif
m.yr=Alltrim(Str( Year(Pat.dBirth)))
m.mo=Alltrim(Padl(Month(Pat.dBirth),2,"0"))
m.day=Alltrim(Padl(Day(Pat.dBirth),2,"0"))
*!* m.hour=Alltrim(Padl(Hour(v.ddatetime),2,"0"))
*!* m.min=Alltrim(Padl(Minute(v.ddatetime),2,"0"))
m.constantdobdateandtime= (m.yr+m.mo+m.day)
*!* +m.hour+m.min)
*!* ?m.constantdobdateandtime
Replace f7 With (m.constantdobdateandtime)
Replace pid.f8 With Pat.cmf
*!* REPLACE HL7_new WITH .F.
Replace Id With maxID+1
&& added for common orders Account #
Replace pid.f20 With Alltrim(v.cAccession)
********************
**** PV1 **********
*******************
Select pv1c
Append Blank
Select pv1c
Replace Segment With "PV1c"
Do Case
Case v.napp=1
Replace pv1c.f2 With 'I'
Case v.napp=2
Replace pv1c.f2 With 'O'
Otherwise
Replace pv1c.f2 With ''
Endcase
mvreadName=''
mvreadName=Alltrim(lutread.corgin_id)+"^"
For i = 1 To Alines(namearray,Alltrim(lutread.Name)," ")
mvreadName=mvreadName+namearray(i)+"^"
Endfor
*!* mvreadName=mvreadName+Alltrim(lutread.Degree)
Replace pv1c.f7 With Alltrim(mvreadName)
mvrefName=''
mvrefName=Alltrim(lutref.corgin_id)+"^"
For q = 1 To Alines(namearray,Alltrim(lutref.Name)," ")
mvrefName=mvrefName+namearray(q)+"^"
Endfor
*!* mvrefName=mvrefName+Alltrim(lutref.Degree)
Replace pv1c.f8 With Alltrim(mvrefName)
********************
**** ORC **********
*******************
If Used ("ORC")
Select ORC
Else
Use Data\ORC In 0
Endif
Select ORC
Append Blank
Select ORC
Replace Segment With "ORC"
*added code to check to see if message has been sent before if changed send C=Changed.
If v.lrepcomp=.T.
If Empty(v.drepalt)
Replace f25 With "F"
m.yr=Alltrim(Str( Year(v.drepcomp)))
m.mo=Alltrim(Padl(Month(v.drepcomp),2,"0"))
m.day=Alltrim(Padl(Day(v.drepcomp),2,"0"))
m.hour=Alltrim(Padl(Hour(v.drepcomp),2,"0"))
m.min=Alltrim(Padl(Minute(v.drepcomp),2,"0"))
m.now= (m.yr+m.mo+m.day+m.hour+m.min)
Replace F22 With m.now
Else
Replace f25 With "C"
m.yr=Alltrim(Str( Year(v.drepalt)))
m.mo=Alltrim(Padl(Month(v.drepalt),2,"0"))
m.day=Alltrim(Padl(Day(v.drepalt),2,"0"))
m.hour=Alltrim(Padl(Hour(v.drepalt),2,"0"))
m.min=Alltrim(Padl(Minute(v.drepalt),2,"0"))
m.now= (m.yr+m.mo+m.day+m.hour+m.min)
Replace F22 With m.now
Endif
Else
Replace f25 With Defaults.result_sta
Endif
&&Added code for Order ID for Common order DR.Kings site.
Replace ORC.F3 With Alltrim(v.cORC_3)
Replace ORC.f4 With Alltrim(v.cOBR_2)
********************
**** OBR **********
*******************
If Used ("OBR")
Select OBR
Else
Use Data\OBR In 0
Endif
Select OBR
Append Blank
Select OBR
Replace Segment With "OBR"
m.num=Alltrim(Str(v.xpivtag))
Replace f4 With m.num + "^" + Alltrim(V.Cprocedure)
Replace f5 With m.num + "^" + Alltrim(Defaults.obr_filler)
*OBR7 needs the original Study date and never changes.
m.yr=Alltrim(Str( Year(v.ddatetime)))
m.mo=Alltrim(Padl(Month(v.ddatetime),2,"0"))
m.day=Alltrim(Padl(Day(v.ddatetime),2,"0"))
m.hour=Alltrim(Padl(Hour(v.ddatetime),2,"0"))
m.min=Alltrim(Padl(Minute(v.ddatetime),2,"0"))
m.constantstudydateandtime= (m.yr+m.mo+m.day+m.hour+m.min)
Replace f7 With (m.constantstudydateandtime)
Replace f8 With (m.constantstudydateandtime)
Replace Id With maxID+1
m.yr=Alltrim(Str( Year(Date( ))))
m.mo=Alltrim(Padl(Month(Date( )),2,"0"))
m.day=Alltrim(Padl(Day(Date( )),2,"0"))
m.hour=Alltrim(Padl(Hour(Datetime()),2,"0"))
m.min=Alltrim(Padl(Minute(Datetime()),2,"0"))
m.now= (m.yr+m.mo+m.day+m.hour+m.min)
Replace F22 With m.now
Replace f24 With Defaults.Diagnostic
*added code to check to see if message has been sent before if changed send C=Changed.
*!* If v.lrepcomp=.T.
If Empty(v.drepalt)
Replace f25 With "F"
m.yr=Alltrim(Str( Year(v.drepcomp)))
m.mo=Alltrim(Padl(Month(v.drepcomp),2,"0"))
m.day=Alltrim(Padl(Day(v.drepcomp),2,"0"))
m.hour=Alltrim(Padl(Hour(v.drepcomp),2,"0"))
m.min=Alltrim(Padl(Minute(v.drepcomp),2,"0"))
m.sec=Alltrim(Padl(Sec(v.drepcomp),2,"0"))
m.now= (m.yr+m.mo+m.day+m.hour+m.min+m.sec)
Replace F22 With m.now
Else
Replace f25 With "C"
m.yr=Alltrim(Str( Year(v.drepalt)))
m.mo=Alltrim(Padl(Month(v.drepalt),2,"0"))
m.day=Alltrim(Padl(Day(v.drepalt),2,"0"))
m.hour=Alltrim(Padl(Hour(v.drepalt),2,"0"))
m.min=Alltrim(Padl(Minute(v.drepalt),2,"0"))
m.sec=Alltrim(Padl(Sec(v.drepcomp),2,"0"))
m.now= (m.yr+m.mo+m.day+m.hour+m.min+m.sec)
Replace F22 With m.now
Endif
*!* Else
*!* Replace f25 With Defaults.result_sta
*!* Endif
&&Added code for Order ID for Common order
Replace OBR.f2 With '1'
Replace OBR.F3 With Alltrim(v.cORC_3)
*!* Replace OBR.f4 With Alltrim(v.cOBR_2)
Replace OBR.F3 With Alltrim(v.cOBR_2)
&&Referring Doc Added Dupage
mvHL7Ref=''
For i = 1 To Alines(refArray,Alltrim(lutref.Name)," ")
If i >1
mvHL7Ref=mvHL7Ref+"^"+refArray(i)
Else
mvHL7Ref=mvHL7Ref+refArray(i)
Endif
Endfor
Replace OBR.f17 With Alltrim(lutref.corgin_id)+"^"+mvHL7Ref
*!* Replace OBR.f5 With Alltrim(v.cobr_4)
&&Added code for Meditech they require obr.20
Replace OBR.f21 With Alltrim(lutown.cobr20)
&&Changed code here for Guthrie the needed site in OBR21
*!* Replace OBR.F22 With Alltrim(lutsite.site)
&&Bassett
Select OBR
Replace OBR.f32 With Alltrim(lutread.corgin_id)+"^"+Alltrim(lutread.Name)+"^"+m.now
*!* && Basset change 3/13/2012
*!* Replace OBR.f12 With v.cobr_11
*!* Replace OBR.f33 With ALLTRIM(lutread.Name)
&&&&Added code to parse HL7 correct format
&&&&Added code to parse HL7 correct format
m.nCharactersInLine=75-10
***********************Cleveland Clinic Formatted***********************************************************
If v.xind =0;
OR v.xind =1;
AND Isblank(v.xind)=.T.
Else
For mycount=1 To 46
indication="LUTTEST.I"+Alltrim(Str(mycount))
ind=Alines(indArray,&indication,"-")
If mycount= v.xind
mvindication=indArray(1)
Do addobx
If ind>1
Replace OBX.F22 With indArray(2)
Else
Replace OBX.F22 With ''
Endif
Endif
Endfor
Endif
*!* For gncount= 1 To 3
*!* Do addobx
*!* Endfor
Do addobx
Replace f5 With Padc(Alltrim(lutown.Inst),m.nCharactersInLine-10," ")
*!* Do addobx
Do addobx
Replace f5 With Padc(Alltrim(lutown.Address1)+" "+Alltrim(lutown.City)+" "+Alltrim(lutown.State)+" ";
+Alltrim(lutown.zip),m.nCharactersInLine-10," ")
*!* For gncount= 1 To 3
*!* Do addobx
*!* Endfor
Do addobx
Replace f5 With Padc(Alltrim(lutown.Title),m.nCharactersInLine-10," ")
Do addobx
If Isblank(Pat.cextpatid)
mvMRN=Alltrim(Pat.Xrcssn)
Else
mvMRN=Alltrim(Pat.cextpatid)
Endif
Do addobx
Replace f5 With"NAME: "+Alltrim(Pat.xrcname)+" ";
+Alltrim(Defaults.PID_2)+" "+mvMRN
* +"CLINIC NO.: "+Alltrim(Pat.Xrcssn)
Do addobx
Do addobx
Replace f5 With "TEST: "+Alltrim(v.cprocedure)
*!* Do addobx
Select Vflart
If Isblank(Vflart.mTech)=.F.
Do addobx
Do addobx
Replace OBX.f5 With "TECH NOTES:"
Select Vflart
Do addobx
Replace OBX.f5 With Alltrim(Vflart.mTech)
Endif
*!* Select r
*!* Locate For xpivtag = r.xpivtag
Select r
If Isblank(r.mhmemo)=.F.
Do addobx
Do addobx
Replace OBX.f5 With Upper("History NOTES:")
Select r
Set Memowidth To 75
For gncount = 1 To Memlines(r.mhmemo)
Do addobx
Replace OBX.f5 With Mline(r.mhmemo,gncount)
Endfor
Endif
*!* Do addobx
If v.xind =0;
OR v.xind =1;
AND Isblank(v.xind)=.T.
Else
For mycount=1 To 46
indication="LUTTEST.I"+Alltrim(Str(mycount))
If mycount= v.xind
Do addobx
Replace OBX.f5 With "PRIMARY INDICATION: "+ &indication
Do addobx
Endif
Endfor
Endif
*!* *!* &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
*!* &&&&&&&&&&&&&&&&&&&Clincal Observations&&&&&&&&&&&&&
Do addobx
Replace OBX.f5 With "CLINICAL OBSERVATIONS:"
Select r
Scan For r.xpivtag = v.xpivtag &&&&Pull out all the risk Factors and clinical observations
Select LUTTEST
Scan For Xtest = r.Xtest
For clincalcount=17 To 46
myclin="r.h"+Alltrim(Str(clincalcount))+""
myhis="LUTTEST.h"+Alltrim(Str(clincalcount))+""
If Isblank(&myclin)=.F.
Do addobx
Replace OBX.f5 With Space(10) +&myhis +": "+&myclin
Endif
Endfor
Endscan
Endscan
&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
&&&&&&&&&&&&&&&&&&& RISK FACTORS &&&&&&&&&&&&&
Select r
Scan For r.xpivtag = v.xpivtag &&&&Pull out all the risk Factors and clinical observations
Select LUTTEST
Scan For Xtest = r.Xtest
For clincalcount=1 To 16
myclin="r.h"+Alltrim(Str(clincalcount))+""
myhis="LUTOWNA.r"+Alltrim(Str(clincalcount))+""
If Isblank(&myclin)=.F.
Do addobx
Replace OBX.f5 With "RISK FACTORS:"
Exit
Endif
Endfor
Endscan
Endscan
Select r
Scan For r.xpivtag = v.xpivtag &&&&Pull out all the risk Factors and clinical observations
Select LUTTEST
Scan For Xtest = r.Xtest
For clincalcount=1 To 16
myclin="r.h"+Alltrim(Str(clincalcount))+""
myhis="LUTOWNA.r"+Alltrim(Str(clincalcount))+""
If Isblank(&myclin)=.F.
Do addobx
Replace OBX.f5 With Space(10) +&myhis +": "+&myclin
Endif
Endfor
Endscan
Endscan
*!* Quality of care
Select v
If Isblank(v.Qmemo)=.F.
Do addobx
Replace OBX.f5 With "QUALITY OF CARE:"
Select vfext
Do addobx
Replace OBX.f5 With Alltrim(v.Qmemo)
Endif
*!* *!* Tech Notes
*!* Select vfext
*!* If Isblank(vfext.Qmemo)=.F.
*!* Do addobx
*!* Replace OBX.f5 With "TECH NOTES:"
*!* Select vfext
*!* Replace OBX.f5 With Alltrim(vfext.mTech)
*!* Endif
*!* IMPRESSIONS
Select Vflart
If Isblank(Vflart.mimpress)=.F.
Do addobx
Replace OBX.f5 With "IMPRESSIONS:"
Do addobx
Replace OBX.f5 With Alltrim(Vflart.mimpress)
Endif
&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
Select OBX
Do addobx
Select OBX
Do addobx
Select OBX
Public mvReadSignature
If Not Empty(lutread.Name)
mvLastLength=At(" ",lutread.Name)
mvReadSignature=Alltrim(Substr(lutread.Name,mvLastLength))+" "+Alltrim(Substr(lutread.Name,1,mvLastLength))+" "+Alltrim(lutread.Degree)
Else
mvReadSignature=""
Endif
If v.lrepcomp=.T.
Replace OBX.f5 With "Signed electronically by " + mvReadSignature
Do addobx
Select OBX
m.hour=Alltrim(Str(Hour(v.drepcomp)))
If m.hour='13' Or m.hour='14' Or m.hour='15' Or m.hour='16' Or m.hour='17' Or m.hour='18' Or m.hour='19' Or m.hour='20' Or m.hour='21' Or m.hour='22' Or m.hour='23' Or m.hour='24'
Do Case
Case m.hour='13'
m.hour='01'
Case m.hour='14'
m.hour='02'
Case m.hour='15'
m.hour='03'
Case m.hour='16'
m.hour='04'
Case m.hour='17'
m.hour='05'
Case m.hour='18'
m.hour='06'
Case m.hour='19'
m.hour='07'
Case m.hour='20'
m.hour='08'
Case m.hour='21'
m.hour='09'
Case m.hour='22'
m.hour='10'
Case m.hour='23'
m.hour='11'
Case m.hour='24'
m.hour='12'
Endcase
If Minute(v.drepcomp)<10
m.minutes="0"+Alltrim(Str(Minute(v.drepcomp)))
Else
m.minutes=Alltrim(Str(Minute(v.drepcomp)))
Endif
If Substr(m.hour,1,1)="0"
Replace OBX.f5 With "at "+Substr(m.hour,2)+":"+m.minutes+" PM on " +Cdow(v.drepcomp)+", "+Cmonth(v.drepcomp)+" "+Alltrim(Str(Day(v.drepcomp)))+", "+Alltrim(Str(Year(v.drepcomp)))
Else
Replace OBX.f5 With "at "+m.hour+":"+m.minutes+" PM on " +Cdow(v.drepcomp)+", "+Cmonth(v.drepcomp)+" "+Alltrim(Str(Day(v.drepcomp)))+", "+Alltrim(Str(Year(v.drepcomp)))
Endif
Else
If Minute(v.drepcomp)<10
m.minutes="0"+Alltrim(Str(Minute(v.drepcomp)))
Else
m.minutes=Alltrim(Str(Minute(v.drepcomp)))
Endif
If Substr(m.hour,1,1)="0"
Replace OBX.f5 With "at "+Substr(m.hour,2)+":"+m.minutes+" AM on " +Cdow(v.drepcomp)+", "+Cmonth(v.drepcomp)+" "+Alltrim(Str(Day(v.drepcomp)))+", "+Alltrim(Str(Year(v.drepcomp)))
Else
Replace OBX.f5 With "at "+m.hour+":"+m.minutes+" AM on " +Cdow(v.drepcomp)+", "+Cmonth(v.drepcomp)+" "+Alltrim(Str(Day(v.drepcomp)))+", "+Alltrim(Str(Year(v.drepcomp)))
Endif
Endif
Else
Replace OBX.f5 With "READ BY: "+mvReadSignature
Endif
If Empty(v.drepalt)=.F.
Do addobx
Select v
m.hour=Alltrim(Str(Hour(v.drepalt)))
If m.hour='13' Or m.hour='14' Or m.hour='15' Or m.hour='16' Or m.hour='17' Or m.hour='18' Or m.hour='19' Or m.hour='20' Or m.hour='21' Or m.hour='22' Or m.hour='23' Or m.hour='24'
Do Case
Case m.hour='13'
m.hour='01'
Case m.hour='14'
m.hour='02'
Case m.hour='15'
m.hour='03'
Case m.hour='16'
m.hour='04'
Case m.hour='17'
m.hour='05'
Case m.hour='18'
m.hour='06'
Case m.hour='19'
m.hour='07'
Case m.hour='20'
m.hour='08'
Case m.hour='21'
m.hour='09'
Case m.hour='22'
m.hour='10'
Case m.hour='23'
m.hour='11'
Case m.hour='24'
m.hour='12'
Endcase
If Minute(v.drepalt)<10
m.minutes="0"+Alltrim(Str(Minute(v.drepalt)))
Else
m.minutes=Alltrim(Str(Minute(v.drepalt)))
Endif
If Substr(m.hour,1,1)="0"
Replace OBX.f5 With "Altered at "+Substr(m.hour,2)+":"+m.minutes+" PM on " +Cdow(v.drepalt)+", "+Cmonth(v.drepalt)+" "+Alltrim(Str(Day(v.drepalt)))+", "+Alltrim(Str(Year(v.drepalt)))
Else
Replace OBX.f5 With "Altered at "+m.hour+":"+m.minutes+" PM on " +Cdow(v.drepalt)+", "+Cmonth(v.drepalt)+" "+Alltrim(Str(Day(v.drepalt)))+", "+Alltrim(Str(Year(v.drepalt)))
Endif
Else
If Minute(v.drepalt)<10
m.minutes="0"+Alltrim(Str(Minute(v.drepalt)))
Else
m.minutes=Alltrim(Str(Minute(v.drepalt)))
Endif
If Substr(m.hour,1,1)="0"
Replace OBX.f5 With "Altered at "+Substr(m.hour,2)+":"+m.minutes+" AM on " +Cdow(v.drepalt)+", "+Cmonth(v.drepalt)+" "+Alltrim(Str(Day(v.drepalt)))+", "+Alltrim(Str(Year(v.drepalt)))
Else
Replace OBX.f5 With "Altered at "+m.hour+":"+m.minutes+" AM on " +Cdow(v.drepalt)+", "+Cmonth(v.drepalt)+" "+Alltrim(Str(Day(v.drepalt)))+", "+Alltrim(Str(Year(v.drepalt)))
Endif
Endif
Endif
Endif
************** Embedded Digital Reports *************************************
Select OBX
Scan
Replace OBX.F3 With Alltrim(v.cobr_4)
If Alltrim(OBX.f2)=="RP"
Else
Replace OBX.f2 With Alltrim(Defaults.obx_value)
Endif
Replace F3 With Alltrim(Defaults.obx_id)
Replace OBX.f4 With Alltrim(Defaults.obx_obs_su)
Replace Segment With "OBX"
Replace F16 With Alltrim(lutread.corgin_id)+"^"+Alltrim(lutread.Name)+"^"+m.now
Endscan
If custpaperless.Lrep_path=.T.
Select OBX
Append Blank
Replace F3 With Alltrim(Defaults.obx_id)
Replace f4 With Alltrim(Defaults.obx_obs_su)
Replace Segment With "OBX"
Do Case
Case custpaperless.LPathunc=.T.
Replace f2 With "RP"
x=Alltrim(v.cDigreport)
Replace OBX.f5 With x
Case custpaperless.led=.T.
*Kalida Health
*For the PDF - OBX:5 OBX with "ED" in OBX:2 set up as follows: This should be a coded Base64 PDF.
*copy what you have in OBX:5 to OBX:5.5
* add OBX:5.1 should be blank
* OBX:5.2 = "IMAGE"
* OBX:5.3 = "PDF"
* OBX:5.4 = "BASE64"
Replace f2 With "ED"
x=Strconv(Filetostr(Alltrim(v.cDigreport)),13)
Replace OBX.f5 With "" + "^IMAGE" + "^PDF" + "^BASE64^" + x
Case custpaperless.Lpathurl=.T.
Replace f2 With "RP"
x=Alltrim(custpaperless.cprefix)+Alltrim(v.cDigreport)
Replace OBX.f5 With x
Endcase
Endif
********************************************************************************************
Select OBX
GOTO TOP
Scan
If Alltrim(OBX.f2)=="ED"
Else
Replace OBX.f2 With ""
Endif
Endscan
********************************************************************************************
*!* One more correction. For OBX:3 please use order alias and description that is OBR:4.
*!* In the last message you should have seen this "VASL0012^Venous Lower Unilateral" in OBR:4.
Select OBX
GOTO TOP
Scan
If Alltrim(OBX.f2)=="ED"
ELSE
Replace OBX.f3 With Alltrim(V.Cobr_4)
*!* Replace OBX.f3 With m.num + "^" + Alltrim(V.Cprocedure)
Endif
ENDSCAN
********************************************************************************************
Select MSH
Replace HL_Message With ;
ALLTRIM(Segment)+Alltrim(f1)+Alltrim(f2)+"|"+Alltrim(F3)+"|"+Alltrim(f4)+"|"+;
ALLTRIM(f5)+"|"+Alltrim(f6)+"|"+Alltrim(f7)+"|"+Alltrim(f8)+"|"+Alltrim(f9)+"|"+Alltrim(f10)+;
"|"+Alltrim(f11)+"|"+Alltrim(f12)+"|"+Alltrim(f13)
&&&PID
Select MSH
Replace HL_Message With HL_Message + Chr(13)
Select MSH
Replace HL_Message With HL_Message;
+Alltrim(pid.Segment)+"|"+Alltrim(Str(OBR.f1))+"|"+Alltrim(pid.f2)+"|"+Alltrim(pid.F3)+"|"+Alltrim(pid.f4)+"|"+;
ALLTRIM(pid.f5)+"|"+Alltrim(pid.f6)+"|"+Alltrim(pid.f7)+"|"+Alltrim(pid.f8)+"|"+Alltrim(pid.f9)+"|"+Alltrim(pid.f10);
+Alltrim(pid.f11)+"|"+Alltrim(pid.f12)+"|"+Alltrim(pid.f13)+"|"+Alltrim(pid.F14)+"|"+Alltrim(pid.f15)+"|"+Alltrim(pid.F16);
+Alltrim(pid.f17)+"|"+Alltrim(pid.f18)+"|"+Alltrim(pid.F19)+"|"+Alltrim(pid.f20)+"|"+Alltrim(pid.f21)+"|"+Alltrim(pid.F22);
+Alltrim(pid.F23)+"|"+Alltrim(pid.f24)+"|"+Alltrim(pid.f25)+"|"+Alltrim(pid.f26)+"|"+Alltrim(pid.f27)+"|"+Alltrim(pid.f28);
+Alltrim(pid.F29)+"|"+Alltrim(pid.f30)
&&&Pv1
If Defaults.cpv1 = .T.
&&&PV1
Select MSH
Replace HL_Message With HL_Message + Chr(13)
Select MSH
Replace HL_Message With HL_Message;
+Alltrim(pv1c.Segment)+"|"+Alltrim(Str(OBR.f1))+"|"+Alltrim(pv1c.f2)+"|"+Alltrim(pv1c.F3)+"|"+Alltrim(pv1c.f4)+"|"+;
ALLTRIM(pv1c.f5)+"|"+Alltrim(pv1c.f6)+"|"+Alltrim(pv1c.f7)+"|"+Alltrim(pv1c.f8)+"|"+Alltrim(pv1c.f9)+"|"+Alltrim(pv1c.f10);
+Alltrim(pv1c.f11)+"|"+Alltrim(pv1c.f12)+"|"+Alltrim(pv1c.f13)+"|"+Alltrim(pv1c.F14)+"|"+Alltrim(pv1c.f15)+"|"+Alltrim(pv1c.F16);
+Alltrim(pv1c.f17)+"|"+Alltrim(pv1c.f18)+"|"+Alltrim(pv1c.F19)+"|"+Alltrim(pv1c.f20)+"|"+Alltrim(pv1c.f21)+"|"+Alltrim(pv1c.F22);
+Alltrim(pv1c.F23)+"|"+Alltrim(pv1c.f24)+"|"+Alltrim(pv1c.f25)+"|"+Alltrim(pv1c.f26)+"|"+Alltrim(pv1c.f27)+"|"+Alltrim(pv1c.f28);
+Alltrim(pv1c.F29)+"|"+Alltrim(pv1c.f30)
Endif
&&&Pv2
If Defaults.cpv2 = .T.
mvpv2="PV2"
For q = 1 To 37
mvField="f"+Alltrim(Str(q))
mvpv2=mvpv2+"|"+Alltrim(pv2.&mvField)
Endfor
Select MSH
Replace HL_Message With HL_Message + Chr(13)
Select MSH
Replace HL_Message With HL_Message;
+mvpv2
Endif
&&OCR
If Defaults.corc = .T.
Select MSH
Replace HL_Message With HL_Message + Chr(13)
Select MSH
Replace HL_Message With HL_Message;
+ Alltrim(ORC.Segment)+"|"+Alltrim(Str(ORC.f1))+"|"+Alltrim(ORC.f2)+"|"+Alltrim(ORC.F3);
+"|"+Alltrim(ORC.f4)+"|"+ORC.f5+"|"+Alltrim(ORC.f6);
+"|"+Alltrim(ORC.f7)+"|"+Alltrim(ORC.f8)+"|"+Alltrim(ORC.f9)+"|"+Alltrim(ORC.f10)+"|"+Alltrim(ORC.f11)+"|"+Alltrim(ORC.f12);
+"|"+Alltrim(ORC.f13)+"|"+Alltrim(ORC.F14)+"|"+Alltrim(ORC.f15)+"|"+Alltrim(ORC.F16)+"|"+Alltrim(ORC.f17)
Endif
&&OBR
Select MSH
Replace HL_Message With HL_Message + Chr(13)
Select MSH
Replace HL_Message With HL_Message;
+Alltrim(OBR.Segment)+"|"+Alltrim(OBR.f2)+"|"+Alltrim(OBR.F3)+"|"+Alltrim(OBR.f4)+"|"+;
ALLTRIM(OBR.f5)+"|"+Alltrim(OBR.f6)+"|"+Alltrim(OBR.f7)+"|"+Alltrim(OBR.f8)+"|"+Alltrim(OBR.f9)+"|"+Alltrim(OBR.f10);
+"|"+Alltrim(OBR.f11)+"|"+Alltrim(OBR.f12)+"|"+Alltrim(OBR.f13)+"|"+Alltrim(OBR.F14)+"|"+Alltrim(OBR.f15)+"|"+;
ALLTRIM(OBR.F16)+"|"+Alltrim(OBR.f17)+"|"+Alltrim(OBR.f18)+"|"+Alltrim(OBR.F19)+"|"+Alltrim(OBR.f20)+"|"+"|"+;
ALLTRIM(OBR.f21)+"|"+Alltrim(OBR.F22)+"|"+Alltrim(OBR.F23)+"|"+Alltrim(OBR.f24)+"|"+Alltrim(OBR.f25)+"|"+Alltrim(OBR.f26);
+"|"+Alltrim(OBR.f27)+"|"+Alltrim(OBR.f28)+"|"+Alltrim(OBR.F29)+"|"+Alltrim(OBR.f30)+"|"+Alltrim(OBR.f31)+"|"+;
ALLTRIM(OBR.f32)+"|"+Alltrim(OBR.f33)+"|"+Alltrim(OBR.f34)+ "|"+Chr(13)
&&OBX
Select OBX
Scan
Replace MSH.HL_Message With MSH.HL_Message + Alltrim(OBX.Segment)+"|"+Alltrim(Str(OBX.f1))+"|"+Alltrim(OBX.f2)+"|"+Alltrim(OBX.F3);
+"|"+Alltrim(OBX.f4)+"|"+OBX.f5+"|"+Alltrim(OBX.f6);
+"|"+Alltrim(OBX.f7)+"|"+Alltrim(OBX.f8)+"|"+Alltrim(OBX.f9)+"|"+Alltrim(OBX.f10)+"|"+Alltrim(OBX.f11)+"|"+Alltrim(OBX.f12);
+"|"+Alltrim(OBX.f13)+"|"+Alltrim(OBX.F14)+"|"+Alltrim(OBX.f15)+"|"+Alltrim(OBX.F16)+"|"+Alltrim(OBX.f17);
+Chr(13)
Endscan
Select OBX
If MessageOK=.F.
Mystring="Failed"
Else
Mystring=MSH.HL_Message
Endif
Select v
Replace d7SendAck With Datetime()
Replace v.LhL7sent With .T.
Select v
Set Multilocks On
CursorSetProp("Buffering",3)
If Not Tableupdate(1,.F.,"v")
Tablerevert(.T.,'v')
*!* mvSuccessful = "Unsuccessful"
Else
Select v
=Tableupdate(.T.)
Endif
Set Relation To
Select Pat
Use
Select r
Use
Select Vflart
Use
Select pv1
Use
Select pv2
Use
Select v
Use
Select Defaults
Use
Select luttech
Use
Select lutref
Use
Select lutread
Use
Select LUTOWNA
Use
Select lutown
Use
Select LUTTESTSTEN
Use
Select LUTTEST
Use
Select custpaperless
Use
Select lutsite
Use
Select MSH
Return Mystring
Endproc
*!* Enddefine
Procedure errHandler
Parameter merror, Mess, mess1, mprog, mlineno
MessageOK=.F.
mvAck= 'Error number: ' + Ltrim(Str(merror))+Chr(13)+;
'Error message: ' + Mess +Chr(13)+;
'Line of code with error: ' + mess1 +Chr(13)+;
'Line number of error: ' + Ltrim(Str(mlineno))+Chr(13)+;
'Program with error: ' + mprog
*If Ack is good add to log and delete file otherwise resend
*****************************************************************************************************************
Set Safety Off
Mystring="Failed"
If File('log.txt')
Else
Strtofile("",'log.txt',0)
Endif
mvHourNow=Hour(Datetime())
Alltrim(Str(Hour(Datetime())))
If mvHourNow>12
For gnhour = 13 To 24
If mvHourNow==gnhour
mvTime=Alltrim(Str(gnhour-12))
mvAMPM='PM'
Endif
Endfor
Else
mvTime=Alltrim(Str(Hour(Datetime())))
mvAMPM='AM'
Endif
mvMinute=Alltrim(Str(Minute(Datetime())))
If Lenc(mvMinute)=1
mvMinute="0"+mvMinute
Endif
mvloginfo="Patient Name: "+Alltrim(Pat.xrcname)+Chr(13)+Chr(10)+;
"Study Date: "+Dtoc(v.ddate)+Chr(13)+Chr(10)+;
"Test Performed: "+Alltrim(v.cprocedure)
login=""+Chr(13)+Chr(10)+;
"HL7 Message: Failed "+ Chr(13);
+" "+Dtoc(Date())+" "+mvTime+":"+mvMinute+" "+mvAMPM+"."+Chr(13)+Chr(10)+;
mvloginfo+ Chr(13)+mvAck+"........................................................................"+Chr(13)+Chr(10)
xLog=Filetostr('log.txt')
Strtofile(login+Substr(xLog,1,10000),'log.txt',0)
Return Mystring
Cancel
Endproc
Procedure addobx
Select OBX
Append Blank
*!* Replace OBX.f2 With Alltrim(Defaults.obx_value)
*!* Replace F3 With Alltrim(Defaults.obx_value)
*!* Replace f4 With Defaults.obx_obs_su+"^"
*!* Replace Segment With "OBX"
*!* Replace f16 With Alltrim(lutread.corgin_id)+"^"+Alltrim(lutread.Name)+"^"+m.now
Endproc
-
1
- #13
Mike Lewis
Programmer
Sorry, too much for my poor brain to take in.
Mike
__________________________________
Mike Lewis (Edinburgh, Scotland)
Visual FoxPro articles, tips and downloads
Mike
__________________________________
Mike Lewis (Edinburgh, Scotland)
Visual FoxPro articles, tips and downloads
Olaf Doschke
Programmer
OK, I asked for it, so beat me up.
The answer is in line 1:
*!* Define Class ARTERIAL_L As Session OlePublic
As you comment out the class definition you destroy the whole purpose of the code to be a DLL, a DLL only publishes OLEPublic classes and since you remove that, there is nothing left this DLL would do.
And besides that commenting out that DEFINE also makes the ENDDEFINE useless.
But to use it that way without the class definition with the single SEARCHFORPATIENT() method, it has to be compiled as EXE and run.
There needs to be a Defaults.XML file to run it, too, maybe some more, I didn't read it all.
So what do we learn from this? Code has many forms of brackets, not only paranthesis like (), [], or {}, but also if..endif and define...endddefine.
If you remove one bracket, the other also has to be removed. Here it makes a bit sense, as a class with only one method has only one way to use it: Create an instance of it and call this one method. Then you can also simply run the code straight forward. But that won't work as DLL, that will work compiling this as EXE (with dependent files in the same directory, of course).
Bye, Olaf.
The answer is in line 1:
*!* Define Class ARTERIAL_L As Session OlePublic
As you comment out the class definition you destroy the whole purpose of the code to be a DLL, a DLL only publishes OLEPublic classes and since you remove that, there is nothing left this DLL would do.
And besides that commenting out that DEFINE also makes the ENDDEFINE useless.
But to use it that way without the class definition with the single SEARCHFORPATIENT() method, it has to be compiled as EXE and run.
There needs to be a Defaults.XML file to run it, too, maybe some more, I didn't read it all.
So what do we learn from this? Code has many forms of brackets, not only paranthesis like (), [], or {}, but also if..endif and define...endddefine.
If you remove one bracket, the other also has to be removed. Here it makes a bit sense, as a class with only one method has only one way to use it: Create an instance of it and call this one method. Then you can also simply run the code straight forward. But that won't work as DLL, that will work compiling this as EXE (with dependent files in the same directory, of course).
Bye, Olaf.
Tore Bleken
Programmer
The code you showed doesn't match the code you showed earlier. At least I can see that Enddefine has been commented out.
Olaf Doschke
Programmer
If this is intended to be a DLL used in any other non VFP software, the only reason I can see for the code having been as it was is, your developer switched the code from Olepublic class to straight away callable prg code, when he wanted to test changes without needing to do a CREATEOBJECT + SEARCHFORPATIENT call and instead be able to click te run button. The situation it was in would rather need to be fixed by including some of the commented lines again.
He also seemed to have used comments for switch in the CURSORTOXML line to sometimes update the Defaults.XML after having edited the Defaults cursor created from XMLTOCURSOR. It's a bag of dirty hacks. I still haven't looked at the whole code, but that doesn't look well planned and structured, just by knowing it is mainly one procedure. At least there is error handling. The only other function/procedure defined - addobx, does nothing but an append blank in obx, that's quite lost to be done as a separate procedure.
Bye, Olaf.
He also seemed to have used comments for switch in the CURSORTOXML line to sometimes update the Defaults.XML after having edited the Defaults cursor created from XMLTOCURSOR. It's a bag of dirty hacks. I still haven't looked at the whole code, but that doesn't look well planned and structured, just by knowing it is mainly one procedure. At least there is error handling. The only other function/procedure defined - addobx, does nothing but an append blank in obx, that's quite lost to be done as a separate procedure.
Bye, Olaf.
- Status
Similar threads
- Locked
- Question