untmeasurecase.pas

简要说明:对医院幼儿心理情况做的一个调查,统计系统.

unit untMeasureCase;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, untBaseDialog, StdCtrls, Buttons, ExtCtrls, jpeg, DB, ADODB,
  Grids, DBGrids, untGlobalVar,IniFiles, fcButton, fcImgBtn;

type
  TfrmMeasureCase = class(TfrmBaseDialog)
    pnlLeft: TPanel;
    pnlRight: TPanel;
    Splitter1: TSplitter;
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    DBGrid1: TDBGrid;
    DBGrid2: TDBGrid;
    adsMeasure: TADODataSet;
    adsMeasureItem: TADODataSet;
    dsMeasure: TDataSource;
    dsMeasureItem: TDataSource;
    adsMeasurecode: TStringField;
    adsMeasureshortname: TStringField;
    adsMeasurename: TStringField;
    adsMeasureQuestionGrp: TStringField;
    adsMeasureIsUsed: TBooleanField;
    adsMeasureItemcode: TStringField;
    adsMeasureItemName: TStringField;
    adsMeasureItemItemValue: TBCDField;
    adsMeasureItemMeasurecode: TStringField;
    adsMeasureTested: TBooleanField;
    ADODataSet1: TADODataSet;
    StringField1: TStringField;
    StringField2: TStringField;
    StringField3: TStringField;
    StringField4: TStringField;
    BooleanField1: TBooleanField;
    BooleanField2: TBooleanField;
    ds1: TDataSource;
    btnTest: TfcImageBtn;
    btnExport: TfcImageBtn;
    procedure FormShow(Sender: TObject);
    procedure adsMeasureAfterScroll(DataSet: TDataSet);
    procedure btnTestClick(Sender: TObject);
    procedure DBGrid1DblClick(Sender: TObject);
    procedure btnExportClick(Sender: TObject);
  private
    FConn: TADOConnection;
    FLoginInfo: TUserRec;
    FFromMenu: Boolean;
    FChildrenID: Integer;
    FMeasureCode:string;
    procedure Cacldata(AChildren:TChildren;ADataType:SmallInt);
    procedure CaclXLData(AChildren:TChildren);
    procedure CaclQZData(AChildren:TChildren);
    procedure CaclXWData(AChildren:TChildren);
    procedure CaclGJData(AChildren:TChildren);
    { Private declarations }
  public
    { Public declarations }
    property Conn: TADOConnection read FConn write FConn;
    property LoginInfo: TUserRec read FLoginInfo write FLoginInfo;
    property FromMenu: Boolean read FFromMenu write FFromMenu default False;
    property ChildrenID: Integer read FChildrenID write FChildrenID;
    property MeasureCode :string  read  FMeasureCode write FMeasureCode ;
  end;

var
  frmMeasureCase: TfrmMeasureCase;

implementation

uses untDM, untAnswerInput, untGlobalFun, untSelectRecord;

const
  SQLText = 'select code,name,MeasureCode from tMeasure_Item where Measurecode in (select code from tMeasure where IsUsed=1)';

{$R *.dfm}

procedure TfrmMeasureCase.FormShow(Sender: TObject);
begin
  inherited;
  with adsMeasureItem do
  begin
    CreateDataSet;
    Open;
    with TADODataSet.Create(nil) do begin
      Connection := Conn;
      CommandText := SQLText;
      Active := true;
      while not Eof do begin
        adsMeasureItem.Append;
        adsMeasureItem['code'] := FieldByName('code').Value;
        adsMeasureItem['name'] := FieldByName('name').Value;
        adsMeasureItem['measurecode'] := FieldByName('measurecode').Value;
        adsMeasureItem['ItemValue'] := 0;
        adsMeasureItem.Post;
        Next;
      end;
      Free;
    end;
  end;
  with adsMeasure do
  begin
    AfterScroll := nil;
    CreateDataSet;
    Open;
    with TADODataSet.Create(nil) do begin
      Connection := Conn;
      CommandText := 'select * from tMeasure where IsUsed=1';
      Active := True;
      while not Eof do begin
        adsMeasure.Append;
        adsMeasure['code'] := FieldByName('code').Value;
        adsMeasure['shortname'] := FieldByName('ShortName').Value;
        adsMeasure['name'] := FieldByName('name').Value;
        adsMeasure['QuestionGrp'] := FieldByName('QuestionGrp').Value;
        adsMeasure['IsUsed'] := FieldByName('IsUsed').Value;
        adsMeasure['Tested'] := false;
        Next;
      end;
      Free;
    end;
    AfterScroll := adsMeasureAfterScroll;
    First;
  end;
end;

