2009年8月28日 星期五

2007美國捐血作業報告

http://www.hhs.gov/ophs/bloodsafety/2007nbcus_survey.pdf
已經開始在評估2009的作業了(2009 NATIONAL BLOOD COLLECTION AND UTILIZATION SURVEY - NBCUS)

好希望台灣的捐血中心也能做出這樣的報告,應該也是一份好的參考文獻,輸血學會來做好了!

2009年8月17日 星期一

SHOT

英國 Serious Harzard of Transfusion 2008 報告
http://www.shotuk.org/SHOT Report 2008.pdf

2009年8月16日 星期日

勇士舞

不小心轉到一個電視台,在介紹兩個年輕原住民向排灣族年長的族人學習建築、食物等習俗,到了晚上有一個跳"勇士舞"的活動,可是沒有一個舞者是年輕人。

覺得有些諷刺與難過,沒有年輕人的原因應該不需要說明了。

2009年8月12日 星期三

錯亂

有一天全院開會,我旁邊坐了個大醫師,他還上過新聞。
會議開始前他跟我一一數落坐在前排的長官,各個都是混蛋...。
但到了會議開始後,司儀在介紹長官時,他卻又跟著大家一起拍手,我腦子裡只有"錯亂"這個詞不斷的盤旋。
  • 他是因為被制約嗎?那種場合,大家拍手,就自動會跟著拍手,而不會去思考剛剛罵人的那些事情?
  • 如果我覺得這些人真的是混蛋,我是不是也跟著拍手?
  • 其實,每天的工作中,自己也充滿了這種"錯亂",明明對老闆不認同,銘名覺得老闆是個笨蛋,明明覺得老闆很不了解事情的狀況;但老闆指示東、指示西的時候,還是回答"是,是,是!"

2009年8月9日 星期日

連線程式練習

連線程式小試,同事一直反應,人工分類完,再以手工 key in 電腦常常出錯,造成修改報告頻繁,只好自己找資料,買了RS-232 測試的工具玩一玩,找到底下這篇論文參考,真的可以用喔!
使用儀器:白血球分類計數儀 comdek MD-200

感謝 洪敬瑞 成功大學研究所論文的參考
論文種類 碩士論文
口試日期 2004-07-22
論文名稱(中) 建立臨床檢驗室數位醫療資訊系統
論文名稱(英) Impiementation of Clinical Laboratory Information System
做了部份修改,有些小問題,製作時才會遇到。
  1. timer 要設定 Interval timer1(500ms), timer2(1ms), timer3(1ms)
  2. item() 要設定群組,才能給順序呼叫
  3. 檢體編號說有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