一些仪器的解码程序(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( ...
随机推荐
- djiango控制语句
{# 从0开始的索引#} {% for foo in value %} {# 从0开始的索引#} <p>{{ forloop.counter0 }}: {{ foo }}</p> ...
- angular2在双向数据绑定时[(ngModel)]无法使用的问题
angular2在双向数据绑定时[(ngModel)]无法使用,出现的错误是: Can't bind to 'ngModel' since it isn't a known property of ' ...
- 使用yarn 安装 Vue-DevTools
1. 从 github 下载 vuejs/vue-devtools https://github.com/vuejs/vue-devtools/archive/dev.zip 2.安装yarn 及 编 ...
- SpringBoot注册Servlet/Filter/Listener
由于SpringBoot默认是以jar包的方式启动嵌入式的Servlet容器来启动SpringBoot的web应用,那么没有web.xml文件,如何配置我们的三大Web基础组件呢? 通过使用XXXRe ...
- 棋盘问题（NOIP1997）
题目链接:棋盘问题 这道题水不水呢?还是很水的,为什么?因为数据太小了.直接算就行了. #include<bits/stdc++.h> using namespace std; int m ...
- python里面的数学
一.基本运算符 1.算数运算 2.比较运算 特殊情况:!= 不等于 新版本不支持 <> 不等号 3.赋值运算 4.逻辑运算 not : 非 非真即假,非假即真. - and : 并 ...
- mac挂载ntfs文件系统方法
1.插入磁盘,并查看 zz@pzdeMacBook-Pro:~/Volumes/ntfs16g$ df Filesystem 512-blocks Used Available Capacity iu ...
- php-fpm超时时间设置request_terminate_timeout分析
之前发现一个php配置之后关于返回500和502的问题,今天看到一个兄弟写的非常不错,记录一下. php日志中有一条超时的日志,但是我request_terminate_timeout中设置的是0 ...
- 含参变量积分-Leibniz法则
定理3,5参考同济下册. 下面的求导-> 三重积分可以化为累次积分经过过2次累次积分后,三重积分对dt的导数形式就等价于定理3了
- MFC连接MySQL C API方法
1.首先下载一个32位的MySQL,因为vc的版本是32位了,不用32 位的MySQL会出现无效的机械码错误. MySQL安装地址:https://dev.mysql.com/downloads/my ...