一些仪器的解码程序(delphi)

原作者: [db:作者] 来自: [db:来源] 收藏邀请

http://www.jiandande.com/html/ITzixun-jishu/Lisyanjiuyuan/2013/0204/1600_3.html 

看了后觉得不错，可能有需要的

－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－

本人是做His的，有几家医院非要让我帮他们做Lis，这些仪器的资料真是不太好找，比做His麻烦多了，下面这些东西提供给需要的人，省得找这么辛苦。

Function C2000_A(RxStr:string):BOOL;//普利生C2000-A全自动血凝仪

Function LBY_N6C(RxStr:string):BOOL;//普利生LBY-N6C全自动血液流变仪

Function AU_680(RxStr:string):BOOL;//贝克曼AU680生化分析仪

Function DIMENSION(RxStr:string):BOOL;//西门子Dimension Xpand生化分析仪

Function CENTAU(RxStr:string):BOOL;//西门子ADVIA Centaur CP发光免疫分析仪

Function XT1800I(RxStr:string):BOOL;//希森美康XT-1800i全自动血液细胞分析仪

Function XS500i(RxStr:string):BOOL;//希森美康XS-500i全自动血液细胞分析仪

Function MEJER_600(RxStr:string):BOOL;//美侨MEJER-600尿液分析仪

