Dim jl As WinForm.TextBox = e.Form.Controls("TextBoxJL")
Dim path As String = ProjectPath & "data\检验检查人次数统计.txt"
Dim ss As String
ss = FileSys.ReadAllText(path)
Dim Proc As New Process '定义一个新的Process
If ss.Length > 0
If MessageBox.Show("2022年5-7月已经有查询数据,是否重新查询?大约需要50分钟,耐心等候......","提示",MessageBoxButtons.YesNo,MessageBoxIcon.Information) = DialogResult.No
jl.Text = ss
Return
End If
End If
'
Dim jyrc As Double
Dim jcrc As Double
Dim i1 As Integer
Dim i2 As Integer
Dim i3 As Integer
Dim ii As Integer
Dim jctj As Integer '检查项目人次
Dim jytj As Integer '检验项目人次
Dim txtj As Integer '有图像结果的检查项目人次
Dim dr As DataRow
Dim d1 As Date
Dim d2 As Date
d1 = Date.Now()
Dim kssj As WinForm.DateTimePicker = e.Form.Controls("DateTimePickerS")
Dim jssj As WinForm.DateTimePicker = e.Form.Controls("DateTimePickerE")
Dim djs As Date = jssj.Value
djs = djs.AddDays(1)
Dim Products As List(Of String)
Products = DataTables("Zymx2").SQLGetValues("住院号码","结算日期 >= '" & kssj.Value & "' And 结算日期 < '" & djs & "'")
Dim pg As WinForm.ProgressBar = e.Form.Controls("ProgressBar1")
pg.Minimum = 0
pg.Maximum = Products.Count
For Each s As String In Products
ii += 1
'Output.Show(ii)
'Tables("Zymx2").Filter = "住院号码 = '" & s & "' and (费用归并 = '检查类放射费' or 费用归并 = '放射费' or 费用归并 = '检查费' or 费用归并 = 'CT费' or 费用归并 = '彩超费' or 费用归并 = '心电图费')"
'i = Tables("Zymx2").Rows.Count
''===
i1 = DataTables("Zymx2").SQLCompute("Count([住院号码])", "住院号码 = '" & s & "' and (费用归并 = '检查类放射费' or 费用归并 = '放射费' or 费用归并 = '检查费' or 费用归并 = 'CT费' or 费用归并 = '彩超费' or 费用归并 = '心电图费')")
i2 = DataTables("Zymx2").SQLCompute("Count([住院号码])", "住院号码 = '" & s & "' and 费用归并 = '化验费'" )
i3 = DataTables("Zymx2").SQLCompute("Count([住院号码])", "住院号码 = '" & s & "' and (费用归并 = '放射费' or 费用归并 = 'CT费')")
'''===
If i1 > 0
jctj += 1
End If
If i2 > 0
jytj += 1
End If
If i3 > 0
txtj += 1
End If
pg.Value = ii
Next
d2 = Date.Now()
Dim t As TimeSpan = d2 - d1
Dim st As String
st = "耗时:" & Format(t.TotalMinutes,"0.00") & "分钟, " & "出院病人数:" & Products.Count & ", 住院检查项目人次数:" & jctj & ", 住院检验项目人次数:" & jytj & " ,有图像结果的检查项目人次:" & txtj
jl.Text = jl.Text & vbcrlf & kssj.Value & " 至 " & djs & vbcrlf & st
FileSys.WriteAllText (path,vbcrlf & kssj.Value & " 至 " & jssj.Value & vbcrlf & st,True)
Proc.File = path '指定要打开的文件
Proc.Start()
加好友 
发短信
Post By：2022/9/6 14:14:00 [显示全部帖子]
此主题相关图片如下：按钮变灰.png
