一些仪器的解码程序(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( ...
随机推荐
- BZOJ4326或洛谷2680 运输计划
BZOJ原题链接 洛谷原题链接 用\(LCA\)初始化出所有运输计划的原始时间,因为答案有单调性,所以二分答案,然后考虑检验答案. 很容易想到将所有超出当前二分的答案的运输计划所经过的路径标记,在这些 ...
- linux学习第三天 (Linux就该这么学)
今天是学习的第三天,讲了很多命令,又赶上双11,网络经常波动,我经常掉线,没有听到多少,回头再看一下录播.我也写一下讲的命令吧,也加深一下命令的印象.第三章老师讲完了. ifconfig命令:输出信息 ...
- PHP字符串反转
function getRev($str,$encoding='utf-8'){ $result = ''; $len = mb_strlen($str); for($i=$len-1; $i> ...
- Linux下设置Apache支持Https服务
HTTPS的主要作用: 1)建立一个信息安全通道,来保证数据传输的安全性 2)确认网站的真实性 HTTPS与HTTP的区别: 1)HTTPS协议需要到ca申请证书,免费证书较少 2)HTTP是超文本传 ...
- java 多态的深入理解
简单来说 : 多态 能够很好的解决代码耦合性的问题 考虑这样一个场景 有个人 买了辆捷达汽车 .这个系统应该如何设计呢? public class JettaCar { public void run ...
- python+selenium—webdriver入门（一）
一.浏览器最大化 二.设置浏览器分辨率大小 三.打印页面title 四.打印URL 五.控制浏览器前进或后退 #!/usr/bin/env python#-*- coding:utf-8 -*- fr ...
- 【WebService】使用CXF开发WebService（四）
CXF简介 Apache CXF = Celtix + XFire,开始叫 Apache CeltiXfire,后来更名为 Apache CXF 了,以下简称为 CXF.CXF 继承了 Celtix ...
- Selenium+python入门
在 WebDriver 中, 将这些关于鼠标操作的方法封装在 ActionChains 类提供 ActionChains 类提供了鼠标操作的常用方法: perform(): 执行所有 ActionCh ...
- 进制转换(NOIP2000&NOIP水题测试(2017082301))
题目链接:进制转换 这题得明白其中的数学方法,明白后就不难了. 那么我们应该怎么计算呢? 其实也很简单. 我们依然采取辗转相除法. 但是,对于负的余数,我们需要进行一些处理. 我们怎么处理呢? 很简单 ...
- JS高级-Date- Error-***Function:
1. Date: API: 1. 8个单位: FullYear Month Date Day Hours Minutes Seconds Milliseconds 2. 每 ...