一些仪器的解码程序(delphi)
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_(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_(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 ',#,[rfReplaceAll]);
while True do
begin
if pos(#,RxStr)> then
begin
sStr:= copy(RxStr,,pos(#,RxStr));
Delete(RxStr,,pos(#,RxStr));
end
else
Break;
if Length(sStr)< then continue;
//获取实验号：
sSampleNo:= Trim(copy(sStr,pos(#,sStr)+,));
Delete(sStr,pos(#,sStr)+,);
with PutStrToStrList(sStr,#$A#$D) do
begin
for i:= to Count- do
begin
if Length(Trim(Strings))< then Continue;
sF:=Trim(Strings);
sItemChannel:=Trim(PutStrToStrList(sF,' ').Strings[]);
sResult:= Trim(PutStrToStrList(sF,' ').Strings[]);
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,'');
end;
if (sItemChannel='') And (PutStrToStrList(sF,' ').Count>) then
begin
sItemChannel:='12_1';
sResult:= Trim(PutStrToStrList(sF,' ').Strings[]);
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,'');
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,)<># then RxStr:=RxStr+#;
while True do
begin
if pos(#,RxStr)> then
begin
sStr:= copy(RxStr,,pos(#,RxStr));
Delete(RxStr,,pos(#,RxStr));
end
else
Break;
if Length(sStr)< then continue;
//获取实验号：
sSampleNo:= Trim(copy(sStr,pos(#,sStr)+,));
with PutStrToStrList(sStr,'B') do
begin
for i:= to Count- do
begin
if i= then Continue;
sItemChannel:=Trim(copy(Strings,,));
sResult:= Trim(copy(Strings,,));
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,'');
end;
end;
Free;
end;
if sSampleNo<>'' then AutoCalc(g_nSysEquipmentId,sSampleNo);
end;
B:=True;
except
B:=False;
end;
Result:= B;
end;
Function AU_(RxStr:string):BOOL;//贝克曼AU680生化分析仪
var B:BOOL;
sStr:string;
sSampleNo,sItemChannel,sIdItem,sResult:String;
begin
try
while True do
begin
if pos(#,RxStr)> then
begin
sStr:= copy(RxStr,,pos(#,RxStr));
Delete(RxStr,,pos(#,RxStr));
end
else
Break;
//获取实验号：
sSampleNo:= Trim(copy(sStr,pos(#,sStr)++,));
if uppercase(copy(sStr,pos(#,sStr)+,))=':K' then //质控标本从1001开始
sSampleNo:=sSampleNo+''+Trim(copy(sStr,pos(#,sStr)+,));
//获取项目数
sStr:= copy(sStr,pos(#,sStr)+,pos(#,sStr));
while Length(sStr)>= do
begin
sItemChannel:= Trim(copy(sStr,,));
sResult:= Trim(copy(sStr,,));
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,'');
end;
sStr:=copy(sStr,+)
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:= ;
while True do
begin
if pos(#,RxStr)> then
begin
sStr:=copy(RxStr,pos(#,RxStr),pos(#,RxStr));
Delete(RxStr,,pos(#,RxStr));
end
else
Break;
//获取实验号：
sSampleNo:=Trim(GetFileld(sStr,char(),));
if (Length(sSampleNo)>) and (IsInteger(RightStr(sSampleNo,))) then
begin
sSampleNo:=IntToStr(ToInt(GetNumberOnly(sSampleNo,))+ToInt(RightStr(sSampleNo,))-);
end
else
begin
sSampleNo:=GetNumberOnly(sSampleNo,);
end;
nLoop:=StrToInt(Trim(GetFileld(sStr,char(),)));
for i:= to nLoop do
begin
sItemChannel:=Trim(GetFileld(sStr,char(),+i*));
sResult:=Trim(GetFileld(sStr,char(),+i*));
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,'');
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,#,'',[rfReplaceAll, rfIgnoreCase]);
RxStr:=StringReplace(RxStr,#,'',[rfReplaceAll, rfIgnoreCase]);
RxStr:=StringReplace(RxStr,#,'',[rfReplaceAll, rfIgnoreCase]);
RxStr:=StringReplace(RxStr,#,'',[rfReplaceAll, rfIgnoreCase]);
while True do
begin
if pos('L|1',RxStr)> then
begin
sStr:=copy(RxStr,,pos('L|1',RxStr)+);
Delete(RxStr,,pos('L|1',RxStr)+);
end
else
Break;
with PutStrToStrList(sStr,#) do
begin
for i:= to Count- do
begin
with PutStrToStrList(Strings,'|') do
begin
if Count< then
else
begin
sIndexStr:=Trim(RightStr(Strings[],))+'Camei';
case sIndexStr[] of
'O':
if Count> then
sSampleNo:=Trim(Strings[])
else
sSampleNo:='';
'R':
if Count> then
begin
if Count> then
sDate:=Trim(Strings[]);
if RightStr(Strings[],)='DOSE' then
begin
sItemChannel:=Trim(GetFileld(Strings[],'^',));
sResult:=Trim(Strings[]);
//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:='';
if (sSampleNo<>'') and (sIdItem<>'') then //and (sResult<>'')
begin
DataPos(g_nSysEquipmentId,sSampleNo,sIdItem,sResult,'');
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(#,RxStr)> then
begin
sStr:= copy(RxStr,pos(#,RxStr)+,pos(#,RxStr)-);
Delete(RxStr,,pos(#,RxStr));
end
else
Break;
if LeftStr(sStr,)='DI' then
bIsQc:=False
else
begin
if ((LeftStr(sStr,)='D1C') or (LeftStr(sStr,)='D2C')) then
bIsQc:=True;
end;
if bIsQc=False then
begin
sSampleNo:=Trim(Copy(sStr,,));//IntToStr(ToInt(Trim(Copy(sStr,65,15))));
sSampleDate:=Trim(Copy(sStr,,))+'-'+Trim(Copy(sStr,,))+'-'+Trim(Copy(sStr,,));
////检验结果
sD2U:= copy(sStr,pos('D2U',sStr),);
for II:= to do
begin
sResult:= copy(sD2U,ToInt(sXT1800D2U[II,]),ToInt(sXT1800D2U[II,])-);
if Trim(sResult)<>'' then
begin
if ToInt(sXT1800D2U[II,])<> then
sResult:= LeftStr(sResult,ToInt(sXT1800D2U[II,])-ToInt(sXT1800D2U[II,]))+'.'+rightstr(sResult,ToInt(sXT1800D2U[II,])-);
if pos('*',sResult)> then
sResult:='-----';
sItemChannel:=sXT1800D2U[II,];
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,'');
end;
end;
end;
if sSampleNo<>'' then AutoCalc(g_nSysEquipmentId,sSampleNo);
/////不详////////////////
sDBU:=copy(sStr,pos('DBU',sStr),);
/////图片////////////////
sPicPath:=g_sSysResultPath+'Graph\'+g_sSysEquipmentCode+'\'+FormatDateTime('YYYYMMDD',strtodate(sSampleDate));
ForceDirectories(PChar(sPicPath)); //CreateDirectory
with PutStrToStrList(sItemName,',') do
begin
for J:= to Count- do
begin
nHeadPos:=pos(Trim(Strings[J]),sStr);
if nHeadPos<= then
else
begin
slistPicName:=PutStrToStrList(sPicName,',');
if (Trim(Strings[J])='D3U') or (Trim(Strings[J])='D4U') then
begin //直方图
nlens:=ToInt(Copy(sStr,nHeadPos+ ,))-;
sProcessdata:=Copy(sStr,nHeadPos+ ,nlens);
lStr.nLower:=ToInt(Copy(sStr,nHeadPos + ,));
lStr.nUpper:=ToInt(Copy(sStr,nHeadPos + ,));
lStr.nMaxx:=ToInt(Copy(sStr,nHeadPos + ,));
lStr.nMaxy:=ToInt(Copy(sStr,nHeadPos + ,));
lStr.nResver1:=;
lStr.nResver2:=;
if Trim(Strings[J])='D3U' then
lStr.nStoppos:=
else
lStr.nStoppos:= ;
sItem:=Trim(slistPicName.Strings[J]);
sExtra:=Trim(slistPicName.Strings[J])+'.gif';
sFilena:=sPicPath+'\'+sSampleNo+'_'+sExtra;
if ZFT(sProcessdata,nLens,lStr,'C:\LisTempfile1.bmp',sFilena)= then
DataPos(g_nSysEquipmentId,sSampleNo,sItem,sFilena,'gif');
end
else //if (Trim(Strings[J])='D1G') then
begin //散点图
nlens:=ToInt(Copy(sStr,nHeadPos+ ,))-;
sProcessdata:=Copy(sStr,nHeadPos+,nlens);
sItem:=Trim(slistPicName.Strings[J]);
sExtra:=Trim(slistPicName.Strings[J])+'.gif';
sFilena:=sPicPath+'\'+sSampleNo+'_'+sExtra;
if SDT(sProcessdata,nLens,'C:\LisTempfile1.bmp',sFilena)= then
DataPos(g_nSysEquipmentId,sSampleNo,sItem,sFilena,'gif');
end;
slistPicName.Free;
end;
end;
Free;
end;
end
else
begin //质控
if (LeftStr(sStr,)='D2C') then
begin
end;
end;
end;
B:=True;
except
B:=False;
end;
Result:= B;
end;
本文来自: HC3i中国数字医疗论坛(http://bbs.hc3i.cn/) 详细：http://bbs.hc3i.cn/thread-80160-1.html
Function POCH_80i(RxStr:string):BOOL;//森美康POCH-80i全自动血液细胞分析仪
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;
sWbc,sRbc,sPlt,sGraph:string;
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(#,RxStr)> then
begin
sStr:= copy(RxStr,pos(#,RxStr)+,pos(#,RxStr)-);
Delete(RxStr,,pos(#,RxStr));
end
else
Break;
if LeftStr(sStr,)='D1' then
begin
if Trim(Copy(sStr,,))<>'U' then Break;
sSampleNo:=Trim(Copy(sStr,,));//IntToStr(ToInt(Trim(Copy(sStr,65,15))));
sSampleDate:=Trim(Copy(sStr,,))+'-'+Trim(Copy(sStr,,))+'-'+Trim(Copy(sStr,,));
////检验结果
//sD2U:= copy(sStr,pos('D2U',sStr),216);
for II:= to do
begin
sResult:= copy(sStr,ToInt(sPOCH80Ip[II,]),ToInt(sPOCH80Ip[II,])-);
if Trim(sResult)<>'' then
begin
if ToInt(sPOCH80Ip[II,])<> then
sResult:= LeftStr(sResult,ToInt(sPOCH80Ip[II,])-ToInt(sPOCH80Ip[II,]))+'.'+rightstr(sResult,ToInt(sPOCH80Ip[II,])-);
if pos('*',sResult)> then
sResult:='-----';
sItemChannel:=sPOCH80Ip[II,];
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,'');
end;
end;
end;
if sSampleNo<>'' then AutoCalc(g_nSysEquipmentId,sSampleNo);
end
else if LeftStr(sStr,)='D2' then
begin
sGraph:=Copy(sStr,);
sWbc:=GetGraphCode(LeftStr(sGraph,));
sRbc:=GetGraphCode(Copy(sGraph,,));
end
else if LeftStr(sStr,)='D3' then
begin
sGraph:=Copy(sStr,,);
sPlt:=GetGraphCode(sGraph);
/////图片////////////////
sPicPath:=g_sSysResultPath+'Graph\'+g_sSysEquipmentCode+'\'+FormatDateTime('YYYYMMDD',strtodate(sSampleDate));
ForceDirectories(PChar(sPicPath));
//WBC
nlens:=;
sProcessdata:=sWbc;//Copy(sStr,nHeadPos+ 41,nlens);
lStr.nLower:=ToInt(GetGraphCode(Copy(sStr,,)));
lStr.nUpper:=ToInt(GetGraphCode(Copy(sStr,,)));
lStr.nMaxx:=ToInt(GetGraphCode(Copy(sStr,,)));
lStr.nMaxy:=ToInt(GetGraphCode(Copy(sStr,,)));
lStr.nResver1:=;
lStr.nResver2:=;
lStr.nStoppos:=;
sItem:='Wbc';
sExtra:='Wbc.gif';
sFilena:=sPicPath+'\'+sSampleNo+'_'+sExtra;
if ZFT(sProcessdata,nLens,lStr,'C:\LisTempfile1.bmp',sFilena)= then
DataPos(g_nSysEquipmentId,sSampleNo,sItem,sFilena,'gif');
//Rbc
nlens:=;
sProcessdata:=sRbc;//Copy(sStr,nHeadPos+ 41,nlens);
lStr.nLower:=;//ToInt(GetGraphCode(Copy(sStr,83,2)));
lStr.nUpper:=;//ToInt(GetGraphCode(Copy(sStr,85,2)));
lStr.nMaxx:=ToInt(GetGraphCode(Copy(sStr,,)));
lStr.nMaxy:=ToInt(GetGraphCode(Copy(sStr,,)));
lStr.nResver1:=;
lStr.nResver2:=;
lStr.nStoppos:=;
sItem:='Rbc';
sExtra:='Rbc.gif';
sFilena:=sPicPath+'\'+sSampleNo+'_'+sExtra;
if ZFT(sProcessdata,nLens,lStr,'C:\LisTempfile1.bmp',sFilena)= then
DataPos(g_nSysEquipmentId,sSampleNo,sItem,sFilena,'gif');
//Plt
nlens:=;
sProcessdata:=sPlt;//Copy(sStr,nHeadPos+ 41,nlens);
lStr.nLower:=;//ToInt(GetGraphCode(Copy(sStr,83,2)));
lStr.nUpper:=;//ToInt(GetGraphCode(Copy(sStr,85,2)));
lStr.nMaxx:=ToInt(GetGraphCode(Copy(sStr,,)));
lStr.nMaxy:=ToInt(GetGraphCode(Copy(sStr,,)));
lStr.nResver1:=;
lStr.nResver2:=;
lStr.nStoppos:=;
sItem:='Plt';
sExtra:='Plt.gif';
sFilena:=sPicPath+'\'+sSampleNo+'_'+sExtra;
if ZFT(sProcessdata,nLens,lStr,'C:\LisTempfile1.bmp',sFilena)= then
DataPos(g_nSysEquipmentId,sSampleNo,sItem,sFilena,'gif');
end;
end;
B:=True;
except
B:=False;
end;
Result:= B;
end;
//希森美康XS-500i全自动血液细胞分析仪
Function XS500i(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,D5U';
sPicName:string='HRBC,HPLT,SDIFF,SBASO,SPLT,SRET,SPLT-O,SRET-E,SNRBC,WBC';
begin
try
while True do
begin
if pos(#,RxStr)> then
begin
sStr:= copy(RxStr,pos(#,RxStr)+,pos(#,RxStr)-);
Delete(RxStr,,pos(#,RxStr));
end
else
Break;
if LeftStr(sStr,)='DI' then
bIsQc:=False
else
begin
if ((LeftStr(sStr,)='D1C') or (LeftStr(sStr,)='D2C')) then
bIsQc:=True;
end;
if bIsQc=False then
begin
sSampleNo:=Trim(Copy(sStr,,));//IntToStr(ToInt(Trim(Copy(sStr,65,15))));
sSampleDate:=Trim(Copy(sStr,,))+'-'+Trim(Copy(sStr,,))+'-'+Trim(Copy(sStr,,));
////检验结果
sD2U:= copy(sStr,pos('D2U',sStr),);
for II:= to do
begin
sResult:= copy(sD2U,ToInt(sXS500D2U[II,]),ToInt(sXS500D2U[II,])-);
if Trim(sResult)<>'' then
begin
if ToInt(sXS500D2U[II,])<> then
sResult:= LeftStr(sResult,ToInt(sXS500D2U[II,])-ToInt(sXS500D2U[II,]))+'.'+rightstr(sResult,ToInt(sXS500D2U[II,])-);
if pos('*',sResult)> then
sResult:='-----';
sItemChannel:=sXS500D2U[II,];
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,'');
end;
end;
end;
if sSampleNo<>'' then AutoCalc(g_nSysEquipmentId,sSampleNo);
/////不详////////////////
sDBU:=copy(sStr,pos('DBU',sStr),);
/////图片////////////////
sPicPath:=g_sSysResultPath+'Graph\'+g_sSysEquipmentCode+'\'+FormatDateTime('YYYYMMDD',strtodate(sSampleDate));
ForceDirectories(PChar(sPicPath)); //CreateDirectory
with PutStrToStrList(sItemName,',') do
begin
for J:= to Count- do
begin
nHeadPos:=pos(Trim(Strings[J]),sStr);
if nHeadPos<= then
else
begin
slistPicName:=PutStrToStrList(sPicName,',');
if (Trim(Strings[J])='D3U') or (Trim(Strings[J])='D4U') or (Trim(Strings[J])='D5U') then
begin //直方图
nlens:=ToInt(Copy(sStr,nHeadPos+ ,))-;
sProcessdata:=Copy(sStr,nHeadPos+ ,nlens);
lStr.nLower:=ToInt(Copy(sStr,nHeadPos + ,));
lStr.nUpper:=ToInt(Copy(sStr,nHeadPos + ,));
lStr.nMaxx:=ToInt(Copy(sStr,nHeadPos + ,));
lStr.nMaxy:=ToInt(Copy(sStr,nHeadPos + ,));
lStr.nResver1:=;
lStr.nResver2:=;
if Trim(Strings[J])='D3U' then
lStr.nStoppos:=
else
lStr.nStoppos:= ;
sItem:=Trim(slistPicName.Strings[J]);
sExtra:=Trim(slistPicName.Strings[J])+'.gif';
sFilena:=sPicPath+'\'+sSampleNo+'_'+sExtra;
if ZFT(sProcessdata,nLens,lStr,'C:\LisTempfile1.bmp',sFilena)= then
DataPos(g_nSysEquipmentId,sSampleNo,sItem,sFilena,'gif');
end
else //if (Trim(Strings[J])='D1G') then
begin //散点图
nlens:=ToInt(Copy(sStr,nHeadPos+ ,))-;
sProcessdata:=Copy(sStr,nHeadPos+,nlens);
sItem:=Trim(slistPicName.Strings[J]);
sExtra:=Trim(slistPicName.Strings[J])+'.gif';
sFilena:=sPicPath+'\'+sSampleNo+'_'+sExtra;
if SDT(sProcessdata,nLens,'C:\LisTempfile1.bmp',sFilena)= then
DataPos(g_nSysEquipmentId,sSampleNo,sItem,sFilena,'gif');
end;
slistPicName.Free;
end;
end;
Free;
end;
end
else
begin //质控
if (LeftStr(sStr,)='D2C') then
begin
//
end;
end;
end;
B:=True;
except
B:=False;
end;
Result:= B;
end;
本文来自: HC3i中国数字医疗论坛(http://bbs.hc3i.cn/) 详细：http://bbs.hc3i.cn/thread-80160-1.html
//美侨MEJER-600尿液分析仪
Function MEJER_(RxStr:string):BOOL;
var B:BOOL;
sStr,sF:string;
sSampleNo,sSampleDate,sItemChannel,sIdItem,sResult:String;
I,nPos:Integer;
sItem:array[..] of string;
begin
try
RxStr:=StringReplace(RxStr,' ',#,[rfReplaceAll]);
RxStr:=StringReplace(RxStr,'*','',[rfReplaceAll]);
while True do
begin
if pos('#',RxStr)> then
begin
sStr:= copy(RxStr,pos('#',RxStr),pos(#,RxStr));
Delete(RxStr,,pos(#,RxStr));
end
else
Break;
if Length(sStr)< then continue;
//获取实验号：
sSampleNo:= Trim(copy(sStr,pos('#',sStr)+,));
sSampleDate:= Trim(copy(sStr,pos('#',sStr)+,));
sItem[]:='WBC';
sItem[]:='NIT';
sItem[]:='URO';
sItem[]:='PRO';
sItem[]:='pH';
sItem[]:='BLD';
sItem[]:='SG';
sItem[]:='BIL';
sItem[]:='Vc';
sItem[]:='KET';
sItem[]:='GLU';
for I := to do
begin
nPos:=pos(Trim(sItem[I]),sStr);
if nPos< then Continue;
sItemChannel:=Trim(sItem[I]);
sResult:=Trim(Copy(sStr,nPos+Length(Trim(sItem[I])),));
if sResult='-' then sResult:='阴性';
if sResult='Normal' then 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,'');
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
一些仪器的解码程序(delphi)的更多相关文章
- 红外遥控系统原理及单片机软件解码程序，我的编写经历(C版本)
应该说现在每一块开发板都带有红外模块,并且大都配置了相应的程序.但其实自己动手写解码程序,更能锻炼自己所学,且不谈程序写的如何,这个过程中肯定是受益良多的.现在我就把我花一下午写出的解码程序与大家分享 ...
- DELPHI开发LINUX桌面程序
DELPHI开发LINUX桌面程序 DELPHI官方目前为止尚不能开发LINUX桌面程序. 但三方控件FmxLinux(商业控件)是可以的.网上有破解版本.
- delphi怎样编译LINUX程序
delphi编译LINUX程序 DELPHI XE 10.2(TOKYO)开始可以开发LINUX控制台程序. 1)上传PASERVER到LINUX,并且运行PASERVER. 2)开始编译,PROFI ...
- DELPHI开发LINUX插件架构的程序
DELPHI开发LINUX插件架构的程序 DELPHI可以开发LINUX配置型插件架构的程序,并且这一套插件架构,同样适用于MSWINDOWS和MAC. 配置插件: 根据配置,动态加载插件:
- 转：关于视频H264编解码的应用实现
转:http://blog.csdn.net/scalerzhangjie/article/details/8273410 项目要用到视频编解码,最近半个月都在搞,说实话真是走了很多弯路,浪费了很多时 ...
- Delphi 预编译指令 的用法
A.3 使用条件编译指令条件编译指令是非常重要的编译指令,他控制着在不同条件下(例如,不同的操作系统)产生不同的代码.条件编译指令是包含在注释括号之内的,如下表所示. ...
- H.264视频在android手机端的解码与播放(转)
随着无线网络和智能手机的发展,智能手机与人们日常生活联系越来越紧密,娱乐.商务应用.金融应用.交通出行各种功能的软件大批涌现,使得人们的生活丰富多彩.快捷便利,也让它成为人们生活中不可取代的一部分.其 ...
- Delphi 预编译指令
<Delphi下深入Windows核心编程>(附录A Delphi编译指令说明)Delphi快速高小的编译器主要来自Object PASCAL的严谨,使用Delphi随时都在与编译器交流, ...
- delphi 各版本的特性
delphi 各新版本特性收集 Delphi XE6新增了一些特性并增强了原有的功能,主要有以下几个方面: IDE(整合开发环境) Internet XML(扩展标记语言) Compiler( ...
随机推荐
- MyBatis Generator介绍
MyBatis Generator介绍 MyBatis Generator (MBG) 是一个Mybatis的代码生成器 MyBatis 和 iBATIS. 他可以生成Mybatis各个版本的代码,和 ...
- 查看CPU核数和内存
查看CPU核数 top 然后按数字键1 通过虚拟文件系统proc,直接获取CPU总数量 cat /proc/cpuinfo | grep processor 查看内存 free命令主要用于显示内存数量 ...
- Hive 系列（一）安装部署
Hive 系列(一)安装部署 Hive 官网:http://hive.apache.org.参考手册 一.环境准备 JDK 1.8 :从 Oracle 官网下载,设置环境变量(JAVA_HOME.PA ...
- python flask 项目结构
1. 今天学习遇到一个问题,以前项目比较简单,所有的@app.route 都是写在一个文件app.py 中的,然后启动也是在这个文件中启动app.run .但是我今天 想写一个新的模块, 于是我新启了 ...
- bundler简介（ruby gem）
簡介 Bundler RubyGem 是包裝.散佈Ruby程式庫的標準方式,相關文件可以參考 RubyGems Guides 的說明,或是 簡介 plugins 中的第二個例子.在使用rails ...
- trunc()用法和add_months()
TRUNC函数用于对值进行截断. 用法有两种:TRUNC(NUMBER)表示截断数字,TRUNC(date)表示截断日期. (1)截断数字: 格式:TRUNC(n1,n2),n1表示被截断的数字,n2 ...
- 关于Code Review
为了保证代码质量,我们团队内部一直在推行Code Review.现在Code Review帮我们发现了很多代码的问题,提升了代码的可读性和质量,同时我们在Code Review上也花费了很多时间,有些 ...
- floor函数
C++中 可以用floor函数来截断小数部分 floor(x)返回一个不大于x的整数,有点像取整函数
- css扩大超链接的点击范围
给a标签设置display:block后,它会根据盒模型计算a标签的实际大小.这时候,你可以使用hover伪类使a的整个盒模型生效..link a{display:block;padding:2px ...
- window.frames
// 点击事件 function zTreeOnClick(event, treeId, treeNode) { id = treeNode.id; window.frames["treeF ...