frmdwfy.frm

本系统可用于医院和专业体检中心的健康体检管理

    sngTextBottom = 272
    sngPageNumberTop = 285

    strSql = "select HealthID,YYRXM,SEX,TJRQ from SET_GRXX" _
                & " where GUID=" & lngGUID
    Set rsTemp = New ADODB.Recordset
    rsTemp.Open strSql, GCon, adOpenStatic, adLockOptimistic
    strHealthID = rsTemp("HealthID")
    strName = rsTemp("YYRXM")
    strSex = rsTemp("Sex")
    strTJRQ = Str(rsTemp("TJRQ"))
    rsTemp.Close
    
    sngZheKou = 1
    
    If strType = "" Then
        '********************************************************************
        '散检客户
        '********************************************************************
        strSql = "select XZTC,TCID from YY_SJDJ" _
                & " where GUID=" & lngGUID
    Else
        '********************************************************************
        '团检客户
        '********************************************************************
        strYYID = strType
        strSql = "select distinct XZTC,TCID from YY_TJDJTC,FZ_FZSJ" _
                & " where YY_TJDJTC.YYID=FZ_FZSJ.YYID" _
                & " and YY_TJDJTC.FZID=FZ_FZSJ.FZID" _
                & " and FZ_FZSJ.GUID=" & lngGUID
    End If
    Set rsTemp = New ADODB.Recordset
    rsTemp.Open strSql, GCon, adOpenStatic, adLockReadOnly
    If rsTemp("XZTC") = 1 Then
        blnTC = True
        lngTCID = rsTemp("TCID")
        
        '获取套餐名称，价格等信息
        strSql = "select * from SET_TC" _
                & " where TCID=" & lngTCID
        rsTemp.Close
        Set rsTemp = New ADODB.Recordset
        rsTemp.Open strSql, GCon, adOpenStatic, adLockReadOnly
        strTCMC = rsTemp("TCMC")
        curTCJG = rsTemp("TCJG")
    Else
        blnTC = False
    End If
    rsTemp.Close
    
    '提取体检项目
    If blnTC = False Then
        strSql = "select DXMC,DXJG,TCMC='',KSMC,SET_KSSZ.SXH,SET_DX.SXH from YY_SJDJDX,SET_DX,SET_KSSZ" _
                & " where YY_SJDJDX.GUID=" & lngGUID _
                & " and YY_SJDJDX.DXID=SET_DX.DXID" _
                & " and left(SET_DX.DXID,2)=SET_KSSZ.KSID" _
                & " order by SET_KSSZ.SXH,SET_DX.SXH"
    Else
        '首先提取属于套餐的项目
        strSql = "select DXMC,DXJG,TCMC='" & strTCMC & "',KSMC,SET_KSSZ.SXH,SET_DX.SXH from YY_SJDJDX,SET_DX,SET_KSSZ" _
                & " where YY_SJDJDX.GUID=" & lngGUID _
                & " and YY_SJDJDX.DXID=SET_DX.DXID" _
                & " and YY_SJDJDX.DXID in (" _
                    & "select DXID from SET_TCDX" _
                    & " where TCID=" & lngTCID & ")" _
                & " and left(SET_DX.DXID,2)=SET_KSSZ.KSID"
        strSql = strSql & " union "
        '连上不属于套餐的项目
        strSql = strSql & "select DXMC,DXJG,TCMC='',KSMC,SET_KSSZ.SXH,SET_DX.SXH from YY_SJDJDX,SET_DX,SET_KSSZ" _
                & " where YY_SJDJDX.GUID=" & lngGUID _
                & " and YY_SJDJDX.DXID=SET_DX.DXID" _
                & " and YY_SJDJDX.DXID not in (" _
                    & "select DXID from SET_TCDX" _
                    & " where TCID=" & lngTCID & ")" _
                & " and left(SET_DX.DXID,2)=SET_KSSZ.KSID"
                
        strSql = strSql & " order by SET_KSSZ.SXH,SET_DX.SXH"
    End If
    
    Set rsTemp = New ADODB.Recordset
    rsTemp.Open strSql, GCon, adOpenStatic, adLockOptimistic
    If rsTemp.EOF Then GoTo ExitLab
    curTotal = 0
    
    intPage = 1 '从第一页开始
    '打印第一页的标题
    GoSub PrintTitle
    
    rsTemp.MoveFirst
    With Printer
        '打印报表正文
        '循环打印所有记录
        intCurrLine = 1
        For i = 1 To rsTemp.RecordCount
            .FontSize = 9
            .FontBold = False
            '计算纵坐标
            sngCurrY = sngTextTop + (intCurrLine - 1) * .TextHeight("高度") * 1.5
            If sngCurrY > sngTextBottom Then '该分页
                Printer.NewPage
                intPage = intPage + 1
                GoSub PrintTitle
                
                intCurrLine = 1
                .FontSize = 9
                .FontBold = False
                '分页后重新计算纵坐标
                sngCurrY = sngTextTop + (intCurrLine - 1) * .TextHeight("高度") * 1.5
            End If
            '科室名称
            .CurrentX = sngTextLeft
            .CurrentY = sngCurrY
            Printer.Print rsTemp("KSMC")
            
            '大项名称
            .CurrentX = sngTextLeft + 30
            .CurrentY = sngCurrY
            Printer.Print rsTemp("DXMC")
            
            '套餐名称
            .CurrentX = sngTextLeft + 80
            .CurrentY = sngCurrY
            Printer.Print rsTemp("TCMC")
            
            If rsTemp("TCMC") = "" Then
                '大项价格
                .CurrentX = sngTextLeft + 120
                .CurrentY = sngCurrY
                Printer.Print IIf(IsNull(rsTemp("DXJG")), "", rsTemp("DXJG"))
                
                curOtherXMu = curOtherXMu + IIf(IsNull(rsTemp("DXJG")), 0, rsTemp("DXJG"))
            End If
            
            intCurrLine = intCurrLine + 1
            rsTemp.MoveNext
        Next
        
        '打印合计行
        '在最后一页上打印合计
        .FontSize = 9
        .FontBold = True
        sngCurrY = sngTextTop + (intCurrLine - 1) * .TextHeight("高度") * 1.5 + 5
        Printer.Line (sngTextLeft - 5, sngCurrY - 1.5)-(sngTextLeft + sngOtherJGeLeft + 5, sngCurrY - 1.5)
        .CurrentX = sngTextLeft
        .CurrentY = sngCurrY
        Printer.Print "总计："
        
        .CurrentX = sngTextLeft + 15
        .CurrentY = sngCurrY
        Printer.Print "套餐价格：" & curTCJG
        
        .CurrentX = sngTextLeft + 45
        .CurrentY = sngCurrY
        Printer.Print "折扣率：" & sngZheKou
        
        .CurrentX = sngTextLeft + 70
        .CurrentY = sngCurrY
        Printer.Print "加项费用：" & curOtherXMu
        
        .CurrentX = sngTextLeft + 110
        .CurrentY = sngCurrY
        Printer.Print "实际：" & CCur(curTCJG * sngZheKou + curOtherXMu)
        
        '为每个客户提交一次打印
        Printer.EndDoc
    End With
    GoTo ExitLab

