⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 untmeasurecase.pas

📁 简要说明:对医院幼儿心理情况做的一个调查,统计系统.
💻 PAS
📖 第 1 页 / 共 2 页
字号:
              +' from tChildrenResult cr '
              +' inner join tChildrenResult_Mx crm on cr.iAutoID=crm.CheckResultID '
              +' where ChildrenID='+IntToStr(ChildrenID)
              +'   and cr.MeasureCode =' +QuotedStr(MeasureCode);
    adsreporttest.CommandText:=strSQL;
    adsreporttest.Open;
    strSQL := '  select ItemCode,AvgValue,SDValue=SDValue '
             +' from tJudgeStd js  inner join tJudgeStd_Mx jsm on js.iAutoID=jsm.JSID '
             +' where js.MeasureCode=' +QuotedStr(MeasureCode)
             +'   and js.iType=0 '
             +'   and Sex = '+IntToStr(AChildren.Sex);
    adsStd:=GetDataSet(DM.cnn,strSQL);
     // 节律性
    if adsreporttest.Locate('ItemCode',JLCode,[]) then
       itemvalue:=adsreporttest.fieldbyname('ItemValue').Value
    else
       itemvalue:=0;
    if adsStd.Locate('ItemCode',JLCode,[]) then
       begin
         Avg := adsStd.fieldbyname('avgvalue').Value;
         SD  := adsStd.fieldbyname('SDValue').Value;
       end
       else
        begin
          Avg:=0;
          Sd:=0;
        end;
     if itemvalue>Avg then jlxAvg:=1 else jlxAvg:=0;
     if itemvalue>Avg+SD  then jlxStd:=1 else jlxStd:=0;
     //趋避性
     if adsreporttest.Locate('ItemCode',QBCode,[]) then
        itemvalue:=adsreporttest.fieldbyname('ItemValue').Value
     else
       itemvalue:=0;
     if adsStd.Locate('ItemCode',QBCode,[]) then
        begin
          Avg := adsStd.fieldbyname('avgvalue').Value;
          SD  := adsStd.fieldbyname('SDValue').Value;
        end
        else
        begin
          Avg:=0;
          Sd:=0;
        end;
      if itemvalue>Avg then quxavg:=1 else quxavg:=0;
      if itemvalue>Avg+SD  then quxStd:=1 else quxStd:=0;
      //适应性
      if adsreporttest.Locate('ItemCode',SYCode,[]) then
         itemvalue:=adsreporttest.fieldbyname('ItemValue').Value
      else
         itemvalue:=0;
      if adsStd.Locate('ItemCode',SYCode,[]) then
        begin
          Avg := adsStd.fieldbyname('avgvalue').Value;
          SD  := adsStd.fieldbyname('SDValue').Value;
        end
        else
        begin
          Avg:=0;
          Sd:=0;
        end;
      if itemvalue>Avg then syxAvg:=1 else syxAvg:=0;
      if itemvalue>Avg+SD  then syxStd:=1 else syxStd:=0;
      //反应强度
      if adsreporttest.Locate('ItemCode',FYCode,[]) then
         itemvalue:=adsreporttest.fieldbyname('ItemValue').Value
      else
        itemvalue:=0;
      if adsStd.Locate('ItemCode',FYCode,[]) then
        begin
          Avg := adsStd.fieldbyname('avgvalue').Value;
          SD  := adsStd.fieldbyname('SDValue').Value;
        end
        else
        begin
          Avg:=0;
          Sd:=0;
        end;
      if itemvalue>Avg then fyqdAvg:=1 else fyqdAvg:=0;
      if itemvalue>Avg+SD  then fyqdStd:=1 else fyqdStd:=0;
      // 心境
      if adsreporttest.Locate('ItemCode',XJCode,[]) then
          itemvalue:=adsreporttest.fieldbyname('ItemValue').Value
      else
         itemvalue:=0;
      if adsStd.Locate('ItemCode',XJCode,[]) then
        begin
          Avg := adsStd.fieldbyname('avgvalue').Value;
          SD  := adsStd.fieldbyname('SDValue').Value;
        end
        else
        begin
          Avg:=0;
          Sd:=0;
        end;
       if itemvalue>Avg then xjAvg:=1 else xjAvg:=0;
       if itemvalue>Avg+SD  then xjStd:=1 else xjStd:=0;
       if itemvalue>Avg+0.5*SD  then xjStd_h:=1 else xjStd_h:=0;

       if  adsreporttest.Locate('ItemCode',HDCode,[]) then
           itemvalue:=adsreporttest.fieldbyname('ItemValue').Value
        else
            itemvalue:=0;
          if adsStd.Locate('ItemCode',HDCode,[]) then
        begin
          Avg := adsStd.fieldbyname('avgvalue').Value;
          SD  := adsStd.fieldbyname('SDValue').Value;
        end
        else
        begin
          Avg:=0;
          Sd:=0;
        end;
        if itemvalue>Avg then hdspAvg:=1 else hdspAvg:=0;
        if itemvalue<Avg-SD   then hdspStd:=1 else hdspStd:=0;
        if itemvalue<Avg-SD *0.5  then hdspStd_h:=1 else hdspStd_h:=0;

     if (jlxAvg+quxavg+syxAvg+fyqdAvg+xjAvg<3) and (jlxStd+quxstd+syxStd+fyqdStd+xjStd=0) then
        strResult:=QZType1
        else if (jlxAvg+quxavg+syxAvg+fyqdAvg+xjAvg>3) and (jlxStd+quxstd+syxStd+fyqdStd+xjStd=2) and (fyqdAvg=1) then
          strResult:=QZType2
          else if ((hdspStd=1) and (quxstd+syxStd+xjStd=3) and (fyqdStd=0)) or ((quxstd+syxStd=1) and (hdspStd_h=1) and (xjStd_h=1)) then
            strResult:=QZType3
              else if  ((jlxAvg+quxavg+syxAvg+fyqdAvg+xjAvg>3) and (jlxStd+quxstd+syxStd+fyqdStd+xjStd=1)) or ((jlxStd+quxstd+syxStd+fyqdStd+xjStd=2) or (jlxStd+quxstd+syxStd+fyqdStd+xjStd=3)) then
               strResult:=QZType4  else strResult:=QZType5;

      strResult:=QZType+strResult;
      strSQL := 'insert into tQZTableResult(childrenid, ItemCode, sResult) '
               +' values('+IntToStr(ChildrenID)+','
               +QuotedStr(QZCode)+','
               +QuotedStr(strResult)+')';
     ExecDBCommand(DM.cnn, strSQL);
     //取得标准
     strSQL := '  select ItemCode,AvgValue,SDValue '
                 +' from tJudgeStd js  inner join tJudgeStd_Mx jsm on js.iAutoID=jsm.JSID '
                 +' where js.MeasureCode=' +QuotedStr(MeasureCode)
                 +'   and js.iType=0 '
                 +'   and Sex = '+IntToStr(AChildren.Sex);
               {  +'   and AgeBegin<='+FloatToStr(birth)
                 +'   and AgeEnd >='+FloatToStr(birth); }
     adsStd.Close;
     adsStd.CommandText:=strSQL;
     adsStd.Open;
     with adsTmp do
     begin
        First;
        while not Eof do
        begin
          if adsStd.Locate('ItemCode',FieldbyName('ItemCode').Value, []) then
          begin
            Avg := adsStd.fieldbyname('avgvalue').Value;
            SD  := adsStd.fieldbyname('SDValue').Value;
            if FieldByName('ItemValue').Value < Avg-2*SD then Lvl := -2
            else if FieldByName('ItemValue').Value < Avg-SD then Lvl := -1
                 else if FieldByName('ItemValue').Value <= Avg+SD then Lvl := 0
                 else if FieldByName('ItemValue').Value <= Avg+2*SD then Lvl := 1
                      else Lvl := 2;
             strSQL := 'select discript=isnull(discript,''''),Method=isnull(Method,'''') from tReportText '
                      +'where ItemCode='+QuotedStr(Fieldbyname('Itemcode').AsString)
                      +'  and lvl='+IntToStr(Lvl);
             adsreporttest.Active:=False;
             adsreporttest.CommandText:=strSQL;
             adsreporttest.Active:=True;
             if Trim(strResult) <> '' then
             begin
               strSQL := 'insert into tQZTableResult(childrenid, ItemCode, sResult,sSuggest) '
                        +' values('+IntToStr(ChildrenID)+','
                                   +QuotedStr(Fieldbyname('Itemcode').AsString)+','
                                   +QuotedStr(adsreporttest.Fieldbyname('discript').AsString)+','
                                   +QuotedStr(adsreporttest.Fieldbyname('Method').AsString)+')';
                ExecDBCommand(DM.cnn, strSQL);
              end;
           end;
           Next;
        end;
      end;
   finally
        iniFile.Free;
        if Assigned(adsTmp) then
           adsTmp.free;
        if Assigned(adsStd) then
           adsStd.Free;
        if Assigned(adsreporttest) then
           adsreporttest.Free;
   end;
