一些仪器的解码程序(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( ...
随机推荐
- Behance 大神推荐2019 年所有设计领域的最新趋势！
昨天国内设计界发生了一则重大新闻! 相信大家应该都听说了吧 Behance挂了··· 继续Pinteres之后 在一个设计师不用上班的周六 我的电脑默默打不开Behance了 也就是说大陆地区的ip地 ...
- Python压缩文件夹 tar.gz .zip
打包压缩生成 XXX.tar.gz 文件 import os import tarfile if os.path.exists(outputFileName): with tarfile.open(o ...
- Laravel Many to Many Polymorphic Relationship
Many to many Polymorphic relationship is also a little bit complicated to understand. For example, i ...
- OPNET仿真软件资料合集
1. OPEN中国代理商业 http://www.credit-top.com/page/Default.asp?pageID=105
- 一道区间DP的水题 -- luogu P2858 [USACO06FEB]奶牛零食Treats for the Cows
https://www.luogu.org/problemnew/show/P2858 方程很好想,关键我多枚举了一次(不过也没多大关系) #include <bits/stdc++.h> ...
- Django的开始
一 浏览器相关知识 http:只有依赖一回,属于短链接,不会报错客户端的信息. 浏览器相当于一个客户端,客户端的链接 服务端:socket服务端,起服务监听客户端的请求. import socket ...
- urllib — URL handling modules
urllib is a package that collects several modules for working with URLs: •urllib.request for opening ...
- 使用spring boot +WebSocket实现（后台主动）消息推送
言:使用此webscoket务必确保生产环境能兼容/支持!使用此webscoket务必确保生产环境能兼容/支持!使用此webscoket务必确保生产环境能兼容/支持!主要是tomcat的兼容与支持. ...
- lf-8.4 数据的增删改
MySQL数据操作: DML 在MySQL管理软件中,可以通过SQL语句中的DML语言来实现数据的操作,包括 使用INSERT实现数据的插入 UPDATE实现数据的更新 使用DELETE实现数据的删除 ...
- .Net实现Windows服务安装完成后自动启动的两种方法
考虑到部署方便,我们一般都会将C#写的Windows服务制作成安装包.在服务安装完成以后,第一次还需要手动启动服务,这样非常不方便. 方法一:在安装完成事件里面调用命令行的方式启动服务 此操作之前要先 ...