本文来自: HC3i中国数字医疗论坛(http://bbs.hc3i.cn/) 详细：http://bbs.hc3i.cn/thread-80160-1.html

 

 

Function C2000_A(RxStr:string):BOOL;//普利生C2000-A全自动血凝仪

var B:BOOL;

sStr,sF:string;

sSampleNo,sItemChannel,sIdItem,sResult:String;

I,aaa:Integer;

bbb:string;

begin

try

RxStr:=StringReplace(RxStr,#2+'2 ',#2,[rfReplaceAll]);

while True do

begin

if pos(#3,RxStr)>0 then

begin

sStr:= copy(RxStr,1,pos(#3,RxStr));

Delete(RxStr,1,pos(#3,RxStr));

end

else

Break;

if Length(sStr)<10 then continue;

//获取实验号：

sSampleNo:= Trim(copy(sStr,pos(#2,sStr)+1,5));

Delete(sStr,pos(#2,sStr)+1,5);

with PutStrToStrList(sStr,#$A#$D) do

begin

for i:=0 to Count-1 do

begin

if Length(Trim(Strings))<5 then Continue;

sF:=Trim(Strings);

sItemChannel:=Trim(PutStrToStrList(sF,' ').Strings[0]);

sResult:= Trim(PutStrToStrList(sF,' ').Strings[2]);

sResult:= CutNumeric(sResult);

sIdItem:=dm.GetStr('IdItem', 'BaseItemChannel', ' and IdEquipment='+g_nSysEquipmentId+' And channel='''+sItemChannel+'''');

if (sSampleNo<>'') and (sIdItem<>'') then

begin

DataPos(g_nSysEquipmentId,sSampleNo,sIdItem,sResult,'0');

end;

if (sItemChannel='12') And (PutStrToStrList(sF,' ').Count>4) then

begin

sItemChannel:='12_1';

sResult:= Trim(PutStrToStrList(sF,' ').Strings[5]);

sResult:= CutNumeric(sResult);

sIdItem:=dm.GetStr('IdItem', 'BaseItemChannel', ' and IdEquipment='+g_nSysEquipmentId+' And channel='''+sItemChannel+'''');

if sIdItem='' then sIdItem:=dm.GetStr('Id', 'BaseItem', ' and IdEquipment='+g_nSysEquipmentId+' And Code='''+sItemChannel+'''');

begin

DataPos(g_nSysEquipmentId,sSampleNo,sIdItem,sResult,'0');

end;

end;

end;

Free;

end;

if sSampleNo<>'' then AutoCalc(g_nSysEquipmentId,sSampleNo);

end;

B:=True;

except

B:=False;

end;

Result:= B;

end;

 

 

本文来自: HC3i中国数字医疗论坛(http://bbs.hc3i.cn/) 详细：http://bbs.hc3i.cn/thread-80160-1.html

 

Function LBY_N6C(RxStr:string):BOOL;//普利生LBY-N6C全自动血液流变仪

var B:BOOL;

sStr:string;

sSampleNo,sItemChannel,sIdItem,sResult:String;

I:Integer;

begin

if RightStr(RxStr,1)<>#3 then RxStr:=RxStr+#3;

while True do

begin

if pos(#3,RxStr)>0 then

begin

sStr:= copy(RxStr,1,pos(#3,RxStr));

Delete(RxStr,1,pos(#3,RxStr));

end

else

Break;

if Length(sStr)<10 then continue;

//获取实验号：

sSampleNo:= Trim(copy(sStr,pos(#2,sStr)+9,4));

with PutStrToStrList(sStr,'B') do

begin

for i:=0 to Count-1 do

begin

if i=0 then Continue;

sItemChannel:=Trim(copy(Strings,1,2));

sResult:= Trim(copy(Strings,3,10));

sResult:= CutNumeric(sResult);

sIdItem:=dm.GetStr('IdItem', 'BaseItemChannel', ' and IdEquipment='+g_nSysEquipmentId+' And channel='''+sItemChannel+'''');

if sIdItem='' then sIdItem:=dm.GetStr('Id', 'BaseItem', ' and IdEquipment='+g_nSysEquipmentId+' And Code='''+sItemChannel+'''');

if (sSampleNo<>'') and (sIdItem<>'') then

begin

DataPos(g_nSysEquipmentId,sSampleNo,sIdItem,sResult,'0');

end;

end;

Free;

end;

if sSampleNo<>'' then AutoCalc(g_nSysEquipmentId,sSampleNo);

end;

B:=True;

except

B:=False;

end;

Result:= B;

end;

Function AU_680(RxStr:string):BOOL;//贝克曼AU680生化分析仪

var B:BOOL;

sStr:string;

sSampleNo,sItemChannel,sIdItem,sResult:String;

begin

try

while True do

begin

if pos(#3,RxStr)>0 then

begin

sStr:= copy(RxStr,1,pos(#3,RxStr));

Delete(RxStr,1,pos(#3,RxStr));

end

else

Break;

//获取实验号：

sSampleNo:= Trim(copy(sStr,pos(#2,sStr)+9+3,4));

if uppercase(copy(sStr,pos(#2,sStr)+1,2))=':K' then //质控标本从1001开始

sSampleNo:=sSampleNo+'10'+Trim(copy(sStr,pos(#2,sStr)+5,2));

//获取项目数

sStr:= copy(sStr,pos(#2,sStr)+41,pos(#3,sStr));

while Length(sStr)>=13 do

begin

sItemChannel:= Trim(copy(sStr,1,2));

sResult:= Trim(copy(sStr,3,10));

sResult:= CutNumeric(sResult);

sIdItem:=dm.GetStr('IdItem', 'BaseItemChannel', ' and IdEquipment='+g_nSysEquipmentId+' And channel='''+sItemChannel+'''');

if sIdItem='' then sIdItem:=dm.GetStr('Id', 'BaseItem', ' and IdEquipment='+g_nSysEquipmentId+' And Code='''+sItemChannel+'''');

if (sSampleNo<>'') and (sIdItem<>'') then // and (sResult<>'')

begin

DataPos(g_nSysEquipmentId,sSampleNo,sIdItem,sResult,'0');

end;

sStr:=copy(sStr,13+1)

end;

if sSampleNo<>'' then AutoCalc(g_nSysEquipmentId,sSampleNo);

end;

B:=True;

except

B:=False;

end;

Result:= B;

end;

本文来自: HC3i中国数字医疗论坛(http://bbs.hc3i.cn/) 详细：http://bbs.hc3i.cn/thread-80160-1.html

 

 

Function DIMENSION(RxStr:string):BOOL;//西门子Dimension Xpand生化分析仪

var B:BOOL;

sStr:string;

sSampleNo,sItemChannel,sIdItem,sResult:String;

i,nLoop:integer; //循环数量

begin

try

nLoop:= 0;

while True do

begin

if pos(#3,RxStr)>0 then

begin

sStr:=copy(RxStr,pos(#2,RxStr),pos(#3,RxStr));

Delete(RxStr,1,pos(#3,RxStr));

end

else

Break;

//获取实验号：

sSampleNo:=Trim(GetFileld(sStr,char(28),4));

if (Length(sSampleNo)>3) and (IsInteger(RightStr(sSampleNo,1))) then

begin

sSampleNo:=IntToStr(ToInt(GetNumberOnly(sSampleNo,1))+ToInt(RightStr(sSampleNo,1))-1);

end

else

begin

sSampleNo:=GetNumberOnly(sSampleNo,1);

end;

nLoop:=StrToInt(Trim(GetFileld(sStr,char(28),11)));

for i:=1 to nLoop do

begin

sItemChannel:=Trim(GetFileld(sStr,char(28),8+i*4));

sResult:=Trim(GetFileld(sStr,char(28),9+i*4));

sResult:= CutNumeric(sResult);

sIdItem:=dm.GetStr('IdItem', 'BaseItemChannel', ' and IdEquipment='+g_nSysEquipmentId+' And channel='''+sItemChannel+'''');

if sIdItem='' then sIdItem:=dm.GetStr('Id', 'BaseItem', ' and IdEquipment='+g_nSysEquipmentId+' And Code='''+sItemChannel+'''');

if (sSampleNo<>'') and (sIdItem<>'') then //and (sResult<>'')

begin

DataPos(g_nSysEquipmentId,sSampleNo,sIdItem,sResult,'0');

end;

end;

if sSampleNo<>'' then AutoCalc(g_nSysEquipmentId,sSampleNo);

end;

B:=True;

except

B:=False;

end;

Result:= B;

end;

本文来自: HC3i中国数字医疗论坛(http://bbs.hc3i.cn/) 详细：http://bbs.hc3i.cn/thread-80160-1.html

 

Function CENTAU(RxStr:string):BOOL;//西门子ADVIA Centaur CP发光免疫分析仪

var B:BOOL;

sStr,sIndexStr:string;

sSampleNo,sItemChannel,sIdItem,sResult,sDate:String;

i:integer; //循环数量

begin

try

RxStr:=StringReplace(RxStr,#2,'',[rfReplaceAll, rfIgnoreCase]);

RxStr:=StringReplace(RxStr,#23,'',[rfReplaceAll, rfIgnoreCase]);

RxStr:=StringReplace(RxStr,#3,'',[rfReplaceAll, rfIgnoreCase]);

RxStr:=StringReplace(RxStr,#4,'',[rfReplaceAll, rfIgnoreCase]);

while True do

begin

if pos('L|1',RxStr)>0 then

begin

sStr:=copy(RxStr,1,pos('L|1',RxStr)+7);

Delete(RxStr,1,pos('L|1',RxStr)+7);

end

else

Break;

with PutStrToStrList(sStr,#10) do

begin

for i:=0 to Count-1 do

begin

with PutStrToStrList(Strings,'|') do

begin

if Count<1 then

else

begin

sIndexStr:=Trim(RightStr(Strings[0],1))+'Camei';

case sIndexStr[1] of

'O':

if Count>2 then

sSampleNo:=Trim(Strings[2])

else

sSampleNo:='';

'R':

if Count>3 then

begin

if Count>12 then

sDate:=Trim(Strings[12]);

if RightStr(Strings[2],4)='DOSE' then

begin

sItemChannel:=Trim(GetFileld(Strings[2],'^',4));

sResult:=Trim(Strings[3]);

//sResult:= CutNumeric(sResult);

sIdItem:=dm.GetStr('IdItem', 'BaseItemChannel', ' and IdEquipment='+g_nSysEquipmentId+' And channel='''+sItemChannel+'''');

if sIdItem='' then sIdItem:=dm.GetStr('Id', 'BaseItem', ' and IdEquipment='+g_nSysEquipmentId+' And Code='''+sItemChannel+'''');

if sIdItem='' then sIdItem:='0';

if (sSampleNo<>'') and (sIdItem<>'') then //and (sResult<>'')

begin

DataPos(g_nSysEquipmentId,sSampleNo,sIdItem,sResult,'0');

end;

end;

end;

//'L':

//H (header) record

//P (patient) record

//O (order) record

//L (termination) record

end;

end;

Free;

end;

end;

Free;

if sSampleNo<>'' then AutoCalc(g_nSysEquipmentId,sSampleNo);

end;

end;

B:=True;

except

B:=False;

end;

Result:= B;

end;

本文来自: HC3i中国数字医疗论坛(http://bbs.hc3i.cn/) 详细：http://bbs.hc3i.cn/thread-80160-1.html

 

//希森美康XT-1800i全自动血液细胞分析仪

Function XT1800I(RxStr:string):BOOL;

var B,bIsQc:BOOL;

sStr:string;

sSampleDate,sSampleNo,sItemChannel,sIdItem,sResult:String;

II,J:integer; //循环数量

sD2U,sDBU:string;

sPicPath:string;

nHeadPos:integer;

sProcessdata,sItem,sExtra,sFilena:string;

nLens:Integer;

lStr:TDateRec;

slistPicName:TStringList;

const

sItemName:string='D3U,D4U,D1G,D2G,D3G,D4G,D5G,D6G,D7G';

sPicName:string='HRBC,HPLT,SDIFF,SBASO,SPLT,SRET,SPLT-O,SRET-E,SNRBC';

begin

try

while True do

begin

if pos(#3,RxStr)>0 then

begin

sStr:= copy(RxStr,pos(#2,RxStr)+1,pos(#3,RxStr)-1);

Delete(RxStr,1,pos(#3,RxStr));

end

else

Break;

if LeftStr(sStr,2)='DI' then

bIsQc:=False

else

begin

if ((LeftStr(sStr,2)='D1C') or (LeftStr(sStr,2)='D2C')) then

bIsQc:=True;

end;

if bIsQc=False then

begin

sSampleNo:=Trim(Copy(sStr,65,15));//IntToStr(ToInt(Trim(Copy(sStr,65,15))));

sSampleDate:=Trim(Copy(sStr,43,4))+'-'+Trim(Copy(sStr,47,2))+'-'+Trim(Copy(sStr,49,2));

////检验结果

sD2U:= copy(sStr,pos('D2U',sStr),216);

for II:= 0 to 31 do

begin

sResult:= copy(sD2U,ToInt(sXT1800D2U[II,1]),ToInt(sXT1800D2U[II,2])-1);

if Trim(sResult)<>'' then

begin

if ToInt(sXT1800D2U[II,3])<> 0 then

sResult:= LeftStr(sResult,ToInt(sXT1800D2U[II,2])-ToInt(sXT1800D2U[II,3]))+'.'+rightstr(sResult,ToInt(sXT1800D2U[II,3])-1);

if pos('*',sResult)> 0 then

sResult:='-----';

sItemChannel:=sXT1800D2U[II,0];

sIdItem:=dm.GetStr('IdItem', 'BaseItemChannel', ' and IdEquipment='+g_nSysEquipmentId+' And channel='''+sItemChannel+'''');

if sIdItem='' then sIdItem:=dm.GetStr('Id', 'BaseItem', ' and IdEquipment='+g_nSysEquipmentId+' And Code='''+sItemChannel+'''');

if (sSampleNo<>'') and (sIdItem<>'') then //and (sResult<>'')

begin

DataPos(g_nSysEquipmentId,sSampleNo,sIdItem,sResult,'0');

end;

end;

end;

if sSampleNo<>'' then AutoCalc(g_nSysEquipmentId,sSampleNo);

/////不详////////////////

sDBU:=copy(sStr,pos('DBU',sStr),106);

/////图片////////////////

sPicPath:=g_sSysResultPath+'Graph\'+g_sSysEquipmentCode+'\'+FormatDateTime('YYYYMMDD',strtodate(sSampleDate));

ForceDirectories(PChar(sPicPath)); //CreateDirectory

with PutStrToStrList(sItemName,',') do

begin

for J:=0 to Count-1 do

begin

nHeadPos:=pos(Trim(Strings[J]),sStr);

if nHeadPos<=0 then

else

begin

slistPicName:=PutStrToStrList(sPicName,',');

if (Trim(Strings[J])='D3U') or (Trim(Strings[J])='D4U') then

begin // 
                       
                    
                     
                      



鲜花




握手




雷人




路过




鸡蛋

该文章已有0人参与评论

请发表评论

全部评论

专题导读

More+

10-27 六六分期app的软件客服如何联系？(六六分期

11-06 可心卡盟:win10系统火狐flash插件崩溃怎么

11-06 亲亲特价:怎么删除回收站图标

11-06 济南大学虚拟社区:鲁大师节能降温的具体办

11-06 xlueops.exe:无线网络安装向导

11-06 女斗合众国:win7系统cf与主机连接不稳定怎

11-06 0xc000022-[cf烟雾头]cf怎么调烟雾头

11-06 qizideyouhuo:应用程序无法正常启动0xc0000

11-06 ipz-185:win7系统vcf文件怎么打开

11-06 傻哥蹦迪:win10系统s4怎么打开usb调试

11-06 八神浩树gtaste:回收站清空了怎么恢复

11-06 妖尾之黑色守护:win10系统电脑没有1440x900

11-06 校园至尊魔王小说:win7系统浏览网页时字体

11-06 女斗合众国:win10系统访问共享文件夹提示请

11-06 tokyo hot n0654:恢复win7系统默认字体一招

11-06 雨酷仙境:设置win7系统转移临时文件夹腾出

11-06 阿穆纳伊之杖:win7系统开始菜单在右边还原

11-06 tunespotting:win10系统火狐flash插件总是

11-06 甘尔葛分析师：计谋网站seo关键词暴涨有什

11-06 蔡贵霖: 计谋网站seo关键词暴涨有什么秘密

11-06 博益网首页:ao3网页版进入不了解决方法

11-06 漏斗子专栏: 网站数据分析小白易懂精华篇

11-06 见证双虹怎么做:win7系统开启telnet命令的

11-06 颾狐蝶蜋:系统资源不足无法完成请求的服务

11-06 国光中学校歌:提交网站到alexa查询详细步骤

11-06 西安有情天:静态网页和动态网页的区别

11-06 红木雅尚斋:外部链接构造对网站的好处

11-06 前官礼遇：防止域名劫持–增强域安全性的10

11-06 密传二转答案: 中文分词算法有哪些

11-06 金泉家园邮编:百度快照劫持的表现及应对方

DelphiClassof类引用发布时间：2022-07-18

DelphiXE2之FireMonkey入门(11)-控件居中、旋转、透明发布时间：2022-07-18

剪的笔顺,诠释剪的笔画,认识剪的部首

六六分期app的软件客服如何联系？(六六分期

2023-10-27

florent37/ViewAnimator: A fluent Android

2022-08-15

florent37/Shrine-MaterialDesign2: implem

2022-08-17

CVE-2020-36276

2022-09-23

SimpleSoftwareIO/simple-sms: Send and re

2022-08-13

阅读排行榜

1 六六分期app的软件客服如何联系？(六六分期

六六分期app的软件客服如何联系？不知道吗？加qq群【895510560】即可！标题：六六分期

阅读：19266|2023-10-27

2 可心卡盟:win10系统火狐flash插件崩溃怎么

今天小编告诉大家如何处理win10系统火狐flash插件总是崩溃的问题，可能很多用户都不知

阅读：10012|2022-11-06

3 亲亲特价:怎么删除回收站图标

今天小编告诉大家如何对win10系统删除桌面回收站图标进行设置，可能很多用户都不知道

阅读：8339|2022-11-06

4 济南大学虚拟社区:鲁大师节能降温的具体办

今天小编告诉大家如何对win10系统电脑设置节能降温的设置方法，想必大家都遇到过需要

阅读：8706|2022-11-06

5 xlueops.exe:无线网络安装向导

我们在使用xp系统的过程中,经常需要对xp系统无线网络安装向导设置进行设置，可能很多

阅读：8653|2022-11-06

6 女斗合众国:win7系统cf与主机连接不稳定怎

今天小编告诉大家如何处理win7系统玩cf老是与主机连接不稳定的问题，可能很多用户都不

阅读：9682|2022-11-06

7 0xc000022-[cf烟雾头]cf怎么调烟雾头

电脑对日常生活的重要性小编就不多说了，可是一旦碰到win7系统设置cf烟雾头的问题，很

阅读：8640|2022-11-06

8 qizideyouhuo:应用程序无法正常启动0xc0000

我们在日常使用电脑的时候，有的小伙伴们可能在打开应用的时候会遇见提示应用程序无法

阅读：8009|2022-11-06

9 ipz-185:win7系统vcf文件怎么打开

今天小编告诉大家如何对win7系统打开vcf文件进行设置，可能很多用户都不知道怎么对win

阅读：8676|2022-11-06

10 傻哥蹦迪:win10系统s4怎么打开usb调试

今天小编告诉大家如何对win10系统s4开启USB调试模式进行设置，可能很多用户都不知道怎

阅读：7545|2022-11-06

扫描微信二维码

查看手机版网站

随时了解更新最新资讯

139-2527-9053

在线客服（服务时间 9:00～18:00）

在线QQ客服

地址：深圳市南山区西丽大学城创智工业园

电邮：jeky_zhao#qq.com

移动电话：139-2527-9053

客服电话

电子邮件

一些仪器的解码程序(delphi)

请发表评论

全部评论

上一篇：

下一篇：

PacktPublishing/Python-Machine-Learning-

sussillo/hfopt-matlab: A parallel, cpu-b

鲁东大学一米网:Win7系统USB驱动器RAM的操

emersion/go-ostatus: An OStatus library

从matlab导入fig图片数据并设定输出大小