一些儀器的解碼程式(delphi)
阿新 • • 發佈：2018-12-12
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