procedure TfrmMeasureCase.adsMeasureAfterScroll(DataSet: TDataSet);
begin
  inherited;
  with adsMeasureItem do begin
    if not Active then Exit;
    if Filtered then Filtered := false;
    Filter := 'measurecode='+QuotedStr(DataSet.fieldbyname('code').AsString);
    Filtered := true;
  end;
  btnExport.Enabled := DataSet['Tested'];
end;

procedure TfrmMeasureCase.btnTestClick(Sender: TObject);
var
  adsTmp: TADODataSet;
  Children:TChildren;
begin
  inherited;
  with adsMeasure do
  begin
    if (not Active) or (Recordcount=0) then Exit;
    adsTmp := GetMeasureResult(Conn, fieldbyname('code').AsString,FChildrenID);
    if adsTmp = nil then Exit;
    if not adsTmp.Active then
    begin
      adsTmp.Free;
      Exit;
    end;
    try
      adsTmp.First;
      adsMeasureItem.DisableControls;
      while not adsTmp.Eof do
       begin
        if adsMeasureItem.Locate('code',adsTmp['code'],[]) then
        begin
          adsMeasureItem.Edit;
          adsMeasureItem['ItemValue'] := adsTmp['score'];
          adsMeasureItem.Post;
        end;
        adsTmp.Next;
      end;
      if not (adsMeasure.State in [dsInsert, dsEdit]) then adsMeasure.Edit;
      adsMeasure['Tested'] := True;
      adsMeasure.Post;
      FMeasureCode:=adsMeasure['Code'];
      btnExport.Enabled := true;

    finally
      adsMeasureItem.EnableControls;
      adsTmp.Free;
    end;
  end;
end;

procedure TfrmMeasureCase.DBGrid1DblClick(Sender: TObject);
begin
  inherited;
  if adsMeasure.Active and (adsMeasure.RecordCount>0) then
    btnTestClick(btnTest);
end;

procedure TfrmMeasureCase.btnExportClick(Sender: TObject);
var
  PatientInfo : TPatientInfo;
  iDatatype:SmallInt;
  iResultID:Integer;
  Children:TChildren;
begin
  inherited;
  //ChildrenID := SelectRecord;
  if ChildrenID=-1 then Exit;
  btnExport.Enabled:=False;
  //获取试卷分类
  with TADODataSet.Create(Self) do
  begin
    try
      Connection := Conn;
      CommandText :=Format('select typeid from tMeasure where code=%s',[QuotedStr(MeasureCode)]);
      Active:=True;
      iDatatype:=Fields[0].AsInteger;
      Active:=False;
      //读取儿童资料  出生年月
      CommandText:=Format('select * from tChildren  where iautoID=%d',[ChildrenID]);
      Active:=True;
      Children.iAutoID:=ChildrenID;
      Children.Code:=fieldbyname('code').Value;
      Children.Sex:=fieldbyname('Sex').Value;
      Children.BirthYear:=fieldbyname('BirthYear').Value;
      Children.BirthMonth:=fieldbyname('BirthMonth').Value;
      Active:=False;
      //保存检查结果主表
      DM.cnn.BeginTrans;
      try
        ExecDBCommand(DM.cnn, 'insert into tChildrenResult(ChildrenID, MeasureCode) '
                          + ' values ('+inttostr(ChildrenID)+','+QuotedStr(MeasureCode)+')');
        iResultID := GetDBValue(DM.cnn, 'select iAutoID from tChildrenResult '
          + ' where ChildrenID='+IntToStr(ChildrenID)+' and MeasureCode='+QuotedStr(MeasureCode));
        //修改问卷
        ExecDBCommand(DM.cnn,Format('update tQuestionDa set ResultID=%d where ChildRenID=%d',[iResultID,ChildrenID]));
        //保存明细数据
        adsMeasureItem.First;
        while not adsMeasureItem.Eof do
        begin
          ExecDBCommand(DM.cnn, 'insert into tChildrenResult_Mx(CheckResultID,ItemCode,ItemValue)'
           +' values('+IntToStr(iResultID)+','+QuotedStr(adsMeasureItem.Fields[0].AsString)+','
                       +QuotedStr(adsMeasureItem.Fields[3].AsString)+')');
          adsMeasureItem.Next;
        end;
        Cacldata(Children,iDatatype);
        DM.cnn.CommitTrans;
        ModalResult:=mrOK;
       except
        DM.cnn.RollbackTrans;
        raise Exception.Create('导入资料错误！');
       end;
       
    finally
      Free;
    end;
  end;
end;
procedure TfrmMeasureCase.CaclXLData(AChildren:TChildren);
var
  strResult,strSQL:string;
  adsTmp:TADODataSet;
