一些仪器的解码程序(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_680(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_600(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+'2 ',#2,[rfReplaceAll]);

while True do

begin

if pos(#3,RxStr)>0 then

begin

sStr:= copy(RxStr,1,pos(#3,RxStr));

Delete(RxStr,1,pos(#3,RxStr));

end

else

Break;

if Length(sStr)<10 then continue;

//获取实验号：

sSampleNo:= Trim(copy(sStr,pos(#2,sStr)+1,5));

Delete(sStr,pos(#2,sStr)+1,5);

with PutStrToStrList(sStr,#$A#$D) do

begin

for i:=0 to Count-1 do

begin

if Length(Trim(Strings))<5 then Continue;

sF:=Trim(Strings);

sItemChannel:=Trim(PutStrToStrList(sF,' ').Strings[0]);

sResult:= Trim(PutStrToStrList(sF,' ').Strings[2]);

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,'0');

end;

if (sItemChannel='12') And (PutStrToStrList(sF,' ').Count>4) then

begin

sItemChannel:='12_1';

sResult:= Trim(PutStrToStrList(sF,' ').Strings[5]);

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,'0');

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,1)<>#3 then RxStr:=RxStr+#3;

while True do

begin

if pos(#3,RxStr)>0 then

begin

sStr:= copy(RxStr,1,pos(#3,RxStr));

Delete(RxStr,1,pos(#3,RxStr));

end

else

Break;

if Length(sStr)<10 then continue;

//获取实验号：

sSampleNo:= Trim(copy(sStr,pos(#2,sStr)+9,4));

with PutStrToStrList(sStr,'B') do

begin

for i:=0 to Count-1 do

begin

if i=0 then Continue;

sItemChannel:=Trim(copy(Strings,1,2));

sResult:= Trim(copy(Strings,3,10));

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,'0');

end;

end;

Free;

end;

if sSampleNo<>'' then AutoCalc(g_nSysEquipmentId,sSampleNo);

end;

B:=True;

except

B:=False;

end;

Result:= B;

end;

Function AU_680(RxStr:string):BOOL;//贝克曼AU680生化分析仪

var B:BOOL;

sStr:string;

sSampleNo,sItemChannel,sIdItem,sResult:String;

begin

try

while True do

begin

if pos(#3,RxStr)>0 then

begin

sStr:= copy(RxStr,1,pos(#3,RxStr));

Delete(RxStr,1,pos(#3,RxStr));

end

else

Break;

//获取实验号：

sSampleNo:= Trim(copy(sStr,pos(#2,sStr)+9+3,4));

if uppercase(copy(sStr,pos(#2,sStr)+1,2))=':K' then //质控标本从1001开始

sSampleNo:=sSampleNo+'10'+Trim(copy(sStr,pos(#2,sStr)+5,2));

//获取项目数

sStr:= copy(sStr,pos(#2,sStr)+41,pos(#3,sStr));

while Length(sStr)>=13 do

begin

sItemChannel:= Trim(copy(sStr,1,2));

sResult:= Trim(copy(sStr,3,10));

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,'0');

end;

sStr:=copy(sStr,13+1)

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:= 0;

while True do

begin

if pos(#3,RxStr)>0 then

begin

sStr:=copy(RxStr,pos(#2,RxStr),pos(#3,RxStr));

Delete(RxStr,1,pos(#3,RxStr));

end

else

Break;

//获取实验号：

sSampleNo:=Trim(GetFileld(sStr,char(28),4));

if (Length(sSampleNo)>3) and (IsInteger(RightStr(sSampleNo,1))) then

begin

sSampleNo:=IntToStr(ToInt(GetNumberOnly(sSampleNo,1))+ToInt(RightStr(sSampleNo,1))-1);

end

else

begin

sSampleNo:=GetNumberOnly(sSampleNo,1);

end;

nLoop:=StrToInt(Trim(GetFileld(sStr,char(28),11)));

for i:=1 to nLoop do

begin

sItemChannel:=Trim(GetFileld(sStr,char(28),8+i*4));

sResult:=Trim(GetFileld(sStr,char(28),9+i*4));

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,'0');

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,#2,'',[rfReplaceAll, rfIgnoreCase]);

RxStr:=StringReplace(RxStr,#23,'',[rfReplaceAll, rfIgnoreCase]);

RxStr:=StringReplace(RxStr,#3,'',[rfReplaceAll, rfIgnoreCase]);

RxStr:=StringReplace(RxStr,#4,'',[rfReplaceAll, rfIgnoreCase]);

while True do

begin

if pos('L|1',RxStr)>0 then

begin

sStr:=copy(RxStr,1,pos('L|1',RxStr)+7);

Delete(RxStr,1,pos('L|1',RxStr)+7);

end

else

Break;

with PutStrToStrList(sStr,#10) do

begin

for i:=0 to Count-1 do

begin

with PutStrToStrList(Strings,'|') do

begin

if Count<1 then

else

begin

sIndexStr:=Trim(RightStr(Strings[0],1))+'Camei';

case sIndexStr[1] of

'O':

if Count>2 then

sSampleNo:=Trim(Strings[2])

else

sSampleNo:='';

'R':

if Count>3 then

begin

if Count>12 then

sDate:=Trim(Strings[12]);

if RightStr(Strings[2],4)='DOSE' then

begin

sItemChannel:=Trim(GetFileld(Strings[2],'^',4));

sResult:=Trim(Strings[3]);

//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:='0';

if (sSampleNo<>'') and (sIdItem<>'') then //and (sResult<>'')

begin

DataPos(g_nSysEquipmentId,sSampleNo,sIdItem,sResult,'0');

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(#3,RxStr)>0 then

begin

sStr:= copy(RxStr,pos(#2,RxStr)+1,pos(#3,RxStr)-1);

Delete(RxStr,1,pos(#3,RxStr));

end

else

Break;

if LeftStr(sStr,2)='DI' then

bIsQc:=False

else

begin

if ((LeftStr(sStr,2)='D1C') or (LeftStr(sStr,2)='D2C')) then

bIsQc:=True;

end;

if bIsQc=False then

begin

sSampleNo:=Trim(Copy(sStr,65,15));//IntToStr(ToInt(Trim(Copy(sStr,65,15))));

sSampleDate:=Trim(Copy(sStr,43,4))+'-'+Trim(Copy(sStr,47,2))+'-'+Trim(Copy(sStr,49,2));

////检验结果

sD2U:= copy(sStr,pos('D2U',sStr),216);

for II:= 0 to 31 do

begin

sResult:= copy(sD2U,ToInt(sXT1800D2U[II,1]),ToInt(sXT1800D2U[II,2])-1);

if Trim(sResult)<>'' then

begin

if ToInt(sXT1800D2U[II,3])<> 0 then

sResult:= LeftStr(sResult,ToInt(sXT1800D2U[II,2])-ToInt(sXT1800D2U[II,3]))+'.'+rightstr(sResult,ToInt(sXT1800D2U[II,3])-1);

if pos('*',sResult)> 0 then

sResult:='-----';

sItemChannel:=sXT1800D2U[II,0];

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,'0');

end;

end;

end;

if sSampleNo<>'' then AutoCalc(g_nSysEquipmentId,sSampleNo);

/////不详////////////////

sDBU:=copy(sStr,pos('DBU',sStr),106);

/////图片////////////////

sPicPath:=g_sSysResultPath+'Graph'+g_sSysEquipmentCode+''+FormatDateTime('YYYYMMDD',strtodate(sSampleDate));

ForceDirectories(PChar(sPicPath)); //CreateDirectory

with PutStrToStrList(sItemName,',') do

begin

for J:=0 to Count-1 do

begin

nHeadPos:=pos(Trim(Strings[J]),sStr);

if nHeadPos<=0 then

else

begin

slistPicName:=PutStrToStrList(sPicName,',');

if (Trim(Strings[J])='D3U') or (Trim(Strings[J])='D4U') then

begin //直方图

nlens:=ToInt(Copy(sStr,nHeadPos+ 22,6))-12;

sProcessdata:=Copy(sStr,nHeadPos+ 41,nlens);

lStr.nLower:=ToInt(Copy(sStr,nHeadPos + 29,4));

lStr.nUpper:=ToInt(Copy(sStr,nHeadPos + 33,4));

lStr.nMaxx:=ToInt(Copy(sStr,nHeadPos + 16,3));

lStr.nMaxy:=ToInt(Copy(sStr,nHeadPos + 19,3));

lStr.nResver1:=0;

lStr.nResver2:=0;

if Trim(Strings[J])='D3U' then

lStr.nStoppos:= 46

else

lStr.nStoppos:= 40;

sItem:=Trim(slistPicName.Strings[J]);

sExtra:=Trim(slistPicName.Strings[J])+'.gif';

sFilena:=sPicPath+''+sSampleNo+'_'+sExtra;

if ZFT(sProcessdata,nLens,lStr,'C:LisTempfile1.bmp',sFilena)=1 then

DataPos(g_nSysEquipmentId,sSampleNo,sItem,sFilena,'gif');

end

else //if (Trim(Strings[J])='D1G') then

begin //散点图

nlens:=ToInt(Copy(sStr,nHeadPos+ 22,6))-1;

sProcessdata:=Copy(sStr,nHeadPos+29,nlens);

sItem:=Trim(slistPicName.Strings[J]);

sExtra:=Trim(slistPicName.Strings[J])+'.gif';

sFilena:=sPicPath+''+sSampleNo+'_'+sExtra;

if SDT(sProcessdata,nLens,'C:LisTempfile1.bmp',sFilena)=1 then

DataPos(g_nSysEquipmentId,sSampleNo,sItem,sFilena,'gif');

end;

slistPicName.Free;

end;

end;

Free;

end;

end

else

begin //质控

if (LeftStr(sStr,3)='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(#3,RxStr)>0 then

begin

sStr:= copy(RxStr,pos(#2,RxStr)+1,pos(#3,RxStr)-1);

Delete(RxStr,1,pos(#3,RxStr));

end

else

Break;

if LeftStr(sStr,2)='D1' then

begin

if Trim(Copy(sStr,3,1))<>'U' then Break;

sSampleNo:=Trim(Copy(sStr,53,15));//IntToStr(ToInt(Trim(Copy(sStr,65,15))));

sSampleDate:=Trim(Copy(sStr,44,4))+'-'+Trim(Copy(sStr,48,2))+'-'+Trim(Copy(sStr,50,2));

////检验结果

//sD2U:= copy(sStr,pos('D2U',sStr),216);

for II:= 0 to 19 do

begin

sResult:= copy(sStr,ToInt(sPOCH80Ip[II,1]),ToInt(sPOCH80Ip[II,2])-1);

if Trim(sResult)<>'' then

begin

if ToInt(sPOCH80Ip[II,3])<> 0 then

sResult:= LeftStr(sResult,ToInt(sPOCH80Ip[II,2])-ToInt(sPOCH80Ip[II,3]))+'.'+rightstr(sResult,ToInt(sPOCH80Ip[II,3])-1);

if pos('*',sResult)> 0 then

sResult:='-----';

sItemChannel:=sPOCH80Ip[II,0];

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,'0');

end;

end;

end;

if sSampleNo<>'' then AutoCalc(g_nSysEquipmentId,sSampleNo);

end

else if LeftStr(sStr,2)='D2' then

begin

sGraph:=Copy(sStr,3);

sWbc:=GetGraphCode(LeftStr(sGraph,100));

sRbc:=GetGraphCode(Copy(sGraph,101,100));

end

else if LeftStr(sStr,2)='D3' then

begin

sGraph:=Copy(sStr,3,70);

sPlt:=GetGraphCode(sGraph);

/////图片////////////////

sPicPath:=g_sSysResultPath+'Graph'+g_sSysEquipmentCode+''+FormatDateTime('YYYYMMDD',strtodate(sSampleDate));

ForceDirectories(PChar(sPicPath));

//WBC

nlens:=150;

sProcessdata:=sWbc;//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,87,2)));

lStr.nMaxy:=ToInt(GetGraphCode(Copy(sStr,89,2)));

lStr.nResver1:=0;

lStr.nResver2:=0;

lStr.nStoppos:=46;

sItem:='Wbc';

sExtra:='Wbc.gif';

sFilena:=sPicPath+''+sSampleNo+'_'+sExtra;

if ZFT(sProcessdata,nLens,lStr,'C:LisTempfile1.bmp',sFilena)=1 then

DataPos(g_nSysEquipmentId,sSampleNo,sItem,sFilena,'gif');

//Rbc

nlens:=150;

sProcessdata:=sRbc;//Copy(sStr,nHeadPos+ 41,nlens);

lStr.nLower:=0;//ToInt(GetGraphCode(Copy(sStr,83,2)));

lStr.nUpper:=0;//ToInt(GetGraphCode(Copy(sStr,85,2)));

lStr.nMaxx:=ToInt(GetGraphCode(Copy(sStr,91,2)));

lStr.nMaxy:=ToInt(GetGraphCode(Copy(sStr,93,2)));

lStr.nResver1:=0;

lStr.nResver2:=0;

lStr.nStoppos:=46;

sItem:='Rbc';

sExtra:='Rbc.gif';

sFilena:=sPicPath+''+sSampleNo+'_'+sExtra;

if ZFT(sProcessdata,nLens,lStr,'C:LisTempfile1.bmp',sFilena)=1 then

DataPos(g_nSysEquipmentId,sSampleNo,sItem,sFilena,'gif');

//Plt

nlens:=105;

sProcessdata:=sPlt;//Copy(sStr,nHeadPos+ 41,nlens);

lStr.nLower:=0;//ToInt(GetGraphCode(Copy(sStr,83,2)));

lStr.nUpper:=0;//ToInt(GetGraphCode(Copy(sStr,85,2)));

lStr.nMaxx:=ToInt(GetGraphCode(Copy(sStr,95,2)));

lStr.nMaxy:=ToInt(GetGraphCode(Copy(sStr,97,2)));

lStr.nResver1:=0;

lStr.nResver2:=0;

lStr.nStoppos:=46;

sItem:='Plt';

sExtra:='Plt.gif';

sFilena:=sPicPath+''+sSampleNo+'_'+sExtra;

if ZFT(sProcessdata,nLens,lStr,'C:LisTempfile1.bmp',sFilena)=1 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(#3,RxStr)>0 then

begin

sStr:= copy(RxStr,pos(#2,RxStr)+1,pos(#3,RxStr)-1);

Delete(RxStr,1,pos(#3,RxStr));

end

else

Break;

if LeftStr(sStr,2)='DI' then

bIsQc:=False

else

begin

if ((LeftStr(sStr,2)='D1C') or (LeftStr(sStr,2)='D2C')) then

bIsQc:=True;

end;

if bIsQc=False then

begin

sSampleNo:=Trim(Copy(sStr,65,15));//IntToStr(ToInt(Trim(Copy(sStr,65,15))));

sSampleDate:=Trim(Copy(sStr,43,4))+'-'+Trim(Copy(sStr,47,2))+'-'+Trim(Copy(sStr,49,2));

////检验结果

sD2U:= copy(sStr,pos('D2U',sStr),216);

for II:= 0 to 31 do

begin

sResult:= copy(sD2U,ToInt(sXS500D2U[II,1]),ToInt(sXS500D2U[II,2])-1);

if Trim(sResult)<>'' then

begin

if ToInt(sXS500D2U[II,3])<> 0 then

sResult:= LeftStr(sResult,ToInt(sXS500D2U[II,2])-ToInt(sXS500D2U[II,3]))+'.'+rightstr(sResult,ToInt(sXS500D2U[II,3])-1);

if pos('*',sResult)> 0 then

sResult:='-----';

sItemChannel:=sXS500D2U[II,0];

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,'0');

end;

end;

end;

if sSampleNo<>'' then AutoCalc(g_nSysEquipmentId,sSampleNo);

/////不详////////////////

sDBU:=copy(sStr,pos('DBU',sStr),106);

/////图片////////////////

sPicPath:=g_sSysResultPath+'Graph'+g_sSysEquipmentCode+''+FormatDateTime('YYYYMMDD',strtodate(sSampleDate));

ForceDirectories(PChar(sPicPath)); //CreateDirectory

with PutStrToStrList(sItemName,',') do

begin

for J:=0 to Count-1 do

begin

nHeadPos:=pos(Trim(Strings[J]),sStr);

if nHeadPos<=0 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+ 22,6))-12;

sProcessdata:=Copy(sStr,nHeadPos+ 41,nlens);

lStr.nLower:=ToInt(Copy(sStr,nHeadPos + 29,4));

lStr.nUpper:=ToInt(Copy(sStr,nHeadPos + 33,4));

lStr.nMaxx:=ToInt(Copy(sStr,nHeadPos + 16,3));

lStr.nMaxy:=ToInt(Copy(sStr,nHeadPos + 19,3));

lStr.nResver1:=0;

lStr.nResver2:=0;

if Trim(Strings[J])='D3U' then

lStr.nStoppos:= 46

else

lStr.nStoppos:= 40;

sItem:=Trim(slistPicName.Strings[J]);

sExtra:=Trim(slistPicName.Strings[J])+'.gif';

sFilena:=sPicPath+''+sSampleNo+'_'+sExtra;

if ZFT(sProcessdata,nLens,lStr,'C:LisTempfile1.bmp',sFilena)=1 then

DataPos(g_nSysEquipmentId,sSampleNo,sItem,sFilena,'gif');

end

else //if (Trim(Strings[J])='D1G') then

begin //散点图

nlens:=ToInt(Copy(sStr,nHeadPos+ 22,6))-1;

sProcessdata:=Copy(sStr,nHeadPos+29,nlens);

sItem:=Trim(slistPicName.Strings[J]);

sExtra:=Trim(slistPicName.Strings[J])+'.gif';

sFilena:=sPicPath+''+sSampleNo+'_'+sExtra;

if SDT(sProcessdata,nLens,'C:LisTempfile1.bmp',sFilena)=1 then

DataPos(g_nSysEquipmentId,sSampleNo,sItem,sFilena,'gif');

end;

slistPicName.Free;

end;

end;

Free;

end;

end

else

begin //质控

if (LeftStr(sStr,3)='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_600(RxStr:string):BOOL;

var B:BOOL;

sStr,sF:string;

sSampleNo,sSampleDate,sItemChannel,sIdItem,sResult:String;

I,nPos:Integer;

sItem:array[0..11] of string;

begin

try

RxStr:=StringReplace(RxStr,' ',#3,[rfReplaceAll]);

RxStr:=StringReplace(RxStr,'*','',[rfReplaceAll]);

while True do

begin

if pos('#',RxStr)>0 then

begin

sStr:= copy(RxStr,pos('#',RxStr),pos(#3,RxStr));

Delete(RxStr,1,pos(#3,RxStr));

end

else

Break;

if Length(sStr)<10 then continue;

//获取实验号：

sSampleNo:= Trim(copy(sStr,pos('#',sStr)+1,4));

sSampleDate:= Trim(copy(sStr,pos('#',sStr)+10,10));

sItem[0]:='WBC';

sItem[1]:='NIT';

sItem[2]:='URO';

sItem[3]:='PRO';

sItem[4]:='pH';

sItem[5]:='BLD';

sItem[6]:='SG';

sItem[7]:='BIL';

sItem[8]:='Vc';

sItem[9]:='KET';

sItem[10]:='GLU';

for I := 0 to 10 do

begin

nPos:=pos(Trim(sItem[I]),sStr);

if nPos<0 then Continue;

sItemChannel:=Trim(sItem[I]);

sResult:=Trim(Copy(sStr,nPos+Length(Trim(sItem[I])),19));

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,'0');

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

相关阅读:
Oracle课堂实验一“表的使用”代码。
Oracle安装时忘记解锁scott用户的解决方案
 PHP中CURL技术模拟登陆抓取网站信息，用与微信公众平台成绩查询
 Fckeditor漏洞利用总结
 js 倒计时 button不可用
 .net 下载图片
 截取字符串
 js 后台弹窗
 账号注册，密码安全级别提示（弱、中、强）代码
 jquery 评论等级（很差，差，一般，好，很好）代码
原文地址：https://www.cnblogs.com/westsoft/p/10106407.html

最新文章
第六次作业
 第五次作业
 第四次作业
 第三次作业
 gravity2
Infect
generator
Cross
flattern
Card2