'打印报表标题
PrintTitle:
    With Printer
        '打印标题
        .FontName = "宋体"
        .FontSize = 17
        .FontBold = True
        .FontItalic = False
        .FontUnderline = False
        
        .CurrentX = (Printer.ScaleWidth - .TextWidth("体检费用清单")) / 2
        .CurrentY = sngTitleTop
        Printer.Print "单位体检费用清单"
        
        '打印单位
        .FontSize = 11
        .CurrentX = (Printer.ScaleWidth - .TextWidth(gstrHospital)) / 2
        .CurrentY = sngHospitalTop
        Printer.Print gstrHospital
        
        '打印个人信息
        .FontSize = 9
        .CurrentX = sngTextLeft - 5
        .CurrentY = sngPersonTop
        Printer.Print "档案号：" & strHealthID
        
        .CurrentX = sngTextLeft + 43 - 5
        .CurrentY = sngPersonTop
        Printer.Print "姓名：" & strName
        
        .CurrentX = sngTextLeft + 75 - 5
        .CurrentY = sngPersonTop
        Printer.Print "性别：" & strSex
        
        .CurrentX = sngTextLeft + 95 - 5
        .CurrentY = sngPersonTop
        Printer.Print "体检日期：" & strTJRQ
        
        '打印报表题头
        Printer.DrawWidth = 5
        Printer.Line (sngTextLeft - 5, sngHeaderTop - 1.5)-(sngTextLeft + sngOtherJGeLeft + 5, sngHeaderTop - 1.5)
        
        .CurrentX = sngNameLeft
        .CurrentY = sngHeaderTop
        Printer.Print "姓名"
        
        .CurrentX = sngSexLeft
        .CurrentY = sngHeaderTop
        Printer.Print "性别"
        
        .CurrentX = sngTCanLeft
        .CurrentY = sngHeaderTop
        Printer.Print "套餐名称"
        
        .CurrentX = sngJGeLeft
        .CurrentY = sngHeaderTop
        Printer.Print "套餐价格(元)"
        
        .CurrentX = sngOtherJGeLeft
        .CurrentY = sngHeaderTop
        Printer.Print "加项价格(元)"
        
        Printer.Line (sngTextLeft - 5, sngHeaderTop + .TextHeight("高度") + 1)-(sngTextLeft + sngOtherJGeLeft + 5, sngHeaderTop + .TextHeight("高度") + 1)
    
        .CurrentX = (Printer.ScaleWidth - .TextWidth(Str(intPage))) / 2
        .CurrentY = sngPageNumberTop
        Printer.Print intPage
    End With
    Return
    
ExitLab:
    Me.MousePointer = 0
End Sub

Private Sub Form_Load()

End Sub