一些仪器的解码程序(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( ...
随机推荐
- Python Numpy中transpose()函数的使用
在Numpy对矩阵的转置中,我们可以用transpose()函数来处理. 这个函数的运行是非常反常理的,可能会令人陷入思维误区. 假设有这样那个一个三维数组(2*4*2): array ([[[ 0, ...
- angular2在双向数据绑定时[(ngModel)]无法使用的问题
angular2在双向数据绑定时[(ngModel)]无法使用,出现的错误是: Can't bind to 'ngModel' since it isn't a known property of ' ...
- 移动端300ms延迟由来及解决方案
1.300ms延迟由来 300 毫秒延迟的主要原因是解决双击缩放(double tap to zoom).双击缩放,顾名思义,即用手指在屏幕上快速点击两次,iOS 自带的 Safari 浏览器会将网页 ...
- Linux修改/etc/profile配置错误command is not found自救方法
export PATH=/usr/local/sbin:/usr/local/bin:/sbin:/bin:/usr/sbin:/usr/bin:/root/bin
- .NET发送邮件的方法
整理一下,在.NET中发送邮件的一个方法,代码如下: public static string Net_Email(string strSendto, string strCC, string str ...
- appium获取package和activity
输入命令adb shell dumpsys window w |findstr \/ |findstr name=然后在手机端打开app,电脑上按enter就即可显示 以微信为例子 appPackag ...
- kbmmw 与extjs 的初次结合
前面写了extjs 的安装,今天写一下kbmmw 与extjs 的结合,参照delphi 产品经理marco文章 . 由于extjs 设计时要读取服务器端的数据,所以先要做一个rest 服务器. 先要 ...
- mysql之表与表关联和表操作
一 表于表之间的关联 foregin key:设置外键表于表之间建立关联. 多对一关联: 创建步骤,应该先创建好被关联的那一张表,然后再去创建关联的那一张表. 关联表的多条对应着被关联的那张表的一条记 ...
- 2018.10.25 uestc上天的卿学姐（计数dp）
传送门 看了DZYODZYODZYO的题解之后发现自己又sbsbsb了啊. 直接dpdpdp是O(2d)O(2^d)O(2d)更新,O(1)O(1)O(1)查询或者O(1)O(1)O(1)更新,O(2 ...
- select 选中是否包含
$("#regionname1").find("option:contains('"+regionname+"')").prop(" ...