end;

procedure TfrmMeasureCase.CaclXWdata(AChildren:TChildren);
var
  itemvalue, Avg, SD: Double;
  strSQL,strResult,strItemValue:string;
  adsTmp, adsStd,adsreporttest: TADODataSet;
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);
  adsTmp := GetDataSet(DM.cnn, strSQL);
  strSQL := '  select ItemCode,AvgValue  from tJudgeStd js '
             +'   inner join tJudgeStd_Mx jsm on js.iAutoID=jsm.JSID '
             +' where js.MeasureCode=' +QuotedStr(MeasureCode)
             +'   and js.iType=1  and Sex = '+IntToStr(AChildren.Sex);
  adsStd := GetDataSet(DM.cnn, strSQL);
  adsreporttest:=TADODataSet.Create(nil);
  try
    adsreporttest.Connection:=dm.cnn;
    with adsTmp do
    begin
      first;
      while not Eof do
        begin
          if adsStd.Locate('ItemCode',FieldbyName('ItemCode').Value, []) then
          begin
            Avg := adsStd.fieldbyname('avgvalue').AsFloat;
            if FieldByName('ItemValue').AsFloat >= Avg then
            begin
              strResult := '*';
              strSQL := 'select discript=isnull(discript,''''),Method=isnull(Method,'''') from tReportText '
                      +'where ItemCode='+QuotedStr(Fieldbyname('Itemcode').AsString)
                      +'  and lvl=6';
            end
            else
            begin
              strResult := '';
               strSQL := 'select discript=isnull(discript,''''),Method=isnull(Method,'''') from tReportText '
                      +'where ItemCode='+QuotedStr(Fieldbyname('Itemcode').AsString)
                      +'  and lvl=5';
            end;
            adsreporttest.Active:=False;
            adsreporttest.CommandText:=strSQL;
            adsreporttest.Active:=True;
            if FieldByName('ItemValue').AsString = '.' then
                strItemValue := '-1'
            else strItemValue := FieldByName('ItemValue').AsString;
            strSQL := 'insert into tXWResult(childrenid, ItemCode, NormalValue, CalcValue, FlagText,sSuggest) '
                     +' values('+IntToStr(ChildrenID)+','
                     +QuotedStr(Fieldbyname('Itemcode').AsString)+','
                     +Adsstd.fieldbyname('avgvalue').AsString+','
                     +strItemValue+','
                     +QuotedStr(strResult)+','+QuotedStr(adsreporttest.Fieldbyname('Method').AsString)+')';
            ExecDBCommand(DM.cnn, strSQL);
          end;
          Next;
        end;
      end;
  finally
    if Assigned(adsTmp) then
       adsTmp.free;
    if Assigned(adsStd) then
       adsStd.Free;
    if Assigned(adsreporttest) then
       adsreporttest.Free;   
  end;