begin
   strSQL := '  select mi.Content,crm.ItemCode '
               +' from tChildrenResult cr '
               +'   inner join tChildrenResult_Mx crm on cr.iAutoID=crm.CheckResultID '
               +'   inner join tMeasure_Item mi on crm.ItemCode=mi.Code '
               +' where ChildrenID='+IntToStr(ChildrenID)
               +'   and cr.MeasureCode = '+QuotedStr(MeasureCode)
               +'   and (crm.ItemValue=''是'' or crm.ItemValue=''1'')';
  adsTmp := GetDataSet(DM.cnn, strSQL);
  try
  if adsTmp.IsEmpty then
     begin
       strResult := XLGood;
       strSQL := 'insert into tXLResult(ChildrenID,sResult) '
                 +' values('+IntToStr(ChildrenID)+','+QuotedStr(strResult)+')';
       ExecDBCommand(DM.cnn, strSQL);
     end
     else
     begin
       with adsTmp do
       begin
         First;
         while not eof do
         begin
           strSQL := 'select Method from tReportText '
                    +'where ItemCode='+QuotedStr(Fieldbyname('Itemcode').AsString);
           strResult:=VarToStr(GetDBValue(DM.cnn,strSQL));
           strSQL := 'insert into tXLResult(ChildrenID,sResult,sSuggest) '
                 +' values('+IntToStr(ChildrenID)+','+QuotedStr(Fieldbyname('Content').AsString)+','
                 +QuotedStr(strResult)+')';
           ExecDBCommand(DM.cnn, strSQL);
           Next;
         end;
       end;
    end;
    finally
      if Assigned(adsTmp) then
           adsTmp.free;
    end;
end;

{1.      平易型：5个维度中大于均值的不超过2个，并且都小于均值加一个标准差；
2.	麻烦型：5个维度中有4个或5个大于均值（其中必须包括反应强度），并且其中两个必须大于均值加一个标准差。
3.	发动缓慢型：首先要求活动水平小于均值减一个标准差，趋避性、适应性以及心境都大于均值加一个标准差，同时反应强度小于均值。如果趋避性或适应性只有一项大于均值加一个标准差，则活动水平必须小于均值加半个标准差，同时心境大于均值减半个标准差。
4.	中间偏麻烦型：5个维度中有4个或5个大于均值并有一个大于均值加一个标准差。或者有2个或3个维度大于均值加一个标准差。
5.	中间偏平易型：不属于以上分类标准者。
}
procedure TfrmMeasureCase.CaclQZData(AChildren:TChildren);
var
  Lvl: Integer;
  birth,itemvalue, Avg, SD: Double;
  strSQL,strResult,strItemValue:string;
  adsTmp, adsStd,adsreporttest: TADODataSet;
  jlxAvg,jlxStd:Integer;
  quxavg,quxstd:Integer;
  syxAvg,syxStd:Integer;
  fyqdAvg,fyqdStd:Integer;
  xjAvg,xjStd,xjStd_h:Integer;
  hdspAvg,hdspStd,hdspStd_h:Integer;
  QZCode,JLCode,QBCode ,SYCode ,FYCode,XJCode,HDCode : string;
  QZType1,QZType2,QZType3,QZType4,QZType5:string;
  iniFile: TIniFile;
begin
  strSQL := ' select crm.ItemCode,crm.ItemValue '
                   +' from tChildrenResult cr '
                   +' inner join tChildrenResult_Mx crm on cr.iAutoID=crm.CheckResultID '
                   +' where ChildrenID='+IntToStr(ChildrenID)
                   +'   and cr.MeasureCode =' +QuotedStr(MeasureCode)
                   +'   and crm.ItemCode <> ' +QuotedStr(QZCode);
        //气质类型
  adsTmp := GetDataSet(DM.cnn, strSQL);
  adsreporttest:=TADODataSet.Create(nil);
  iniFile := TIniFile.Create(ExtractFilePath(Application.ExeName) + 'Ini\PI.ini');
  try
    adsreporttest.Connection:=DM.cnn;

    QZCode:=iniFile.ReadString('Code', 'QZCode', '0000000013');
    JLCode:=iniFile.ReadString('Code', 'JLCode', '0000000015');
    QBCode:=iniFile.ReadString('Code', 'QBCode', '0000000016');
    SYCode:=iniFile.ReadString('Code', 'SYCode', '0000000017');
    FYCode:=iniFile.ReadString('Code', 'FYCode', '0000000018');
    XJCode:=iniFile.ReadString('Code', 'XJCode', '0000000019');
    HDCode:=iniFile.ReadString('Code', 'HDCode', '0000000014');

    QZType1:=iniFile.ReadString('ReportText', 'QZType1', '平易型');
    QZType2:=iniFile.ReadString('ReportText', 'QZType2', '麻烦型');
    QZType3:=iniFile.ReadString('ReportText', 'QZType3', '发动缓慢型');
    QZType4:=iniFile.ReadString('ReportText', 'QZType4', '中间偏麻烦型');
    QZType5:=iniFile.ReadString('ReportText', 'QZType5', '中间偏平易型');

    strSQL := ' select ItemCode,crm.ItemValue '