Foxtable(狐表)用户栏目专家坐堂 → 根据出生日期计算年龄月龄及日龄的代码(医学相关)


  共有12454人关注过本帖树形打印复制链接

主题:根据出生日期计算年龄月龄及日龄的代码(医学相关)

帅哥哟,离线,有人找我吗?
sxdoc
  1楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:童狐 帖子:278 积分:2387 威望:0 精华:0 注册:2011/8/18 8:33:00
根据出生日期计算年龄月龄及日龄的代码(医学相关)  发帖心情 Post By:2012/11/3 20:36:00 [只看该作者]

If e.DataCol.Name = "出生日期" Then
    If e.DataRow.IsNull("出生日期") Then '如果没有输入出生日期
    Else
        '否则计算年龄
        e.DataRow("年龄") = Date.Today.Year - e.DataRow("出生日期").Year
    End If
    If e.DataRow.IsNull("出生日期") Then '如果没有输入出生日期
        e.DataRow("月龄") = Nothing '则清空年龄
    Else
        '否则计算月龄
        e.DataRow("月龄") = Date.Today.month - e.DataRow("出生日期").month
        If e.DataRow("月龄") < 0 Then '如果月龄小于0
            e.DataRow("月龄")  = e.DataRow("月龄") + 12
            e.DataRow("年龄") =  e.DataRow("年龄") -1
        End If
    End If
    If e.DataRow.IsNull("出生日期") Then '如果没有输入出生日期
        e.DataRow("日龄") = Nothing '则清空年龄
    Else
        '否则计算日龄
        e.DataRow("日龄") = Date.Today.day - e.DataRow("出生日期").day + 1
        If e.DataRow("日龄") < 0 Then '如果日龄小于0
            e.DataRow("日龄")  =  30 + e.DataRow("日龄")
            e.DataRow("月龄") =  e.DataRow("月龄") -1
        End If
    End If
End If
If e.DataCol.Name = "患者姓名" Then '如果更改的是姓名列
    If e.DataRow.IsNull("患者姓名") Then '姓名是否为空
        e.DataRow("拼音码") = Nothing '如果为空,则清除拼音码
    Else
        '否则从姓名列中提取拼音码
        e.DataRow("拼音码") = GetPY(e.DataRow("患者姓名"),True)
    End If
End If

 回到顶部
帅哥哟,离线,有人找我吗?
sxdoc
  2楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:童狐 帖子:278 积分:2387 威望:0 精华:0 注册:2011/8/18 8:33:00
  发帖心情 Post By:2012/11/3 21:11:00 [只看该作者]

上面的有错,下面对

If e.DataCol.Name = "出生日期" Then
    If e.DataRow.IsNull("出生日期") Then '如果没有输入出生日期
    Else
        '否则计算年龄
        e.DataRow("年龄") = Date.Today.Year - e.DataRow("出生日期").Year
    End If
    If e.DataRow.IsNull("出生日期") Then '如果没有输入出生日期
        e.DataRow("月龄") = Nothing '则清空月龄
    Else
        '否则计算月龄
        e.DataRow("月龄") = Date.Today.month - e.DataRow("出生日期").month
        If e.DataRow("月龄") < 0 Then '如果月龄小于0
            e.DataRow("月龄")  = e.DataRow("月龄") + 12
            e.DataRow("年龄") =  e.DataRow("年龄") -1
        End If
    End If
    If e.DataRow.IsNull("出生日期") Then '如果没有输入出生日期
        e.DataRow("日龄") = Nothing '则清空日龄
    Else
        '否则计算日龄
        e.DataRow("日龄") = Date.Today.day - e.DataRow("出生日期").day + 1
        If e.DataRow("日龄") < 0 Then '如果日龄小于0
            Dim intInputMonth As Integer = e.DataRow("出生日期").month '这是出生的月份
            Dim dt As New DateTime(DateTime.Today.Year, intInputMonth, 1) '计算该月份的天数
            Dim days As Integer = dt.AddMonths(1).DayOfYear - dt.DayOfYear '该月份的天数
            e.DataRow("日龄")  =  days + e.DataRow("日龄")
            e.DataRow("月龄") =  e.DataRow("月龄") -1
        End If
    End If
End If

 

这样计算出的一个人的年龄月龄日龄才符合实际

(开处方时3岁以上写年龄,1-3岁要写年月龄,三个月到1岁写月日龄,满月内写日龄)


 回到顶部
帅哥哟,离线,有人找我吗?
擎天柱
  3楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:二尾狐 帖子:542 积分:4243 威望:0 精华:4 注册:2008/9/1 8:27:00
  发帖心情 Post By:2012/11/3 21:18:00 [只看该作者]

如果用DateYMD,可能会简化一点


 回到顶部
帅哥哟,离线,有人找我吗?
擎天柱
  4楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:二尾狐 帖子:542 积分:4243 威望:0 精华:4 注册:2008/9/1 8:27:00
  发帖心情 Post By:2012/11/3 21:21:00 [只看该作者]

再用TimeSpan

 回到顶部
帅哥哟,离线,有人找我吗?
sxdoc
  5楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:童狐 帖子:278 积分:2387 威望:0 精华:0 注册:2011/8/18 8:33:00
  发帖心情 Post By:2012/11/3 21:53:00 [只看该作者]

见笑了

 


 回到顶部
帅哥哟,离线,有人找我吗?
sxdoc
  6楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:童狐 帖子:278 积分:2387 威望:0 精华:0 注册:2011/8/18 8:33:00
  发帖心情 Post By:2012/11/3 23:11:00 [只看该作者]

If e.DataCol.Name = "登记时间" Then '如果登记里间列的内容变动
Dim d1 As Date = e.DataRow("登记时间")
Dim d2 As Date = now
Dim t As TimeSpan = d2 - d1
End If
e.DataRow("登记未来小时数") = t.Hours
e.DataRow("登记未来天数") = t.Days

 回到顶部
帅哥哟,离线,有人找我吗?
sxdoc
  7楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:童狐 帖子:278 积分:2387 威望:0 精华:0 注册:2011/8/18 8:33:00
  发帖心情 Post By:2012/11/3 23:13:00 [只看该作者]


图片点击可在新窗口打开查看此主题相关图片如下:无标题.png
图片点击可在新窗口打开查看

 回到顶部
帅哥哟,离线,有人找我吗?
sxdoc
  8楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:童狐 帖子:278 积分:2387 威望:0 精华:0 注册:2011/8/18 8:33:00
  发帖心情 Post By:2012/11/3 23:16:00 [只看该作者]

If e.DataCol.Name = "登记时间" Then '如果登记里间列的内容变动
Dim d1 As Date = e.DataRow("登记时间")
Dim d2 As Date = now
Dim t As TimeSpan = d2 - d1
e.DataRow("登记未来小时数") = t.Hours
e.DataRow("登记未来天数") = t.Days
End If

 回到顶部