end;

procedure TfrmMeasureCase.CaclGJData(AChildren:TChildren);
var
  Lvl:Integer;
  itemvalue, Avg, SD: Double;
  strSQL,strResult,strItemValue:string;
  adsTmp, adsStd: TADODataSet;
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);
     adsTmp := GetDataSet(DM.cnn, strSQL);
     try
       //取得标准
       strSQL := '  select ItemCode,AvgValue,SDValue '
                +' from tJudgeStd js inner join tJudgeStd_Mx jsm on js.iAutoID=jsm.JSID '
                +' where js.MeasureCode=' +QuotedStr(MeasureCode)
                +'   and js.iType=0 and Sex = '+IntToStr(AChildren.Sex);
              {  +'   and AgeBegin<='+FloatToStr(birth)
                +'   and AgeEnd >='+FloatToStr(birth); }
        adsStd := GetDataSet(DM.cnn, strSQL);
        with adsTmp do
        begin
          first;
          while not Eof do
          begin
            if adsStd.Locate('ItemCode',FieldbyName('ItemCode').Value, []) then
            begin
              Avg := adsStd.fieldbyname('avgvalue').Value;
              SD  := adsStd.fieldbyname('SDValue').Value;
              if FieldByName('ItemValue').Value < Avg-2*SD then Lvl := -2
              else if FieldByName('ItemValue').Value < Avg-SD then Lvl := -1
                   else if FieldByName('ItemValue').Value <= Avg+SD then Lvl := 0
                        else if FieldByName('ItemValue').Value <= Avg+2*SD then Lvl := 1
                             else Lvl := 2;
              strSQL := 'select RptText=isnull(discript,'''')+isnull(Method,'''') from tReportText '
                       +'where ItemCode='+QuotedStr(Fieldbyname('Itemcode').AsString)
                       +'  and lvl='+IntToStr(Lvl);
              strResult := VarToStr(GetDBValue(DM.cnn, strSQL));
              if Trim(strResult) <> '' then
               begin
                strSQL := 'insert into tGJResult(childrenid, ItemCode, sResult) '
                         +' values('+IntToStr(ChildrenID)+','
                                    +QuotedStr(Fieldbyname('Itemcode').AsString)+','
                                    +QuotedStr(strResult)+')';
                ExecDBCommand(DM.cnn, strSQL);
              end;
            end;
            Next;
          end;
        end;
     finally
       if Assigned(adsTmp) then
          adsTmp.free;
       if Assigned(adsStd) then
          adsStd.Free;
     end;
end;

procedure TfrmMeasureCase.Cacldata(AChildren:TChildren;ADataType:SmallInt);
var
  Lvl: Integer;
  birth,itemvalue, Avg, SD: Double;
  strSQL,strResult,strItemValue:string;
  adsTmp, adsStd,adsreporttest: TADODataSet;

begin
  birth:=AChildren.BirthYear+AChildren.BirthMonth/100.0;
  case ADataType of
    1 :  CaclXLData(AChildren);
    2 :  //气质   修改显示建议
    begin
        CaclQZData(AChildren);
    end;
    3 : //行为
    begin
       CaclXWdata(AChildren);
    end;
    4 : //感觉统合功能量表
    begin
      CaclGJData(AChildren);
     // end case
    end;
  end;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -