連線程式小試，同事一直反應，人工分類完，再以手工 key in 電腦常常出錯，造成修改報告頻繁，只好自己找資料，買了RS-232 測試的工具玩一玩，找到底下這篇論文參考，真的可以用喔！
使用儀器：白血球分類計數儀 comdek MD-200
感謝 洪敬瑞 成功大學研究所論文的參考
| 論文種類 | 碩士論文 |
|---|
| 口試日期 | 2004-07-22 |
|---|
| 論文名稱(中) | 建立臨床檢驗室數位醫療資訊系統 |
|---|
| 論文名稱(英) | Impiementation of Clinical Laboratory Information System |
|---|
做了部份修改，有些小問題，製作時才會遇到。
- timer 要設定 Interval timer1(500ms), timer2(1ms), timer3(1ms)
- item() 要設定群組，才能給順序呼叫
- 檢體編號說有12位數，可是怎麼測都只有8位數，又亂跳位置！難！
'==============程式碼================
Dim InByte() As Byte
Dim buf(0 To 11) As String
Public counter%, reg$
Private CN As ADODB.Connection
Private RS As ADODB.Recordset
Private Sub Command1_Click()
'SEND BUTTON
Dim SQL_STR As String
Dim I%
'===CHECK 基本資料是否齊全
If Len(Text1.Text) <> 10 Or IsNull(Text1.Text) Or item(12) = 0 Then
MsgBox "試管號碼錯誤 或是" & Chr(13) & "總和值有問題" & Chr(13) _
& "無法繼續？", vbCritical, "注意!!"
Call RESET_FORM
Exit Sub
End If
'===依序將不是0的ITEM資料填入 EXPER_SIGN
For I = 0 To 11
' If item(I) > 0 Then
SQL_STR = "UPDATE EXPER_SIGN SET " _
& "EXPER_DATA2='" & item(I) & "' " _
& "WHERE TUBE_NUMBER='" & Text1.Text & "' " _
& "AND EXPER_CODE='" & Label1(I) & "' " _
& "AND TYPE_FLAG<>'Y';" '注意已經確認的報告不要再 UPDATE!!
CN.Execute SQL_STR, 1
'MsgBox SQL_STR
'===ADD"人工閱片確認"
If Label1(I) = "NEUT" Then
SQL_STR = "UPDATE EXPER_SIGN SET " _
& "DATA_REMARK='人工閱片確認' " _
& "WHERE TUBE_NUMBER='" & Text1.Text & "' " _
& "AND EXPER_CODE='" & Label1(I) & "' " _
& "AND TYPE_FLAG<>'Y';" '注意已經確認的報告不要再 UPDATE!!
CN.Execute SQL_STR
End If
'===INSERT LOG
SQL_STR = "INSERT INTO EXPER_LOG " _
& "SELECT LAB_NO,GROUP_CODE,SOUR_FLAG,EXPER_CLASS," _
& "EXPER_TYPE,EXPER_CODE,EXPER_NO,TUBE_NUMBER,KEY_FLAG,TYPE_FLAG, " _
& "'" & Trim(Format(Date, "YYYYMMDD") - 19110000) & "','" & Format(Time, "HHNN") & "','CBC'," _
& "CHR_NO,ID_NO,EXPER_DATE,EXPER_TIME," _
& "FEE_NO,TAKE_DATE,TAKE_TIME,SIGN_DATE,SIGN_TIME,MACHINE_CODE,MACHINE_SEQ," _
& "COMP_DATE,COMP_TIME,EXPER_DATA,EXPER_DATA2,EXPER_DATA3,EXPER_DATA4,EXPER_DATA5," _
& "DATA_REMARK,LOCAL_NO,REPORT_NO,REPORT_DATE,REPORT_TIME,REPORT_OPER,EXPER_DOC " _
& "FROM EXPER_SIGN " _
& "WHERE TUBE_NUMBER='" & Text1.Text & "' " _
& "AND EXPER_CODE='" & Label1(I) & "';"
CN.Execute SQL_STR
' End If
Next I
'===RESET FORM
Call RESET_FORM
End Sub
Private Sub form_load()
MSComm1.CommPort = 1
MSComm1.Settings = "1200,N,8,1"
MSComm1.PortOpen = True
counter = 0
'===DATA CONNECT
Set CN = New ADODB.Connection
CN.ConnectionString = "Provider=MSDASQL.1;Password=xxx;Persist Security Info=True;User ID=exp;Data Source=wfh2"
CN.Open
End Sub
Private Sub Form_Unload(Cancel As Integer)
RS.Close
RS.ActiveConnection = Nothing
End Sub
Private Sub Text1_Change()
If Len(Text1.Text) = 10 Then
Call DATA_GRID(Text1.Text)
Command1.SetFocus
Else
Exit Sub
End If
End Sub
Private Sub Timer1_timer()
If MSComm1.DSRHolding Then
MSComm1.RTSEnable = False
Else
Timer2.Enabled = True
Timer1.Enabled = False
'Text1.Text = "TIMER1"
End If
End Sub
Private Sub Timer2_timer()
MSComm1.RTSEnable = True
Timer3.Enabled = True
Timer2.Enabled = False
'Text1.Text = "TIMER2"
End Sub
Private Sub Timer3_timer()
On Error Resume Next
'Text1.Text = "timer3"
Dim I%, j%
Dim reg1$, reg_ID$, tube_number$
Dim sum_all As Currency
Timer2.Enabled = False
InByte = MSComm1.Input
For I = LBound(InByte) To UBound(InByte)
reg = reg + Hex(InByte(I))
Next I
'Text2.Text = reg
counter = counter + 1
If counter = 75 Then
Timer1.Enabled = True
Timer3.Enabled = False
MSComm1.RTSEnable = False
counter = 0
'print out reg contents
'Text2.Text = Text2.Text & Chr(13) & "counter>75: " & reg
'此型號要取最後121個字元
reg = Right(reg, 141)
reg_ID = Left(reg, 20)
tube_number = Right(Format(Date, "yymmdd"), 5) + "0" + Mid(reg_ID, 13, 1) _
+ Mid(reg_ID, 20, 1) + Mid(reg_ID, 17, 1) + Mid(reg_ID, 18, 1)
Text2.Text = tube_number
Text2.Text = reg + "x" + Mid(reg_ID, 5, 1) + Mid(reg_ID, 2, 1) + Mid(reg_ID, 3, 1) _
+ Mid(reg_ID, 10, 1) + Mid(reg_ID, 8, 1) + Mid(reg_ID, 9, 1) _
+ Mid(reg_ID, 15, 1) + Mid(reg_ID, 12, 1) + Mid(reg_ID, 13, 1) _
+ Mid(reg_ID, 20, 1) + Mid(reg_ID, 17, 1) + Mid(reg_ID, 18, 1)
reg = Right(reg, 121)
'trim extra "0"
For I = 2 To 120 Step 2
'reg1 = reg1 & Format(Val(Mid(reg, I, 2)))
reg1 = reg1 & Mid(reg, I, 1)
Next I
buf(0) = Mid(reg1, 1, 5)
For j = 1 To 11
buf(j) = Mid(reg1, (j * 5 + 1), 5)
Next j
For j = 0 To 11
' Text1.Text = Text1.Text + buf(j) + Chr(13)
item(j).Text = Int(Val(Left(buf(j), 3) + "." + Right(buf(j), 2)) * 10 + 0.5) / 10
sum_all = sum_all + item(j)
Next j
End If
item(12).Text = sum_all
End Sub
Private Sub DATA_GRID(tube_number As String)
Dim SQL_STR As String
Set RS = New ADODB.Recordset
RS.CursorLocation = adUseClient
SQL_STR = "SELECT TUBE_NUMBER,CHR_NO,GROUP_CODE,EXPER_CODE,EXPER_DATA2 " _
& "FROM EXPER_SIGN " _
& "WHERE TUBE_NUMBER ='" & tube_number & "' " _
& "AND TYPE_FLAG<>'Y';"
RS.Open SQL_STR, CN, adOpenKeyset, adLockOptimistic
RS.MoveLast
'MsgBox RS.RecordCount
Text2.Text = Text2.Text & "RecordCount=" & RS.RecordCount
If RS.RecordCount = 0 Then
MsgBox "找不到試管號碼??", vbCritical, "注意!"
End If
Set DataGrid1.DataSource = RS
End Sub
Private Sub RESET_FORM()
Dim I%
'===RESET FORM
Text1.Text = ""
For I = 0 To 12
item(I).Text = 0
Next I
Set DataGrid1.DataSource = Nothing
Text1.SetFocus
End Sub
