一些仪器的解码程序(delphi)

其他 2018-12-12 09:08:02 阅读次数: 0 
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

猜你喜欢

转载自www.cnblogs.com/westsoft/p/10106407.html
今日推荐
基于大语言模型的开源知识库问答系统 MaxKB GitHub Star 数量突破 5,000 个！
美国拟限制 AI 大模型出口中国和俄罗斯
苹果将与 OpenAI 达成协议，将 ChatGPT 应用于 iPhone
openKylin 社区生态委员会第六次会议圆满召开
阿里云正式发布通义千问 2.5
Python 3.13 发布首个 Beta：实验性自由线程模式和 JIT、改进交互式解释器
Stack Overflow 拿我的代码去训练 AI 大模型，还封了我的账号
Pop!_OS 的 COSMIC 桌面完成 App Store 上架工作
《2024 年一季度互联网投融资运行情况》研究报告
报告：Django 仍然是 74% 开发者的首选
15 年前上了“FFmpeg 耻辱柱”，今天他还得谢谢咱——腾讯QQPlayer一雪前耻？
TIOBE 5 月榜单：Fortran “复活”进入 Top 10
周排行
记一下去大梅沙的准备（2018-05-26）
Spring 注解 事务
基于HTTP协议的客户端缓存
阿里云rds 备份和还原
[PHP] 几个拖慢 PHP 程序/API 运行速度的点
python 代码风格------------PEP8规则
js控制json生成菜单——自制菜单（一）
将字符串: 'k:1|k1:2|k2:3|k3:4 ' ,处理成 python 字典: {'k':1, 'k1':2, ...}
微信小程序转支付宝小程序
Qt551.窗口滚动条
每日归档
更多
2024-05-13(18)
2024-05-12(0)
2024-05-11(38)
2024-05-10(38)
2024-05-09(35)
2024-05-08(42)
2024-05-07(14)
2024-05-06(40)
2024-05-05(0)
2024-05-04(7)

代码天地 © 2018 codetd.com

境外服务器   最新电视剧2022